解决分辨率问题
2010-09-16 10:22
162 查看
Option Explicit
Public Xtwips As Integer, Ytwips As Integer
Public Xpixels As Integer, Ypixels As Integer
Type FRMSIZE
Height As Long
Width As Long
End Type
Public RePosForm As Boolean
Public DoResize As Boolean
Dim myForm As FRMSIZE
Dim DesignX As Integer
Dim DesignY As Integer
Dim ScaleFactorX As Single, ScaleFactorY As Single
Sub Resize_For_Resolution(ByVal SFX As Single, ByVal SFY As Single, myForm As Form)
Dim I As Integer
Dim SFFont As Single
SFFont = (SFX + SFY) / 2
On Error Resume Next
With myForm
For I = 0 To .Count - 1
If TypeOf .Controls(I) Is ComboBox Then
.Controls(I).Left = .Controls(I).Left * SFX
.Controls(I).Top = .Controls(I).Top * SFY
.Controls(I).Width = .Controls(I).Width * SFX
Else
.Controls(I).Move .Controls(I).Left * SFX, _
.Controls(I).Top * SFY, _
.Controls(I).Width * SFX, _
.Controls(I).Height * SFY
End If
.Controls(I).FontSize = .Controls(I).FontSize * SFFont
Next I
If RePosForm Then
.Move .Left * SFX, .Top * SFY, .Width * SFX, .Height * SFY
End If
End With
End Sub
Public Sub FormResize(TheForm As Form)
Dim ScaleFactorX As Single, ScaleFactorY As Single
If Not DoResize Then
DoResize = True
Exit Sub
End If
RePosForm = False
ScaleFactorX = TheForm.Width / myForm.Width
ScaleFactorY = TheForm.Height / myForm.Height
Resize_For_Resolution ScaleFactorX, ScaleFactorY, TheForm
myForm.Height = TheForm.Height
myForm.Width = TheForm.Width
End Sub
Public Sub AdjustForm(TheForm As Form)
Dim Res As String ' Returns resolution of system
' Put the design time resolution in here
DesignX = 640
DesignY = 480
RePosForm = True
DoResize = False
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips
Xpixels = Screen.Width / Xtwips
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
TheForm.ScaleMode = 1
Resize_For_Resolution ScaleFactorX, ScaleFactorY, TheForm
Res = Str$(Xpixels) + " by " + Str$(Ypixels)
'Debug.Print Res
myForm.Height = TheForm.Height
myForm.Width = TheForm.Width
End Sub
Public Xtwips As Integer, Ytwips As Integer
Public Xpixels As Integer, Ypixels As Integer
Type FRMSIZE
Height As Long
Width As Long
End Type
Public RePosForm As Boolean
Public DoResize As Boolean
Dim myForm As FRMSIZE
Dim DesignX As Integer
Dim DesignY As Integer
Dim ScaleFactorX As Single, ScaleFactorY As Single
Sub Resize_For_Resolution(ByVal SFX As Single, ByVal SFY As Single, myForm As Form)
Dim I As Integer
Dim SFFont As Single
SFFont = (SFX + SFY) / 2
On Error Resume Next
With myForm
For I = 0 To .Count - 1
If TypeOf .Controls(I) Is ComboBox Then
.Controls(I).Left = .Controls(I).Left * SFX
.Controls(I).Top = .Controls(I).Top * SFY
.Controls(I).Width = .Controls(I).Width * SFX
Else
.Controls(I).Move .Controls(I).Left * SFX, _
.Controls(I).Top * SFY, _
.Controls(I).Width * SFX, _
.Controls(I).Height * SFY
End If
.Controls(I).FontSize = .Controls(I).FontSize * SFFont
Next I
If RePosForm Then
.Move .Left * SFX, .Top * SFY, .Width * SFX, .Height * SFY
End If
End With
End Sub
Public Sub FormResize(TheForm As Form)
Dim ScaleFactorX As Single, ScaleFactorY As Single
If Not DoResize Then
DoResize = True
Exit Sub
End If
RePosForm = False
ScaleFactorX = TheForm.Width / myForm.Width
ScaleFactorY = TheForm.Height / myForm.Height
Resize_For_Resolution ScaleFactorX, ScaleFactorY, TheForm
myForm.Height = TheForm.Height
myForm.Width = TheForm.Width
End Sub
Public Sub AdjustForm(TheForm As Form)
Dim Res As String ' Returns resolution of system
' Put the design time resolution in here
DesignX = 640
DesignY = 480
RePosForm = True
DoResize = False
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips
Xpixels = Screen.Width / Xtwips
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
TheForm.ScaleMode = 1
Resize_For_Resolution ScaleFactorX, ScaleFactorY, TheForm
Res = Str$(Xpixels) + " by " + Str$(Ypixels)
'Debug.Print Res
myForm.Height = TheForm.Height
myForm.Width = TheForm.Width
End Sub
相关文章推荐
- Android笔记:多分辨率适配及碎片化问题解决方案总结 推荐
- 解决virtual box安装ubuntu后,虚拟机屏幕分辨率太小的问题
- Android自定义布局的背景在多分辨率的情况下设置fill_parent时背景不能够横向全屏的问题解决
- 解决VMware下安装Ubuntu 16.04 不支持1920X1080分辨率的问题
- 设置Ubuntu系统的分辨率--解决vmware workstaion中shell窗口太小的问题
- VMware调整分辨率&解决鼠标"飘"的问题笔记(Linux)
- 解决浏览器分辨率问题
- 自定义RatingBar,不同分辨率屏幕下图片拉伸或者显示不完整问题解决
- 在用vmware安装ubuntu的时候由于分辨率问题,界面显示不全解决办法
- OpenCV 调用摄像头录制指定分辨率视频----(解决保存的视频仅有6Kb的问题)
- (转)Ubuntu 10.04开机画面低分辨率问题解决方案
- Viewport解决分辨率适配问题
- android开发图片分辨率问题解决方案
- EasyRTMP手机直播推流到EasyDSS进行RTMP直播过程中分辨率反复切换崩溃问题解决
- 解决问题,缩小图片文件分辨率
- 浏览器分辨率不一的浮动问题解决方法
- 解决unity5 地形 从assetbundle载入后,贴图分辨率不正常的问题
- 解决16:10分辨率显示器ubuntu开机黑屏问题
- 解决Ubuntu屏幕分辨率不正常问题
- MPEG4更改图像分辨率后编码不对的问题已经解决!