原作者:loooooo
修改: auqaiss
Option Compare Database
Type JLtype '????????????
Tn As String '?????
T1 As Integer '?????????
L1 As Integer '?????????
W1 As Integer '??????
H1 As Integer '??????
End Type
Type CTS '????????????
Cn As String '??????
OLDW As Integer '????????
OLDH As Integer '????????
TZzz() As JLtype '????????????????
i As Integer '?????????????????
End Type
Public CC() As CTS '???????????飨??????????????????棩
Public Sub TZLoad(Frm As Form)
'--------------------------
On Error GoTo cuowu1
Dim Cw As Long '??鴰????±???????δ???????
Cw = UBound(CC)
'----------------------------
'On Error GoTo cuowu
Dim N As String
Dim JJ As Integer
Dim PD As Boolean
'?????????????壬??????????????
N = Frm.name
For JJ = LBound(CC) To UBound(CC)
If CC(JJ).Cn = N Then
PD = True
Exit For
Else
PD = False
End If
Next JJ
If PD = False Then
JJ = JJ + 1
ReDim Preserve CC(JJ)
End If
'????????????????????????????????????
CC(JJ).Cn = N
CC(JJ).OLDH = Frm.InsideHeight
CC(JJ).OLDW = Frm.InsideWidth
CC(JJ).i = 0 '????????????????
Dim obj As Control
Dim L As Integer
For Each obj In Frm
CC(JJ).i = CC(JJ).i + 1
L = CC(JJ).i
ReDim Preserve CC(JJ).TZzz(L)
CC(JJ).TZzz(L).Tn = obj.name
CC(JJ).TZzz(L).T1 = obj.Top
CC(JJ).TZzz(L).L1 = obj.Left
CC(JJ).TZzz(L).W1 = obj.Width
CC(JJ).TZzz(L).H1 = obj.Height
Next obj
Exit Sub
cuowu1:
ReDim CC(1)
Resume Next
cuowu:
MsgBox Err.Description
Exit Sub
End Sub
Public Sub TZsize(Frmt As Form)
'On Error GoTo cuowu
Dim N As String
Dim X As Double
Dim Y As Double
Dim j As Integer
Dim JJ As Integer
N = Frmt.name
For JJ = LBound(CC) To UBound(CC)
If CC(JJ).Cn = N Then Exit For
Next JJ
Dim obj As Control
Y = Frmt.InsideHeight / CC(JJ).OLDH
X = Frmt.InsideWidth / CC(JJ).OLDW
Frmt.Section(acDetail).Height = Frmt.InsideHeight '????????,?????????
For j = 1 To CC(JJ).i
Set obj = Frmt(CC(JJ).TZzz(j).Tn)
'if obj.Name="
With obj
If Len(.name) < 16 or Left(.name, 16) <> "NavigationButton" Then '原来作者这里没有判断是否是NavigationButton,导致一旦对其.top .left属性赋值就会报错
.Top = CC(JJ).TZzz(j).T1 * 1.1
.Left = CC(JJ).TZzz(j).L1 * X
End If
.Width = CC(JJ).TZzz(j).W1 * X
.Height = CC(JJ).TZzz(j).H1 * Y
End With
Next j
Exit Sub
cuowu:
MsgBox Err.Description
Exit Sub
End Sub