Startseite / Tipps / VB 5/6-Tipp 0126: Transparentes Formular mit Hilfe von Regions entwickeln

VB 5/6-Tipp 0126: Transparentes Formular mit Hilfe von Regions entwickeln

 von Matt Hart

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kombinationsliste "Combo1"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Textfeld "txtCity"
' Steuerelement: Textfeld "txtAddress"
' Steuerelement: Textfeld "txtName"
' Steuerelement: Schaltfläche "cmdOk"
' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 2)

Option Explicit

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 SetWindowRgn Lib "user32" (ByVal _
        hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As _
        Long) As Long
        
Const RGN_OR = 2
Const RGN_DIFF = 4

Public Sub GlassForm()
  Dim FWidth&, FHeight&, FBorder&, FTitle&
  Dim CLeft&, CTop&, CRight&, CBottom&, CRgn&, Ctrl As Control
  Dim ROuter&, RInner&, RCombined&

    If WindowState <> vbMinimized Then
      'Ganzen Form als Region festlegen
      FWidth = ScaleX(Me.Width, vbTwips, vbPixels)
      FHeight = ScaleY(Me.Height, vbTwips, vbPixels)
      ROuter = CreateRectRgn(0, 0, FWidth, FHeight)
      
      
      'Ränder und Titel abzziehen & als Region festlegen
      Me.ScaleMode = vbPixels
      FBorder = (FWidth - Me.ScaleWidth) / 2
      FTitle = FHeight - FBorder - Me.ScaleHeight
      RInner = CreateRectRgn(FBorder, FTitle, FWidth - FBorder, _
                             FHeight - FBorder)

      'Innere von der äußeren Region abziehen
      RCombined = CreateRectRgn(0, 0, 0, 0)
      Call CombineRgn(RCombined, ROuter, RInner, RGN_DIFF)

      'Regions für die einzelnen Controls ermitteln
      For Each Ctrl In Controls
        With Ctrl
          If .Container Is Me Then
            
            'Abmaße ermitteln
            CLeft = ScaleX(.Left, Me.ScaleMode, vbPixels) + FBorder
            CTop = ScaleX(.Top, Me.ScaleMode, vbPixels) + FTitle
            CRight = ScaleX(.Width, Me.ScaleMode, vbPixels) + CLeft
            CBottom = ScaleX(.Height, Me.ScaleMode, vbPixels) + CTop
            
            'Region erstellen und von der gesamten abziehen
            CRgn = CreateRectRgn(CLeft, CTop, CRight, CBottom)
            Call CombineRgn(RCombined, RCombined, CRgn, RGN_OR)
          End If
        End With
      Next Ctrl
      
      'Region zuweisen
      Call SetWindowRgn(hWnd, RCombined, True)
    End If
End Sub

Private Sub Form_Resize()
  Call GlassForm
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

und