得到以及设置屏幕分辨率

最新推荐文章于 2021-08-11 01:29:07 发布

ZOU_SEAFARER

最新推荐文章于 2021-08-11 01:29:07 发布

阅读量1.2k

点赞数

CC 4.0 BY-SA版权

分类专栏： VB 文章标签： integer string function user command

本文链接：https://blog.youkuaiyun.com/ZOU_SEAFARER/article/details/1519039

VB 专栏收录该内容

67 篇文章

订阅专栏

得到以及设置屏幕分辨率

Option Explicit
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Const SM_CXSCREEN = 0
    Const SM_CYSCREEN = 1

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000

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
Dim DevM                As DEVMODE

Sub ChangeRes(iWidth As Single, iHeight As Single)
    Dim a       As Boolean
    Dim i       As Integer
    Dim b       As Long
    i = 0
    Do
        a = EnumDisplaySettings(0&, i, DevM)
        i = i + 1
    Loop Until (a = False)
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmPelsWidth = iWidth
    DevM.dmPelsHeight = iHeight
    ChangeDisplaySettings DevM, 0
End Sub

Private Sub Command1_Click()

Dim x As String
Dim y As String

    If Val(x) <> 1024 Or Val(y) <> 768 Then
        Call ChangeRes(1024, 768)
    End If
    x = CStr(GetSystemMetrics(SM_CXSCREEN))
    y = CStr(GetSystemMetrics(SM_CYSCREEN))
    Me.Caption = "当前显示器分辨率: " & x & "x" & y

End Sub

Private Sub Form_Load()
    Dim x   As String
    Dim y   As String
    x = CStr(GetSystemMetrics(SM_CXSCREEN))
    y = CStr(GetSystemMetrics(SM_CYSCREEN))
    Me.Caption = "当前显示器分辨率: " & x & "x" & y
    Call ChangeRes(800, 600) '将分辨率设置成800*600

End Sub