refresh rate on API Call

Posted on 2002-06-05
Last Modified: 2012-06-27
im using the code below in order to change the resolution.

ive noticed that this is causing the refresh rate to be set too low (thus looking like crap because it is shaky)

is there a better way to do this (for deployment in a mixed OS enviornment to perhaps 100 desktops)

Option Explicit

Private Const EWX_REBOOT = 2
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_TEST = &H4

Private Type typDevMODE
    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, _
  lptypDevMode As Any) As Boolean

Private Declare Function ChangeDisplaySettings Lib _
  "user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, _
  ByVal dwFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib _
  "user32" (ByVal uFlags As Long, _
  ByVal dwReserved As Long) As Long

Public Function ChangeDisplayResolution(NewWidth As Long, _
   NewHeight As Long) As Boolean

'Usage:  ChangeDisplayResolution 800, 600

'Returns: True if succesful, false otherwise

'Comments:  Problems have been reported using this code for
'resolutions higher than 1024 X 768.  We recommend not using this
'snippet to go above this limit.

Dim typDM As typDevMODE
Dim lRet As Long
Dim iResp  As Integer

'typDM = pointer to info about current
'display settings

lRet = EnumDisplaySettings(0, 0, typDM)
If lRet = 0 Then Exit Function

' Set the new resolution.
With typDM
    .dmPelsWidth = NewWidth
    .dmPelsHeight = NewHeight
End With

'Do the update -- Pass update structure to
'ChangeDisplaySettings API function
lRet = ChangeDisplaySettings(typDM, CDS_UPDATEREGISTRY)
Select Case lRet

   iResp = MsgBox _
  ("You must restart your computer to apply these changes." & _
        vbCrLf & vbCrLf & "Restart now?", _
        vbYesNo + vbInformation, "Screen Resolution Changed")
    If iResp = vbYes Then
        ChangeDisplayResolution = True
    End If

    ChangeDisplayResolution = True
Case Else
    ChangeDisplayResolution = False
End Select

End Function

Private Sub Reboot()
    Dim lRet As Long
    lRet = ExitWindowsEx(EWX_REBOOT, 0)
End Sub

Question by:aaronkempf
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 16

Expert Comment

ID: 7057472

Author Comment

ID: 7057868
im technically an access developer.

im using this in VBA.

my boss made a db that is only to be viewed in 1024x768.

he watches it in a bigger resolution.

and i want him to do it in 1024x768 (as he keeps on saying that everything looks to small and im trying to fit too much on the screen.

i cant do anything stretch/shrink.

im deadset on sticking with access.
i just want to enforce that everyone uses 1024x768.
LVL 49

Expert Comment

ID: 7858121
Hi aaronkempf,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Refund points and save as a 0-pt PAQ.

aaronkempf, Please DO NOT accept this comment as an answer.
EXPERTS: Post a comment if you are certain that an expert deserves credit.  Explain why.
DanRollins -- EE database cleanup volunteer

Accepted Solution

Computer101 earned 0 total points
ID: 7967206
Question placed in PAQ

E-E Admin

Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

738 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question