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