调节分辨率的函数

最新推荐文章于 2021-01-15 01:30:33 发布

hwmys

最新推荐文章于 2021-01-15 01:30:33 发布

阅读量1.5k

点赞数

分类专栏：编程模块文章标签： integer string function user

本文链接：https://blog.csdn.net/hwmys/article/details/1890127

版权

编程模块专栏收录该内容

7 篇文章 0 订阅

订阅专栏

在启动软件前调整为所需的分辨率并保存之前的分辨率，关闭软件后恢复原先的分辨率。

函数用法：
启动软件调整为我需要的分辨率及色板：Call ScreenBat(1024, 768, 16, "1024")
关闭软件恢复原先分辨率：Call ScreenBat(1024, 768, 16, "old")

Public Declare Function EnumDisplaySettings Lib " user32 " Alias " EnumDisplaySettingsA " (ByVal lpszDeviceName As Long , ByVal iModeNum As Long , lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettings Lib " user32 " Alias " ChangeDisplaySettingsA " (lpDevMode As Any, ByVal dwFlags As Long ) As Long
Public oldWidth, oldHigh, oldPerpel As Long

Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = & H40000
Private Const DM_PELSWIDTH = & H80000
Private Const DM_PELSHEIGHT = & H100000
Private Const CDS_UPDATEREGISTRY = & H1
Private Const CDS_TEST = & H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1

Private Const ENUM_REGISTRY_SETTINGS = ( - 2 )
Private Const ENUM_CURRENT_SETTINGS = ( - 1 )

‘刷新频率常量
Private Const DM_DISPLAYFREQUENCY = & H400000

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
Private DevCurrent As DEVMODE
Private ret As Long
Public Sub ScreenBat(ByVal newWi As Long , ByVal newHi As Long , ByVal newPer As Long , ByVal Scren As String )
If Scren = " 1024 " Then
        ret = EnumDisplaySettings( 0 & , ENUM_REGISTRY_SETTINGS, DevM)
         ' ret = EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevCurrent)
        oldWidth = DevM.dmPelsWidth
        oldHigh = DevM.dmPelsHeight
        oldPerpel = DevM.dmBitsPerPel
             ' DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL
             If DevM.dmPelsWidth <> newWi Then DevM.dmPelsWidth = newWi: Scren = " T "    '想要设定的屏幕宽度
             If DevM.dmPelsHeight <> newHi Then DevM.dmPelsHeight = newHi: Scren = " T " '想要设定的屏幕高度
             If DevM.dmBitsPerPel <> newPer Then DevM.dmBitsPerPel = newPer: Scren = " T "    ' (could be 8, 16, 32 or even 4) '此行可用于改变色板
             If Scren = " T " Then Call ChangeDisplaySettings(DevM, CDS_TEST)
ElseIf Scren = " old " Then

         If DevM.dmPelsWidth <> oldWidth Then DevM.dmPelsWidth = oldWidth: Scren = " T "      ' 恢复屏幕宽度
         If DevM.dmPelsHeight <> oldHigh Then DevM.dmPelsHeight = oldHigh: Scren = " T "    ' 恢复屏幕高度
         If DevM.dmBitsPerPel <> oldPerpel Then DevM.dmBitsPerPel = oldPerpel: Scren = " T "    ' (could be 8, 16, 32 or even 4) '恢复色板
         If Scren = " T " Then Call ChangeDisplaySettings(DevM, CDS_TEST)

End If
End Sub