⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mod_autosize.bas

📁 农村水电费记帐录入
💻 BAS
字号:
Attribute VB_Name = "mod_autosize"

Option Explicit

'************************************
'常数
'************************************
    '------------------------------------------
    '坐标轴
    '------------------------------------------
    Global Const size_axis_x = 1
    Global Const size_axis_y = 2

'************************************
'数据类型
'************************************
    '------------------------------------------
    '快速替换对象数据类型,保持所有必须的数据
    '------------------------------------------
    Public Type objectinfo
        top As Long
        left As Long
        height As Long
        width As Long
        tag As String
    End Type

'************************************
'数据类型
'************************************
    '------------------------------------------
    '自动缩放标志定义
    '-----------------------------------------
    'STRETCHH - 水平缩放标志
    'STRETCHV - 垂直缩放标志
    'STRETCHALL - 水平和垂直缩放
    'MOVEH - 水平移动对象
    'MOVEV - 垂直移动对象
    'MOVEALL - 水平和垂直移动对象
    'STRETCHVMOVEH - STRETCHES VERTICALY AND MOVES THE OBJECT HORIZONTALLY
    'STRETCHHMOVEV - STRETCHES HORIZONTALLY AND MOVES THE OBJECT VERTICALY
    '------------------------------------------
    Public Sub Autosizeform(ByRef sizeobjects() As objectinfo, ByRef effectobjects() As Object, ByRef firstwidth As Long, ByRef firstheight As Long, ByRef noofobjects As Integer, sizeform As Form, Optional forcereset As Boolean, Optional axis As Integer)
        If sizeform.WindowState = vbMinimized Then Exit Sub
        Dim getobject As Object             '得到当前对象CURRENT OBJECT BEING RETRIEVED
        Dim setobject As Integer            '设置当前对象CURRENT OBJECT BEING RESCALED
        Dim restricted As Boolean           '更新坐标轴变量
        'If sizeform.width = firsthwidth And sizeform.height = firstheight Then Exit Sub
        '------------------------------------------
        'GET THE AXIS VARIABLE AND SET RESTRICTED
        'TO TRUE IF IT IS ABOVE 0.  THIS WILL CAUSE
        'ONLY SELECTED AXIS'S TO BE SCALES, HANDY
        'TO STOP THE OBJECTS BEING SCALED BELOW 0
        If axis > 0 Then restricted = True
        
        '------------------------------------------
        'THIS BIT RESETS ALL THE SAVED INFORMATION
        'IF NO PREVIOUSLY FOUND OBJECTS WERE FOUND
        'AND IF THE FORCERESET FLAG IS HIGH
        If noofobjects = 0 Or forcereset Then
            For Each getobject In sizeform
                If getobject.tag <> "" Then
                    '-------------------------------------------
                    'INCREASE THE NUMBER OF FOUND OBJECTS
                    noofobjects = noofobjects + 1
                    '-------------------------------------------
                    'REDIM AND SAVE THE OBJECT POSITIONS TO
                    'THE NEW NUMBER OF OBJECTS FOUND
                    ReDim Preserve sizeobjects(noofobjects)
                    sizeobjects(noofobjects).top = getobject.top
                    sizeobjects(noofobjects).left = getobject.left
                    sizeobjects(noofobjects).width = getobject.width
                    sizeobjects(noofobjects).height = getobject.height
                    sizeobjects(noofobjects).tag = getobject.tag
                    '-------------------------------------------
                    'REDIM THE EFFECT OBJECTS AND SET THE
                    'NEW FOUND OBJECT, USING PRESERVE TO KEEP
                    'ALL EXISTING OBJECTS IN THE ARRAY
                    ReDim Preserve effectobjects(noofobjects)
                    Set effectobjects(noofobjects) = getobject
                    '-------------------------------------------
                End If
            Next
            '-------------------------------------------
            'GET THE ORIGINAL HEIGHT AND WIDTH OF THE
            'FORM BEING AUTOSIZED
            firstheight = sizeform.height
            firstwidth = sizeform.width
            '-------------------------------------------
        End If
        '------------------------------------------
        
        '------------------------------------------
        'THIS BIT LOOKS AT THE TAG PART OF THE SAVED
        'OBJECTS AND SCALES THEM AS NECESSARY
        'NO SCALING ALGORYTHMS ARE ACTUALLY USED,
        'THE ROUTINE WORKS BE KEEPING THE RIGHTHAND
        'GAP THE SAME
        If noofobjects >= 1 Then
            For setobject = 1 To noofobjects
                If sizeobjects(setobject).tag <> "" Then effectobjects(setobject).Visible = False
                Select Case sizeobjects(setobject).tag
                    Case "STRETCHH"
                        If restricted = True And axis <> size_axis_x Then GoTo nextobject
                        effectobjects(setobject).width = sizeform.width - (firstwidth - (sizeobjects(setobject).left + sizeobjects(setobject).width)) - sizeobjects(setobject).left
                    Case "STRETCHV"
                        If restricted = True And axis <> size_axis_y Then GoTo nextobject
                        effectobjects(setobject).height = sizeform.height - (firstheight - (sizeobjects(setobject).top + sizeobjects(setobject).height)) - sizeobjects(setobject).top
                    Case "STRETCHALL"
                        If Not restricted Then
                        Debug.Print effectobjects(setobject).Name
                            effectobjects(setobject).width = sizeform.width - (firstwidth - (sizeobjects(setobject).left + sizeobjects(setobject).width)) - sizeobjects(setobject).left
                            effectobjects(setobject).height = sizeform.height - (firstheight - (sizeobjects(setobject).top + sizeobjects(setobject).height)) - sizeobjects(setobject).top
                        Else
                            If axis = size_axis_x Then
                                effectobjects(setobject).width = sizeform.width - (firstwidth - (sizeobjects(setobject).left + sizeobjects(setobject).width)) - sizeobjects(setobject).left
                            Else
                                effectobjects(setobject).height = sizeform.height - (firstheight - (sizeobjects(setobject).top + sizeobjects(setobject).height)) - sizeobjects(setobject).top
                            End If
                        End If
                    Case "MOVEH"
                        If restricted = True And axis <> size_axis_x Then GoTo nextobject
                        effectobjects(setobject).left = sizeform.width - (firstwidth - sizeobjects(setobject).left)
                    Case "MOVEV"
                        If restricted = True And axis <> size_axis_y Then GoTo nextobject
                        effectobjects(setobject).top = sizeform.height - (firstheight - sizeobjects(setobject).top)
                    Case "MOVEALL"
                        If Not restricted Then
                            effectobjects(setobject).left = sizeform.width - (firstwidth - sizeobjects(setobject).left)
                            effectobjects(setobject).top = sizeform.height - (firstheight - sizeobjects(setobject).top)
                        Else
                            If axis = size_axis_x Then
                                effectobjects(setobject).left = sizeform.width - (firstwidth - sizeobjects(setobject).left)
                            Else
                                effectobjects(setobject).top = sizeform.height - (firstheight - sizeobjects(setobject).top)
                            End If
                        End If
                    Case "STRETCHVMOVEH"
                        If Not restricted Then
                            effectobjects(setobject).height = sizeform.height - (firstheight - (sizeobjects(setobject).top + sizeobjects(setobject).height)) - sizeobjects(setobject).top
                            effectobjects(setobject).left = sizeform.width - (firstwidth - sizeobjects(setobject).left)
                        Else
                            If axis = size_axis_x Then
                                effectobjects(setobject).left = sizeform.width - (firstwidth - sizeobjects(setobject).left)
                            Else
                                effectobjects(setobject).height = sizeform.height - (firstheight - (sizeobjects(setobject).top + sizeobjects(setobject).height)) - sizeobjects(setobject).top
                            End If
                        End If
                    Case "STRETCHHMOVEV"
                        If Not restricted Then
                            effectobjects(setobject).width = sizeform.width - (firstwidth - (sizeobjects(setobject).left + sizeobjects(setobject).width)) - sizeobjects(setobject).left
                            effectobjects(setobject).top = sizeform.height - (firstheight - sizeobjects(setobject).top)
                        Else
                            If axis = size_axis_x Then
                                effectobjects(setobject).width = sizeform.width - (firstwidth - (sizeobjects(setobject).left + sizeobjects(setobject).width)) - sizeobjects(setobject).left
                            Else
                                effectobjects(setobject).top = sizeform.height - (firstheight - sizeobjects(setobject).top)
                            End If
                        End If
                End Select
nextobject:
                effectobjects(setobject).Visible = True
            Next setobject
        End If
        '------------------------------------------
    End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -