Sicher haben Sie auch schon desöfteren so manche Anwendung bewundert, weil diese nicht im eckigen Windows-Design daherkommt, sondern rund, oval oder ... Hierbei spricht man von Skins. Wie man für seine eigenen Anwendung "Skin-Forms" erstellt, das zeigt nachfolgender Tipp. Basis für das neue Outfit der Form ist hierbei ein Bild. Dieses Bild wird zur Laufzeit in ein PictureBox-Control geladen. Anschließend wird anhand der transparenten Bildpunkte eine neue "Region" erstellt und der Form zugewiesen. Die Form selbst soll ohne Titelleiste angezeigt werden, was wiederum bedeutet, dass wir uns um die Möglichkeit, die Form verschieben zu können, selbst kümmern müssen. Erstellen Sie ein neues Projekt und setzen die BorderStyle-Eigenschaft auf 0 - kein Rahmen. Platzieren Sie auf die Form ein PictureBox-Control und einen CommandButton. Über den CommandButton soll die Anwendung beendet werden können. Fügen Sie dem Projekt ein Modul hinzu und fügen Sie nachfolgenden Code in den Codeteil des Moduls ein: Option Explicit ' Benötigte API-Deklarationen Private Declare Function SetWindowRgn Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hRgn As Long, _ ByVal bRedraw As Boolean) As Long Private Declare Function GetPixel Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal X As Long, _ ByVal Y As Long) As Long Private Declare Function CreateRectRgn Lib "gdi32" ( _ ByVal X1 As Long, _ ByVal Y1 As Long, _ ByVal X2 As Long, _ ByVal Y2 As Long) As Long Private Declare Function CombineRgn Lib "gdi32" ( _ ByVal hDestRgn As Long, _ ByVal hSrcRgn1 As Long, _ ByVal hSrcRgn2 As Long, _ ByVal nCombineMode As Long) As Long Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long) As Long Private Const RGN_OR = 2 Private Const WM_NCLBUTTONDOWN = &HA1 Private Const HTCAPTION = 2 ' 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 Function 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 Fügen Sie nachfolgenden Code in den Codeteil der FORM1 ein: Option Explicit Private Sub Form_Load() ' Skin erstellen SkinMe Me, PicMainSkin, App.Path & "\Test.gif" End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) ' Fenster verschieben ohne Titelleiste MoveWindow Me.hWnd End Sub Private Sub Command1_Click() ' Anwendung beenden Unload Me End Sub Tipp: Dieser Tipp wurde bereits 20.251 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |