追蹤
虛幻與現實之間
關於部落格
  • 2509

    累積人氣

  • 1

    今日人氣

    0

    追蹤人氣

[VB6]搭配API 調整螢幕解析度

Option Explicit
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
   
    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 Sub Command_OK_Click()

    Dim i As Long
    Dim b As Long
    Dim ans As Long
    Dim a As Long
   
    a = EnumDisplaySettings(0, 0, DevM) 'Initial Setting
   
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmPelsWidth = 1280 '設定成想要的解析度
    DevM.dmPelsHeight = 1024
    b = ChangeDisplaySettings(DevM, 0) 'Changed Only this time
   
    If b = DISP_CHANGE_RESTART Then
   
        ans = MsgBox("要重開機設定才能完成,重開?", vbOKCancel)
   
        If ans = 1 Then
       
            b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
            'after this , Will Update in Registry
            Call ExitWindowsEx(EWX_REBOOT, 0)
                                           
        End If
       
              
    Else
   
        If b <> DISP_CHANGE_SUCCESSFUL Then
       
            Call MsgBox("設定有誤,請聯絡資訊部", vbCritical)
       
        End If
       
    INPUTData1.Show
    Unload Me
   
   
    End If
       
End Sub


參考網頁: http://vbqa.pixnet.net/blog/post/54308176-%E8%A7%A3%E6%9E%90%E5%BA%A6%E7%9A%84api....%28%E7%B7%A8%E8%99%9F%EF%BC%9A26075%29


相簿設定
標籤設定
相簿狀態