|
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
|
|