Question

关于VB窗口调整大小的问题

我做了一个VB窗口在分辨率为1280X1024的屏幕上刚好完全显示，但是当在分辨率为1024X768的屏幕上显示时，就会有一部分无法显示，请大家教教我，如何使窗口以及里面的控件自动适应不同的屏幕分辨率，请给出详细的代码，如果需要知道细节，请加我的QQ：25380563，注明VB。谢谢。

Answer 1

现在宽屏，大屏幕显示器越来越普遍，原来在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）重新写函数进行处理。

如果背景图片需要自动调整大小的话，可加入以下代码（在窗体中引入图片背景，将AutoRedraw设置为true）

Private Sub Form_Resize()
Dim objPicBuf As IPictureDisp
AutoRedraw = True
Set objPicBuf = Picture
PaintPicture objPicBuf, 0, 0, ScaleWidth, ScaleHeight
End Sub

Answer 2

窗口启动直接最大化>>WindowState 选择2-Maximize

Answer 3

加入一个command控件，这是个例子，不管你分辨率怎么变，窗口的长度都是X分辨率的0.2倍，窗口的比例都和屏幕的比例一样，窗口大小改变的话，那个command的大小也会改变，楼主自己看看吧，再根据自己的程序改改。
'————————————————模块代码————————————————————
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_GETWORKAREA = 48
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Function GetTaskbarHeight() As Integer
Dim lRes As Long
Dim rectVal As RECT
lRes = SystemParametersInfo(SPI_GETWORKAREA, 0, rectVal, 0)
GetTaskbarHeight = ((Screen.Height / Screen.TwipsPerPixelX) - rectVal.Bottom) * Screen.TwipsPerPixelX
End Function
'——————————————窗口代码——————————————————————
Dim a As Long '储存窗体宽度
Dim b As Long '储存窗体长度
Private Sub Form_Load()
a = Screen.Width * 0.2 '保证不同分辨率下能正常显示，0.2倍的分辨率
b = (Screen.Height - GetTaskbarHeight()) * a / Screen.Width '确保比例为最大化时的比例，GetTaskbarHeight()是获得工具栏高度的模块
Form1.Move Form1.Left, Form1.Top, a, b
End Sub
Private Sub Form_Resize()
If Form1.WindowState = 0 Then
If Abs(Form1.Width - a) < Abs(Form1.Height - b) Then '获得新的尺寸
Form1.Width = (Form1.Height * a) / b
End If
If Abs(Form1.Width - a) > Abs(Form1.Height - b) Then '获得新的尺寸
Form1.Height = (Form1.Width * b) / a
End If
End If
Command1.Width = Form1.ScaleWidth * 0.2 '按钮宽度同步改变
Command1.Height = Form1.ScaleHeight * 0.2
Command1.Top = 0.5 * Form1.ScaleHeight '这个0.5表示按钮的左上角位于Y方向的最中间，这里用ScaleHeight（去掉标题的高度）
Command1.Left = 0.5 * Form1.ScaleWidth '这个0.5表示按钮的左上角位于X方向的最中间，这里用ScaleWidth（去掉标题的宽度）
End Sub