'************************************************************* '* 名称: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 Long'********************************************************* '* 名称:SetDisplayMode '* 功能:设置显示分辨率 '* 用法:SetDisplayMode() '********************************************************* Public 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 Dim K As Integer Dim nAnswer As Long If nScreenWidth <> 800 And nScreenHeight <> 600 Then nAnswer = MsgBox("警告:显示器当前分辨率为 " & Trim(Str(nScreenWidth)) & "x" & _ Trim(Str(nScreenHeight)) & ",为使系统正常运行" & Chr(13) & _ "请将分辨率设置为 800x600 增强色(16位)" & _ ",是否继续?", vbYesNo, cProgramName) Select Case nAnswer Case vbYes K = SetDisplayMode(800, 600, 16) Case vbNo End End Select End If
第二,就是如上所说在resize中重新调整控件的相对位置
to sha_boy(笨小孩),我的信箱:[email protected]
'* 名称: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 Long'*********************************************************
'* 名称:SetDisplayMode
'* 功能:设置显示分辨率
'* 用法:SetDisplayMode()
'*********************************************************
Public 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 Dim K As Integer
Dim nAnswer As Long
If nScreenWidth <> 800 And nScreenHeight <> 600 Then
nAnswer = MsgBox("警告:显示器当前分辨率为 " & Trim(Str(nScreenWidth)) & "x" & _
Trim(Str(nScreenHeight)) & ",为使系统正常运行" & Chr(13) & _
"请将分辨率设置为 800x600 增强色(16位)" & _
",是否继续?", vbYesNo, cProgramName)
Select Case nAnswer
Case vbYes
K = SetDisplayMode(800, 600, 16)
Case vbNo
End
End Select
End If
您的意思是必须在800*600下?