I design my GUI in 1024x768 resoultion, and because this is goping to be a multi-user thing, some of my User's PCs are 800x600 and, belive it or not, some are 640x480. When they open the database, its not very pretty.
this is the code that I use though you will need to change the calculation at the end to resize downwards
Ozrodent
Thanks to Jamie
Module by Jamie Czernik 31st March 2000 {JSCzernik@Hotmail.com}'
'Please feel free to use or distribute this module as you see fit.'
'If you have any useful code that you wish to share then please email it to me'
'
'USE: Design your form to fit 640 * 480 resolution and import this module into your project.'
'Call as "Resizeform Me" on the form's On Open event'
'You might use Form.Visble=False before and Form.Visible=true after the call to stop the '
'Screen flicker when the controls resize. Email me and let me know how you get on.....Jamie'
Option Compare Database
Option Explicit
'Module Declarations'
Global Const WM_HORZRES = 8
Global Const WM_VERTRES = 10
Dim Width As Integer
Dim Factor As Single 'Used as multiplier for current size properties'
Declare Function WM_apiGetDeviceCaps _
Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function WM_apiGetDesktopWindow _
Lib "user32" Alias "GetDesktopWindow" () As Long
Declare Function WM_apiGetDC _
Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long) As Long
Declare Function WM_apiReleaseDC _
Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function WM_apiGetSystemMetrics _
Lib "user32" Alias "GetSystemMetrics" _
(ByVal nIndex As Long) As Long
Function GetScreenResolution() As String
'returns the height and width'
Dim DisplayHeight As Integer
Dim DisplayWidth As Integer
Dim hDesktopWnd As Long
Dim hDCcaps As Long
Dim iRtn As Integer
'API call get current resolution'
hDesktopWnd = WM_apiGetDesktopWindow() 'get handle to desktop
hDCcaps = WM_apiGetDC(hDesktopWnd) 'get display context for desktop
DisplayHeight = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
DisplayWidth = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
iRtn = WM_apiReleaseDC(hDesktopWnd, hDCcaps) 'release display context
On Error Resume Next
SetFactor 'Call to procedure SetFactor'
With frm
.Width = frm.Width * Factor
End With
For Each ctl In frm.Controls
With ctl
.Height = ctl.Height * Factor
.Left = ctl.Left * Factor
.Top = ctl.Top * Factor
.Width = ctl.Width * Factor
.FontSize = .FontSize * Factor
End With
Next ctl
End Sub
Sub SetFactor()
GetScreenResolution 'Call to function GetScreenResolution'
If Width = 800 Then
Factor = 1.25
Else
If Width = 1024 Then
Factor = 1.6
Else
If Width = 1152 Then
Factor = 1.8
Else: Factor = 1
End If
End If
End If
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.