[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 153
  • Last Modified:

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..
0
rbend
Asked:
rbend
1 Solution
 
caraf_gCommented:
Try screen.width and screen.height

Normally, the screen width and height are retrieved in twips.

Screen.width / screen.TwipsPerPixelX will give you the width of the screen.

0
 
vbyuvalCommented:
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 .
0
 
JuiletteCommented:
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")
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
Éric MoreauSenior .Net ConsultantCommented:
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
0
 
caraf_gCommented:
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.
0
 
JuiletteCommented:
Ok...I'll trash the old code .
Wayne
0
 
JuiletteCommented:
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
   
0
 
caraf_gCommented:
Yes, that should work pretty well.
0
 
rbendAuthor Commented:
I found Juliette's answer precisely what I needed.
Thank you to ALL of you for trying to help.
Juliette, please answer for points.
0
 
HunterKillerCommented:
you can click at Accept comment as answer, on that dark blue line where Comment is written.
0
 
JuiletteCommented:
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.
 

0
 
caraf_gCommented:
Cheers, Wayne
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now