Guidance
指路人
g.yi.org
software / rapidq / Examples / Devices / Display / Change Display.bas

Register 
新用户注册
Search 搜索
首页 
Home Home
Software
Upload

  
'by John White, modified by John Kelly

'THE DEVMODE IN THE WIN32API.INC IS WRONG. It gives long (integer value)
'declarations where there should be WORD declarations (probably the reason for many
'codes not working). If you use the win32api.inc for the code below you get a corrupt registry
'(CDS_UPDATEREGISTRY). Why? because although EnumDisplaySettings() just fills in
'a block of code (of any size - I.e incorrect DEVMODE Integers) when that code is
'saved to the registry, as incorrect integer values instead of word values, the registry
'becomes mangled. Hence why I did a DEVMODE Type.....End Type definition
'that uses the proper values from the win32 api manual.

'Also note, that there are other values/flags you can set. I just did a quick example.

'Rapidq will change DWORD to long so don`t worry about the DWORD
'declarations. Besides. Keeps it simple for the Linux programmers!!

'Finally. If you do get a corrupt registry and/or this code does not work on
'the fly (in an instance - no reboot) then more than likely you have registry
'problems to begin with. For example. If you corrupted your display code from
'previous attempts at converting the VB code (or whatever) for example
'and could not get that converted rapidq code to work you may of just thought
'"oh well it did not work", not realizing it messed up your registry. One way
'to tell is to run the code below. If it works on the fly then it works, but if
'you need a reboot then.......!!.....you will probably get a low resolution
'screen but now try and put it back to 800 x 600 and you may have problems!
'but hopefully not. How do I know all this? Because I debugged it to the point of
'having so many reboots and fiddling to get back to 800x 600 before I finally
'realized what was going on. Bad DevMode, Registry buggered, etc.

     $INCLUDE "RAPIDQ.INC"
     $OPTIMIZE ON
'$APPTYPE GUI
     $TYPECHECK ON
     $ESCAPECHARS ON

     CONST EWX_LOGOFF = 0
     CONST EWX_SHUTDOWN = 1
     CONST EWX_REBOOT = 2
     CONST EWX_FORCE = 4
     CONST DM_BITSPERPEL = &H40000
     CONST DM_PELSWIDTH = &H80000
     CONST DM_PELSHEIGHT = &H100000
     CONST DM_DISPLAYFREQUENCY = &H400000
     CONST CDS_DYNAMIC = &H0
     CONST CDS_UPDATEREGISTRY = &H1
     CONST CDS_TEST = &H4
     CONST CDS_FULLSCREEN = &H4
     CONST CDS_GLOBAL = &H8
     CONST CDS_SET_PRIMARY = &H10
     CONST CDS_RESET = &H40000000
     CONST CDS_SETRECT = &H20000000
     CONST CDS_NORESET = &H10000000
     CONST DISP_CHANGE_SUCCESSFUL = 0
     CONST DISP_CHANGE_RESTART = 1
     CONST DISP_CHANGE_FAILED = -1
     CONST DISP_CHANGE_BADMODE = -2
     CONST DISP_CHANGE_NOTUPDATED = -3
     CONST DISP_CHANGE_BADFLAGS = -4
     CONST DISP_CHANGE_BADPARAM = -5
     CONST ENUM_CURRENT_SETTINGS = -1    'try 0 then call again with a non-zero to restore
     CONST ENUM_REGISTRY_SETTINGS = -2
     CONST STRING_SIZE=32



     TYPE DEVMODE
      dmDeviceName AS STRING * STRING_SIZE
      dmSpecVersion AS WORD
      dmDriverVersion AS WORD
      dmSize AS WORD
      dmDriverExtra AS WORD
      dmFields AS DWORD
      dmOrientation AS SHORT
      dmPaperSize AS SHORT
      dmPaperLength AS SHORT
      dmPaperWidth AS SHORT
      dmScale AS SHORT
      dmCopies AS SHORT
      dmDefaultSource AS SHORT
      dmPrintQuality AS SHORT
      dmColor AS SHORT
      dmDuplex AS SHORT
      dmYResolution AS SHORT
      dmTTOption AS SHORT
      dmCollate AS SHORT
      dmFormName AS STRING * STRING_SIZE
      dmLogPixels AS WORD
      dmBitsPerPel AS DWORD
      dmPelsWidth AS DWORD
      dmPelsHeight AS DWORD
      dmDisplayFlags AS DWORD
      dmDisplayFrequency AS DWORD
     END TYPE

     DECLARE FUNCTION EnumDisplaySettings LIB "user32" ALIAS "EnumDisplaySettingsA" (BYVAL lpszDeviceName AS LONG, BYVAL iModeNum AS LONG, lpDevMode AS LONG) AS LONG
     DECLARE FUNCTION ChangeDisplaySettings LIB "user32" ALIAS "ChangeDisplaySettingsA" (lpDevMode AS LONG, BYVAL dwFlags AS LONG) AS LONG
' NT & 2000 Declare Function ChangeDisplaySettingsEx Lib "user32" Alias "ChangeDisplaySettingsExA" (lpszDeviceName As long, lpDevMode As long, ByVal hWnd As Long, ByVal dwFlags As Long, lParam As long) As Long
     DECLARE FUNCTION ExitWindowsEx LIB "user32" ALIAS "ExitWindowsEx" (BYVAL uFlags AS LONG, BYVAL dwReserved AS LONG) AS LONG

     DIM devm AS DEVMODE
     DIM stg$ AS STRING, rtn AS INTEGER
     DIM OldX AS DWORD, OldY AS DWORD
     DIM OldBitsPerPel AS DWORD
     DIM OldDisplayFrequency AS DWORD

     rtn=EnumDisplaySettings("", ENUM_CURRENT_SETTINGS, devm) ' Null for current display(or \DisplayX), caches the current settings if 0 or recalls from last call with non-zero, type var pointer
' also see Function GetDeviceCaps(nDC, BITSPIXEL)


     IF rtn = DISP_CHANGE_FAILED THEN       SHOWMESSAGE("eds failed" + STR$(rtn)): END  'call failed

     OldX = devM.dmPelsWidth
     OldY = devM.dmPelsHeight
     OldBitsPerPel = devM.dmBitsPerPel
     OldDisplayFrequency = devM.dmDisplayFrequency
     devm.dmFields = DM_PELSWIDTH OR DM_PELSHEIGHT OR DM_BITSPERPEL OR DM_DISPLAYFREQUENCY
     devm.dmPelsWidth = 1152             'Pixel (screen) Width
     devm.dmPelsHeight = 864               'Pixel (Screen) Height
     devm.dmBitsPerPel = 8                    'Bits Per Colours. 4=16 colours, 8=256 colours, 16=65536 colours...
     devm.dmDisplayFrequency = 70         ' the vertical refresh rate in Hz. if  0 or 1 sets default,


'rtn=ChangeDisplaySettings(devm, CDS_TEST OR CDS_UPDATEREGISTRY)
     rtn=ChangeDisplaySettings(devm, CDS_DYNAMIC)
     SLEEP 5
     SHOWMESSAGE "ready to revert"

     IF rtn>-1 THEN
      IF rtn=DISP_CHANGE_SUCCESSFUL THEN
       SHOWMESSAGE("successfull")
       devM.dmPelsWidth =  OldX
       devM.dmPelsHeight = OldY
       devM.dmBitsPerPel = OldBitsPerPel
       devM.dmDisplayFrequency = OldDisplayFrequency
       devm.dmFields = DM_PELSWIDTH OR DM_PELSHEIGHT OR DM_BITSPERPEL OR DM_DISPLAYFREQUENCY
       rtn=ChangeDisplaySettings(devm, CDS_DYNAMIC)
    'elseif rtn=DISP_CHANGE_RESTART then
    '    showmessage("re-booting now...")
    '    ExitWindowsEx(EWX_REBOOT ,0)
      ELSE
       SHOWMESSAGE("failed")
      END IF
     ELSE
      SHOWMESSAGE("cds failed")
     END IF
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Thu 2019-4-25  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-04-02 08:11:24