View Full Version : Test Screen Resolution


Djblois
03-23-2009, 06:08 AM
I found some code to test Screen Resolution, so I can change elements in my form to accomadate but I can't get it to work. Here is the code:

Public Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _
(ByVal nIndex As Long) As Long


and then in a module:

intScreenWidth = CInt(WM_apiGetDesktopWindow(0))
If intScreenWidth = 1600 Then
end if

It just keeps giving me an error.

DCrake
03-24-2009, 04:14 AM
Create a new module and place the following code in to it.

Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

'************************************************* ****************
' 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
' 1280 x 800
'************************************************* ****************
Function GetScreenResolution() As String

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

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

End Function

Function ShowFrmScreenResolution() As String

Dim StrState As String
If Dir(App.Path & "\ScreenResolution.txt") <> "" Then
Open App.Path & "\ScreenResolution.txt" For Input As #1
Line Input #1, StrState
Close #1
ShowFrmScreenResolution = StrState
Else
Open App.Path & "\ScreenResolution.txt" For Output As #1
Print #1, "1"
Close #1
ShowFrmScreenResolution = "1"
End If

End Function

Function StopScreenResolution()
If Dir(App.Path & "\ScreenResolution.txt") <> "" Then
Open App.Path & "\ScreenResolution.txt" For Output As #1
Print #1, "0"
Close #1

End If

End Function




Then of the OnLoad event of your form

Call GetScreenResolution
If ShowFrmScreenResolution() = "1" Then
If ResWidth < 1280 Or ResHeight < 800 Then
FrmScreenResolution.Show vbModal My code
End If
End If


This has been taken from a VB6.0 application you may need to amend certain lines to get it to work in Access, Namely App.Path should be CurrentProject.Path

EDIT:Have attached sample mdb