UpdateLayerWindow ...

02/07/2012 - 16:04 von Heinz-Mario Frühbeis | Report spam
Hallo!

'PicPath1' ist ein irgendein einfarbiges Bitmap.
'PicPath' ist ein Icon im *.bmp-Format. Dieses Icon *hat* herum einen
schwarzen Rand.
Wenn man mit folgendem Code als Hintergrund 'PicPath1' nimmt und darauf dann
'PicPath' blendet, dann erscheint *kein* schwarzer Rand!

Warum ist das so? <haar am raufen>

(Der Hintergrund dazu ist, daß ich versuche das in dem API (CreateWindowEx,
etc.) wiederzugeben und da bekomme ich einfach diesen schwarzen Rand nicht
weg.)

Mit Gruß
Heinz-Mario Frühbeis

Option Explicit
Private Const DEF_APP_TRANSPARENCY = 140
Private Const PicPath As String =
"D:\VB\UpdateLayer\Using_32pp1724133242004\1.bmp"
Private Const PicPath1 As String =
"D:\VB\UpdateLayer\Using_32pp1724133242004\83.bmp"

Private Const vbLongSize As Long = 2147483647
Private Const ULW_OPAQUE = &H4 ' Used to tell UpdateLayeredWindow to
draw the window without alpha-blending
Private Const ULW_COLORKEY = &H1 ' Used to draw the window with a color
key
Private Const ULW_ALPHA = &H2 ' Used to draw the window with
alpha-blending.
Private Const BI_RGB As Long = 0&
Private Const DIB_RGB_COLORS As Long = 0
Private Const AC_SRC_ALPHA As Long = &H1
Private Const AC_SRC_OVER = &H0
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE As Long = -20
Private Const HWND_TOPMOST As Long = -1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1

' Types

' Used by UpdateLayeredWindow and AlphaBlend
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type

Private Type Size
cx As Long
cy As Long
End Type

Private Type POINTAPI
x As Long
y As Long
End Type

' Used to set the positions for our balls of light
Private Type LightBall
LightX As Integer
LightY As Integer
XVel As Integer
YVel As Integer
Alpha As Integer
AlphaIncrement As Integer
End Type

' Not really used
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

' Function declarations
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As
Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function AlphaBlend Lib "Msimg32.dll" (ByVal hdcDest As
Long, ByVal nXOriginDest As Long, ByVal lnYOriginDest As Long, ByVal
nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal
nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long,
ByVal nHeightSrc As Long, ByVal bf As Long) As Boolean
Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As
Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As
Long, pptSrc As Any, ByVal crKey As Long, ByRef pblend As BLENDFUNCTION,
ByVal dwFlags As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As
Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any,
ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As
Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long,
ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As
Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long,
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As
Long, ByVal cy As Long, ByVal wFlags As Long) As Long

' Variable Declarations
Private m_mainSurfaceDC As Long
Private m_mainSurfaceBitmap As Long
Private m_backSurfaceDC As Long
Private m_lightMapDC As Long
Private m_lightMapBitmap As Long
Private m_lmWidth As Long
Private m_lmHeight As Long
Private m_backPic As StdPicture
Dim m_backHeight As Long
Dim m_backWidth As Long
Private m_blendFunc As BLENDFUNCTION
Private m_backBlendFUnc As Long
Private m_windowSize As Size
Private m_srcPoint As POINTAPI
Private m_lBlendFunc As Long
Private m_lightRows As Integer
Private m_lightColumns As Integer
Private m_lightBalls(0 To 4) As LightBall

Private rVal As Long

Private Sub Form_DblClick()
Unload Me
End Sub

Private Sub Form_Initialize()
Dim tempBI As BITMAPINFO ' Holds the bitmap information
Dim tempBlend As BLENDFUNCTION ' Used to specify what kind of blend
we want to perform
Dim lBlendFunc As Long
Dim I As Long
SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_LAYERED
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
BuildLightMap
m_mainSurfaceDC = CreateCompatibleDC(Me.hdc)
m_backSurfaceDC = CreateCompatibleDC(Me.hdc)
Set m_backPic = LoadPicture(PicPath1)
m_backHeight = ScaleY(m_backPic.Height, vbHimetric, vbPixels)
m_backWidth = ScaleX(m_backPic.Width, vbHimetric, vbPixels)
SelectObject m_backSurfaceDC, m_backPic.handle
With tempBI.bmiHeader
.biSize = Len(tempBI.bmiHeader)
.biBitCount = 32 ' Each pixel is 32 bit's wide
.biHeight = Me.ScaleHeight ' Height of the form
.biWidth = Me.ScaleWidth ' Width of the form
.biPlanes = 1 ' Always set to 1
.biSizeImage = .biWidth * .biHeight * (.biBitCount / 8) ' This is
the number of bytes that the bitmap takes up. It is equal to the
Width*Height*ByteCount (bitCount/8)
End With
m_mainSurfaceBitmap = CreateDIBSection(m_mainSurfaceDC, tempBI,
DIB_RGB_COLORS, ByVal 0, 0, 0)
SelectObject m_mainSurfaceDC, m_mainSurfaceBitmap
With tempBlend
.AlphaFormat = 0
.BlendFlags = 0
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = DEF_APP_TRANSPARENCY
End With
CopyMemory m_backBlendFUnc, tempBlend, 4
rVal = AlphaBlend(m_mainSurfaceDC, 0, 0, Me.ScaleWidth, Me.ScaleHeight _
, m_backSurfaceDC, 0, 0, m_backWidth, m_backHeight, m_backBlendFUnc)
m_lightRows = (m_backWidth / 32) - 1
m_lightColumns = (m_backHeight / 32) - 1
m_srcPoint.x = 0
m_srcPoint.y = 0
m_windowSize.cx = Me.ScaleWidth
m_windowSize.cy = Me.ScaleHeight
With m_blendFunc
.AlphaFormat = AC_SRC_ALPHA ' Now we sent this to AC_SRC_ALPHA
since our bitmap
.BlendFlags = 0
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
End With
CopyMemory m_lBlendFunc, m_blendFunc, 4
PaintIcon
'BitBlt
End Sub

Private Sub PaintIcon()
rVal = AlphaBlend(m_mainSurfaceDC, 0, 0, Me.ScaleWidth, Me.ScaleHeight _
, m_backSurfaceDC, 0, 0, m_backWidth, m_backHeight, m_backBlendFUnc)
With m_lightBalls(0)
AlphaBlend m_mainSurfaceDC, 40, 5, m_lmWidth _
, m_lmHeight, m_lightMapDC, 0, 0, m_lmWidth, m_lmHeight,
m_lBlendFunc
End With
rVal = UpdateLayeredWindow(Me.hwnd, Me.hdc, ByVal 0, m_windowSize _
, m_mainSurfaceDC, m_srcPoint, 0, m_blendFunc, ULW_ALPHA)
End Sub

Private Sub BuildLightMap()
Dim tempPic As StdPicture
Dim tempDC As Long
Dim tempBI As BITMAPINFO
Dim tempBlend As BLENDFUNCTION
Dim lBlend As Long
Dim I As Long
tempDC = CreateCompatibleDC(Me.hdc)
Set tempPic = LoadPicture(PicPath)
SelectObject tempDC, tempPic
m_lmWidth = ScaleX(tempPic.Width, vbHimetric, vbPixels)
m_lmHeight = ScaleY(tempPic.Height, vbHimetric, vbPixels)
m_lightMapDC = CreateCompatibleDC(Me.hdc)
With tempBI.bmiHeader
.biSize = Len(tempBI.bmiHeader)
.biBitCount = 32 ' Each pixel is 32 bit's wide
.biHeight = m_lmHeight
.biWidth = m_lmWidth
.biPlanes = 1 ' Always set to 1
.biSizeImage = .biWidth * .biHeight * (.biBitCount / 8) ' This is
the number of bytes that the bitmap takes up. It is equal to the
Width*Height*ByteCount (bitCount/8)
End With
m_lightMapBitmap = CreateDIBSection(m_lightMapDC, tempBI _
, DIB_RGB_COLORS, ByVal 0, 0, 0)
SelectObject m_lightMapDC, m_lightMapBitmap
With tempBlend
.AlphaFormat = 0
.BlendFlags = 0
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 254
End With
CopyMemory lBlend, tempBlend, 4
AlphaBlend m_lightMapDC, 0, 0, m_lmWidth, m_lmHeight _
, tempDC, 0, 0, m_lmWidth, m_lmHeight, lBlend
Set tempPic = Nothing
DeleteDC tempDC
End Sub

Private Sub Form_Unload(Cancel As Integer)
' Destroy the objects
DeleteObject m_mainSurfaceBitmap
DeleteDC m_mainSurfaceDC
DeleteObject m_lightMapBitmap
DeleteDC m_lightMapDC
Set m_backPic = Nothing
DeleteDC m_backSurfaceDC
End Sub
 

Lesen sie die antworten

#1 Heinz-Mario Frühbeis
03/07/2012 - 14:16 | Warnen spam
[...]

Ähnliche fragen