Tipp 0078 Skins erstellen
Autor/Einsender:
Datum:
  René Schädlich
08.06.2001
Entwicklungsumgebung:   VB 6
Mit Hilfe dieses Tipps ist man in der Lage unregelmäßige Formen und Steuerelemente zu erstellen. Jeder kennt bestimmt den Wunsch statt des Standards seinen Fenstern oder Button einmal ein anderes Aussehen zu geben. Wenn man selbst einmal versucht hat eine unregelmäßige Form zu erstellen, merkt man schnell, dass das nicht so einfach ist und wenn es eine bestimmte Form ist, kann das sehr aufwendig sein. Wie einfach es eigentlich ist, demonstriert dieses Beispiel. Zuerst wird eine BMP-Grafik erstellt, die das spätere Aussehen des Formulars haben soll. Außen herum muss die Farbe sein, die transparent werden soll.
Der Tipp nimmt die Farbe von Pixel 1;1 und schneidet diese Farbe überall dort, wo diese Farbe in der Grafik vorhanden ist komplett weg. Somit kann man nicht nur schöne Skins für sein Formular erstellen, sondern auch für jedes Steuerelement.
Code im Codebereich des Moduls
 
Option Explicit

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 Declare Function ReleaseCapture Lib "User32" () As Long

Public Declare Function SendMessage Lib "User32" Alias _
    "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Long) As Long

Public Sub CreateSkin(ByVal fFORM As Form, pSKIN As PictureBox)
  Dim lSkin As Long

  fFORM.Hide

  Screen.MousePointer = vbHourglass

  With pSKIN
    .Visible = False
    .Left = 0
    .Top = 0
    .BorderStyle = 0
    .AutoRedraw = True
    .AutoSize = True
  End With

  With fFORM
    .Width = pSKIN.Width
    .Height = pSKIN.Height
    .Picture = pSKIN.Picture

    lSkin = RegionFromBitmap(pSKIN)
    Call SetWindowRgn(.hWnd, lSkin, True)
  End With

  Screen.MousePointer = vbDefault

  fFORM.Show
End Sub

Private Function RegionFromBitmap(pSKIN As PictureBox) As Long
  Dim lHoch As Long, lBreit As Long
  Dim lTemp As Long, lSkin As Long
  Dim lStart As Long, lZeile As Long, lSpalte As Long
  Dim lBackColor As Long

  lSkin = CreateRectRgn(0, 0, 0, 0)

  With pSKIN
    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
  End With

  RegionFromBitmap = lSkin
End Function

Public Sub MoveWindow(ByVal lHandle As Long)
  ReleaseCapture
  Call SendMessage(lHandle, &HA1, 2, 0)
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Form_Load()
  CreateSkin frmSkin, picSKIN
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
    x As Single, y As Single)
  MoveWindow Me.hWnd
End Sub

Private Sub lblEnde_Click()
  End
End Sub
 
Weitere Links zum Thema
Transparente Fenster
Transparente Fenster (ab Windows 2000)

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (11 kB) Downloads bisher: [ 6871 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 5. Juni 2011