Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

code to change screen resolution?

Status
Not open for further replies.

pronate

Technical User
Jul 7, 2002
64
SG
Hi,

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.

How do i please everyone?
 
G'Day pronate

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'
' - my web site :)'

'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

GetScreenResolution = DisplayWidth & "x" & DisplayHeight
Width = DisplayWidth

End Function

Public Sub ResizeForm(frm As Form)

Dim ctl As Control
Dim I As Integer

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

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top