Results 1 to 3 of 3

Thread: Setting video resolution in windows with VB6

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jan 2001
    Posts
    129

    Question Setting video resolution in windows with VB6

    Im trying to change windows video resolution, like gaming programs and emulators do when they go full screen...

    How can I do this with VB code ?
    How can I lower the resolution to low values such as 320x240 or 640 x 480 ?


    Thanks !
    BaLLZaCH

  2. #2
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333
    VB Code:
    1. Private Const WM_DISPLAYCHANGE = &H7E
    2. Private Const HWND_BROADCAST = &HFFFF&
    3. Private Const EWX_LOGOFF = 0
    4. Private Const EWX_SHUTDOWN = 1
    5. Private Const EWX_REBOOT = 2
    6. Private Const EWX_FORCE = 4
    7. Private Const CCDEVICENAME = 32
    8. Private Const CCFORMNAME = 32
    9. Private Const DM_BITSPERPEL = &H40000
    10. Private Const DM_PELSWIDTH = &H80000
    11. Private Const DM_PELSHEIGHT = &H100000
    12. Private Const CDS_UPDATEREGISTRY = &H1
    13. Private Const CDS_TEST = &H4
    14. Private Const DISP_CHANGE_SUCCESSFUL = 0
    15. Private Const DISP_CHANGE_RESTART = 1
    16. Private Const BITSPIXEL = 12
    17.  
    18. Private Type DEVMODE
    19.     dmDeviceName As String * CCDEVICENAME
    20.     dmSpecVersion As Integer
    21.     dmDriverVersion As Integer
    22.     dmSize As Integer
    23.     dmDriverExtra As Integer
    24.     dmFields As Long
    25.     dmOrientation As Integer
    26.     dmPaperSize As Integer
    27.     dmPaperLength As Integer
    28.     dmPaperWidth As Integer
    29.     dmScale As Integer
    30.     dmCopies As Integer
    31.     dmDefaultSource As Integer
    32.     dmPrintQuality As Integer
    33.     dmColor As Integer
    34.     dmDuplex As Integer
    35.     dmYResolution As Integer
    36.     dmTTOption As Integer
    37.     dmCollate As Integer
    38.     dmFormName As String * CCFORMNAME
    39.     dmUnusedPadding As Integer
    40.     dmBitsPerPel As Integer
    41.     dmPelsWidth As Long
    42.     dmPelsHeight As Long
    43.     dmDisplayFlags As Long
    44.     dmDisplayFrequency As Long
    45. End Type
    46.  
    47. Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
    48. Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
    49. Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    50. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    51. Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
    52. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    53. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    54.  
    55. Private OldX As Long
    56. Private OldY As Long
    57. Private nDC As Long
    58.  
    59.  
    60. Private Sub ChangeRes(X As Long, Y As Long, Bits As Long)
    61.     Dim DevM As DEVMODE, ScInfo As Long, erg As Long, an As VbMsgBoxResult
    62.     'Get the info into DevM
    63.     erg = EnumDisplaySettings(0&, 0&, DevM)
    64.     'This is what we're going to change
    65.     DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
    66.     DevM.dmPelsWidth = X 'ScreenWidth
    67.     DevM.dmPelsHeight = Y 'ScreenHeight
    68.     DevM.dmBitsPerPel = Bits '(can be 8, 16, 24, 32 or even 4)
    69.     'Now change the display and check if possible
    70.     erg = ChangeDisplaySettings(DevM, CDS_TEST)
    71.     'Check if succesfull
    72.     Select Case erg&
    73.         Case DISP_CHANGE_RESTART
    74.             an = MsgBox("You've to reboot", vbYesNo + vbSystemModal, "Info")
    75.             If an = vbYes Then
    76.                 erg& = ExitWindowsEx(EWX_REBOOT, 0&)
    77.             End If
    78.         Case DISP_CHANGE_SUCCESSFUL
    79.             erg = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
    80.             ScInfo = Y * 2 ^ 16 + X
    81.             'Notify all the windows of the screen resolution change
    82.             SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo
    83.             MsgBox "Everything's ok", vbOKOnly + vbSystemModal, "It worked!"
    84.         Case Else
    85.             MsgBox "Mode not supported", vbOKOnly + vbSystemModal, "Error"
    86.     End Select
    87. End Sub
    88.  
    89. Private Sub Command1_Click()
    90. 'KPD-Team 1999
    91.     'URL: [url]http://www.allapi.net/[/url]
    92.     'E-Mail: [email][email protected][/email]
    93.     Dim nDC As Long
    94.     'retrieve the screen's resolution
    95.     OldX = Screen.Width / Screen.TwipsPerPixelX
    96.     OldY = Screen.Height / Screen.TwipsPerPixelY
    97.     'Create a device context, compatible with the screen
    98.     nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    99.     'Change the screen's resolution
    100.     ChangeRes 640, 480, GetDeviceCaps(nDC, BITSPIXEL)
    101. End Sub

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Jan 2001
    Posts
    129

    Exclamation cool

    Check out what I built ... Its a resolution changer called ReZoLution... Its simple but really kewl and damn easy to use.
    Thanks for the help !
    Attached Files Attached Files
    BaLLZaCH

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width