|
Option Explicit
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) _
As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject _
As Long) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 _
As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 _
As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn _
As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd _
As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Public cmdDc As Long
Public Function picTranz(cPic As PictureBox) As Long
Dim lHoch As Long
Dim lBreit As Long
Dim lTemp As Long
Dim lSkin As Long
Dim lStart As Long
Dim lZeile As Long
Dim lSpalte As Long
Dim lBackColor As Long
lSkin = CreateRectRgn(0, 0, 0, 0)
With cPic
lHoch = .Height / Screen.TwipsPerPixelY
lBreit = .Width / Screen.TwipsPerPixelX
lBackColor = GetPixel(.hDC, 0, 0)
For lZeile = 0 To lHoch - 1
lSpalte = 0
Do While lSpalte < lBreit
Do While lSpalte < lBreit And _
GetPixel(.hDC, lSpalte, lZeile) = lBackColor
lSpalte = lSpalte + 1
Loop
If lSpalte < lBreit Then
lStart = lSpalte
Do While lSpalte < lBreit And _
GetPixel(.hDC, lSpalte, lZeile) <> lBackColor
lSpalte = lSpalte + 1
Loop
If lSpalte > lBreit Then lSpalte = lBreit
lTemp = _
CreateRectRgn(lStart, lZeile, lSpalte, lZeile + 1)
Call CombineRgn(lSkin, lSkin, lTemp, 2)
Call DeleteObject(lTemp)
End If
Loop
Next lZeile
End With
picTranz = lSkin
End Function
Public Sub picTransparent(cPic As PictureBox)
Dim lSkin As Long
With cPic
.Visible = True
.Left = 0
.Top = 0
.BorderStyle = 0
.AutoRedraw = True
.AutoSize = True
lSkin = picTranz(cPic)
Call SetWindowRgn(cPic.hwnd, lSkin, True)
End With
End Sub
Public Function cmdTranz(cBttn As CommandButton) As Long
Dim lHoch As Long
Dim lBreit As Long
Dim lTemp As Long
Dim lSkin As Long
Dim lStart As Long
Dim lZeile As Long
Dim lSpalte As Long
Dim lBackColor As Long
lSkin = CreateRectRgn(0, 0, 0, 0)
With cBttn
lHoch = .Height / Screen.TwipsPerPixelY
lBreit = .Width / Screen.TwipsPerPixelX
cmdDc = GetDC(.hwnd)
lBackColor = cBttn.BackColor
For lZeile = 2 To lHoch - 3
lSpalte = 2
Do While lSpalte < (lBreit - 3)
Do While lSpalte < (lBreit - 3) And _
GetPixel(cmdDc, lSpalte, lZeile) = lBackColor
lSpalte = lSpalte + 1
Loop
If lSpalte < (lBreit - 3) Then
lStart = lSpalte
Do While lSpalte < (lBreit - 3) And _
GetPixel(cmdDc, lSpalte, lZeile) <> lBackColor
lSpalte = lSpalte + 1
Loop
If lSpalte > lBreit Then lSpalte = lBreit
lTemp = _
CreateRectRgn(lStart, lZeile, lSpalte, lZeile + 1)
Call CombineRgn(lSkin, lSkin, lTemp, 2)
Call DeleteObject(lTemp)
End If
Loop
Next lZeile
End With
cmdTranz = lSkin
End Function
Public Sub cmdTransparent(cBttn As CommandButton)
Dim lSkin As Long
With cBttn
.Visible = True
.Left = cBttn.Left
.Top = cBttn.Top
lSkin = cmdTranz(cBttn)
Call SetWindowRgn(cBttn.hwnd, lSkin, True)
End With
End Sub
|
|