如何在vb中编写程序使得窗体运行时根据分辨率大小自动调整窗体大小？

Question

如何在vb中编写程序使得窗体运行时根据分辨率大小自动调整窗体大小？

Answer 1

如果是在运行前变的话，比较简单。用screen就可以取得当前屏幕的大小。
screen.width
screen.height然后再改变窗体大小，但是如果再运行期间随时检测屏幕分辨率有没有改变的话会比较麻烦，要么用Timer，要么要用API捕获系统消息。呵呵，本人才疏学浅，时间也不多，楼主自己去查一下吧。

Answer 2

呵呵，查了一下资料，还是找到了。
-------------------------------------------------------------
屏幕分辨率改变的响应 作者： ZDNet China
Friday, December 12 2003 11:31 AM  对于运行于整个屏幕方式的程序，最重要的是能够正确识别和响应屏幕分辨率的改变。在VB程序中可以通过引用微软的SysInfo控件实现这一功能。  
SysInfo控件提供了系统设置的信息，当系统设置更改时其能够激活响应事件。为了使用这一控件，可以参见于“Microsoft SysInfo Control 6.0”，并将控件添加到窗体中。WorkArea属性提供了有关屏幕分辨率的信息：Debug.Print "Height : " & SysInfo1.WorkAreaHeight
Debug.Print "Width : " & SysInfo1.WorkAreaWidth
Debug.Print "Top : " & SysInfo1.WorkAreaTop
Debug.Print "Left : " & SysInfo1.WorkAreaLeft 为了能够捕捉屏幕分辨率的更改，在DisplayChanged事件中添加如下的代码。这一代码段改变了窗体以适合于可用的屏幕区域。Private Sub SysInfo1_DisplayChanged()
    Me.Move SysInfo1.WorkAreaLeft, SysInfo1.WorkAreaTop, _
        SysInfo1.WorkAreaWidth, SysInfo1.WorkAreaHeight
End Sub SysInfo控件能够让你很容易地对屏幕分辨率的改变作出反应，它也提供了有关设备驱动程序改变，电源设置等方面的信息。 

Answer 3

Option ExplicitPrivate Sub Form_Load()
    Me.Left = 0
    Me.Top = 0
    Me.Width = Screen.Width
    Me.Height = Screen.Height
End Sub其实最难的是根据窗体大小变化来调整控件位置。如果需要这样的代码，可以给我发短信。

Answer 4

'-----------------------------------------------------------------------
'有时窗体变化后，如改变分辨率后控件大小却不能随之改变。
'手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件
'并使其改变大小以适应窗体变化。'在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小，如：
'-----------------------------------------------------------------------
'Private Sub Form_Resize()
'    Resize_ALL Me   'Me是窗体名，Form1,Form2等等都可以
'End Sub
'-----------------------------------------------------------------------
Public Type ctrObj
       Name As String
       Index As Long
       Parrent As String
       Top As Long
       Left As Long
       Height As Long
       Width As Long
       ScaleHeight As Long
       ScaleWidth As Long
End TypePrivate FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Function ActualPos(plLeft As Long) As Long    If plLeft < 0 Then
           ActualPos = plLeft + 75000
    Else
           ActualPos = plLeft
    End IfEnd Function
Function FindForm(pfrmIn As Form) As Long    Dim i As Long
    FindForm = -1    If MaxForm > 0 Then
        For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = pfrmIn.Name Then
                   FindForm = i
                   Exit Function
            End If
        Next i
    End IfEnd Function
Function AddForm(pfrmIn As Form) As Long    Dim FormControl As Control
    Dim i As Long
    ReDim Preserve FormRecord(MaxForm + 1)
    
    FormRecord(MaxForm).Name = pfrmIn.Name
    FormRecord(MaxForm).Top = pfrmIn.Top
    FormRecord(MaxForm).Left = pfrmIn.Left
    FormRecord(MaxForm).Height = pfrmIn.Height
    FormRecord(MaxForm).Width = pfrmIn.Width
    FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
    FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
    AddForm = MaxForm
    MaxForm = MaxForm + 1
    
    For Each FormControl In pfrmIn
        i = FindControl(FormControl, pfrmIn.Name)
        If i < 0 Then
            i = AddControl(FormControl, pfrmIn.Name)
        End If
    Next FormControlEnd Function
Function FindControl(inControl As Control, inName As String) As LongDim i As Long
FindControl = -1For i = 0 To (MaxControl - 1)
    If ControlRecord(i).Parrent = inName Then
        If ControlRecord(i).Name = inControl.Name Then
            On Error Resume Next
            If ControlRecord(i).Index = inControl.Index Then
                FindControl = i
                Exit Function
            End If
            On Error GoTo 0
        End If
    End If
Next iEnd Function
Function AddControl(inControl As Control, inName As String) As Long    ReDim Preserve ControlRecord(MaxControl + 1)
    On Error Resume Next
    ControlRecord(MaxControl).Name = inControl.Name
    ControlRecord(MaxControl).Index = inControl.Index
    ControlRecord(MaxControl).Parrent = inName    If TypeOf inControl Is Line Then
        ControlRecord(MaxControl).Top = inControl.Y1
        ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
        ControlRecord(MaxControl).Height = inControl.Y2
        ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
    Else
        ControlRecord(MaxControl).Top = inControl.Top
        ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
        ControlRecord(MaxControl).Height = inControl.Height
        ControlRecord(MaxControl).Width = inControl.Width
    End If    inControl.IntegralHeight = False
    On Error GoTo 0
    AddControl = MaxControl
    MaxControl = MaxControl + 1
End Function
Function PerWidth(pfrmIn As Form) As Long    Dim i As Long
    i = FindForm(pfrmIn)    If i < 0 Then
           i = AddForm(pfrmIn)
    End If    PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function

Answer 5

'接上Function PerHeight(pfrmIn As Form) As Double    Dim i As Long
    i = FindForm(pfrmIn)    If i < 0 Then
           i = AddForm(pfrmIn)
    End If    PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function
Public Sub ResizeControl(inControl As Control, pfrmIn As Form)    On Error Resume Next
    Dim i As Long
    Dim widthfactor As Single, heightfactor As Single
    Dim minFactor As Single
    Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
    yRatio = PerHeight(pfrmIn)
    xRatio = PerWidth(pfrmIn)
    i = FindControl(inControl, pfrmIn.Name)    If inControl.Left < 0 Then
           lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
    Else
           lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
    End If    lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
    lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
    lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
    
    If TypeOf inControl Is Line Then        If inControl.X1 < 0 Then
               inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
        Else
               inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
        End If        inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)        If inControl.X2 < 0 Then
               inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
        Else
               inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
        End If        inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
    Else
        inControl.Move lLeft, lTop, lWidth, lHeight
        inControl.Move lLeft, lTop, lWidth
        inControl.Move lLeft, lTop
    End IfEnd SubPublic Sub ResizeForm(pfrmIn As Form)    Dim FormControl As Control
    Dim isVisible As Boolean
    Dim StartX, StartY, MaxX, MaxY As Long
    Dim bNew As Boolean
    
    If Not bRunning Then
           bRunning = True
    
    If FindForm(pfrmIn) < 0 Then
           bNew = True
    Else
           bNew = False
    End If
    
    
    If pfrmIn.Top < 30000 Then
        isVisible = pfrmIn.Visible
        On Error Resume Next        If Not pfrmIn.MDIChild Then
               On Error GoTo 0
               '     ' pfrmIn.Visible = False
        Else
        
            If bNew Then
                StartY = pfrmIn.Height
                StartX = pfrmIn.Width
                On Error Resume Next
        
                For Each FormControl In pfrmIn
        
                    If FormControl.Left + FormControl.Width + 200 > MaxX Then
                        MaxX = FormControl.Left + FormControl.Width + 200
                    End If
        
                    If FormControl.Top + FormControl.Height + 500 > MaxY Then
                        MaxY = FormControl.Top + FormControl.Height + 500
                    End If
        
                    If FormControl.X1 + 200 > MaxX Then
                        MaxX = FormControl.X1 + 200
                    End If
        
                    If FormControl.Y1 + 500 > MaxY Then
                        MaxY = FormControl.Y1 + 500
                    End If
        
                    If FormControl.X2 + 200 > MaxX Then
                        MaxX = FormControl.X2 + 200
                    End If
        
        
                    If FormControl.Y2 + 500 > MaxY Then
                        MaxY = FormControl.Y2 + 500
                    End If
        
                Next FormControl
        
                On Error GoTo 0
                pfrmIn.Height = MaxY
                pfrmIn.Width = MaxX
            End If
        
            On Error GoTo 0
        End If
        
        
        For Each FormControl In pfrmIn
               ResizeControl FormControl, pfrmIn
        Next FormControl
        
        On Error Resume Next
        
        If Not pfrmIn.MDIChild Then
            On Error GoTo 0
            pfrmIn.Visible = isVisible
        Else
            If bNew Then
                pfrmIn.Height = StartY
                pfrmIn.Width = StartX
                For Each FormControl In pfrmIn
                       ResizeControl FormControl, pfrmIn
                Next FormControl
            End If
        End If
        
        On Error GoTo 0    End If    bRunning = False
    End IfEnd Sub
Public Sub SaveFormPosition(pfrmIn As Form)
    Dim i As Long
    
    If MaxForm > 0 Then
        For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = pfrmIn.Name Then
                FormRecord(i).Top = pfrmIn.Top
                FormRecord(i).Left = pfrmIn.Left
                FormRecord(i).Height = pfrmIn.Height
                FormRecord(i).Width = pfrmIn.Width
                Exit Sub
            End If
        Next i
        AddForm (pfrmIn)
    End If
End Sub
Public Sub RestoreFormPosition(pfrmIn As Form)    Dim i As Long
    If MaxForm > 0 Then
        For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = pfrmIn.Name Then
                If FormRecord(i).Top < 0 Then
                    pfrmIn.WindowState = 2
                ElseIf FormRecord(i).Top < 30000 Then
                    pfrmIn.WindowState = 0
                    pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
                Else
                    pfrmIn.WindowState = 1
                End If
                Exit Sub
            End If
        Next i
    End IfEnd Sub
Public Sub Resize_ALL(Form_Name As Form)    Dim OBJ As Object
    For Each OBJ In Form_Name
        ResizeControl OBJ, Form_Name
    Next OBJEnd SubPublic Sub DragForm(frm As Form)    On Local Error Resume Next
    Call ReleaseCapture
    Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0)End Sub

Answer 6

自己设计程序时按照屏幕的比例来设计窗体(代码写再form_load)中,这样就时屏幕分辨率改变,程序也会按照窗体和屏幕的比例进行调整

Answer 7

写在Form_Resize是否更为妥当？

Answer 8

Dim a(), g(1) As Single
Dim t As Integer, dt As IntegerPrivate Sub Form_Activate()
If g(0) = 0 Then '原始值只記錄一次
 g(0) = Form1.ScaleWidth: g(1) = Form1.ScaleHeight '一開始表單的大小
 ReDim a(Form1.Controls.Count - 1, 5)
 j = 0
 For Each i In Form1.Controls '記錄每個物件的資料
   a(j, 0) = i.Name
   On Error Resume Next '避免某些物件沒有指定的屬性而錯誤
   a(j, 1) = i.Left:  a(j, 2) = i.Top
   a(j, 3) = i.Width:  a(j, 4) = i.Height
   a(j, 5) = i.FontSize
   On Error GoTo 0 '取消錯誤處理
  j = j + 1
 Next i
t = 0: dt = 100: 'Timer1.Enabled = True
End If
End SubPrivate Sub Form_Resize()
If Form1.WindowState <> 1 And g(0) > 0 And g(1) > 0 Then
'重算物件的新位置
 For i = 0 To Form1.Controls.Count - 1
  Set b = Controls(a(i, 0))
   On Error Resume Next
   b.Left = a(i, 1) / g(0) * Form1.ScaleWidth
   b.Top = a(i, 2) / g(1) * Form1.ScaleHeight
   b.Width = a(i, 3) / g(0) * Form1.ScaleWidth
   b.Height = a(i, 4) / g(1) * Form1.ScaleHeight
   If Form1.ScaleWidth / g(0) < Form1.ScaleHeight / g(1) Then
    b.FontSize = a(i, 5) / g(0) * Form1.ScaleWidth
    Else
    b.FontSize = a(i, 5) / g(1) * Form1.ScaleHeight
   End If
   On Error GoTo 0
   If TypeOf b Is PictureBox Then
  '  If Check1.Value = 1 Then b.PaintPicture b.Picture, 0, 0, b.ScaleWidth, b.ScaleHeight Else b.Cls
   End If
  Set b = Nothing
 Next i
End If
End Sub
偶比較喜歡這段代碼，但是是講隨這表單變化，控制控件變化不是你說的分辨率問題一般可以用api判斷分辨率，然後寫2組不同的數據進入ini文件，在讀出應該顯示的大小