如何得知当前电脑的分辨率

如何得知当前电脑的分辨率  
   
  800   X   600  
  1024   X   758  
   
  ...... 问题点数：20、回复次数：4Top

1 楼king_shadow（天才混混）回复于 2005-11-15 21:31:41 得分 7

Public   Function   CheckRez(pixelWidth   As   Long,   pixelHeight   As   Long)   As   Boolean  
          注释：  
          Dim   lngTwipsX   As   Long  
          Dim   lngTwipsY   As   Long  
          注释：   convert   pixels   to   twips  
          lngTwipsX   =   pixelWidth   *   15  
          lngTwipsY   =   pixelHeight   *   15  
          注释：   check   against   current   settings  
          If   lngTwipsX   <>   Screen.Width   Then  
                  CheckRez   =   False  
          Else  
                  If   lngTwipsY   <>   Screen.Height   Then  
                          CheckRez   =   False  
                  Else  
                          CheckRez   =   True  
                  End   If  
          End   If  
  End   Function  
   
          If   CheckRez(640,   480)   =   True   Then  
                  MsgBox   "640,   480!"  
          Else   if     CheckRez(800,   600)   =   True     then  
                MsgBox   "800,   600!"  
          End   If    
   
  要不就用API吧Top

2 楼faysky2（出来混，迟早是要还嘀）回复于 2005-11-15 21:37:17 得分 7

用API获得屏幕分辨率和色彩度    
  --------------------------------------------------------------------------------  
   
      　窗体加载时通过调用函数DeviceInfo将返回的屏幕分辨率宽、高和色彩度装入变量DisplayX、DisplayY、DisplayColor中。在你的程序中使用时只需要使用红色标记的一行调用语句即可。    
  Option   Explicit  
  '声明API函数  
  Private   Declare   Function   GetDC   Lib   "user32"   (ByVal   hwnd   As   Long)   As   Long  
  Private   Declare   Function   GetDeviceCaps   Lib   "gdi32"   (ByVal   hdc   As   Long,   ByVal   nIndex   As   Long)   As   Long  
  Private   Declare   Function   ReleaseDC   Lib   "user32"   (ByVal   hwnd   As   Long,   ByVal   hdc   As   Long)   As   Long  
   
  Private   Sub   Form_Load()  
  Dim   DisplayX   As   Integer  
  Dim   DisplayY   As   Integer  
  Dim   DisplayColor   As   Integer  
  Form1.Show  
  Call   DeviceInfo(DisplayX,   DisplayY,   DisplayColor)  
  Print   Trim(DisplayX):Print   Trim(DisplayY);:?Trim(DisplayColor)  
  End   Sub    
   
  DeviceInfo自定义函数代码如下    
  Public   Sub   DeviceInfo(DisplayX   As   Integer,   DisplayY   As   Integer,   DisplayColor   As   Integer)  
  Dim   hdesktopwnd  
  Dim   hdccaps  
  Dim   lblRes   As   String  
  Dim   DisplayBits  
  Dim   DisplayPlanes  
  Dim   RetVal  
  hdccaps   =   GetDC(hdesktopwnd)  
  DisplayBits   =   GetDeviceCaps(hdccaps,   12)  
  DisplayPlanes   =   GetDeviceCaps(hdccaps,   14)  
  DisplayX   =   GetDeviceCaps(hdccaps,   8)  
  DisplayY   =   GetDeviceCaps(hdccaps,   10)  
  RetVal   =   ReleaseDC(hdesktopwnd,   hdccaps)  
  Select   Case   DisplayBits  
  Case   1  
  If   DisplayPlanes   =   1   Then  
  DisplayColor   =   1  
  Else  
  If   DisplayPlanes   =   4   Then   DisplayColor   =   4   Else   DisplayColor   =   0  
  End   If  
  Case   8  
  DisplayColor   =   8  
  Case   16  
  DisplayColor   =   16  
  Case   24  
  DisplayColor   =   24  
  Case   32  
  DisplayColor   =   32  
  Case   Else  
  DisplayColor   =   0'未知色彩度  
  End   Select  
  End   SubTop

3 楼northwolves（狼行天下）回复于 2005-11-15 21:59:16 得分 6

Private   Sub   Command1_Click()  
  MsgBox   Screen.Width   /   Screen.TwipsPerPixelX   &   "x"   &   Screen.Height   /   Screen.TwipsPerPixelY  
  End   SubTop

4 楼gzhoney（@）回复于 2005-11-15 22:09:43 得分 0

谢谢Top

相关问题

• 函数
• checkrez
• displayy
• displaycolor
• displayx
• lngtwipsy
• hdccaps
• lngtwipsx
• deviceinfo
• getdevicecaps

• 帖主：gzhoney
• king_shadow
• faysky2
• northwolves

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