mformresize.bas

地面测试仪

Attribute VB_Name = "mFormResize"
Option Explicit
    '------------------------------------------
    '根据控件tag标志自动缩放
    '-----------------------------------------
    'SH - 水平缩放
    'SV - 垂直缩放
    'SA - 水平和垂直缩
    'MH - 水平移动
    'MV - 垂直移动
    'MA - 水平和垂直移动
    'SVMH - 垂直缩放水平移动
    'SVMV
    'SHMV - 水平缩放垂直移动
    'SHMH
    'SAMA -
    '以Twips为单位

Const MinWidth = 780
Const MinHeight = 570

Public Sub ResizeInit(FormName As Form)
'**********************************************************************
'* 函数名称:ResizeInit
'* 函数描述:初始化
'* 参数列表:FormName窗体名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
    With FormName
        FormName.Tag = .Width & "|" & .Height
'        FormOldWidth = .Width '\ Screen.TwipsPerPixelX
'        FormOldHeight = .Height '\ Screen.TwipsPerPixelY
    End With
    On Error GoTo 0
End Sub
 
Public Sub ResizeForm(FormName As Form)
   
'********************************************************************** '好好研究一下
'* 函数名称:ResizeForm
'* 函数描述:缩放窗体
'* 参数列表:FormName窗体名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
    Dim i As Long, widthOffset As Single, heightOffset As Single
    Dim obj As Control
    Dim TagArr() As String
    Dim FormOldWidth As Long '保存窗体的原始宽度
    Dim FormOldHeight As Long '保存窗体的原始高度
    
    If FormName.WindowState = 1 Then Exit Sub '最小化
    '限定长宽最小值
    If FormName.Width < MinWidth * Screen.TwipsPerPixelX Then FormName.Width = MinWidth * Screen.TwipsPerPixelX
    If FormName.Height < MinHeight * Screen.TwipsPerPixelY Then FormName.Height = MinHeight * Screen.TwipsPerPixelY
   
    On Error Resume Next
    TagArr = Split(FormName.Tag, "|")
    
    FormOldWidth = TagArr(0)
    FormOldHeight = TagArr(1)
    widthOffset = FormName.Width - FormOldWidth
    heightOffset = FormName.Height - FormOldHeight
    For Each obj In FormName
'      Obj.Width = FormName.Width - (FormOldWidth - (Obj.Left + Obj.Width)) - Obj.Left
'      Obj.Left = FormName.Width - (FormOldHeight - Obj.Left)
        TagArr = Split(UCase(obj.Tag), "|")
        Select Case TagArr(0)
            Case "SH" '水平缩放
                obj.Width = widthOffset + obj.Width
            Case "SV" '垂直缩放
                obj.Height = heightOffset + obj.Height
            Case "SA" '水平和垂直缩
                obj.Width = widthOffset + obj.Width
                obj.Height = heightOffset + obj.Height
            Case "MH" '水平移动
                obj.Left = widthOffset + obj.Left
            Case "MV" '垂直移动
                obj.Top = heightOffset + obj.Top
            Case "MA" '水平和垂直移动
                obj.Left = widthOffset + obj.Left
                obj.Top = heightOffset + obj.Top
            Case "SVMH" '垂直缩放水平移动
                obj.Height = heightOffset + obj.Height
                obj.Left = widthOffset + obj.Left
            Case "SVMV" '垂直
                obj.Top = (heightOffset / 2) + obj.Top
                obj.Height = (heightOffset / 2) + obj.Height
            Case "SHMV" '水平缩放垂直移动
                obj.Width = widthOffset + obj.Width
                obj.Top = heightOffset + obj.Top
            Case "SHMH" '水平
                obj.Left = (widthOffset / 2) + obj.Left
                obj.Width = (widthOffset / 2) + obj.Width
            Case "SAMA"
                obj.Left = (widthOffset / 2) + obj.Left
                obj.Top = (heightOffset / 2) + obj.Top
                obj.Width = (widthOffset / 2) + obj.Width
                obj.Height = (heightOffset) / 2 + obj.Height
            Case Else '
        End Select
    Next obj
 
    ResizeInit FormName
    On Error GoTo 0
End Sub