大哥：还是关于如何让窗体适应不同分辨率！[求助]

wty_lx

谢谢斑竹

wty_lx

在感谢一次

wu8313

原帖由 tz-chf 于 2007-9-11 10:56 发表


这个方法比较好，开销也小，原汁原味。有没有原代码？

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _
ByVal iModeNum As Long, lpDevMode As Any) As Long
Private Declare Function ChangeDisplaySettings Lib "user32" Alias _
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Const EWX_REBOOT = 2
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const CDS_UPDATEREGISTRY = 1
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
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 * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private DevM As DEVMODE
Dim XVal As Long, YVal As Long, Z As Long
Private Sub DisplaySetting()
Dim i As Long
Dim b As Long
Dim ans As Long
Dim a As Long
a = EnumDisplaySettings(0, 0, DevM)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = XVal
DevM.dmPelsHeight = YVal
b = ChangeDisplaySettings(DevM, 0)
If b = DISP_CHANGE_RESTART Then
ans = MsgBox("要重开机设定才能完成，重开？", vbOKCancel)
If ans = 1 Then
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
Call ExitWindowsEx(EWX_REBOOT, 0)
End If
Else
If b <> DISP_CHANGE_SUCCESSFUL Then
Call MsgBox("设定有误", vbCritical)
End If
End If
End Sub
Private Sub Form_Load()
Dim MBN As Integer, x As Long, y As Long
   y = GetSystemMetrics(SM_CYSCREEN)
   x = GetSystemMetrics(SM_CXSCREEN)
   If Not x = 1024 Then
      MBN = MsgBox("您的屏幕分辨率为" & x & "×" & y & "，而程序的最佳显示分辨率为1024×768。" _
          & Chr(13) + Chr(10) & "*  如果需要程序自动重新设置分辨率，请单击“确定”按钮。" _
          & Chr(13) + Chr(10) & "*  如果退出程序自己重新设置分辨率，请单击“取消”按钮。", vbOKCancel + vbExclamation, "提示...")
      If MBN = 1 Then
         XVal = 1024
         YVal = 768
         Call DisplaySetting
         XVal = x
         YVal = y
         Z = 1
         
      Else
         Application.Quit
        
      End If
   
   End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim MBN As Integer
   If Z = 1 Then
      MBN = MsgBox("是否恢复原来的屏幕分辨率?" _
          & Chr(13) + Chr(10) & "*  如果需要程序自动恢复分辨率，请单击“确定”按钮。" _
          & Chr(13) + Chr(10) & "*  如果退出程序自己恢复分辨率，请单击“取消”按钮。", vbOKCancel + vbExclamation, "提示...")
      If MBN = 1 Then
         Call DisplaySetting
      Else
         Application.Quit
      End If
   End If
End Sub
============================
以上代码可以放在你的启动窗体中就可以了。
我记得 游戏 "红色警戒" 以前的单机版本就是强行更改你的分辨率为800*600,退出的时候又改回了用户的分辨率

上述代码中：程序设计时分辨率为1024*768 ，如果你设计时的分辨率不同于1024*768的话，适当修改代码就可以了。

一旦修改分辨率成功后，后面运行就不用管了，不必每次都去调用。

[ 本帖最后由 wu8313 于 2008-7-28 21:53 编辑 ]

chenlugen

下来看看...

qinds1977

[:50] [:50] [:50] [:50]

bpchan

学习！！！

轻风

在ACCESS2010下，这个问题就很好办了。

songwenqin

看看

songwenqin

学习了，谢谢