Hallo Andreas,
habe dir eine E-Mail geschickt!
Ist natürlich unfair, all den anderen gegenüber, deshalb hier ein bißchen was (ohne die API-Deklarationen).
' Nachfolgender Code verformt eine Form
' anhand eines Bildes
Public Sub SkinMe(sknFrm As Form, APic As PictureBox, ByVal picFile As String)
Dim WindowRegion As Long
' Picture in PictureBox laden
' und Eigenschaften festlegen
With APic
.Visible = False
.ScaleMode = vbPixels
.AutoRedraw = True
.AutoSize = True
' .BorderStyle = vbBSNone
Set .Picture = LoadPicture(picFile)
End With
' Formgröße des Skin-Pictures anpassen
' und Windows-Region erstellen
With sknFrm
.Width = sknFrm.ScaleX(APic.Width, .ScaleMode, vbTwips)
.Height = sknFrm.ScaleY(APic.Height, .ScaleMode, vbTwips)
WindowRegion = MakeRegion(APic)
SetWindowRgn .hWnd, WindowRegion, True
.Refresh
.Picture = APic.Picture
End With
End Sub
Private Function MakeRegion(picSkin As PictureBox) As Long
' Diese Funktion erstellt eine Windows-Region basierend
' auf das Bild der übergebenen PictureBox.
'
' Hierbei werden alle "transparenten" Bildpunkte zu einer
' Region zusammengefasst.
Dim X As Long, Y As Long, StartLineX As Long
Dim FullRegion As Long, LineRegion As Long
Dim TransparentColor As Long
Dim InFirstRegion As Boolean
Dim InLine As Boolean
Dim hDC As Long
Dim PicWidth As Long
Dim PicHeight As Long
With picSkin
hDC = .hDC
PicWidth = .ScaleWidth
PicHeight = .ScaleHeight
End With
InFirstRegion = True: InLine = False
X = Y = StartLineX = 0
' Als transparente Farbe wird der oberste linke Farbpunkt
' herangezogen.
' Sie können aber auch Ihre eigene durchsichtige Farbe
' definieren wie z.B. pink oder einen Hexwert wie &H00C00000&
' oder als RGB(50, 14, 254) oder vbBlack, vbwhite etc.
TransparentColor = GetPixel(hDC, 0, 0)
For Y = 0 To PicHeight - 1
For X = 0 To PicWidth - 1
If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then
' Wir haben einen durchsichtigen pixel erreicht
If InLine Then
InLine = False
LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
If InFirstRegion Then
FullRegion = LineRegion
InFirstRegion = False
Else
CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
' Immer säubern!
DeleteObject LineRegion
End If
End If
Else
' Wir haben einen nicht durchsichtigen pixel erreicht
If Not InLine Then
InLine = True
StartLineX = X
End If
End If
Next X
Next Y
MakeRegion = FullRegion
End Function
Public Sub MoveWindow(OHwnd As Long)
' Verschieben eines Formulars mit der Maus
ReleaseCapture
SendMessage OHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub Aufruf von der Form_Load:
Private Sub Form_Load()
' Skin erstellen
SkinMe Me, PicMainSkin, App.Path & "\Test.gif"
End Sub BAStler |