'Form átméretezését végző általános modul 'Filenév: mdlResizing.bas 'Készítette: Balogh Tamás '2002. októberében 'szabadon felhasználható Option Explicit 'Enum a kiválasztható horgony
tulajdonságra Public Enum enmAnchorTo
eAnchorTo_TopLeft eAnchorTo_TopRight
eAnchorTo_TopLeftRight
eAnchorTo_BottomLeft
eAnchorTo_BottomRight
eAnchorTo_BottomLeftRight
eAnchorTo_TopBottomLeft
eAnchorTo_TopBottomRight
eAnchorTo_All End Enum 'A meghívandó fő funkció Public Function DoResizeControls( _ ByRef
ThisForm As Form) As Boolean On Error
GoTo Exc_Handler 'A Form_Resize
esemény a form betöltésekor automatikusan meghívódik
'De az a cél, hogy csak akkor fusson le az átméretezési funkció,
'ha a form már be van töltve If Not IsObjectInitialized(ThisForm) Then
DoResizeControls = True Exit
Function End If 'Ha a form minimalizált, akkor sem kívánatos a funkció
lefutása If
ThisForm.WindowState = vbMinimized Then
DoResizeControls = True Exit
Function End If 'A funkció meghívása
Call
DoResizeChildControls(ThisForm, _
ThisForm, _
ThisForm.FormOldWidth, _
ThisForm.FormOldHeight) 'Az új méretek rögzítése
ThisForm.FormOldWidth = ThisForm.Width ThisForm.FormOldHeight
= ThisForm.Height
DoResizeControls = True Exc_Handler: If Err
Then MsgBox
Err.Description & vbCrLf & "Source: " & Err.Source End If
DoResizeControls = False End Function 'Annak a megállapítása, hogy egy
adott objektum inicializálva van-e 'Megfelel a .NET
"<object> Is Nothing" függvényének Private Function IsObjectInitialized( _ ByRef
ObjectInQuestion As Object) As Boolean On Error
GoTo Exc_Handler Dim
pstrObjectName As String
pstrObjectName = TypeName(IsObjectInitialized) If
pstrObjectName = "Nothing" Then GoTo Exc_Handler
IsObjectInitialized = True Exit
Function Exc_Handler:
IsObjectInitialized = False End Function 'Tulajdonképpeni átméretezést végző funkció Private Sub DoResizeChildControls( _ ByRef
ContainerForm As Form, _ ByRef
ParentObject As Object, _ ByVal
OldWidth As Long, _ ByVal
OldHeight As Long) Dim ctr
As Control 'A régi méret elmentése Dim
plngOldWidth As Long Dim
plngOldHeight As Long Dim
penmAnchor As enmAnchorTo 'Végiglépdelünk a befogadó form egyes vezérlőelemein For Each
ctr In ContainerForm 'Azon, és csak azon vezérlőelemekre melyek a ParentObject
elemei,
'végigfut az átméretezési művelet If
ctr.Container Is ParentObject Then If
IsNull(ctr.Tag) Or ctr.Tag = "" Then
penmAnchor = eAnchorTo_TopLeft Else
penmAnchor = ctr.Tag End
If 'csak ha nem a default (TopLeft) If
penmAnchor <> eAnchorTo_TopLeft Then 'Eredeti méretek elmentése
plngOldHeight = ctr.Height
plngOldWidth = ctr.Width 'A kérdéses tulajdonságok számítása az adott vezérlőelemre 'Left If
penmAnchor = eAnchorTo_TopRight _ Or
penmAnchor = eAnchorTo_BottomRight _ Or
penmAnchor = eAnchorTo_BottomLeftRight Then
ctr.Left = ctr.Left + ParentObject.Width - OldWidth
End If 'Top If
penmAnchor = eAnchorTo_BottomRight _ Or
penmAnchor = eAnchorTo_BottomLeft _ Or
penmAnchor = eAnchorTo_BottomLeftRight Then
ctr.Top = ctr.Top + ParentObject.Height - OldHeight
End If 'Width If
penmAnchor = eAnchorTo_BottomLeftRight _ Or
penmAnchor = eAnchorTo_TopLeftRight _ Or
penmAnchor = eAnchorTo_All Then
ctr.Width = ctr.Width + ParentObject.Width - OldWidth
End If 'Height If
penmAnchor = eAnchorTo_TopBottomLeft _ Or
penmAnchor = eAnchorTo_TopBottomRight _ Or
penmAnchor = eAnchorTo_All Then ctr.Height = ctr.Height +
ParentObject.Height - OldHeight
End If 'Ha az adott vezérlőelem tartalmaz más vezérlőelemeket, akkor 'azokra is végigfut a funkció
rekurzívan If
IsControlHasChildControl(ContainerForm, ctr) Then
Call DoResizeChildControls(ContainerForm, _ ctr,
_
plngOldWidth, _
plngOldHeight)
End If End
If End If Next End Sub 'Annak megállapítása, hogy az adott
vezérlőelem
tartalmaz-e más '(gyermek) vezérlőelemeket Private Function IsControlHasChildControl( _ ByRef
ParentForm As Form, _ ByRef
ControlInQuestion As Object) As Boolean Dim ctr
As Control For Each
ctr In ParentForm If
ctr.Container Is ControlInQuestion Then
IsControlHasChildControl = True Exit
Function End If Next
IsControlHasChildControl = False End
Function |