|
|
|
|
|
Code des UserControls FormX
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CombineRgn Lib "gdi32" _
(ByVal hDestRgn&, ByVal hSrcRgn1&, ByVal hSrcRgn2&, _
ByVal nCombineMode&) As Long
Private Declare Function CreateRectRgn Lib "gdi32" _
(ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject&) As Long
Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" _
() As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseCapture Lib "user32" () 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 Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal Order As Long, ByVal X As Long, _
ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, _
ByVal Flags As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd&, ByVal hrgn&, ByVal bRedraw As Boolean) As Long
Private WithEvents eForm As Form
Private mDummyButtonName As String
Private mFirst As Boolean
Private mFormName As String
Private mHRgn As Long
Private mLeft As Long
Private mTop As Long
Private mToMoveBack As Boolean
Public Enum ftTransparentConstants
fttOpaque
fttTransparentIfControls
fttTransparentAlways
fttInvisibleButOnTaskBar
End Enum
Private pTransparent As ftTransparentConstants
Private pTopMost As Boolean
Public Property Get Transparent() As ftTransparentConstants
Transparent = pTransparent
End Property
Public Property Let Transparent(ByVal New_Transparent _
As ftTransparentConstants)
Select Case New_Transparent
Case fttOpaque To fttInvisibleButOnTaskBar
If Ambient.UserMode Then
If eForm Is Nothing Then
pTransparent = fttOpaque
Else
pTransparent = New_Transparent
If pTransparent Then
zMakeTransparent
Else
zMakeIntransparent
End If
End If
Else
pTransparent = New_Transparent
End If
Case Else
Err.Raise 380
End Select
PropertyChanged "Transparent"
End Property
Public Property Get TopMost() As Boolean
TopMost = pTopMost
End Property
Public Property Let TopMost(ByVal New_TopMost As Boolean)
pTopMost = New_TopMost
zTopMost
PropertyChanged "TopMost"
End Property
Public Sub DragForm()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
If Not (eForm Is Nothing) Then
ReleaseCapture
SendMessage eForm.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End If
End Sub
Public Sub Refresh()
If pTransparent Then
If Ambient.UserMode Then
If Not (eForm Is Nothing) Then
zMakeTransparent
End If
End If
End If
End Sub
Private Sub eForm_Load()
If mFirst Then
mLeft = eForm.Left
mTop = eForm.Top
eForm.Move -10000, -10000
End If
End Sub
Private Sub eForm_Resize()
With eForm
If .MDIChild Then
If pTransparent Then
Select Case .WindowState
Case vbMinimized
zMakeIntransparent
Case Else
.Refresh
zMakeTransparent
End Select
End If
ElseIf mFirst Then
Me.Refresh
eForm.Move mLeft, mTop
End If
End With
mFirst = False
End Sub
Private Sub eForm_Unload(Cancel As Integer)
zMakeIntransparent
End Sub
Private Sub tmr_Timer()
tmr.Enabled = False
If Len(mDummyButtonName) Then
eForm.Controls.Remove mDummyButtonName
End If
mDummyButtonName = ""
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
pTransparent = PropBag.ReadProperty("Transparent", fttOpaque)
If Ambient.UserMode Then
With UserControl
If TypeOf .Parent Is Form Then
If Not TypeOf .Parent Is MDIForm Then
Set eForm = .Parent
mFormName = eForm.Name
If pTransparent Then
mFirst = True
End If
End If
End If
End With
End If
Me.TopMost = PropBag.ReadProperty("TopMost", False)
End Sub
Private Sub UserControl_Resize()
Static sInProc As Boolean
If sInProc Then
Exit Sub
Else
sInProc = True
End If
UserControl.Size 32 * Screen.TwipsPerPixelX, _
32 * Screen.TwipsPerPixelY
sInProc = False
End Sub
Private Sub UserControl_Terminate()
zMakeIntransparent
End Sub
Private Sub UserControl_WriteProperties(_
PropBag As PropertyBag)
PropBag.WriteProperty "Transparent", pTransparent, fttOpaque
PropBag.WriteProperty "TopMost", pTopMost, False
End Sub
Private Sub zMakeTransparent()
Dim nXDiff As Long
Dim nYDiff As Long
Dim nOldScaleMode As Integer
Dim nParentRect As RECT
Dim nClientRect As RECT
Dim nMeRect As RECT
Dim nClientXDiff As Long
Dim nClientYDiff As Long
Dim nControl As Control
Dim nControlRect As RECT
Dim nWindowRgn As Long
Dim nControlRgn As Long
Dim nFirstLoop As Boolean
'*** VB 6:
Dim nDummyButton As CommandButton
'*** Alternative für VB 5:
' Dim nHelperControl As Control
' Dim nHelperWnd As Long
' Dim nHelperLeft As Long
' Dim nHelperTop As Long
' Dim nHelperVisible As Boolean
'***
Dim i%
Const RGN_OR = 2&
With eForm
nOldScaleMode = .ScaleMode
If pTransparent <> fttInvisibleButOnTaskBar Then
.ScaleMode = vbPixels
GetWindowRect .hWnd, nParentRect
GetClientRect .hWnd, nClientRect
On Error Resume Next
'*** Alternative für VB 5:
' For Each nHelperControl In .Controls
' nHelperWnd = nHelperControl.hWnd
' If Err.Number Then
' Err.Clear
' Else
' Exit For
' End If
' Next
' If nHelperWnd Then
' With nHelperControl
' nHelperLeft = .Left
' nHelperTop = .Top
' nHelperVisible = .Visible
' .Visible = False
' .Move 0, 0
' GetWindowRect .hWnd, nMeRect
' .Move nHelperLeft, nHelperTop
' .Visible = nHelperVisible
' End With
' Else
' .ScaleMode = nOldScaleMode
' Exit Sub
' End If
'*** Ende VB 5
'*** VB 6:
Do
Err.Clear
Set nDummyButton = eForm.Controls.Add(_
"VB.CommandButton", Ambient.DisplayName & _
"Dummy" & i)
i = i + 1
Loop While Err.Number
With nDummyButton
.Move 0, 0
GetWindowRect .hWnd, nMeRect
mDummyButtonName = .Name
End With
eForm.Controls.Remove mDummyButtonName
If Err.Number = 365 Then
tmr.Enabled = True
End If
Err.Clear
'*** Ende VB 6
With nParentRect
nClientXDiff = nMeRect.Left - .Left
nClientYDiff = nMeRect.Top - .Top
nXDiff = ((.Right - .Left) - (nClientRect.Right - _
nClientRect.Left)) - nClientXDiff
nYDiff = ((.Bottom - .Top) - (nClientRect.Bottom - _
nClientRect.Top)) '- nClientYDiff
nYDiff = nYDiff - (nYDiff - nClientYDiff)
End With
nFirstLoop = True
On Error GoTo NextControl
For Each nControl In .Controls
With nControl
If Not TypeOf nControl Is Menu Then
If .Container.Name = mFormName Then
If Err.Number = 0 Then
If .Visible Then
nControlRect.Left = .Left + nXDiff
nControlRect.Top = .Top + nYDiff
nControlRect.Right = (.Left + .Width) + nXDiff
nControlRect.Bottom = (.Top + .Height) + nYDiff
With nControlRect
nControlRgn = CreateRectRgn(.Left, .Top, .Right, _
.Bottom)
If nFirstLoop Then
nWindowRgn = nControlRgn
nFirstLoop = False
Else
CombineRgn nWindowRgn, nWindowRgn, nControlRgn, _
RGN_OR
DeleteObject nControlRgn
End If
End With
End If
End If
End If
End If
End With
NextControl:
If Err.Number Then
Resume NextControl_Resume
NextControl_Resume:
End If
Next
End If
On Error GoTo 0
If nWindowRgn = 0 Then
Select Case pTransparent
Case fttTransparentAlways, fttInvisibleButOnTaskBar
With nParentRect
nWindowRgn = CreateRectRgn(0, 0, 0, 0)
End With
End Select
End If
If mHRgn Then
DeleteObject mHRgn
End If
mHRgn = nWindowRgn
SetWindowRgn .hWnd, mHRgn, True
.ScaleMode = nOldScaleMode
End With
End Sub
Private Sub zMakeIntransparent()
If mHRgn Then
DeleteObject mHRgn
mHRgn = 0
With eForm
SetWindowRgn .hWnd, 0, True
End With
End If
End Sub
Private Sub zTopMost()
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
If Ambient.UserMode Then
If Not (eForm Is Nothing) Then
Select Case pTopMost
Case False
SetWindowPos eForm.hWnd, HWND_NOTOPMOST, _
0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Case True
SetWindowPos eForm.hWnd, HWND_TOPMOST, _
0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Select
End If
End If
End Sub
|