Can I adjust the resolution with VBA?

Hi:
I need a code to chick if the screen resolution is 1024 X 768 pixel ?
If not, change the resolution to 1024 X 768 pixel , and when close my program retrieve it back to the previous resolution.
please
Mohammad Alsolaimanapplication programmerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Sujith_NairCommented:
Plz go through the attached code (Modify it according as per your screen size requirements! )...

Hope this helps...

Regards,
Sujith

'************************************************* ****************
' DECLARATIONS SECTION
'************************************************* ****************

Option Compare Database
Option Explicit

Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

' NOTE: The following declare statements are case sensitive.

Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" _
(ByVal hWnd As Long, rectangle As RECT) As Long
'================================================= =====

'This code shows how to change the screen resolution.

'Call the function like this:

' ChangeResolution 640, 480

'This would change the screen resolution to 640 pixels x 480 pixels. Note
that
'you can only change the resolution to values supported by the display.

'Paste the following code into a module:'

Private Declare Function ChangeDisplaySettings Lib "User32" Alias _
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "User32" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As _
Long, lpDevMode As Any) As Boolean

Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CCFORMNAME = 32
Const CCDEVICENAME = 32

Private Type DEVMODE
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

Public Function Change_Resolution(iWidth As Single, iHeight As Single)

Dim DevM As DEVMODE
Dim a As Boolean
Dim i As Long
Dim b As Long

i = 0

'Enumerate settings
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)

'Change settings
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight

b = ChangeDisplaySettings(DevM, 0)

End Function

'************************************************* ****************
' FUNCTION: GetScreenResolution()
'
' PURPOSE:
' To determine the current screen size or resolution.
'
' RETURN:
' The current screen resolution. Typically one of the following:
' 640 x 480
' 800 x 600
' 1024 x 768
'
'************************************************* ****************
Function GetScreenResolution() As String

Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long

hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)

End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Systems AnalystCommented:
I would respectfully suggest not doing this. Doing so is very likely to make users mad who are used to a specific resolution.  Further, desktop icons can easily get rearranged and end up in different positions ... even after resetting the resolution back.

Instead, I would suggest trying a resizing product such as the following:

http://www.peterssoftware.com/ss.htm

I use this in several apps ... an outstanding product.

mx
0
Mohammad Alsolaimanapplication programmerAuthor Commented:
thaks to all of you
it was great
mx
i my self agree to you
but the customer some times force you to do such things
0
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Systems AnalystCommented:
"Grading Comment:
thaks to all of you
it was great
mx
i my self agree to you
but the customer some times force you to do such things"
----

"but the customer some times force you to do such things"
I understand then.  And in this case, they can only be mad at themselves, lol.

mx

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.