Sometimes the form changes, if the resolution is changed, the control is not changed. Handmade code adjustment is troublesome, the following module implements automatically finds the control on the form and changing the size to accommodate the form variation.
Calling a function resize_all in the Form's Resize event to automatically resize the control, such as:
PRIVATE SUB FORM_RESize () DIM H, I as INTEGERON ERROR RESUME NEXTRESIZE_ALL ME 'ME is the form name, Form1, Form2, etc.
End Sub
Add the following code to the module:
Public Type Ctrobj Name AS String Index As Long Parrent AS String Top As Long Left As Long Height As Long Width As Long ScaleHeight As Long Scalewidth As Longend Type
Private FormRecord () As ctrObjPrivate ControlRecord () As ctrObjPrivate bRunning As BooleanPrivate MaxForm As LongPrivate MaxControl As LongPrivate Const WM_NCLBUTTONDOWN = & HA1Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long BYVAL LPARAM AS Long) As longprivate declare function releasecapture lib "user32" () AS Longfunction ActualPos (PLLEFT AS Long) As long
IF PLLEFT <0 THEN ATUALPOS = PLLEFT 75000 else actualpos = PLLEFT END IF
END FUNCTION
Function Findform (Pfrmin as Form) As Long
DIM I as long findform = -1
IF Maxform> 0 THEN
For i = 0 TO (MaxForm - 1)
IF FormRecord (i) .Name = pfrmin.name kil1n findform = i exit function endiff
Next I
END IF
END FUNCTION
Function Addform (Pfrmin as Form) As long
DIM FORMCONTROL AS Control Dim i as long redim preserve formRecord (MaxForm 1)
FormRecord (MAXFORM) .Name = pfrmin.name
FormRecord (MAXFORM) .top = Pfrmin.topFormRecord (MAXFORM) .left = Pfrmin.Left
FormRecord (MAXFORM) .height = pfrmin.height
FormRecord (MAXFORM) .width = Pfrmin.width FormRecord (MaxForm) .scaleHeight = Pfrmin.scaleHeight
FormRecord (MaxForm) .scaleWidth = Pfrmin.scaleWidth Addform = Maxform MaxForm = MaxForm 1
For Each FormControl in Pfrmin I = FindControl (FormControl, Pfrmin.name)
I <0 THEN I = AddControl (FormControl, Pfrmin.name) Endiff
Next formControl
END FUNCTION
Function FindControl (Incontrol as Control, Inname As String) AS Long
DIM I as long findcontrol = -1
For i = 0 TO (MaxControl - 1)
If ControlRecord (i) .parrent = Inname Then IF ControlRecord (i) .name = incontrol.name dam ire resume next
IF ControlRecord (i) .index = incontrol.index the FINDCONTROL = I Exit function end ifon error goto 0 endiff
END IF
Next I
END FUNCTION
Function AddControl (Incontrol As Control, Inname As String) AS Long
ReDim Preserve ControlRecord (MaxControl 1) On Error Resume Next ControlRecord (MaxControl) .Name = inControl.Name ControlRecord (MaxControl) .Index = inControl.Index ControlRecord (MaxControl) .Parrent = inName
If TypeOf inControl Is Line Then ControlRecord (MaxControl) .Top = inControl.Y1 ControlRecord (MaxControl) .Left = ActualPos (inControl.X1) ControlRecord (MaxControl) .Height = inControl.Y2 ControlRecord (MaxControl) .Width = ActualPos (inControl. X2) Else ControlRecord (MaxControl) .Top = inControl.Top ControlRecord (MaxControl) .Left = ActualPos (inControl.Left) ControlRecord (MaxControl) .Height = inControl.Height ControlRecord (MaxControl) .Width = inControl.Width End If
Incontrol.integralHeight = false on error goto 0 AddControl = maxcontrol maxControl = maxcontrol 1END function
Function Perwidth (Pfrmin As Form) As long
DIM I as long i = findform (pfrmin)
IF i <0 THEN i = addform (pfrmin) endiff
Perwidth = (pfrmin.scalewidth * 100) / FormRecord (i) .scalewidthend FunctionFunction Perheight (Pfrmin as form) AS DOUBLE
DIM I as long i = findform (pfrmin)
IF i <0 THEN i = addform (pfrmin) endiff
Perheight = (Pfrmin.scaleHeight * 100) / FormRecord (i) .scaleheightend function
Public Sub Resizecontrol (Incontrol AS Control, Pfrmin As Form)
On Error Resume Next Dim i As Long Dim widthfactor As Single, heightfactor As Single Dim minFactor As Single Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long yRatio = PerHeight (pfrmIn) xRatio = PerWidth (pfrmIn) i = FindControl ( Incontrol, Pfrmin.name)
If Incontrol.Left <0 dam Lleft = ClNG ((ControlRecord (i) .left * xratio) / 100) - 75000) Else Lleft = ClNG ((ControlRecord (i) .left * xratio) / 100) Endiff
LTOP = ClNG ((ControlRecord (i) .top * yratio) / 100) lwidth = clng ((ControlRecord (i) .width * xratio) / 100) LHEight = ClNG ((ControlRecord (i) .height * Yratio) / 100 ) If TypeOf Incontrol Is Line Then
If Incontrol.x1 <0 damtrol.x1 = clng ((ControlRecord (i) .left * xratio) / 100) - 75000) Else InControl.x1 = CLNG ((ControlRecord (i) .left * xratio) / 100) END IF
InControl.y1 = CLNG ((ControlRecord (i) .top * yratio) / 100)
If Incontrol.x2 <0 damtrol.x2 = clng ((ControlRecord (i) .width * xratio) / 100) - 75000) Else InControl.x2 = CLNG ((ControlRecord (i) .width * xratio) / 100) End IfinControl.Y2 = CLng ((ControlRecord (i) .Height * yRatio) / 100) Else inControl.Move lLeft, lTop, lWidth, lHeight inControl.Move lLeft, lTop, lWidth inControl.Move lLeft, lTop End If
End Sub
Public Sub Resizeform (Pfrmin As Form)
Dim FormControl As Control Dim Isvisible As Boolean Dim StartX, Starty, Maxx, Maxy As Long Dim Bnew as Boolean
IF not brunning kilning = true
IF Findform (Pfrmin) <0 THEN BNEW = true else bnew = false endiff
IF pfrmin.top <30000 Then isvisible = pfrmin.visible on Error ResMe next
IF not pfrmin.mdichild life on error goto 0 '' pfrmin.visible = false else
IF bnew kiln = pfrmin.height startx = pfrmin.width on error resume next
For Each FormControl in Pfrmin
If FormControl.Left FormControl.Width 200> MaxX Then MaxX = FormControl.Left FormControl.Width 200 End IfIf FormControl.Top FormControl.Height 500> MaxY Then MaxY = FormControl.Top FormControl.Height 500 End IF
IF FormControl.x1 200> maxx kilaxx = formcontrol.x1 200 end if
IF formControl.y1 500> Maxy Then Maxy = formControl.y1 500 End IF
IF FormControl.x2 200> maxx kilaxx = formControl.x2 200 end if
IF formControl.y2 500> Maxy the maxy = formControl.y2 500 End IF
Next formControl
On Error Goto 0 Pfrmin.Height = Maxy Pfrmin.width = Maxx end ifon error goto 0 Endix
For Each FormControl in Pfrmin Resizecontrol FormControl, Pfrmin Next FormControl
ON Error ResMe next
IF not pfrmin.mdichild life ignal goto 0 pfrmin.visible = isvisible else
If BNEW THEN PFRMIN.HEIGHT = Starty Pfrmin.width = StartX
For Each FormControl in Pfrmin Resizecontrol FormControl, Pfrmin Next FormControl
END IF
END IF
ON Error Goto 0 End IF
Brunning = false endiff
End Sub
Public Sub SaveFormPosition (Pfrmin as Form)
DIM I as long
IF Maxform> 0 THEN
For i = 0 TO (MaxForm - 1)
IF FormRecord (i) .Name = pfrmin.name dam
FormRecord (i) .top = pfrmin.top
FormRecord (i) .left = pfrmin.Left
FormRecord (i) .height = pfrmin.height
FormRecord (i) .width = pfrmin.width exit sub end ifnext i
Addform (PFRMIN) endiff
End Sub
Public Sub RestoreFormPosition (PFRMIN as Form)
DIM I as long if maxform> 0 THEN
For i = 0 TO (MaxForm - 1)
IF FormRecord (i) .Name = pfrmin.name dam
If FormRecord (i) .top <0 Then Pfrmin.windowState = 2 elseif Formord (i) .top <30000 Then Pfrmin.WindowState = 0 Pfrmin.move Formord (i) .left, FormRecord (i) .top, FormRecord (i ) .Width, FormRecord (i) .height else pfrmin.windowState = 1 Endix
EXIT SUB END IF
Next I
END IF
End Subpublic Sub Resize_all (Form_name as Form)
DIM OBJ As Objectfor Each Obj IN FORM_NAME RESIZECONTROL OBJ, FORM_NAMENEXT OBJ
End Sub
Public Sub Dragform (FRM AS FORM)
On Local Error Resume NextCall ReleaseCaptureCall SendMessage (frm.hwnd, wm_nclbuttondown, 2, 0)
End Sub
