当前位置:首页 > 点滴记录 > 正文

VB 全屏代码

VB 全屏代码

方法一:文字大小不变的放大窗体的WindowsState属性设置为2,BorderStyle属性设置为0,其他代码如下Option ExplicitDim AutoSh...

方法一:文字大小不变的放大

窗体的WindowsState属性设置为2,BorderStyle属性设置为0,其他代码如下

Option Explicit

Dim AutoShiYing_T(), AutoShiYing_L(), AutoShiYing_H(), AutoShiYing_W(), AutoShiYing_N%

Private Sub Form_Load()

    Dim mcontrol As Object

    On Error Resume Next

    AutoShiYing_N = 0

    For Each mcontrol In Me.Controls

        If Not (TypeOf mcontrol Is Menu) Then

            AutoShiYing_N = AutoShiYing_N + 1

            ReDim Preserve AutoShiYing_T(AutoShiYing_N)

            ReDim Preserve AutoShiYing_L(AutoShiYing_N)

            ReDim Preserve AutoShiYing_H(AutoShiYing_N)

            ReDim Preserve AutoShiYing_W(AutoShiYing_N)

            AutoShiYing_T(AutoShiYing_N) = mcontrol.Top / ScaleHeight

            AutoShiYing_L(AutoShiYing_N) = mcontrol.Left / ScaleWidth

            AutoShiYing_H(AutoShiYing_N) = mcontrol.Height / ScaleHeight

            AutoShiYing_W(AutoShiYing_N) = mcontrol.Width / ScaleWidth

        End If

    Next

    On Error GoTo 0

End Sub

Private Sub Form_Resize()

    Dim mcontrol As Object

    On Error Resume Next

    AutoShiYing_N = 0

    For Each mcontrol In Me.Controls

        If Not (TypeOf mcontrol Is Menu) Then

            AutoShiYing_N = AutoShiYing_N + 1

            mcontrol.Top = AutoShiYing_T(AutoShiYing_N) * ScaleHeight

            mcontrol.Left = AutoShiYing_L(AutoShiYing_N) * ScaleWidth

            mcontrol.Height = AutoShiYing_H(AutoShiYing_N) * ScaleHeight

            mcontrol.Width = AutoShiYing_W(AutoShiYing_N) * ScaleWidth

        End If

    Next

    On Error GoTo 0

End Sub

第二种,所有控件都变大

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)

    Label2.Caption = Format(Now, "yyyy年mm月dd日")

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 sa

    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

            sa = Obj.Name

            Select Case Obj.Name

            Case Is = "Label14"

                Obj.Font.Size = ObjOldFont * FormName.ScaleHeight '控制字体组大小

            Case Is = "Label1"

                Obj.Font.Size = ObjOldFont * 1.5 * FormName.ScaleHeight

            Case Is = "Label6"

                Obj.Font.Size = ObjOldFont * 0.6 * FormName.ScaleHeight

            End Select

        Next i

    Next Obj

End Sub


发表评论

最新文章

取消
扫码支持 支付码