vb实现控件大小随窗体最大化按比例变化

'以下代码写在标准模块中
  Private FormOldWidth     As Long         '保存窗体的原始宽度
  Private FormOldHeight     As Long       '保存窗体的原始高度
   
  '在调用ResizeForm前先调用本函数
  Public Sub ResizeInit(FormName As Form)
      Dim Obj     As Control
      FormOldWidth = FormName.ScaleWidth    '记录窗体的原始宽度
      FormOldHeight = FormName.ScaleHeight    '记录窗体的原始高度
      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
      '在调试时如果出现除数为零错误，是因为没有设定form的初值，请双击form1然后再测试，这个问题绝对不会在编译好的程序中出现
      If FormOldWidth = 0 Then           '防止该错误的产生
          Exit Sub
      End If
      ScaleX = FormName.ScaleWidth / FormOldWidth               '保存窗体宽度缩放比例
      ScaleY = FormName.ScaleHeight / FormOldHeight           '保存窗体高度缩放比例
      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
      Next i
      Next Obj
      On Error GoTo 0
  End Sub
   
   
  Private Sub Form_Resize()
          ResizeForm Me
  End Sub

Private Sub Form_Load()
ResizeInit Me
End Sub

上一篇: 搜索引擎收录查询工具v1.0
下一篇: VB中不使用菜单编辑器添加右键菜单
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: vb
相关日志: