Code:
Option Compare DatabaseOption Explicit
Public Sub clm(frm1 As Form, Optional fst As Boolean)
Dim ctl As Control
Dim frms As Variant
Dim frm As Variant
Dim i As Integer
i = 0
If fst Then
ScreenRes
y(0) = "-P888,888.88"
x(12) = frm1.Toggle22.FontSize
x(13) = frm1.Toggle22.FontWeight
y(1) = frm1.Toggle22.FontName
Else
frm1.Toggle22.FontSize = x(12)
frm1.Toggle22.FontWeight = x(13)
frm1.Toggle22.FontName = y(1)
frm1.Toggle22.Height = x(12) * 24
frm1.Toggle22.Width = w
End If
x(0) = 0 'u y top seems useless
x(1) = 0 'u x left
Do
GetTextLength frm1.Toggle22, y(0)
If w < 900 Then
w = 900
End If
x(2) = 11 * w 'u w
If x(2) > 31680 Then
x(12) = x(12) - 1
frm1.Toggle22.FontSize = x(12)
Else
Exit Do
End If
Loop Until x(2) < 31681
frm1.fnt2.Value = x(12) & y(1) & w
frm1.fnt2.BackColor = vbGreen
frm1.fnt2.ForeColor = vbBlue
x(3) = 800 'u h
x(4) = 400 's y top seems useless
x(5) = 0 's x left
x(6) = w + w / 2 's w
x(7) = 800 's h
x(8) = x(6) 'b y top seems useless
x(9) = x(5) 'b x left
x(10) = x(2) - x(6) 'b w
x(11) = x(7) 'b h
DoCmd.MoveSize 0, 0
DoCmd.Maximize
frms = Array("used", "saving", "bal_crosstab")
For Each frm In frms
For Each ctl In Forms!form1!(frm).Form.Controls
With ctl
If .ControlType = acTextBox Then
.CanGrow = True
.CanShrink = True
Select Case .Name
Case Is = "Tot"
.ColumnWidth = w + w / 6
Case Is = "dt"
.ColumnWidth = w - w / 12
Case Else
.ColumnWidth = w
End Select
End If
End With
Next ctl
Forms!form1!(frm).Form.DatasheetFontName = y(1)
Forms!form1!(frm).Form.DatasheetFontHeight = x(12)
Forms!form1!(frm).Form.DatasheetFontWeight = 700
Forms!form1!(frm).Form.RowHeight = x(12) * 24
Forms!form1!(frm).Form.DatasheetBackColor = vbYellow
Forms!form1!(frm).Form.DatasheetForeColor = vbRed
If frm = "used" Then
x(3) = Forms!form1!(frm).Form.RowHeight * 2.5 + 250
Forms!form1!saving.Form.Recordset.MoveLast
Forms!form1!saving.Form.Recordset.MoveFirst
x(7) = (Forms!form1!saving.Form.Recordset.RecordCount + 3) * Forms!form1!(frm).Form.RowHeight
x(11) = x(7)
End If
Forms!form1!(frm).Top = x(i + 0)
Forms!form1!(frm).Left = x(i + 1)
Forms!form1!(frm).Width = x(i + 2)
Forms!form1!(frm).Height = x(i + 3)
i = i + 4
Next frm
Forms!form1!used!fil.ColumnWidth = Forms!form1!(frm).Width - w + 90
hnp frm1
End Sub
Function hnp(ByRef happy As Form)
Dim strCurrentObjectName As String
strCurrentObjectName = Application.CurrentObjectName
DoCmd.NavigateTo ("acNavigationCategoryObjectType")
If strCurrentObjectName <> Application.CurrentObjectName Then
DoCmd.RunCommand acCmdWindowHide
End If
End Function
Function df() As Boolean
Dim f As FormFontInfo
With f
.Color = 0
.Height = 12
.Weight = 700
.Italic = False
.UnderLine = False
.Name = "Arial"
End With
Call DialogFont(f)
With f
y(1) = .Name
x(12) = .Height
x(13) = .Weight
End With
df = True
End Function
Sub ScreenRes()
x(15) = GetSystemMetrics32(0) ' width in points
x(16) = GetSystemMetrics32(1) ' height in points
End Sub
Public Function GetTextLength(pCtrl As Control, ByVal str As String, Optional ByVal Height As Boolean = False)
Dim lx As Long, ly As Long
WizHook.Key = 51488399
WizHook.TwipsFromFont pCtrl.FontName, pCtrl.FontSize, pCtrl.FontWeight, _
pCtrl.FontItalic, pCtrl.FontUnderline, 0, str, 0, lx, ly
If Not Height Then
w = lx
Else
GetTextLength = ly
End If
End Function