Tipp 0505 Transparente Fenster
Autor/Einsender:
Datum:
  Detlev Schubert
01.08.2006
Entwicklungsumgebung:   VB 6
Windows stellt mit seinen API-Funktionen Möglichkeiten zur Verfügung, mit deren Hilfe sich besondere Effekte erzeugen lassen. Um nun eine Form transparent machen, wird die BorderStyle-Eigenschaft der Form auf 0 gesetzt. Nach dem Ermitteln der Formmaße wird mit der API-Funktion CreateRectRgn eine leere Region erzeugt, die dann mit einer Region mit den Maßen der Form kombiniert wird.
Da nun alle auf der Form befindlichen Steuerelemente weiterhin voll sichtbar bleiben sollen, wird in einer Schleife für jedes Steuerelement eine Region erstellt und anschließend mit der bereits erstellten Region kombiniert. So ist es möglich während der Laufzeit Steuerelemente (wie im Beispielprojekt) ein und ausblenden zu können.
Zum Schluss wird mit der API-Funktion SetWindowRgn das Fenster auf die kombinierte Region reduziert. Damit sich nun auch die unsichtbare Form bewegen lässt, kommen die API-Funktion ReleaseCapture und SendMessage aus dem Tipp Form ohne Titelleiste verschieben zum Einsatz.
Mit einem solchen Effekt ist es möglich eine Gruppe von Steuerelementen frei über dem Desktop schweben lassen.
Code im Codebereich des Moduls
 
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

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 Sub ReleaseCapture Lib "user32" ()

Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Public hCombined As Long

Sub MakeFormTransparent(Frm As Form)
  On Error Resume Next

  Const RGN_DIFF = 4
  Const RGN_OR = 2

  Dim Breite As Single
  Dim Hoehe As Single
  Dim Links As Single
  Dim Rechts As Single
  Dim Oben As Single
  Dim Unten As Single

  Dim hInner As Long
  Dim hRgn As Long

  Dim Ctrl As Control
  If Frm.WindowState = vbMinimized Then Exit Sub

  With Frm
    .BorderStyle = 0
    .Caption = ""
    .ScaleMode = vbPixels
  End With

  hCombined = CreateRectRgn(0, 0, 0, 0)

  Abmessungen Frm, Breite, Hoehe

  hInner = CreateRectRgn(0, 0, Breite, Hoehe)
  CombineRgn hCombined, hInner, hInner, RGN_DIFF

  For Each Ctrl In Frm.Controls
    Err = 0
    If Err = 0 Then
      If (Ctrl.Visible = True) Then
        Links = Frm.ScaleX(Ctrl.Left, Frm.ScaleMode, vbPixels)
        Oben = Frm.ScaleX(Ctrl.Top, Frm.ScaleMode, vbPixels)
        Rechts = Frm.ScaleX(Ctrl.Width, Frm.ScaleMode, vbPixels) _
              + Links
        Unten = Frm.ScaleX(Ctrl.Height, Frm.ScaleMode, vbPixels) _
              + Oben
        hRgn = CreateRectRgn(Links, Oben, Rechts, Unten)
        CombineRgn hCombined, hCombined, hRgn, RGN_OR
      End If
    End If
  Next

  SetWindowRgn Frm.hWnd, hCombined, True
End Sub

Sub Abmessungen(Frm As Form, Breite As Single, Hoehe As Single)
  Dim Ctrl As Control
  Dim intW As Integer, intH As Integer

  On Error Resume Next
  For Each Ctrl In Frm.Controls
    Err = 0
    If Err = 0 Then
      intW = Ctrl.Left + Ctrl.Width
      If intW > Breite Then Breite = intW
      intH = Ctrl.Top + Ctrl.Height
      If intH > Hoehe Then Hoehe = intH
    End If
  Next
End Sub

Sub MoveObject(Obj As Object)
  Dim lngRetVal As Long
  ReleaseCapture
  lngRetVal = SendMessage(Obj.hWnd, WM_NCLBUTTONDOWN, _
        HTCAPTION, 0&)
  Obj.Refresh
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private Declare Function DeleteObject Lib "gdi32" (ByVal _
      hObject As Long) As Long

Private Sub Form_Load()
  Me.Show
  MakeFormTransparent Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim Res As Integer

  Me.Hide
  If hCombined > 0 Then
    Res = DeleteObject(hCombined)
  End If
  End
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As _
      Integer, X As Single, Y As Single)
  If Button = 1 Then
    MoveObject Me
  End If
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, _
      X As Single, Y As Single)
  If Button = 1 Then
    MoveObject Me
  End If
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, _
      X As Single, Y As Single)
  If Button = 1 Then
    MoveObject Me
  End If
End Sub
 
Weitere Links zum Thema
Transparente Fenster (ab Windows 2000)

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


Download  (4,5 kB) Downloads bisher: [ 1053 ]

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, 3. Juli 2011