7,785
社区成员




Public Sub chang(ThisForm As Form)
On Error Resume Next '忽略错误的代码一般放在第一句
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
'..........
'其它代码
'.........
End Sub
'采用这个,你自己按照示例增加就行了.
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
If XFactor = 1 And YFactor = 1 Then Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
Select Case TypeName(.Controls(X))
Case "DriveListBox" 'DriveListBox控件
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
Case "ComboBox" 'ComboBox控件
If .Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Case "TextBox" 'Textbox控件
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
.Controls(X).FontSize = .Controls(X).FontSize * XFactor '设置字体,如果感到小了,可以更改
Case "Label" 'Label控件
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
.Controls(X).FontSize = .Controls(X).FontSize * XFactor '设置字体,如果感到小了,可以更改
'Case "Line" '与上面一样示例,增加其他的控件代码
'....
'.......
Case Else
'除上面申明的控件外,不进行处理 此处也可以增加处理代码
End Select
Next X
End With
End Sub
'上面的代码错误还有.不能起到作用,以下更改后能起到作用.
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
MsgBox XFactor
MsgBox YFactor
If XFactor = 1 And YFactor = 1 Then
Exit Sub
Else
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If .Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
End If
End If
Next X
End With
End If
End Sub
Public Sub chang(ThisForm As Form)
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX% = 1400: DesignY% = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
If XFactor = 1 And YFactor = 1 Then
Exit Sub
With ThisForm
.Move .Left * XFactor, .Top * YFactor, .Width * XFactor, .Height * YFactor
For X = 0 To .Controls.Count - 1
If TypeOf .Controls(X) Is DriveListBox Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
ElseIf TypeOf .Controls(X) Is ComboBox Then
If T.Controls(X).Style <> 1 Then
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor
End If
Else
.Controls(X).Move .Controls(X).Left * XFactor, .Controls(X).Top * XFactor, .Controls(X).Width * XFactor, .Controls(X).Height * YFactor
If TypeOf .Controls(X) Is TextBox Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
ElseIf TypeOf .Controls(X) Is Label Then
.Controls(X).FontSize = .Controls(X).FontSize * XFactor
End If
End If
Next X
End With
End If
End Sub