180 分求助 VB MDI子窗体问题

Question

上次提出个类似的问题，但是一直没有实现，现在重新提出来，实现了立即给分。MDI子窗体随显示器分辨率变化而变化：
即软件是在1024X768的分辨率下做的，当我的显示器分辨率调高后（如1440X900或者1600X1200或者其他更高的宽屏分辨率），界面就会变得很小，怎么使该子窗体充满整个MDI主窗体的内部？？？
假设MDI窗体名称为：MDImain ,有一个工具栏toolbar1和一个状态栏statusbar1,MDI子窗体名称为Form1

Answer 1

由于VB内部已对WM_DISPLAYCHANGE消息进行了处理，故不需要其它特殊设置，只需将Form1.WindowsState设置为2（最大化）就可以了。

Answer 2

但是子窗体上的控件不能充满整个MDI主窗体的内部呀

Answer 3

试一试将所有窗体的ScaleMode设为3,即以像素为单位计量,当分辨率改变后,控件的高和宽的像素按比例改变可否解决些类问题.

Answer 4

private sub form_resize()
with me
 if .scaleheight > 4000 and .scalewidth > 4000 then
   .frame1.width = .scalewidth - frame1.left * 2
   '..其它的类似
 end if
end with
end sub这个没人能完全帮你，控件一大堆都得你自己来控制

Answer 5

在MDI主窗体的Resize中
Form1.Move 0,0,Me.ScaleWidth,Me.ScaleHeight

Answer 6

1)主窗体、子窗体都最大化
2)在 Form_Resize() 中自适应控件大小比如在子窗体中有 Text1、Command1、List1（属性 IntegralHeight = False）：
'子窗体
Option ExplicitPrivate Sub Form_Resize()
    If Me.WindowState = vbMinimized Then Exit Sub
    
    On Error Resume Next
    Command1.Move ScaleWidth - 120 - Command1.Width, 120, Command1.Width, Text1.Height
    Text1.Move 120, 120, Command1.Left - 240
    List1.Move 120, GetBottom(Text1) + 120, ScaleWidth - 240, ScaleHeight - GetBottom(Text1) - 240
    On Error GoTo 0
End Sub
'通用模块
Option ExplicitFunction GetBottom(ByVal ctl As Control) As Single
    GetBottom = ctl.Top + ctl.Height
End FunctionFunction GetRight(ByVal ctl As Control) As Single
    GetRight = ctl.Left + ctl.Width
End Function

Answer 7

问题实际上就是MID子窗体的所有控件都随显示器分辨率变化而变化

Answer 8

将子窗体的WindowState设置为Maximized试试
Form1.WindowState = Maximized

Answer 9

你到底要解决大分辨率界面有空白的问题还是字体太小的问题？
前者用自适应控件解决——就是锁定与边界的距离，.Net 控件的 Anchor 属性就是自动实现该功能用的。
后者可以按窗体分辨率的放大比率更改控件的字体大小来解决。

Answer 10

Option ExplicitPrivate Sub Form_Resize()
    Dim rRateX As Single, rRateY As Single, rRate As Single
    Dim rFontSize As Single
    Dim H1 As Single, W1 As Single
    
    If Me.WindowState = vbMinimized Then Exit Sub
    
    On Error Resume Next
    
    '计算屏幕比率（标准为 1024*768）'
    rRateX = Round(Screen.Width / Screen.TwipsPerPixelX / 1024, 1)
    rRateY = Round(Screen.Height / Screen.TwipsPerPixelY / 768, 1)
    rRate = IIf(rRateX > rRateY, rRateX, rRateY)
    '按比率调整字体（假定 1024*768 下 FontSize 为 10）'
    rFontSize = 10 * rRate
    Command1.FontSize = rFontSize
    Text1.FontSize = rFontSize
    List1.FontSize = rFontSize
    '自适应大小（部分控件需要按比率调整大小）'
    H1 = 375 * rRate 'Text1, Command1 的高度'
    W1 = 1200 * rRate 'Command1 的宽度'
    Command1.Move ScaleWidth - 120 - W1, 120, W1, H1
    Text1.Move 120, 120, Command1.Left - 240, H1
    List1.Move 120, GetBottom(Text1) + 120, ScaleWidth - 240, ScaleHeight - GetBottom(Text1) - 240    On Error GoTo 0
End Sub

Answer 11

各种控件存在差异，比如 Timer 控件就无法调整大小和字体。如果再用上第三方控件，例外更多。
逐个设置最不容易出错。

Answer 12

Dim ctl as ControlFor Each ctl In Me.Controls
    If TypeOf(ctl) Is TextBox Then
        ...
    ElseIf TypeOf(ctl) Is Label Then
        ...
    End If
Next

Answer 13

不知道各位兄弟是否真正理解了我的意思没有，我的意思实际上就是：简单的理解可以理解为这样，在1024X768的情况下，我们可以把子窗体的界面看成是一张图片，当分辨率调整到假如1440X900分辨率后，这张图片就会在屏幕中间显示得较小，现在实际上要解决的问题就是把这张图片整体放大以充满整个屏幕，也就是说子窗体上的所有控件和字体都要按比例缩放。楼上兄弟的我试了一下，不是按比例的呀，比如text1,并不是按照比例的，而是直接充满了整个屏幕，没有按照调整前和调整后的屏幕的比例来缩放。

Answer 14

  Option   Explicit   
  Private   nFormHeight             As   Integer   
  Private   nFormWidth               As   Integer   
  Private   nNumOfControls       As   Integer   
  Private   nTop()                       As   Integer   
  Private   nLeft()                     As   Integer   
  Private   nHeight()                 As   Integer   
  Private   nWidth()                   As   Integer   
  Private   nFontSize()             As   Integer   
  Private   nRightMargin()       As   Integer   
  Private   bFirstTime               As   Boolean   
  Private   txtH                           As   Double   
  '--------------------------------------------------------------------------------   
    
  Sub   Init(frm   As   Form,   Optional   MDIid   As   Boolean,   Optional   nWindState   As   Variant)   
  Dim   i                     As   Integer   
  Dim   bWinMax         As   Boolean   
  bWinMax   =   Not   IsMissing(nWindState)   
  If   MDIid   =   True   Then   
          nFormHeight   =   9000   
          nFormWidth   =   12000   
  Else   
          nFormHeight   =   8130   
          nFormWidth   =   10305   
  End   If   
  nNumOfControls   =   frm.Controls.Count   -   1   
  bFirstTime   =   True   
  ReDim   nTop(nNumOfControls)   
  ReDim   nLeft(nNumOfControls)   
  ReDim   nHeight(nNumOfControls)   
  ReDim   nWidth(nNumOfControls)   
  ReDim   nFontSize(nNumOfControls)   
  ReDim   nRightMargin(nNumOfControls)   
  On   Error   Resume   Next   
  For   i   =   0   To   nNumOfControls   
          If   TypeOf   frm.Controls(i)   Is   Line   Then   
                  nTop(i)   =   frm.Controls(i).Y1   
                  nLeft(i)   =   frm.Controls(i).X1   
                  nHeight(i)   =   frm.Controls(i).Y2   
                  nWidth(i)   =   frm.Controls(i).X2   
          ElseIf   TypeOf   frm.Controls(i)   Is   TextBox   Then   
                  nTop(i)   =   frm.Controls(i).Top   
                  nLeft(i)   =   frm.Controls(i).Left   
                  nHeight(i)   =   frm.Controls(i).Height   
                  nWidth(i)   =   frm.Controls(i).Width   
                  nFontSize(i)   =   frm.FontSize   
                  nRightMargin(i)   =   frm.Controls(i).RightMargin   
                  txtH   =   nHeight(i)   
          Else   
                  nTop(i)   =   frm.Controls(i).Top   
                  nLeft(i)   =   frm.Controls(i).Left   
                  nHeight(i)   =   frm.Controls(i).Height   
                  nWidth(i)   =   frm.Controls(i).Width   
                  nFontSize(i)   =   frm.FontSize   
                  nRightMargin(i)   =   frm.Controls(i).RightMargin   
          End   If   
  Next   
    
  If   MDIid   =   True   Then   
          frm.Height   =   Screen.Height   
          frm.Width   =   Screen.Width   
  Else   
          frm.Height   =   frm_Sys_Main.Height   -   frm_Sys_Main.tbToolBar.Top   -   frm_Sys_Main.tbToolBar.Height   -   frm_Sys_Main.sbStatusBar.Height   
          frm.Width   =   frm_Sys_Main.Width   -   frm_Sys_Main.MainButt.Width   
  End   If   
  bFirstTime   =   True   
  End   Sub   
    
  '--------------------------------------------------------------------------------   
  Sub   FormResize(frm   As   Form,   Optional   MDITofF   As   Boolean)   
  Dim   i                           As   Integer   
  Dim   nCaptionSize     As   Integer   
  Dim   dRatioX               As   Double   
  Dim   dRatioY               As   Double   
  Dim   nSaveRedraw       As   Long   
  Dim   txtnh                   As   Double   
  On   Error   Resume   Next   
  nSaveRedraw   =   frm.AutoRedraw   
  frm.AutoRedraw   =   True   
  If   bFirstTime   Then   
          bFirstTime   =   False   
          Exit   Sub   
  End   If   
  If   frm.Height   <   nFormHeight   /   2   Then   
          frm.Height   =   nFormHeight   /   2   
  End   If   
  If   frm.Width   <   nFormWidth   /   2   Then   
          frm.Width   =   nFormWidth   /   2   
  End   If   
    
  nCaptionSize   =   400   
  nCaptionSize   =   Int(nFontSize(i)   /   dRatioX)   +   Int(nFontSize(i)   /   dRatioX)   Mod   2   
  dRatioY   =   1#   *   (nFormHeight   -   nCaptionSize)   _   
  /   (frm.Height   -   nCaptionSize)   
  dRatioX   =   1#   *   nFormWidth   /   frm.Width   
  If   Not   MDITofF   =   True   Then   
          On   Error   Resume   Next   
          For   i   =   0   To   nNumOfControls   
                  If   TypeOf   frm.Controls(i)   Is   TextBox   Then   
                          frm.Controls(i).Height   =   Int(nHeight(i)   /   dRatioY)   
                          txtnh   =   frm.Controls(i).Height   -   txtH   
                          Exit   For   
                  End   If   
          Next   
  End   If   
  On   Error   Resume   Next   
  For   i   =   0   To   nNumOfControls   
          If   TypeOf   frm.Controls(i)   Is   Line   Then   
                  frm.Controls(i).Y1   =   Int(nTop(i)   /   dRatioY)   +   25   
                  frm.Controls(i).X1   =   Int(nLeft(i)   /   dRatioX)   
                  frm.Controls(i).Y2   =   Int(nHeight(i)   /   dRatioY)   +   25   
                  frm.Controls(i).X2   =   Int(nWidth(i)   /   dRatioX)   
          Else   
                  frm.Controls(i).Top   =   Int(nTop(i)   /   dRatioY)   -   25   
                  frm.Controls(i).Left   =   Int(nLeft(i)   /   dRatioX)   
                  frm.Controls(i).Height   =   Int(nHeight(i)   /   dRatioY)   
                  frm.Controls(i).Width   =   Int(nWidth(i)   /   dRatioX)   
                  frm.Controls(i).FontSize   =   nFontSize(i)   +   IIf(((nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2)   -   Int((nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2)   =   0,   (nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2,   Int((nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2)   +   1)   
                  frm.Controls(i).RightMargin   =   Int(nRightMargin(i)   /   dRatioY)   
          End   If   
  Next   
  frm.AutoRedraw   =   nSaveRedraw   
  End   Sub 有没有哪位兄弟能详细说说这段代码的功能，是不是子窗体随分辨率变化而变化的代码，红色区域的代码是什么意思，结合本帖的要求，能否指点和修改？同样给分

Answer 15

我发个解决控件自适应的
Option ExplicitPrivate Type CtlSize
 Ctl As Control
 X As Long
 Y As Long
 W As Long
 H As Long
End Type
Dim sCtl() As CtlSizePrivate Sub Form_Load()Dim srcFrmScaleMode As Long
srcFrmScaleMode = Me.ScaleMode
Me.ScaleMode = 0
Me.ScaleWidth = 1000
Me.ScaleHeight = 1000
ReDim sCtl(65536)       '这个东西自己来吧，这里设置的很大，为了后面再单独申请存储空间了
Dim i As Control
Dim ctlCount As Long
For Each i In Me.Controls
    
    If (TypeName(i) <> "Timer") And (TypeName(i) <> "Menu") Then        '这个判断句请自己添加,根本不支持移动的控件
        Set sCtl(ctlCount).Ctl = i                                      ' 除了timer,menu控件,还有象 imagelist也是不支持的
        sCtl(ctlCount).X = i.Left                                       ' 还有一个 line 控件比较特殊,自己考虑吧
        sCtl(ctlCount).Y = i.Top                                        '能支持大多数的控件就行了,这个解决方法的关键是巧妙
        sCtl(ctlCount).W = i.Width
        sCtl(ctlCount).H = i.Height
        ctlCount = ctlCount + 1
    End IfNext
ReDim Preserve sCtl(ctlCount - 1)
Me.ScaleMode = srcFrmScaleMode
End SubPrivate Sub Form_Resize()
On Error Resume Next
Dim srcFrmScaleMode As Long
srcFrmScaleMode = Me.ScaleMode
Me.ScaleMode = 0
Me.ScaleWidth = 1000
Me.ScaleHeight = 1000
Dim i As Long
For i = 0 To UBound(sCtl)
    sCtl(i).Ctl.Left = sCtl(i).X            '注释这句，就不支持 Left 属性调整了
    sCtl(i).Ctl.Top = sCtl(i).Y             '                   top
    sCtl(i).Ctl.Height = sCtl(i).H          '                   height
    sCtl(i).Ctl.Width = sCtl(i).W           '                   width
Next
Me.ScaleMode = srcFrmScaleMode
    
End Sub这东西看着麻烦,但使用起来可能是最简单的,效率可能也不会太次,因为他根本不用计算
在设置移动的时候没用 object.move 方法,是因为怕有的控件不支持

Answer 16

'建立一个类模块，代码如下：（类名为ControlAutoSize）   
  Option   Explicit   
  Private   nFormHeight             As   Integer   
  Private   nFormWidth               As   Integer   
  Private   nNumOfControls       As   Integer   
  Private   nTop()                       As   Integer   
  Private   nLeft()                     As   Integer   
  Private   nHeight()                 As   Integer   
  Private   nWidth()                   As   Integer   
  Private   nFontSize()             As   Integer   
  Private   nRightMargin()       As   Integer   
  Private   bFirstTime               As   Boolean   
  Private   txtH                           As   Double   
  '--------------------------------------------------------------------------------   
    
'窗体中定义
  Private   autor   As   New   ControlAutoSize  
  Sub   Init(frm   As   Form,   Optional   MDIid   As   Boolean,   Optional   nWindState   As   Variant)   
  Dim   i                     As   Integer   
  Dim   bWinMax         As   Boolean   
  bWinMax   =   Not   IsMissing(nWindState)   
  If   MDIid   =   True   Then   
          nFormHeight   =   9000   
          nFormWidth   =   12000   
  Else   
          nFormHeight   =   8130   
          nFormWidth   =   10305   
  End   If   
  nNumOfControls   =   frm.Controls.Count   -   1   
  bFirstTime   =   True   
  ReDim   nTop(nNumOfControls)   
  ReDim   nLeft(nNumOfControls)   
  ReDim   nHeight(nNumOfControls)   
  ReDim   nWidth(nNumOfControls)   
  ReDim   nFontSize(nNumOfControls)   
  ReDim   nRightMargin(nNumOfControls)   
  On   Error   Resume   Next   
  For   i   =   0   To   nNumOfControls   
          If   TypeOf   frm.Controls(i)   Is   Line   Then   
                  nTop(i)   =   frm.Controls(i).Y1   
                  nLeft(i)   =   frm.Controls(i).X1   
                  nHeight(i)   =   frm.Controls(i).Y2   
                  nWidth(i)   =   frm.Controls(i).X2   
          ElseIf   TypeOf   frm.Controls(i)   Is   TextBox   Then   
                  nTop(i)   =   frm.Controls(i).Top   
                  nLeft(i)   =   frm.Controls(i).Left   
                  nHeight(i)   =   frm.Controls(i).Height   
                  nWidth(i)   =   frm.Controls(i).Width   
                  nFontSize(i)   =   frm.FontSize   
                  nRightMargin(i)   =   frm.Controls(i).RightMargin   
                  txtH   =   nHeight(i)   
          Else   
                  nTop(i)   =   frm.Controls(i).Top   
                  nLeft(i)   =   frm.Controls(i).Left   
                  nHeight(i)   =   frm.Controls(i).Height   
                  nWidth(i)   =   frm.Controls(i).Width   
                  nFontSize(i)   =   frm.FontSize   
                  nRightMargin(i)   =   frm.Controls(i).RightMargin   
          End   If   
  Next   
    
  If   MDIid   =   True   Then   
          frm.Height   =   Screen.Height   
          frm.Width   =   Screen.Width   
  Else   
          frm.Height   =   frm_Sys_Main.Height   -   frm_Sys_Main.tbToolBar.Top   -   frm_Sys_Main.tbToolBar.Height   -   frm_Sys_Main.sbStatusBar.Height   
          frm.Width   =   frm_Sys_Main.Width   -   frm_Sys_Main.MainButt.Width   
  End   If   
  bFirstTime   =   True   
  End   Sub   
    
  '--------------------------------------------------------------------------------   
  Sub   FormResize(frm   As   Form,   Optional   MDITofF   As   Boolean)   
  Dim   i                           As   Integer   
  Dim   nCaptionSize     As   Integer   
  Dim   dRatioX               As   Double   
  Dim   dRatioY               As   Double   
  Dim   nSaveRedraw       As   Long   
  Dim   txtnh                   As   Double   
  On   Error   Resume   Next   
  nSaveRedraw   =   frm.AutoRedraw   
  frm.AutoRedraw   =   True   
  If   bFirstTime   Then   
          bFirstTime   =   False   
          Exit   Sub   
  End   If   
  If   frm.Height   <   nFormHeight   /   2   Then   
          frm.Height   =   nFormHeight   /   2   
  End   If   
  If   frm.Width   <   nFormWidth   /   2   Then   
          frm.Width   =   nFormWidth   /   2   
  End   If   
    
  nCaptionSize   =   400   
  nCaptionSize   =   Int(nFontSize(i)   /   dRatioX)   +   Int(nFontSize(i)   /   dRatioX)   Mod   2   
  dRatioY   =   1#   *   (nFormHeight   -   nCaptionSize)   _   
  /   (frm.Height   -   nCaptionSize)   
  dRatioX   =   1#   *   nFormWidth   /   frm.Width   
  If   Not   MDITofF   =   True   Then   
          On   Error   Resume   Next   
          For   i   =   0   To   nNumOfControls   
                  If   TypeOf   frm.Controls(i)   Is   TextBox   Then   
                          frm.Controls(i).Height   =   Int(nHeight(i)   /   dRatioY)   
                          txtnh   =   frm.Controls(i).Height   -   txtH   
                          Exit   For   
                  End   If   
          Next   
  End   If   
  On   Error   Resume   Next   
  For   i   =   0   To   nNumOfControls   
          If   TypeOf   frm.Controls(i)   Is   Line   Then   
                  frm.Controls(i).Y1   =   Int(nTop(i)   /   dRatioY)   +   25   
                  frm.Controls(i).X1   =   Int(nLeft(i)   /   dRatioX)   
                  frm.Controls(i).Y2   =   Int(nHeight(i)   /   dRatioY)   +   25   
                  frm.Controls(i).X2   =   Int(nWidth(i)   /   dRatioX)   
          Else   
                  frm.Controls(i).Top   =   Int(nTop(i)   /   dRatioY)   -   25   
                  frm.Controls(i).Left   =   Int(nLeft(i)   /   dRatioX)   
                  frm.Controls(i).Height   =   Int(nHeight(i)   /   dRatioY)   
                  frm.Controls(i).Width   =   Int(nWidth(i)   /   dRatioX)   
                  frm.Controls(i).FontSize   =   nFontSize(i)   +   IIf(((nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2)   -   Int((nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2)   =   0,   (nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2,   Int((nFontSize(i)   /   dRatioX   -   nFontSize(i))   /   2)   +   1)   
                  frm.Controls(i).RightMargin   =   Int(nRightMargin(i)   /   dRatioY)   
          End   If   
  Next   
  frm.AutoRedraw   =   nSaveRedraw   
  End   Sub   
        
Private Sub Form_Load()
autor.Init Me
End SubPrivate Sub Form_Resize()
autor.FormResize Me
End Sub
运行时提示未找到方法或数据成员，然后指向form_load()中的.init ，请问是怎么回事？？？如何解决？？？有没有哪位兄弟能详细说说这段代码的功能，是不是子窗体随分辨率变化而变化的代码，红色区域的代码是什么意思，结合本帖的要求，能否指点和修改？同样给分

Answer 17

谢谢PctGL ！我试试看，不过子窗体还要除去工具栏和状态栏哟，现在好象有些控件的右边和下边部分超过了屏幕看不到

Answer 18

这不是在寻开心么——前面一直在说自适应，你要等比例却偏偏不说。Option ExplicitPrivate Sub Form_Resize()
    Dim rRateX As Single, rRateY As Single, rRate As Single
    Dim rFontSize As Single
    
    If Me.WindowState = vbMinimized Then Exit Sub
    
    On Error Resume Next
    
    '计算屏幕比率（标准为 1024*768）'
    rRateX = Screen.Width / Screen.TwipsPerPixelX / 1024
    rRateY = Screen.Height / Screen.TwipsPerPixelY / 768
    rRate = Round(IIf(rRateX > rRateY, rRateX, rRateY), 1)
    '按比率调整字体（假定 1024*768 下 FontSize 为 10）'
    rFontSize = 10 * rRate
    Command1.FontSize = rFontSize
    Text1.FontSize = rFontSize
    List1.FontSize = rFontSize    '按比率调整大小'
    Text1.Move 120 * rRateX, 120 * rRateY, 13500 * rRateX, 375 * rRateY
    '↑几个定值就是在 1024*768 下的坐标和大小'
    ...'其余控件类似'
    
    On Error GoTo 0
End Sub

Answer 19

没对，还是不成比例的，有些控件的右边和下边部分超过了屏幕看不到，还有就是你这个能适用于MDI子窗体吗？

Answer 20

那是应该现在的比例是按照屏幕比例来算的，但是即使同一个分辨率下用不同的主题，窗体的客户区大小也可能不一样的。
你可以改用窗体的 ScaleWidth、ScaleHeight 来计算比例，标准的 MDI 子窗体是可以的，不过在用了某些工具条、状态条之类的控件后，会导致子窗体的 Resize 事件提早触发，而这时窗体的 ScaleWidth、ScaleHeight 等属性还没有更新。如果控件不提供相应的事件，你只能用 Timer 控件定期检查窗体的客户区是否发生变化，然后进行等比例缩放。

Answer 21

谢谢PCTGL！我看到了的，但是你那个对于MDI子窗体是不行的啊，我还要解决工具栏、状态栏的高度等问题呀，你那个只能针对SDI窗体的

Answer 22

没错，PctGL 就是按客户区比例缩放的。
合并上 FontSize 缩放就能用了。

Answer 23

Option ExplicitPrivate Type CtlSize
 Ctl As Control
 X As Long
 Y As Long
 W As Long
 H As Long
End Type
Dim sCtl() As CtlSizePrivate Sub Form_Load()Dim srcFrmScaleMode As Long
srcFrmScaleMode = Me.ScaleMode
Me.ScaleMode = 0
Me.ScaleWidth = 1000
Me.ScaleHeight = 1000
ReDim sCtl(65536)       '这个东西自己来吧，这里设置的很大，为了后面再单独申请存储空间了
Dim i As Control
Dim ctlCount As Long
For Each i In Me.Controls
    
    If (TypeName(i) <> "Timer") And (TypeName(i) <> "Menu") Then        '这个判断句请自己添加,根本不支持移动的控件
        Set sCtl(ctlCount).Ctl = i                                      ' 除了timer,menu控件,还有象 imagelist也是不支持的
        sCtl(ctlCount).X = i.Left                                       ' 还有一个 line 控件比较特殊,自己考虑吧
        sCtl(ctlCount).Y = i.Top                                        '能支持大多数的控件就行了,这个解决方法的关键是巧妙
        sCtl(ctlCount).W = i.Width
        sCtl(ctlCount).H = i.Height
        ctlCount = ctlCount + 1
    End IfNext
ReDim Preserve sCtl(ctlCount - 1)
Me.ScaleMode = srcFrmScaleMode
End SubPrivate Sub Form_Resize()
On Error Resume Next
Dim srcFrmScaleMode As Long
srcFrmScaleMode = Me.ScaleMode
Me.ScaleMode = 0
Me.ScaleWidth = 1000
Me.ScaleHeight = 1000
Dim i As Long
For i = 0 To UBound(sCtl)
    sCtl(i).Ctl.Left = sCtl(i).X            '注释这句，就不支持 Left 属性调整了
    sCtl(i).Ctl.Top = sCtl(i).Y             '                   top
    sCtl(i).Ctl.Height = sCtl(i).H          '                   height
    sCtl(i).Ctl.Width = sCtl(i).W           '                   width
Next
Me.ScaleMode = srcFrmScaleMode
    
End Sub

Answer 24

确实不满意，真的都挺垃圾的，不过我也没想出不垃圾的做法，升级的vb.net 就没问题了，可惜vb.net 不能编译成ncode,放客户端实在不安全，头疼，难道真得用vc来开发吗？

Answer 25

Option Explicit
  Private ObjOldWidth     As Long       '保存窗体的原始宽度
  Private ObjOldHeight     As Long     '保存窗体的原始高度
  Private ObjOldFont     As Single     '保存窗体的原始字体比
    
  Private Sub Form_Resize()
    
          '确保窗体改变时控件随之改变
          Call ResizeForm(Me)
            
  End Sub
    
  Private Sub Form_Load()
    
          '在程序装入时必须加入
          Call ResizeInit(Me)
            
  End Sub
    
  '模块
        
  '在调用ResizeForm前先调用本函数
  Public Sub ResizeInit(FormName As Form)
    
          Dim Obj     As Control
        
          ObjOldWidth = FormName.ScaleWidth
          ObjOldHeight = FormName.ScaleHeight
          ObjOldFont = FormName.Font.Size / ObjOldHeight
    
  On Error Resume Next
        
          For Each Obj In FormName
                  Obj.Tag = Obj.Left & "   " & Obj.Top & "   " & Obj.Width & "   " & Obj.Height & "   "
          Next Obj
        
  On Error GoTo 0
    
  End Sub
    
  '按比例改变表单内各元件的大小，
  '在调用ReSizeForm前先调用ReSizeInit函数
  Public Sub ResizeForm(FormName As Form)
    
          Dim Pos(4)     As Double
          Dim i     As Long, TempPos       As Long, StartPos       As Long
          Dim Obj     As Control
          Dim ScaleX     As Double, ScaleY       As Double
        
          ScaleX = FormName.ScaleWidth / ObjOldWidth
          '保存窗体宽度缩放比例
          ScaleY = FormName.ScaleHeight / ObjOldHeight
          '保存窗体高度缩放比例
  On Error Resume Next
        
          For Each Obj In FormName
                  StartPos = 1
                    
                  For i = 0 To 4
                          '读取控件的原始位置与大小
                          TempPos = InStr(StartPos, Obj.Tag, "   ", vbTextCompare)
                            
                          If TempPos > 0 Then
                                  Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
                                  StartPos = TempPos + 1
                          Else
                                  Pos(i) = 0
                          End If
                
                          '根据控件的原始位置及窗体改变大
                          '小的比例对控件重新定位与改变大小
                          Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
                          Obj.Font.Size = ObjOldFont * FormName.ScaleHeight
                            
                  Next i
        
          Next Obj
        
  On Error GoTo 0
    
  End Sub