怎么让窗体随着分辨率的改变而改变

[michealin]

我是在800*600模式下开发的，但是有的客户用的是1024*768，程序界面就变成那么小的一块了。游办法让窗体适应不同的分辨率吗？谢谢各位帮忙。如果有代码请发到
[e-mail]

[lilaclone]

1、你试试这个:
Screen.Width及Screen.Height可取得当前窗体的分辨率，加以判断后加载不同的窗体大小即可
2、让界面最大化，窗口控件等大小和位置随界面大小变化

[lilaclone]

一个类似RealPlay窗口的例子
'设置不规则窗体的API
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Const RGN_OR = 2
'拖动窗体的API
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
'获得鼠标位置，用来改变窗体大小的
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'

'该函数用来做圆角窗体
Public Sub RMe()
Dim Regn As Long '定义设置区域的句柄
Dim CER As Long '定义临时句柄变量
'把Twip计量单位转换成象素
X1 = Me.Width / 15
Y1 = Me.Height / 15
'画矩形
Regn = CreateRectRgn(0, 26, X1, Y1 - 26) '把句柄设为第一个矩形区域
CER = CreateRectRgn(23, 0, X1 - 23, Y1) '创建第二个矩形区域
CombineRgn Regn, Regn, CER, RGN_OR '把临时句柄变量或运算到句柄变量中
'由于第四个圆角较小，这里要用矩形补足
CER = CreateRectRgn(23, 52, X1, Y1 - 6)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateRectRgn(52, 52, X1 - 6, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
'画四个圆
CER = CreateEllipticRgn(0, 0, 52, 52)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(X1 - 50, 0, X1 + 1, 52)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(0, Y1 - 52, 52, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(X1 - 9, Y1 - 9, X1, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
Call SetWindowRgn(Me.hwnd, Regn, True) '创建窗体

End Sub




Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Imclose.Tag <> "" Then
Imclose.Picture = LoadPicture()
Imclose.Tag = ""
End If
If Immin.Tag <> "" Then
Immin.Picture = LoadPicture()
Immin.Tag = ""
End If
If Immax.Tag <> "" Then
Immax.Picture = LoadPicture()
Immax.Tag = ""
End If

End Sub

Private Sub Form_Resize()
On Error Resume Next
'改变一些控件位置
IMBar.Width = Me.Width - 1100
Immax.Top = 120
Immax.Left = Me.Width - 780
Immin.Top = 120
Immin.Left = Me.Width - 1095
Imclose.Top = 120
Imclose.Left = Me.Width - 465
Pbottom.Top = Me.Height - Pbottom.Height
Pbottom.Width = Me.Width - 240
Pright.Left = Me.Width - Pright.Width
Pright.Height = Me.Height - 240
Pjiao.Left = Me.Width - Pjiao.Width
Pjiao.Top = Me.Height - Pjiao.Height

'用于把主窗体图片打印成适合窗体大小
Me.Line (0, 0)-(Me.Width, Me.Height), Me.BackColor, BF
Me.PaintPicture Pmain.Picture, 420, 0, Me.Width, 600, 420, 0, 120, 600
Me.PaintPicture Pmain.Picture, 420, Me.Height - 600, Me.Width, 600, 420, Pmain.Height - 600, 120, 600

Me.PaintPicture Pmain.Picture, 0, 0, 200, Me.Height, 0, 880, 200, 40
Me.PaintPicture Pmain.Picture, Me.Width - 200, 0, 200, Me.Height, Pmain.Width - 200, 880, 200, 40

Me.PaintPicture Pmain.Picture, 0, 0, 450, 600, 0, 0, 450, 600
Me.PaintPicture Pmain.Picture, 0, Me.Height - 600, 450, 600, 0, Pmain.Height - 600, 450, 600

Me.PaintPicture Pmain.Picture, Me.Width - 1665, 0, 1665, 435, Pmain.Width - 1665, 0, 1665, 435
Me.PaintPicture Pmain.Picture, Me.Width - 1665, Me.Height - 525, 1665, 525, Pmain.Width - 1665, Pmain.Height - 525, 1665, 525
Me.PaintPicture Imico, 240, 100, 240, 240, 0, 0, 240, 240 '打印标题图标
Me.ForeColor = 12691863
Me.CurrentX = 530
Me.CurrentY = 110
Me.Print Me.Caption '打印标题，有阴影的
Me.ForeColor = 11100191
Me.CurrentX = 540
Me.CurrentY = 120
Me.Print Me.Caption

RMe

End Sub
Private Sub Form_Load()
On Error Resume Next
Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub

Private Sub IMBar_DblClick()
Immax_Click '双击标题栏时最大化和还原
End Sub

Private Sub IMBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'不用多说，拖动窗体
If Button = 1 Then
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If

End Sub

Private Sub ImClose_Click()
Unload Me
End Sub

Private Sub Immax_Click()
'由于最大化和还原按钮是同一个Image，所以这里麻烦一点
If Me.WindowState = 2 Then
Me.WindowState = 0
Pbottom.Visible = True
Pright.Visible = True
Immax.ToolTipText = "最大化"
Else
Me.WindowState = 2
Pbottom.Visible = False
Pright.Visible = False
Me.Line (Immax.Left, Immax.Top)-(Immax.Left + 240, Immax.Top + 240), 16448250, BF
Me.PaintPicture IMus0.Picture, Immax.Left, Immax.Top, 240, 240, 0, 0, 240, 240
Immax.ToolTipText = "还原"
End If
End Sub

Private Sub ImMin_Click()
Me.WindowState = 1
End Sub

Private Sub ImMin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Immin.Picture = ImMin2.Picture
End Sub
Private Sub ImMin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Immin.Tag = "" Then
Immin.Picture = ImMin1.Picture
Immin.Tag = "1"
End If
End Sub
Private Sub ImMin_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Immin.Picture = LoadPicture()
Immin.Tag = ""
End Sub


Private Sub Imclose_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Imclose.Picture = ImClose2.Picture
End Sub
Private Sub Imclose_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Imclose.Tag = "" Then
Imclose.Picture = ImClose1.Picture
Imclose.Tag = "1"
End If
End Sub

[lilaclone]

Private Sub Imclose_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Imclose.Picture = LoadPicture()
Imclose.Tag = ""
End Sub

Private Sub Immax_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.WindowState = 0 Then Immax.Picture = Immax2.Picture
If Me.WindowState = 2 Then Immax.Picture = IMus2.Picture
End Sub
Private Sub Immax_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Immax.Tag = "" Then
If Me.WindowState = 0 Then Immax.Picture = Immax1.Picture
If Me.WindowState = 2 Then Immax.Picture = IMus1.Picture
Immax.Tag = "1"
End If
End Sub
Private Sub Immax_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Immax.Picture = LoadPicture()
Immax.Tag = ""
End Sub

Private Sub pbottom_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pbottom.Tag = ""
End Sub
Private Sub pbottom_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pbottom.Tag = "1"
End Sub
Private Sub pbottom_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Pbottom.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.Y * 15 - Me.Top
If gg > 1500 Then Me.Height = gg '获得鼠标位置，用来改变窗体大小，这可是一个好办法哟
End If

End Sub

Private Sub Pright_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pright.Tag = ""
End Sub
Private Sub Pright_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pright.Tag = "1"
End Sub
Private Sub Pright_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Pright.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.X * 15 - Me.Left
If gg > 2500 Then Me.Width = gg
End If

End Sub


Private Sub Pjiao_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pjiao.Tag = ""
End Sub
Private Sub Pjiao_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pjiao.Tag = "1"
End Sub
Private Sub Pjiao_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Pjiao.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.X * 15 - Me.Left
gg2 = pos.Y * 15 - Me.Top
If gg > 2500 Then Me.Width = gg
If gg2 > 1500 Then Me.Height = gg2

End If

End Sub

[三楼の郎]

1、在Form的Resize事件中修改各控件的位置与大小。（这将是一件非常麻烦的事。 ^_^）

2、DirectX中提供了一些函数可以修改分辨率和刷新频率，你只需要将分辨率调整到适当的值就可以了。（好多游戏都是这么干的！）

[xing0091]

我也遇到过这个问题，我是这样解决的
用screen.with取得当前像素下with值，除以写程序时的screen.with值，得出一个比率
然后用遍历去乘以每个控件的大小，除了字体上不好控制，其它的都没有问题