Office中国论坛/Access中国论坛

标题: [原创分享]窗体自适应函数 [打印本页]
作者: 红尘如烟    时间: 2009-3-29 23:59
标题: [原创分享]窗体自适应函数
本帖最后由 红尘如烟 于 2009-3-31 10:17 编辑

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

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

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

  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

复制代码
[attach]37002[/attach]
作者: t小宝    时间: 2009-3-30 08:34
这个 我要拿来用了
作者: Henry D. Sy    时间: 2009-3-30 10:53
谢谢分享，加分！
作者: tmtony    时间: 2009-3-30 11:07
红尘如烟  最近 高产哦,收藏了
作者: 5988143    时间: 2009-3-30 12:29
精品作品~
作者: narcissus82    时间: 2009-3-30 14:04
有点难度，惭愧！
作者: zyp    时间: 2009-3-30 14:19
佩服, 收藏了
作者: 阿六爱狗    时间: 2009-3-30 14:20
不是有点难度，是很大难度，完全不懂啊，等看懂了估计也是斑竹级别的了
作者: asklove    时间: 2009-3-30 14:51
管它难不难，是好东东就收藏先！
作者: 13555609005    时间: 2009-3-30 17:34
谢谢分享
作者: 红尘如烟    时间: 2009-3-31 10:14
改了一下，布尔型变量的默认值是false，将blnIsInitialize变量改成了blnIsNotInitialize，这样就用不着在窗体的Load事件中对这个变量初始化了
作者: wjsfeng    时间: 2009-3-31 20:22
学习学习
作者: 快乐王    时间: 2009-3-31 20:36
谢谢楼主无私奉献！
作者: huangqinyong    时间: 2009-3-31 23:18
谢谢分享,收藏了
作者: 021230ww    时间: 2009-4-3 12:38
收藏学习
作者: 二阶数组    时间: 2009-4-3 15:33
历害 真不错 这两天也在想呢！
作者: fengxueysh    时间: 2009-4-4 14:32
先收藏，看有难度，有用法示例吗
作者: chaojianan    时间: 2009-4-4 15:45
支持，学习。
作者: Grant    时间: 2009-4-4 15:52
非常棒的实例~收藏了
作者: 陈大林    时间: 2009-4-5 14:39
学习学习再学习哟
作者: fengxueysh    时间: 2009-4-5 16:15
非常好的模块  谢谢分享
作者: yanwei82123300    时间: 2009-4-28 12:12
收藏一下
作者: ty_1029    时间: 2009-4-28 14:32
高手,学习了,,不过还是喜欢拿来主义,哈哈
作者: 蝶舞飛扬    时间: 2009-4-28 15:07
好东西，了解一下
作者: lkkl66    时间: 2009-4-28 16:02
1# 红尘如烟
红尘如烟:你好！
谢谢你的作品，收藏了！
作者: liaug    时间: 2009-4-28 19:59
支持一下
作者: 13555609005    时间: 2009-4-29 11:10
谢谢分享
作者: jackysu78    时间: 2009-4-29 15:24
真是太牛了，佩服
作者: wmok    时间: 2009-4-30 22:12
好东西,谢谢!!!!
作者: LHB    时间: 2009-6-6 16:39
在当今显示器尺寸规格之多的情况下, 这个函数相当实用 !  收藏了!谢谢分享!
作者: 风啸啸    时间: 2009-6-6 17:32
谢谢共享，下载收藏
作者: kelind    时间: 2009-6-6 22:38
好东东，真是好东东！
作者: li08hua    时间: 2010-5-17 23:15
谢谢分享！
作者: 鱼儿游游    时间: 2011-2-12 11:27
本帖最后由 鱼儿游游 于 2011-2-13 00:47 编辑

不明白为什么下面的变量必须在每一个调用此函数的窗体内含模块中声明？
Private blnIsNotInitialize As Boolean
Private MyIni As New Collection
不能定义在函数里吗？因为函数外部没用调用这两个变量。
我认为用 STATIC  语句来定义以上两个变量较好点，不用在外部定义变量。
放大/缩小字体也跟着变化，不太习惯这种方法。呵呵

作者: YXH_YXH    时间: 2013-5-22 16:33
收藏！！！



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3