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

Question

如何得知当前电脑的分辨率800 X 600
1024 X 758......

Answer 1

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吧

Answer 2

用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 LongPrivate 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 Sub

Answer 3

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