VB: Formhintergrund transparent machen

Formen müssen nicht immer nur rechteckig sein. Mit Hilfe von ein paar API-Funktionen lässt sich jedes Muster in Formen erzeugen. Das kann auch gut dazu dienen, um z.B. frei herumschwebende Textboxen mit darunterliegenden CommandButtons zu erzeugen. Mit Hilfe der hier vorgestellten Funktion "MakeTransparent(TransForm As Form)" können Sie das ganz leicht verwirklichen, ohne selbst viel rechnen zu müssen.

Bewertung dieses Tipps:

(bewertet von insgesamt 40 Besuchern)

Als erstes müssen Sie folgende Angaben im Kopf der Form oder des Moduls plazieren:

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 CreateEllipticRgn Lib "gdi32" ( ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long ) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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
Const RGN_XOR = 3

Nun kommen wir zu der Funktion, die das Ganze berechnet und generiert. Dieser Teil des Codes gehört unter die Deklarationen:

Public Sub MakeTransparent(TransForm As Form)
   Dim ErrorTest As Double
   On Error Resume Next
   Dim Regn As Long
   Dim TmpRegn As Long
   Dim TmpControl As Control
   Dim LinePoints(4) As POINTAPI

   'Weil die API mit Pixeln arbeitet, die Maßeinheit auf Pixel setzen
   TransForm.ScaleMode = 3
   'Die Form darf keinen Rand haben, deshalb wird der Rand erstmal geprüft
   If TransForm.BorderStyle <> 0 Then MsgBox "Die Form darf keinen Rand haben (BorderStyle = 0)!", vbCritical, "Achtung!": End
   'Macht alles unsichtbar
   Regn = CreateRectRgn(0, 0, 0, 0)
    'Für jedes Steuerelement der Form
   For Each TmpControl In TransForm
      'Wenn das Steuerelement eine Linie ist
      If TypeOf TmpControl Is Line Then
         If Abs((TmpControl.Y1 - TmpControl.Y2) / (TmpControl.X1 - TmpControl.X2)) > 1 Then
            LinePoints(0).X = TmpControl.X1 - 1
            LinePoints(0).Y = TmpControl.Y1
            LinePoints(1).X = TmpControl.X2 - 1
            LinePoints(1).Y = TmpControl.Y2
            LinePoints(2).X = TmpControl.X2 + 1
            LinePoints(2).Y = TmpControl.Y2
            LinePoints(3).X = TmpControl.X1 + 1
            LinePoints(3).Y = TmpControl.Y1
         Else
            LinePoints(0).X = TmpControl.X1
            LinePoints(0).Y = TmpControl.Y1 - 1
            LinePoints(1).X = TmpControl.X2
            LinePoints(1).Y = TmpControl.Y2 - 1
            LinePoints(2).X = TmpControl.X2
            LinePoints(2).Y = TmpControl.Y2 + 1
            LinePoints(3).X = TmpControl.X1
            LinePoints(3).Y = TmpControl.Y1 + 1
         End If
         TmpRegn = CreatePolygonRgn(LinePoints(0), 4, 1)
      'Wenn das Steuerelement eine Form (Shape) ist
      ElseIf TypeOf TmpControl Is Shape Then
          'Typ der Form
          If TmpControl.Shape = 0 Then
             'Es ist ein Rechteck
             TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height)
         ElseIf TmpControl.Shape = 1 Then
             'Es ist ein Quadrat
            If TmpControl.Width < TmpControl.Height Then
                TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width)
            Else
                TmpRegn = CreateRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height, TmpControl.Top + TmpControl.Height)
            End If
          ElseIf TmpControl.Shape = 2 Then
             'Es ist eine Ellipse
            TmpRegn = CreateEllipticRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 0.5, TmpControl.Top + TmpControl.Height + 0.5)
         ElseIf TmpControl.Shape = 3 Then
             'Es ist ein Kreis
            If TmpControl.Width < TmpControl.Height Then
                TmpRegn = CreateEllipticRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width + 0.5, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width + 0.5)
            Else
                TmpRegn = CreateEllipticRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height + 0.5, TmpControl.Top + TmpControl.Height + 0.5)
            End If
          ElseIf TmpControl.Shape = 4 Then
             'Es ist ein Rechteck mit abgerundeten Ecken
            If TmpControl.Width > TmpControl.Height Then
                TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Height / 4, TmpControl.Height / 4)
            Else
                TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Width / 4, TmpControl.Width / 4)
            End If
          ElseIf TmpControl.Shape = 5 Then
             'Es ist ein Quadrat mit abgerundeten Ecken
            If TmpControl.Width > TmpControl.Height Then
                TmpRegn = CreateRoundRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Height / 4, TmpControl.Height / 4)
            Else
                TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width + 1, TmpControl.Width / 4, TmpControl.Width / 4)
            End If
          End If
          If TmpControl.BackStyle = 0 Then
             'Kombiniert die Regionen im Speicher und erstellt eine neue
            CombineRgn Regn, Regn, TmpRegn, RGN_XOR

            If TmpControl.Shape = 0 Then
                'Rechteck
                TmpRegn = CreateRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width - 1, TmpControl.Top + TmpControl.Height - 1)
            ElseIf TmpControl.Shape = 1 Then
                'Quadrat
                If TmpControl.Width < TmpControl.Height Then
                   TmpRegn = CreateRectRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width - 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width - 1)
                Else
                   TmpRegn = CreateRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height - 1, TmpControl.Top + TmpControl.Height - 1)
                End If
            ElseIf TmpControl.Shape = 2 Then
                'Ellipse
                TmpRegn = CreateEllipticRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width - 0.5, TmpControl.Top + TmpControl.Height - 0.5)
            ElseIf TmpControl.Shape = 3 Then
                'Kreis
                If TmpControl.Width < TmpControl.Height Then
                   TmpRegn = CreateEllipticRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width - 0.5, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width - 0.5)
                Else
                   TmpRegn = CreateEllipticRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height - 0.5, TmpControl.Top + TmpControl.Height - 0.5)
                End If
            ElseIf TmpControl.Shape = 4 Then
                'Rechteck mit abgerundeten Ecken
                If TmpControl.Width > TmpControl.Height Then
                   TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height, TmpControl.Height / 4, TmpControl.Height / 4)
                Else
                   TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height, TmpControl.Width / 4, TmpControl.Width / 4)
                End If
            ElseIf TmpControl.Shape = 5 Then
                'Quadrat mit abgerundeten Ecken
                If TmpControl.Width > TmpControl.Height Then
                   TmpRegn = CreateRoundRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height, TmpControl.Top + TmpControl.Height, TmpControl.Height / 4, TmpControl.Height / 4)
                Else
                   TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width, TmpControl.Width / 4, TmpControl.Width / 4)
                End If
            End If
          End If
      Else
          'Eine Rechteckige Region erstellen
          TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height)
      End If
      'Prüft ob das Steuerelement überhaupt eine Breite hat (die größer als 0 ist)
      ErrorTest = 0
      ErrorTest = TmpControl.Width
       If ErrorTest <> 0 Or TypeOf TmpControl Is Line Then
         'Die Regionen kombinieren
         CombineRgn Regn, Regn, TmpRegn, RGN_XOR
      End If
   Next TmpControl
    'Die Regionen erstellen
   SetWindowRgn TransForm.hwnd, Regn, True
End Sub

Wenn sie die folgende Anweisung in das "Form_Load"-Ereignis der Form setzen, wird die Form sofort richtig zugeschnitten:

MakeTransparent Me

Sie können sich ein Beispiel sowohl als Projektdatei (VB6), als auch als Textdatei herunterladen.

Als Projekt

Als Textdatei

Quellen: SHADOWare.de