请问如何设置屏幕的分辨率？谢谢！

请问如何设置屏幕的分辨率？谢谢！ 问题点数：20、回复次数：7Top

1 楼jzyray（晶）回复于 2003-08-04 20:11:16 得分 0

使用changedispalysetting这个API函数即可Top

2 楼gpo2002（永吹不休）回复于 2003-08-04 20:28:04 得分 10

Option   Explicit  
   
  Private   Const   CCDEVICENAME   =   32  
  Private   Const   CCFORMNAME   =   32  
  Private   Const   DM_PELSWIDTH   =   &H80000  
  Private   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  
   
  Private   Declare   Function   apiEnumDisplaySettings   Lib   "user32"   _  
                  Alias   "EnumDisplaySettingsA"   _  
                  (ByVal   lpszDeviceName   As   Long,   _  
                  ByVal   iModeNum   As   Long,   _  
                  lpDevMode   As   Any)   _  
                  As   Boolean  
   
  Private   Declare   Function   apiChangeDisplaySettings   Lib   "user32"   _  
                  Alias   "ChangeDisplaySettingsA"   _  
                  (lpDevMode   As   Any,   _  
                  ByVal   dwflags   As   Long)   _  
                  As   Long  
   
   
  Function   fChangeRes(intX   As   Integer,   intY   As   Integer)   As   Boolean  
  Dim   tDevMode   As   DEVMODE  
  Dim   boolCanChange   As   Boolean  
  Dim   boolRet   As   Boolean  
  Dim   lngRet   As   Long,   lngMode   As   Long  
   
          On   Error   GoTo   Err_Handler  
          Do  
                  boolRet   =   apiEnumDisplaySettings(0&,   lngMode&,   tDevMode)  
                  With   tDevMode  
                          If   .dmPelsWidth   =   intX   And   .dmPelsHeight   =   intY   Then  
                                  boolCanChange   =   True  
                          End   If  
                  End   With  
                  lngMode   =   lngMode   +   1  
          Loop   Until   boolRet   =   False  
   
          If   boolCanChange   Then  
                  With   tDevMode  
                          .dmFields   =   DM_PELSWIDTH   Or   DM_PELSHEIGHT  
                          .dmPelsWidth   =   intX  
                          .dmPelsHeight   =   intY  
                  End   With  
                  lngRet   =   apiChangeDisplaySettings(tDevMode,   0&)  
          End   If  
          fChangeRes   =   boolCanChange  
  exit_Handler:  
          Exit   Function  
  Err_Handler:  
          fChangeRes   =   False  
          Resume   exit_Handler  
  End   Function  
   
  Private   Sub   Command1_Click()  
  fChangeRes   800,   600  
  End   Sub  
  Top

3 楼zyl910（编程的乐趣在于编程控制硬件，与用图形学实现绚丽效果）回复于 2003-08-04 20:28:51 得分 3

'Change   Resolution  
  Option   Explicit  
  Const   WM_DISPLAYCHANGE   =   &H7E  
  Const   HWND_BROADCAST   =   &HFFFF&  
  Const   EWX_LOGOFF   =   0  
  Const   EWX_SHUTDOWN   =   1  
  Const   EWX_REBOOT   =   2  
  Const   EWX_FORCE   =   4  
  Const   CCDEVICENAME   =   32  
  Const   CCFORMNAME   =   32  
  Const   DM_BITSPERPEL   =   &H40000  
  Const   DM_PELSWIDTH   =   &H80000  
  Const   DM_PELSHEIGHT   =   &H100000  
  Const   CDS_UPDATEREGISTRY   =   &H1  
  Const   CDS_TEST   =   &H4  
  Const   DISP_CHANGE_SUCCESSFUL   =   0  
  Const   DISP_CHANGE_RESTART   =   1  
  Const   BITSPIXEL   =   12  
  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   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  
  Private   Declare   Function   ExitWindowsEx   Lib   "user32"   (ByVal   uFlags   As   Long,   ByVal   dwReserved   As   Long)   As   Long  
  Private   Declare   Function   GetDeviceCaps   Lib   "gdi32"   (ByVal   hdc   As   Long,   ByVal   nIndex   As   Long)   As   Long  
  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  
  Private   Declare   Function   DeleteDC   Lib   "gdi32"   (ByVal   hdc   As   Long)   As   Long  
  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  
  Dim   OldX   As   Long,   OldY   As   Long,   nDC   As   Long  
  Sub   ChangeRes(X   As   Long,   Y   As   Long,   Bits   As   Long)  
          Dim   DevM   As   DEVMODE,   ScInfo   As   Long,   erg   As   Long,   an   As   VbMsgBoxResult  
          'Get   the   info   into   DevM  
          erg   =   EnumDisplaySettings(0&,   0&,   DevM)  
          'This   is   what   we're   going   to   change  
          DevM.dmFields   =   DM_PELSWIDTH   Or   DM_PELSHEIGHT   Or   DM_BITSPERPEL  
          DevM.dmPelsWidth   =   X   'ScreenWidth  
          DevM.dmPelsHeight   =   Y   'ScreenHeight  
          DevM.dmBitsPerPel   =   Bits   '(can   be   8,   16,   24,   32   or   even   4)  
          'Now   change   the   display   and   check   if   possible  
          erg   =   ChangeDisplaySettings(DevM,   CDS_TEST)  
          'Check   if   succesfull  
          Select   Case   erg&  
                  Case   DISP_CHANGE_RESTART  
                          an   =   MsgBox("You've   to   reboot",   vbYesNo   +   vbSystemModal,   "Info")  
                          If   an   =   vbYes   Then  
                                  erg&   =   ExitWindowsEx(EWX_REBOOT,   0&)  
                          End   If  
                  Case   DISP_CHANGE_SUCCESSFUL  
                          erg   =   ChangeDisplaySettings(DevM,   CDS_UPDATEREGISTRY)  
                          ScInfo   =   Y   *   2   ^   16   +   X  
                          'Notify   all   the   windows   of   the   screen   resolution   change  
                          SendMessage   HWND_BROADCAST,   WM_DISPLAYCHANGE,   ByVal   Bits,   ByVal   ScInfo  
                          MsgBox   "Everything's   ok",   vbOKOnly   +   vbSystemModal,   "It   worked!"  
                  Case   Else  
                          MsgBox   "Mode   not   supported",   vbOKOnly   +   vbSystemModal,   "Error"  
          End   Select  
  End   Sub  
  Private   Sub   Form_Load()  
          'KPD-Team   1999  
          'URL:   http://www.allapi.net/  
          'E-Mail:   KPDTeam@Allapi.net  
          Dim   nDC   As   Long  
          'retrieve   the   screen's   resolution  
          OldX   =   Screen.Width   /   Screen.TwipsPerPixelX  
          OldY   =   Screen.Height   /   Screen.TwipsPerPixelY  
          'Create   a   device   context,   compatible   with   the   screen  
          nDC   =   CreateDC("DISPLAY",   vbNullString,   vbNullString,   ByVal   0&)  
          'Change   the   screen's   resolution  
          ChangeRes   640,   480,   GetDeviceCaps(nDC,   BITSPIXEL)  
  End   Sub  
  Private   Sub   Form_Unload(Cancel   As   Integer)  
          'restore   the   screen   resolution  
          ChangeRes   OldX,   OldY,   GetDeviceCaps(nDC,   BITSPIXEL)  
          'delete   our   device   context  
          DeleteDC   nDC  
  End   Sub  
  Top

4 楼zyl910（编程的乐趣在于编程控制硬件，与用图形学实现绚丽效果）回复于 2003-08-04 20:29:47 得分 4

'//第2个示例  
  改变屏幕分辨率  
  Private   Declare   Function   lstrcpy   Lib   "kernel32"   Alias   "lstrcpyA"   (lpString1   As   Any,   lpString2   As   Any)   As   Long  
  Private   Const   CCHDEVICENAME   =   32  
  Private   Const   CCHFORMNAME   =   32  
  Private   Const   ENUM_CURRENT_SETTINGS   =   1  
  Private   Type   DEVMODE  
                  dmDeviceName   As   String   *   CCHDEVICENAME  
                  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   *   CCHFORMNAME  
                  dmUnusedPadding   As   Integer  
                  dmBitsPerPel   As   Long  
                  dmPelsWidth   As   Long  
                  dmPelsHeight   As   Long  
                  dmDisplayFlags   As   Long  
                  dmDisplayFrequency   As   Long  
  End   Type  
   
  Private   Declare   Function   ChangeDisplaySettings   Lib   "user32"   Alias   "ChangeDisplaySettingsA"   (ByVal   lpDevMode   As   Long,   ByVal   dwflags   As   Long)   As   Long  
  Private   Declare   Function   EnumDisplaySettings   Lib   "user32"   Alias   "EnumDisplaySettingsA"   (ByVal   lpszDeviceName   As   String,   ByVal   iModeNum   As   Long,   lpDevMode   As   Any)   As   Long  
  Private   Declare   Function   GetSystemMetrics   Lib   "user32"   (ByVal   nIndex   As   Long)   As   Long  
   
  Private   Const   SM_CXSCREEN   =   0  
  Private   Const   SM_CYSCREEN   =   1  
   
  Dim   pNewMode   As   DEVMODE  
  Dim   pOldMode   As   Long  
  Dim   nOrgWidth   As   Integer,   nOrgHeight   As   Integer  
           
  '设置显示器分辨率的执行函数  
  Private   Function   SetDisplayMode(Width   As   Integer,   Height   As   Integer,   Color   As   Integer)   As   Long   ',   Freq   As   Long)   As   Long  
          On   Error   GoTo   ErrorHandler  
          Const   DM_PELSWIDTH   =   &H80000  
          Const   DM_PELSHEIGHT   =   &H100000  
          Const   DM_BITSPERPEL   =   &H40000  
          Const   DM_DISPLAYFLAGS   =   &H200000  
          Const   DM_DISPLAYFREQUENCY   =   &H400000  
          With   pNewMode  
                  .dmSize   =   Len(pNewMode)  
                  If   Color   =   0   Then   'Color   =   0   时不更改屏幕颜色  
                          .dmFields   =   DM_PELSWIDTH   Or   DM_PELSHEIGHT  
                  Else  
                          .dmFields   =   DM_BITSPERPEL   Or   DM_PELSWIDTH   Or   DM_PELSHEIGHT     'Or   DM_DISPLAYFREQUENCY'属性率的更改还是没办法,不过,不加入此DM_DISPLAYFREQUENCY这个参数,只要系统支持,应该不会更改刷新率的  
                  End   If  
                  .dmPelsWidth   =   Width  
                  .dmPelsHeight   =   Height  
                  If   Color   <>   0   Then  
                  .dmBitsPerPel   =   Color  
                  End   If  
          End   With  
          pOldMode   =   lstrcpy(pNewMode,   pNewMode)  
          SetDisplayMode   =   ChangeDisplaySettings(pOldMode,   1)  
          Exit   Function  
  ErrorHandler:  
          MsgBox   Err.Description,   vbCritical,   "VB广场"  
  End   Function  
   
  Private   Sub   Command1_Click()  
          Dim   nWidth   As   Integer,   nHeight   As   Integer,   nColor   As   Integer  
          Select   Case   Combo1.ListIndex  
                  Case   0  
                          nWidth   =   640:   nHeight   =   480:   nColor   =   16     '640*480*16位真彩色,256色nColor   =   8,16色nColor   =   4,nColor   =   0   表示不改变颜色  
                  Case   1  
                          nWidth   =   640:   nHeight   =   480:   nColor   =   24  
                  Case   2  
                          nWidth   =   640:   nHeight   =   480:   nColor   =   32  
                  Case   3  
                          nWidth   =   800:   nHeight   =   600:   nColor   =   16  
                  Case   4  
                          nWidth   =   800:   nHeight   =   600:   nColor   =   24  
                  Case   5  
                          nWidth   =   800:   nHeight   =   600:   nColor   =   32  
                  Case   6  
                          nWidth   =   1024:   nHeight   =   768:   nColor   =   16  
                  Case   7  
                          nWidth   =   1024:   nHeight   =   768:   nColor   =   24  
                  Case   8  
                          nWidth   =   1024:   nHeight   =   768:   nColor   =   32  
                  Case   other  
                          nWidth   =   800:   nHeight   =   600:   nColor   =   16  
          End   Select  
          Call   SetDisplayMode(nWidth,   nHeight,   nColor)     '注意,系统不支持的显示模式不能选,否则,准备用安全模式重启动吧.API函数EnumDisplaySettings可以选择系统支持的模式,自己去写吧,也很简单.如果你还有什么问题,请给我发信或留言.  
  End   Sub  
   
  Private   Sub   Form_Load()  
          Combo1.AddItem   "640*480*16位真彩色"  
          Combo1.AddItem   "640*480*24位真彩色"  
          Combo1.AddItem   "640*480*32位真彩色"  
          Combo1.AddItem   "800*600*16位真彩色"  
          Combo1.AddItem   "800*600*24位真彩色"  
          Combo1.AddItem   "800*600*32位真彩色"  
          Combo1.AddItem   "1024*768*16位真彩色"  
          Combo1.AddItem   "1024*768*24位真彩色"  
          Combo1.AddItem   "1024*768*32位真彩色"  
          Combo1.Text   =   Combo1.List(0)  
          nOrgWidth   =   GetDisplayWidth  
          nOrgHeight   =   GetDisplayHeight  
          'nOrgWidth   =   GetSystemMetrics(SM_CXSCREEN)'两种获取初始屏幕大小的方法均可  
          'nOrgHeight   =   GetSystemMetrics(SM_CYSCREEN)  
  End   Sub  
   
  Private   Function   GetDisplayWidth()   As   Integer  
          GetDisplayWidth   =   Screen.Width   \   Screen.TwipsPerPixelX  
  End   Function  
   
  Private   Function   GetDisplayHeight()   As   Integer  
          GetDisplayHeight   =   Screen.Height   \   Screen.TwipsPerPixelY  
  End   Function  
   
  Private   Sub   RestoreDisplayMode()  
          Call   SetDisplayMode(nOrgWidth,   nOrgHeight,   0)  
  End   Sub  
   
  Private   Sub   Form_Unload(Cancel   As   Integer)  
          RestoreDisplayMode  
  End   Sub  
   
  Top

5 楼newjgh（无）回复于 2003-08-05 19:15:12 得分 0

大家说的方法都能改变屏幕分辨率。但是......  
  我的显示器的刷新频率总是变到最低(60)，恢复不了初始设置(85)？！Top

6 楼newjgh（无）回复于 2003-08-05 21:52:21 得分 0

upTop

7 楼since1990（level）回复于 2003-08-06 20:32:32 得分 3

http://expert.csdn.net/Expert/topic/2108/2108436.xml?temp=.5908625  
  Top

相关问题

• .net
• as integer
• long
• const
• private

• 帖主：newjgh
• gpo2002
• zyl910
• zyl910
• since1990

• Visual Basic类图书
• Visual Basic类源码下载