[原创分享]窗体自适应函数

红尘如烟

因为正好要用到这个东东，找了一下，有的效果很不错，但都是需要调用Tag属性，这样当需要用tag属性做别的事情的时候，就比较麻烦

而有一些在单个窗体中用着很好，但一旦在多个窗体中调用时会出问题，因为每个窗体都需要单独保存窗体中控件等的初始信息，但只有一个保存位置，也就是一个窗体占用了，其它就用不了，说到底就是无法真正模块化

其实这个问题说到底要实现并不难，主要问题在于每个窗体的初始信息存放，想了半天才想起来用自定义集合来实现，效果还行，当窗体中的控件在100个左右时，我在笔记本上试了一下，访问速度在0.1秒以内，还可以接受（自定义集合内的都是Variant型，所以速度较慢）
代码有点长,主要是处理子窗体和子窗体中的子窗体时代码是重复的,我试了一下用别的办法精减,但代码是少了,却极不稳定,所以为了稳定性考虑,大家将就一下代码的冗长吧

1. 
   
2. '----------------------------------------------------------------------------------------------------
   
3. '-函数名称：         FormResize
   
4. '-功能描述：         通用窗体自适应缩放函数，支持2层子窗体
   
5. '-输入参数：         参数1：frm             窗体对象
   
6. '                    参数2：IsNotInitialize 不为初始
   
7. '                    参数3：ini             存放所有控件初始尺寸信息的自定义集合
   
8. '-使用示例：         在窗体的调整大小事件中调用：Call FormResize(Me,blnIsInitialize,MyIni)
   
9. '-使用注意：         下面的变量必须在每一个调用此函数的窗体内含模块中声明：
   
10. '                    Private blnIsNotInitialize As Boolean
    
11. '                    Private MyIni As New Collection
    
12. '                    调用时参数都必须为按地址传递，不能按值传递
    
13. '-兼 容 性：         不能在子窗体中使用
    
14. '-参考资料：
    
15. '-作    者：         红尘如烟
    
16. '-创建日期：         2008年3月28日
    
17. '----------------------------------------------------------------------------------------------------
    
18. Function FormResize(frm As Form, IsNotInitialize As Boolean, ini As Collection)
    
19.     On Error Resume Next
    
20.     Dim ctl As Control          '循环控件集合用的临时变量
    
21.     Dim ctl1 As Control         '同上，用于子窗体
    
22.     Dim ctl2 As Control         '同上，用于子窗体中的子窗体
    
23.     Dim strName As String       '控件名称（由于在循环中多次调用控件名属性，将其存入变量以加快速度）
    
24.     Dim strName1 As String      '同上，用于子窗体
    
25.     Dim strName2 As String      '同上，用于子窗体中的子窗体
    
26.     Dim ScaleX As Double        '窗体调整大小后的宽度除以初始宽度得到的横向比例
    
27.     Dim ScaleY As Double        '窗体调整大小后的高度除以初始高度得到的纵向比例
    
28.     '取得窗体中控件的初始位置及尺寸
    
29.     If IsNotInitialize = False Then
    
30.         With ini
    
31.             .Add frm.InsideWidth, "InsideWidth"
    
32.             .Add frm.InsideHeight, "InsideHeight"
    
33.             .Add frm.Width, "FormWidth"
    
34.             '窗体的节不包含在Controls集合中，所以只能单独处理
    
35.             .Add frm.Section(acDetail).Height, frm.Section(acDetail).Name & "Height"
    
36.             .Add frm.Section(acHeader).Height, frm.Section(acHeader).Name & "Height"
    
37.             .Add frm.Section(acFooter).Height, frm.Section(acFooter).Name & "Height"
    
38.             For Each ctl In frm.Controls
    
39.                 strName = ctl.Name
    
40.                 .Add ctl.Left, strName & "Left"
    
41.                 .Add ctl.Top, strName & "Top"
    
42.                 .Add ctl.Width, strName & "Width"
    
43.                 .Add ctl.Height, strName & "Height"
    
44.                 .Add ctl.FontSize, strName & "FontSize"
    
45.                 '同样处理子窗体
    
46.                 If TypeOf ctl Is SubForm Then
    
47.                     .Add ctl.Form.Width, strName & "FormWidth"
    
48.                     .Add ctl.Form.Section(acDetail).Height, strName & ctl.Form.Section(acDetail).Name & "Height"
    
49.                     .Add ctl.Form.Section(acHeader).Height, strName & ctl.Form.Section(acHeader).Name & "Height"
    
50.                     .Add ctl.Form.Section(acFooter).Height, strName & ctl.Form.Section(acFooter).Name & "Height"
    
51.                     For Each ctl1 In ctl.Form.Controls
    
52.                         strName1 = ctl1.Name
    
53.                         .Add ctl1.Left, strName & strName1 & "Left"
    
54.                         .Add ctl1.Top, strName & strName1 & "Top"
    
55.                         .Add ctl1.Width, strName & strName1 & "Width"
    
56.                         .Add ctl1.Height, strName & strName1 & "Height"
    
57.                         .Add ctl1.FontSize, strName & strName1 & "FontSize"
    
58.                         '同样处理子窗体中的子窗体
    
59.                         If TypeOf ctl1 Is SubForm Then
    
60.                             .Add ctl1.Form.Width, strName & "FormWidth"
    
61.                             .Add ctl1.Form.Section(acDetail).Height, strName & strName1 & ctl1.Form.Section(acDetail).Name & "Height"
    
62.                             .Add ctl1.Form.Section(acHeader).Height, strName & strName1 & ctl1.Form.Section(acHeader).Name & "Height"
    
63.                             .Add ctl1.Form.Section(acFooter).Height, strName & strName1 & ctl1.Form.Section(acFooter).Name & "Height"
    
64.                             For Each ctl2 In ctl1.Form.Controls
    
65.                                 strName2 = ctl2.Name
    
66.                                 .Add ctl2.Left, strName & strName1 & strName2 & "Left"
    
67.                                 .Add ctl2.Top, strName & strName1 & strName2 & "Top"
    
68.                                 .Add ctl2.Width, strName & strName1 & strName2 & "Width"
    
69.                                 .Add ctl2.Height, strName & strName1 & strName2 & "Height"
    
70.                                 .Add ctl2.FontSize, strName & strName1 & strName2 & "FontSize"
    
71.                             Next
    
72.                         End If
    
73.                     Next
    
74.                 End If
    
75.             Next
    
76.         End With
    
77.         IsNotInitialize = True
    
78.     End If
    
79.     With frm
    
80.         .Painting = False   '关闭窗体重画
    
81.         ScaleX = .InsideWidth / ini("InsideWidth")    '得到横向比例
    
82.         ScaleY = .InsideHeight / ini("InsideHeight")  '得到纵向比例
    
83.         '按照比例缩放控件的位置及尺寸
    
84.         .Width = ini("Form_Width") * ScaleX
    
85.         .Section(acDetail).Height = ini(.Section(acDetail).Name & "Height") * ScaleY
    
86.         .Section(acHeader).Height = ini(.Section(acHeader).Name & "Height") * ScaleY
    
87.         .Section(acFooter).Height = ini(.Section(acFooter).Name & "Height") * ScaleY
    
88.     End With
    
89.     For Each ctl In frm.Controls
    
90.         With ctl
    
91.             strName = .Name
    
92.             .Left = ini(strName & "Left") * ScaleX
    
93.             .Top = ini(strName & "Top") * ScaleY
    
94.             .Width = ini(strName & "Width") * ScaleX
    
95.             .Height = ini(strName & "Height") * ScaleY
    
96.             '字体大小按照横向比例和纵向比例中最小的那个进行设置
    
97.             If ScaleX < ScaleY Then
    
98.                 .FontSize = ini(strName & "FontSize") * ScaleX
    
99.             Else
    
100.                 .FontSize = ini(strName & "FontSize") * ScaleY
     
101.             End If
     
102.         End With
     
103.         '同样处理子窗体
     
104.         If TypeOf ctl Is SubForm Then
     
105.             With ctl
     
106.                 .Form.Width = ini("Form_Width") * ScaleX
     
107.                 .Form.Section(acDetail).Height = ini(strName & .Form.Section(acDetail).Name & "Height") * ScaleY
     
108.                 .Form.Section(acHeader).Height = ini(strName & .Form.Section(acHeader).Name & "Height") * ScaleY
     
109.                 .Form.Section(acFooter).Height = ini(strName & .Form.Section(acFooter).Name & "Height") * ScaleY
     
110.             End With
     
111.             For Each ctl1 In ctl.Form.Controls
     
112.                 With ctl1
     
113.                     strName1 = .Name
     
114.                     .Left = ini(strName & strName1 & "Left") * ScaleX
     
115.                     .Top = ini(strName & strName1 & "Top") * ScaleY
     
116.                     .Width = ini(strName & strName1 & "Width") * ScaleX
     
117.                     .Height = ini(strName & strName1 & "Height") * ScaleY
     
118.                     If ScaleX < ScaleY Then
     
119.                         .FontSize = ini(strName & strName1 & "FontSize") * ScaleX
     
120.                     Else
     
121.                         .FontSize = ini(strName & strName1 & "FontSize") * ScaleY
     
122.                     End If
     
123.                 End With
     
124.                 '同样处理子窗体中的子窗体
     
125.                 If TypeOf ctl1 Is SubForm Then
     
126.                     With ctl1
     
127.                         .Form.Width = ini("Form_Width") * ScaleX
     
128.                         .Form.Section(acDetail).Height = ini(strName & strName1 & .Form.Section(acDetail).Name & "Height") * ScaleY
     
129.                         .Form.Section(acHeader).Height = ini(strName & strName1 & .Form.Section(acHeader).Name & "Height") * ScaleY
     
130.                         .Form.Section(acFooter).Height = ini(strName & strName1 & .Form.Section(acFooter).Name & "Height") * ScaleY
     
131.                     End With
     
132.                     For Each ctl2 In ctl1.Form.Controls
     
133.                         With ctl2
     
134.                             strName2 = .Name
     
135.                             .Left = ini(strName & strName1 & strName2 & "Left") * ScaleX
     
136.                             .Top = ini(strName & strName1 & strName2 & "Top") * ScaleY
     
137.                             .Width = ini(strName & strName1 & strName2 & "Width") * ScaleX
     
138.                             .Height = ini(strName & strName1 & strName2 & "Height") * ScaleY
     
139.                             If ScaleX < ScaleY Then
     
140.                                 .FontSize = ini(strName & strName1 & strName2 & "FontSize") * ScaleX
     
141.                             Else
     
142.                                 .FontSize = ini(strName & strName1 & strName2 & "FontSize") * ScaleY
     
143.                             End If
     
144.                         End With
     
145.                     Next
     
146.                 End If
     
147.             Next
     
148.         End If
     
149.     Next
     
150.     frm.Painting = True '开启窗体重画
     
151. End Function
     
152. 
     

复制代码

t小宝

这个 我要拿来用了

Henry D. Sy

谢谢分享，加分！

tmtony

红尘如烟  最近 高产哦,收藏了

5988143

精品作品~

narcissus82

有点难度，惭愧！

zyp

佩服, 收藏了

阿六爱狗

不是有点难度，是很大难度，完全不懂啊，等看懂了估计也是斑竹级别的了

asklove

管它难不难，是好东东就收藏先！

13555609005

谢谢分享