vb屏幕分辨率设置和获取_hawkol_新浪博客

窗体控件

​Command1 Command1 Command1

'窗体代码:

Private Sub Command1_Click()

SetDisplaymode 800, 600

End Sub

Private Sub Command2_Click()

SetDisplaymode 1920, 1080

End Sub

Private Sub Command3_Click()

Dim x As Integer, y As Integer

x = Screen.Width / Screen.TwipsPerPixelX

y = Screen.Height / Screen.TwipsPerPixelY

MsgBox x & "*" & y

End Sub

'模块:

'EnumDisplaySettings函数得到显示设备的一个图形模式设备，通过对该函数一系列的调用可以得到显示设备所有的图形模式信息。

Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long

Public Const DM_PELSWIDTH = &H80000

Public Const DM_PELSHEIGHT = &H100000

Public Const CDS_UPDATEREGISTRY = &H1

Public Const CCDEVICENAME = 32

Public Const CCFORMNAME = 32

  

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

Public Function SetDisplaymode(ByVal LngWidth As Long, ByVal LngHeight As Long, Optional ByVal LngFrequency As Long = 32) As Long

Dim DevM     As DEVMODE

erg& = EnumDisplaySettings(0&, 0&, DevM)

DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

DevM.dmPelsWidth = LngWidth       '屏幕宽度

DevM.dmPelsHeight = LngHeight       '屏幕高度

DevM.dmBitsPerPel = LngFrequency       '(还可以为   8,   16,   32甚至4)

ChangeDisplaySettings DevM, CDS_UPDATEREGISTRY

End Function