现在宽屏，大屏幕显示器越来越普遍，原来在800*600下设计的软件界面，在大屏幕显示器（1680*1050）上界面总是缩到一角，非常难看，要将老程序的界面按照不同的分辨率在重新进行设计编程，整个过程比较复杂而且实用性不大，如果原来程序比较大且界面比较多的话那么工作量也将是巨大的，而且还可能出现其他错误，有没有一种重要增加少许代码就能将所有的界面自动适应不同的分辨率呢，在网上搜索了一下有很多现成的方法，但或多或少都有些问题，总之没有完美的解决方案，我经过研究找到了一种方法基本可以解决所有问题，与大家共享，当然该代码中所考虑的控件不完全，有些控件还需要特别处理，这个我在后面的常见问题说明里会提到，具体的代码需要你自己去添加。
代码如下：
1、新建一个模块（general.bas），在上面添加两个函数；
Public Type CONTROLRECT
Left As Single
Top As Single
Width As Single
Height As Single
End Type
Public Const HORZRES = 8
Public Const VERTRES = 10
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long,ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long,ByVal nIndex As Long) As Long
'取得界面原始控件的位置及大小，并保存到数组里
Public Sub GetSourcePos(this As Object,rc() As CONTROLRECT,Optional bigFont As Boolean = True)
Dim tempX As Integer,tempY As Integer
tempX = this.ScaleWidth '1024
tempY = this.ScaleHeight '768
'此处原来如果在1024*768分辨率下显示正常的话，就可以直接赋值1024和768
Dim temp As Control
Dim nSum As Integer
nSum = 0
For Each temp In this
'此处要注意，有些控件没有width，height等属性，在此要做出判断
If TypeOf temp Is ComboBox Then
With rc(nSum)
.Left = temp.Left / tempX
.Width = temp.Width / tempX
.Top = temp.Top / tempY
End With
' ElseIf TypeOf temp Is MSComm Then
' 'none
' ElseIf TypeOf temp Is StatusBar Then
' 'none
Else
With rc(nSum)
.Left = temp.Left / tempX
.Width = temp.Width / tempX
.Top = temp.Top / tempY
.Height = temp.Height / tempY
End With
End If
nSum = nSum + 1
Next
End Sub
'根据比例调整控件的大小
Public Sub SetNewPos(this As Object,rc() As CONTROLRECT)
Dim tempX As Integer,tempY As Integer
tempX = this.ScaleWidth '1024
tempY = this.ScaleHeight '768
' '如果初始界面显示始终是以最大化的方式显示的话，此处就可以调用系统分辨率进行设置tempx,tempy
' hwnd = GetDesktopWindow()
' ' Get the device context for the desktop
' hdc = GetWindowDC(hwnd)
' If hdc Then
' Dim a As Long,b As Long
' a = GetDeviceCaps(hdc,HORZRES)
' b = GetDeviceCaps(hdc,VERTRES)
' tempX = a
' tempY = b
' End If
' ReleaseDC hwnd,hdc
Dim temp As Control '//用于取各种控件
Dim nSum As Integer
nSum = 0
For Each temp In this
'此处要注意，有些控件没有width，height等属性，在此要做出判断
If TypeOf temp Is ComboBox Then
temp.Left = rc(nSum).Left * tempX
temp.Width = rc(nSum).Width * tempX
temp.Top = rc(nSum).Top * tempY
' ElseIf TypeOf temp Is MSComm Then
' 'none
' ElseIf TypeOf temp Is StatusBar Then
' 'none
Else
temp.Left = rc(nSum).Left * tempX
temp.Width = rc(nSum).Width * tempX
temp.Top = rc(nSum).Top * tempY
temp.Height = rc(nSum).Height * tempY
End If
nSum = nSum + 1
Next
End Sub
2、在form窗体中定义如下变量
Dim oldpos() As CONTROLRECT
Private Sub Form_Load()
ReDim oldpos(Me.Controls.Count)
GetSourcePos Me,oldpos
End Sub
Private Sub Form_Resize()
SetNewPos Me,oldpos
End Sub
常见问题及解决：
(1) 以上代码单纯的form窗体，根据窗口大小自动调整窗体控件时没有任何问题的，但是如果该窗体是mdi子窗体的话这种办法就会失灵，请看问题2；
(2) 如果form是mdi子窗体的话怎么解决呢，将各个窗体的初始窗体啊全都设置为最大化窗体，然后根据分辨率的大小来调整窗体（上面代码中注释的部分，以固定比例来修改控件大小）。但是这样就缺少灵活性，不能随窗口的大小的改变而自动改变大小，大多数mdi程序，其子窗体都是最大化显示的，只跟系统分辨率有关；
(3) 如果有line，shape等控件放在picture控件里，且picture控件的坐标模式在form_load期间又改变了，则这些控件在每次resize时其大小和位置也会相应的改变，这个问题的解决办法就是在每次resize之前将picture的scalemode改为pixel状态，（还有问题，改过之后定位可能不准确了）；还有一个好办法，就是SetNewPos函数每次load后只调用一次。
(4) 对于在form_load事件中就开始画图，并设置picture等控件的坐标时会出问题，设置的坐标为控件更改前的大小，而不是更改后的大小。
(5) 发现sstab控件的兼容性有问题，修改大小后，点击sstab，隐藏界面无法显示，根据其特性（隐藏界面的控件位置left-75000）重新写函数进行处理。
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。