Printable View
When i install my vb program on client machines, im having problems adjusting to their various screen resolutions ...
Is there an API call i can make to automatically adapt my vb app to adjust to their resolution.....
i know i can use a control to detect the resolution...but the control does just that...i cant change the resolution......
Any API call out there to do that?..........
thanx...subash
Here is a module I found that will change the rez Just type call ChangeRes(1024,768) or any other resolution and if the system supports it it will change.
any questions e-mail me @ [email protected]
option Explicit
'*******************************************************************
' This basic module includes two functions:
' ChangeRes(width,height) changes to the width and height desired
' ChangeResBack changes to the previous resolution
'*******************************************************************
' Functions to Query and Change the Resolution
private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (byval lpszDeviceName as Long, byval iModeNum as Long, lpDevMode as Any) as Boolean
private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode as Any, byval dwflags as Long) as Long
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
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
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1
Const REG_DWORD = 4
' The Current path and Key we wish to Query
Const gREGKEYSYSINFOLOC = "Config\0001\Display\Settings"
Const gREGVALSYSINFOLOC = "Resolution"
' Functions to Open, Close and Query The Windows Registry
private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (byval hKey as Long, byval lpSubKey as string, byval ulOptions as Long, byval samDesired as Long, byref phkResult as Long) as Long
private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (byval hKey as Long, byval lpValueName as string, byval lpReserved as Long, byref lpType as Long, byval lpData as string, byref lpcbData as Long) as Long
private Declare Function RegCloseKey Lib "advapi32" (byval hKey as Long) as Long
Dim m_DevM as DEVMODE
Dim m_strRegKey as string ' Variable to hold the current Screen Resolution Query'ed by the Registry
public Function ChangeRes(lngWidth as Long, lngHeight as Long)
Dim strTempString
Dim lCurrentDisp as Long
Dim blnRes as Boolean
Dim lModeNum as Long
'**************************************
'Setup and change the screen resolution
Dim SysInfoPath as string
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) then
m_strRegKey = SysInfoPath
End If
strTempString = Str(lngWidth) & "," & Str(lngHeight)
If m_strRegKey <> strTempString then
' Check all screen resolutions to see if it supports what we wish to change it to
lModeNum = 0
Do
blnRes = EnumDisplaySettings(0, lModeNum, m_DevM)
lModeNum = lModeNum + 1
Loop Until (blnRes = false)
' Change the screen resolution Dynamically (don't save to the registry)
m_DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
m_DevM.dmPelsWidth = lngWidth
m_DevM.dmPelsHeight = lngHeight
lCurrentDisp = ChangeDisplaySettings(m_DevM, 0)
End If
'************************************************
End Function
public Sub ChangeResBack()
Dim lWidth as Long
Dim lHeight as Long
Dim lCurrentDisp as Long
Dim blnRes as Boolean
Dim lModeNum as Long
'If the original resolution was below 1024x768
If len(m_strRegKey) = 7 then
lWidth = CLng(Left(m_strRegKey, 3))
lHeight = CLng(Right(m_strRegKey, 3))
'If the original resolution was 1024x768
ElseIf len(m_strRegKey) = 8 then
lWidth = CLng(Left(m_strRegKey, 4))
lHeight = CLng(Right(m_strRegKey, 3))
'If the original resolution was above 1024x768
ElseIf len(m_strRegKey) = 9 then
lWidth = CLng(Left(m_strRegKey, 4))
lHeight = CLng(Right(m_strRegKey, 4))
End If
' Check all screen resolutions to see if it supports what we wish to change it to
lModeNum = 0
Do
blnRes = EnumDisplaySettings(0, lModeNum, m_DevM)
lModeNum = lModeNum + 1
Loop Until (blnRes = false)
' No need to re-save to the registry, we are changeing the resolution to the resolution already stored in the registry
m_DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
m_DevM.dmPelsWidth = lWidth
m_DevM.dmPelsHeight = lHeight
lCurrentDisp = ChangeDisplaySettings(m_DevM, 0)
End Sub
private Function GetKeyValue(KeyRoot as Long, KeyName as string, SubKeyRef as string, byref KeyVal as string) as Boolean
Dim I as Long
Dim RC as Long
Dim hKey as Long
Dim KeyValType as Long
Dim tmpVal as string
Dim KeyValSize as Long
' Open the Registry
RC = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (RC <> ERROR_SUCCESS) then
GoTo GetKeyError
End If
' set up buffer size
tmpVal = string$(1024, 0)
KeyValSize = 1024
' Query the Registry
RC = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)
If (RC <> ERROR_SUCCESS) then
GoTo GetKeyError
End If
If (Asc(mid(tmpVal, KeyValSize, 1)) = 0) then
tmpVal = Left(tmpVal, KeyValSize - 1)
else
tmpVal = Left(tmpVal, KeyValSize)
End If
Select Case KeyValType
Case REG_SZ
KeyVal = tmpVal
Case REG_DWORD
for I = len(tmpVal) to 1 step -1
KeyVal = KeyVal + Hex(Asc(mid(tmpVal, I, 1)))
next
KeyVal = Format$("&h" + KeyVal)
End Select
GetKeyValue = true
' Close the Registry
RC = RegCloseKey(hKey)
Exit Function
GetKeyError:
KeyVal = "" ' set Return Val to empty string
GetKeyValue = false ' Return Failure
RC = RegCloseKey(hKey) ' Close Registry Key
End Function
Write your app to 800x600, which is industry standard, and you should be ok.
or
Just size your form up with a :
Windowstate = vbMaximized
--
Chizl
[email protected]
http://www.chizl.com/