rbend
asked on
How to determin screen resolution
Need the code to find out screen resolution.
Msgbox "Screen is 800x600" if 800x600
or
Msgbox "Screen is 1024x768" if 1024x768
thanks..
Msgbox "Screen is 800x600" if 800x600
or
Msgbox "Screen is 1024x768" if 1024x768
thanks..
I can send you a project with full control on the screen resolution .
Send me your E-mail to nice@newmail.net and I will send you the project .
Send me your E-mail to nice@newmail.net and I will send you the project .
You can use the following small piece of code to
detect the current screen resolution and
then act on the information -
for instance, by resizing form objects to suit the user's resolution.
'form event code
Dim x,y As Integer
x = Screen.Width / 15
y = Screen.Height / 15
If x = 640 And y = 480 Then MsgBox ("640 * 480")
If x = 800 And y = 600 Then MsgBox ("800 * 600")
If x = 1024 And y = 768 Then MsgBox ("1024 * 768")
detect the current screen resolution and
then act on the information -
for instance, by resizing form objects to suit the user's resolution.
'form event code
Dim x,y As Integer
x = Screen.Width / 15
y = Screen.Height / 15
If x = 640 And y = 480 Then MsgBox ("640 * 480")
If x = 800 And y = 600 Then MsgBox ("800 * 600")
If x = 1024 And y = 768 Then MsgBox ("1024 * 768")
Try this code bellow. It is a lot more complete!
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4860
ClientLeft = 48
ClientTop = 336
ClientWidth = 5388
LinkTopic = "Form1"
ScaleHeight = 4860
ScaleWidth = 5388
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Change Resolution"
Height = 972
Left = 4080
TabIndex = 1
Top = 2280
Width = 1212
End
Begin VB.ListBox List1
Height = 4464
Left = 240
TabIndex = 0
Top = 120
Width = 3732
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
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 Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_DISPLAYFLAGS = &H200000
Private Const DM_DISPLAYFREQUENCY = &H400000
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpInitData As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (lpszDeviceName As Any, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
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 Const BITSPIXEL = 12
' Flags for ChangeDisplaySettings
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H2
Private Const CDS_FULLSCREEN = &H4
Private Const CDS_GLOBAL = &H8
Private Const CDS_SET_PRIMARY = &H10
Private Const CDS_RESET = &H40000000
Private Const CDS_SETRECT = &H20000000
Private Const CDS_NORESET = &H10000000
' Return values for ChangeDisplaySettings
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const DISP_CHANGE_FAILED = -1
Private Const DISP_CHANGE_BADMODE = -2
Private Const DISP_CHANGE_NOTUPDATED = -3
Private Const DISP_CHANGE_BADFLAGS = -4
Private Const DISP_CHANGE_BADPARAM = -5
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private D() As DEVMODE
Private lNumModes As Long
Private Sub Command1_Click()
Dim l As Long
Dim Flags As Long
Dim x As Long
x = List1.ListIndex
D(x).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
Flags = CDS_UPDATEREGISTRY
l = ChangeDisplaySettings(D(x) , Flags)
Select Case l
Case DISP_CHANGE_RESTART
l = MsgBox("This change will not take effect until you reboot the system. Reboot now?", vbYesNo)
If l = vbYes Then
Flags = 0
l = ExitWindowsEx(EWX_REBOOT, Flags)
End If
Case DISP_CHANGE_SUCCESSFUL
Case Else
MsgBox "Error changing resolution! Returned: " & l
End Select
End Sub
Private Sub Form_Load()
Dim l As Long
Dim lMaxModes As Long
Dim lBits As Long
Dim lWidth As Long
Dim lHeight As Long
lBits = GetDeviceCaps(hdc, BITSPIXEL)
lWidth = Screen.Width \ Screen.TwipsPerPixelX
lHeight = Screen.Height \ Screen.TwipsPerPixelY
lMaxModes = 8
ReDim D(0 To lMaxModes) As DEVMODE
lNumModes = 0
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Do While l
List1.AddItem D(lNumModes).dmPelsWidth & "x" & D(lNumModes).dmPelsHeight & "x" & D(lNumModes).dmBitsPerPel
If lBits = D(lNumModes).dmBitsPerPel And _
lWidth = D(lNumModes).dmPelsWidth And _
lHeight = D(lNumModes).dmPelsHeight Then
List1.ListIndex = List1.NewIndex
End If
lNumModes = lNumModes + 1
If lNumModes > lMaxModes Then
lMaxModes = lMaxModes + 8
ReDim Preserve D(0 To lMaxModes) As DEVMODE
End If
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Loop
lNumModes = lNumModes - 1
End Sub
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4860
ClientLeft = 48
ClientTop = 336
ClientWidth = 5388
LinkTopic = "Form1"
ScaleHeight = 4860
ScaleWidth = 5388
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Change Resolution"
Height = 972
Left = 4080
TabIndex = 1
Top = 2280
Width = 1212
End
Begin VB.ListBox List1
Height = 4464
Left = 240
TabIndex = 0
Top = 120
Width = 3732
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
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 Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_DISPLAYFLAGS = &H200000
Private Const DM_DISPLAYFREQUENCY = &H400000
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpInitData As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (lpszDeviceName As Any, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
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 Const BITSPIXEL = 12
' Flags for ChangeDisplaySettings
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H2
Private Const CDS_FULLSCREEN = &H4
Private Const CDS_GLOBAL = &H8
Private Const CDS_SET_PRIMARY = &H10
Private Const CDS_RESET = &H40000000
Private Const CDS_SETRECT = &H20000000
Private Const CDS_NORESET = &H10000000
' Return values for ChangeDisplaySettings
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const DISP_CHANGE_FAILED = -1
Private Const DISP_CHANGE_BADMODE = -2
Private Const DISP_CHANGE_NOTUPDATED = -3
Private Const DISP_CHANGE_BADFLAGS = -4
Private Const DISP_CHANGE_BADPARAM = -5
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private D() As DEVMODE
Private lNumModes As Long
Private Sub Command1_Click()
Dim l As Long
Dim Flags As Long
Dim x As Long
x = List1.ListIndex
D(x).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
Flags = CDS_UPDATEREGISTRY
l = ChangeDisplaySettings(D(x)
Select Case l
Case DISP_CHANGE_RESTART
l = MsgBox("This change will not take effect until you reboot the system. Reboot now?", vbYesNo)
If l = vbYes Then
Flags = 0
l = ExitWindowsEx(EWX_REBOOT, Flags)
End If
Case DISP_CHANGE_SUCCESSFUL
Case Else
MsgBox "Error changing resolution! Returned: " & l
End Select
End Sub
Private Sub Form_Load()
Dim l As Long
Dim lMaxModes As Long
Dim lBits As Long
Dim lWidth As Long
Dim lHeight As Long
lBits = GetDeviceCaps(hdc, BITSPIXEL)
lWidth = Screen.Width \ Screen.TwipsPerPixelX
lHeight = Screen.Height \ Screen.TwipsPerPixelY
lMaxModes = 8
ReDim D(0 To lMaxModes) As DEVMODE
lNumModes = 0
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Do While l
List1.AddItem D(lNumModes).dmPelsWidth & "x" & D(lNumModes).dmPelsHeight & "x" & D(lNumModes).dmBitsPerPel
If lBits = D(lNumModes).dmBitsPerPel And _
lWidth = D(lNumModes).dmPelsWidth And _
lHeight = D(lNumModes).dmPelsHeight Then
List1.ListIndex = List1.NewIndex
End If
lNumModes = lNumModes + 1
If lNumModes > lMaxModes Then
lMaxModes = lMaxModes + 8
ReDim Preserve D(0 To lMaxModes) As DEVMODE
End If
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Loop
lNumModes = lNumModes - 1
End Sub
Juilette, your code will return incorrect results if the user uses Large Fonts (12 Twips per Pixel)
Apart from that, there are much higher resolutions around than 1024x768 these days....
emoreau et al, very nice if you want to control the screen resolution but AFAIK rbend only wants to find out the resolution, not change it.
Apart from that, there are much higher resolutions around than 1024x768 these days....
emoreau et al, very nice if you want to control the screen resolution but AFAIK rbend only wants to find out the resolution, not change it.
Ok...I'll trash the old code .
Wayne
Wayne
rbend...this is caraf's code expanded.
caraf: how's this..
Ps..I don't want points I was just adding my 2 cents worth since the Q has already been answered. Thanks for the update.
'form event code
Dim x, y As Integer
x = Screen.Width / Screen.TwipsPerPixelX
y = Screen.Height / Screen.TwipsPerPixelY
Dim msg
msg = "Screen Width = " & x & " TwipsPerPixel" & vbCrLf
msg = msg & "Screen Height = " & y & " TwipsPerPixel"
MsgBox msg
caraf: how's this..
Ps..I don't want points I was just adding my 2 cents worth since the Q has already been answered. Thanks for the update.
'form event code
Dim x, y As Integer
x = Screen.Width / Screen.TwipsPerPixelX
y = Screen.Height / Screen.TwipsPerPixelY
Dim msg
msg = "Screen Width = " & x & " TwipsPerPixel" & vbCrLf
msg = msg & "Screen Height = " & y & " TwipsPerPixel"
MsgBox msg
Yes, that should work pretty well.
ASKER
I found Juliette's answer precisely what I needed.
Thank you to ALL of you for trying to help.
Juliette, please answer for points.
Thank you to ALL of you for trying to help.
Juliette, please answer for points.
you can click at Accept comment as answer, on that dark blue line where Comment is written.
Thank you very much but I would rather you gave the points to caraf-g....his answer was correct except he didn't add the msgbox part of it. I'm sure he would have if you requested it of him.
Please go to the comment below mine and use the "accept comment as answer"...
Thanks anyway,
Wayne
From: caraf_g
Date: Thursday, December 16 1999 - 11:59AM NST
Yes, that should work pretty well.
Please go to the comment below mine and use the "accept comment as answer"...
Thanks anyway,
Wayne
From: caraf_g
Date: Thursday, December 16 1999 - 11:59AM NST
Yes, that should work pretty well.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Normally, the screen width and height are retrieved in twips.
Screen.width / screen.TwipsPerPixelX will give you the width of the screen.