VB 全屏代码
- 点滴记录
- 2021-03-25
- 3063
方法一:文字大小不变的放大窗体的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
本文链接:http://zxmcloud.com/?id=38
上一篇:阿里云盘公测啦,快领免费空间
下一篇:关于小达人点读笔
发表评论