VB的大小设置问题，在线等待~~

Question

小弟用VB做了一个软件，当时是用1027*768的分辨率，但是现在用的显示器是800*600，所以尺寸不当，打开软件时有些东西显示不出来，因为分辨太低，有谁能告诉我怎么解决啊？谢过~~

Answer 1

窗体中加入下面的代码，那么窗体上的所有控件都能随窗体变化等比例变化Option Explicit
Private mlngW As Long
Private mlngh  As Long
Private Type TControlInfo
    ctrl As Control
    Left As Single
    Top As Single
    Width As Single
    Height As Single
    FontSize As Single
End Type
Dim SaveCtrl() As TControlInfoPrivate Sub Form_Initialize()
    On Error Resume Next
    mlngW = Me.Width
    mlngh = Me.Height
    '±£´æ¿Ø¼þµÄ״̬
    ReDim SaveCtrl(Me.Controls.Count - 1) As TControlInfo
    Dim i As Integer
    Dim ctrl As Control
    For i = 0 To Me.Controls.Count - 1
        Set ctrl = Me.Controls(i)
        With SaveCtrl(i)
            Set .ctrl = ctrl
            .Left = ctrl.Left
            .Top = ctrl.Top
            .Width = ctrl.Width
            .Height = ctrl.Height
            .FontSize = ctrl.Font.Size
        End With
    Next
End SubPrivate Sub Form_Resize()
    On Error Resume Next
    Dim lngW As Long
    Dim lngh  As Long
    Dim lngf As Single
    Dim i As Integer    lngW = Me.Width
    lngh = Me.Height
        ' take the lesser of the two
    If (lngW / mlngW) < (lngh / mlngh) Then
        lngf = (lngW / mlngW)
    Else
        lngf = (lngh / mlngh)
    End If
       For i = 0 To UBound(SaveCtrl)
      With SaveCtrl(i)
         If .ctrl.Left < 0 Then
            .ctrl.Left = ((.ctrl.Left + 75000) * (lngW / mlngW)) - 75000
         ElseIf .Left < 0 Then
            .ctrl.Left = (.Left + 75000) * (lngW / mlngW)
         Else
            .ctrl.Left = .Left * (lngW / mlngW)
         End If
         .ctrl.Top = .Top * (lngh / mlngh)
         .ctrl.Width = .Width * (lngW / mlngW)
         .ctrl.Height = .Height * (lngh / mlngh)
         
         
         If .FontSize > 0 Then
            If (.FontSize * lngf) < 8 Then
               If (.FontSize * lngf) > 7 Then
                  .ctrl.Font.Size = 7
               Else
                  .ctrl.Font.Size = .FontSize * lngf
               End If
            Else
              .ctrl.Font.Size = .FontSize * lngf
            End If
         End If
      End With
   Next
End Sub

Answer 2

设置分辨率nScreenWidth = Screen.Width / 15         '屏幕宽度
    nScreenHeight = Screen.Height / 15       '屏幕高度
    Dim K As Integer
    Dim nAnswer As Long
    If nScreenWidth <> 1024 And nScreenHeight <> 768 Then
        nAnswer = MsgBox("警告：显示器当前分辨率为 " & Trim(str(nScreenWidth)) & "x" & _
        Trim(str(nScreenHeight)) & "，为使系统正常运行" & Chr(13) & _
        "请将分辨率设置为 1024x768 增强色(16位)" & _
        "，是否继续？", vbYesNo, cProgramName)
        Select Case nAnswer
            Case vbYes
                K = SetDisplayMode(1024, 768, 16)
            Case vbNo
                End
        End Select
    End If'*************************************************************
'* 名称：WinMode
'* 用途：改变分辨率
'*************************************************************
Const SPI_GETWORKAREA = 48
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
'
Private Type winmode
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByVal lpwinmode As Long, ByVal dwflags As Long) As LongPublic Function SetDisplayMode(Width As Integer, Height As Integer, Color As Integer) As Long
    Dim Newwinmode As winmode
    Dim p As Long
    With Newwinmode
        .dmSize = 122
        If Color = -1 Then
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
        Else
            .dmFields = DM_PELSWIDTH Or _
            DM_PELSHEIGHT Or DM_BITSPERPEL
        End If
        .dmPelsWidth = Width
        .dmPelsHeight = Height
        
        If Color <> -1 Then
            .dmBitsPerPel = Color
        End If
    End With
    p = lstrcpy(Newwinmode, Newwinmode)
    SetDisplayMode = ChangeDisplaySettings(p, 0)
End Function

Answer 3

这个问题说来简单：
如果你不想改程序的话，那就把显示器分辨率再调整到1024，没有人规定软件一定要适应任何分辨率才好，DOS就一种分辨率下运行，不也长久不衰？
如果你觉得改显示器分辨率太对不起自己，那就改程序吧，说起来也没什么，做一次就知道，只要小学数学学得好就一定能搞定。

Answer 4

你用一个叫resize32。ocx得控件就可以了，任何代吗都不要写
[email protected]
我发给你，
或者到网上下载