Proper screen resolution

This tip describes a procedure for obtaining the proper screen resolution.

In too many cases I had problems with screen resolution in my work with users. Their tables were too wide or too short or the colors were of bad quality. So to resolve that problem I made a short class that will force users to use proper screen resolution and color depth when he or she uses the application. After the work is done, screen resolution will be reset to its previous value. I like to use this class in database scripts (initialize call constructor and adopt my screen settings and terminate call destructor).

  'Script Library
Option Public
Option Explicit

Type DevMode
 dmDeviceName As String * 32
 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 * 32
 dmLogPixels As Integer
 dmBitsPerPel As Long
 dmPelsWidth As Long
 dmPelsHeight As Long
 dmDisplayFlags As Long
 dmDisplayFrequency As Long
 dmICMMethod As Long      
 dmICMIntent As Long         
 dmMediaType As Long       
 dmDitherType As Long        
 dmICCManufacturer As Long 
 dmICCModel As Long          
 dmPanningWidth As Long  
 dmPanningHeight As Long 
End Type

Declare Function ChangeDisplaySettings Lib 
"user32" Alias "ChangeDisplaySettingsA" 
(lpDevMode As DevMode, Byval dwFlags As Long)
 As Long
Declare Function GetSystemMetrics Lib "user32.dll" 
(Byval nIndex As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" 
(Byval hdc As Long, Byval nIndex As Long) As Long
Declare Function GetDesktopWindow Lib "user32"
 () As Long
Declare Function GetDC Lib "user32" 
(Byval hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (Byval 
hwnd As Long, Byval hdc As Long) As Long
Const DM_BITSPERPEL = &H40000
Const DM_PELSHEIGHT = &H100000
Const DM_PELSWIDTH = &H80000
Const BITSPIXEL = 12 

%REM dmBitsPerPel
1 bpp   Monochrome
 4 bpp   16 colors
 8 bpp   256 colors
 15 bpp   32,768 (32K) colors
 16 bpp   65,536 (64K) colors
 24 bpp   16.7 million (16.7M) colors
 32 bpp   16.7 million colors 
%REM ScreenResolution
X   *  Y
640  *  480
800  *  600
1024  *  768
1152  *  864
1280  *  960
1280  *  1024

Class WindowResolution
 Private mPreviouseWidth As Long 
 Private mPreviouseHeight As Long
 Private mCurrentWidth As Long 
 Private mCurrentHeight As Long
 Private mPreviouseBPP As Long
 Private mCurrentBPP As Long
 Sub new() 'constructor
  Dim hSrcDC As Long
  'Get screen width
  mPreviouseWidth = GetSystemMetrics
  mCurrentWidth = mPreviouseWidth
  'Get screen hight
  mPreviouseHeight = GetSystemMetrics
  mCurrentHeight  = mPreviouseHeight
  'Get bits per pixel
  hSrcDC = GetDC(GetDesktopWindow())
  mPreviouseBPP =  GetDeviceCaps
  ReleaseDC GetDesktopWindow(), hSrcDC
  mCurrentBPP = mPreviouseBPP
 End Sub
 Property Get ScreenWidth As Long 'Read only
  ScreenWidth  = mCurrentWidth 
 End Property
 Property Get ScreenHeight As Long 'read only
  ScreenHeight = mCurrentHeight
 End Property
 Property Get BitsPerPixel As Long 'Read only
  BitsPerPixel = mCurrentBPP
 End Property
 Sub ChangeResolution(lWidth As Long, 
lHeight As Long, lBpp As Long) 'method
  'lBpp means long BitPerPixel
  Dim myDevMode As DevMode
  Dim lRes As Long
  'Setting usful parameters
  myDevMode.dmSize = Len(myDevMode)
  myDevMode.dmPelsWidth = lWidth
  myDevMode.dmPelsHeight = lHeight
  myDevMode.dmBitsPerPel = lBpp
  myDevMode.dmFields = DM_BITSPERPEL 
  lRes = ChangeDisplaySettings(myDevMode,
 CDS_UPDATEREGISTRY) 'Change screen 
resolution using win API
  If lRes = 0 Then 'For successfull operation 
change class members
   mCurrentWidth = lWidth
   mCurrentHeight = lHeight
   mCurrentBPP = lBpp
  End If
 End Sub
 Sub delete() 'destructor
  ChangeResolution mPreviouseWidth, 
mPreviouseHeight, mPreviouseBPP
 End Sub
End Class

'Database Script
Option Explicit
Use "WindowResolution"

Dim win As WindowResolution
Sub Initialize
 Set win = New WindowResolution
 win.ChangeResolution 800, 600, 32
End Sub
Sub Terminate
 Set win = Nothing
End Sub
This was last published in March 2003

Dig Deeper on LotusScript

Start the conversation

Send me notifications when other members comment.

By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Please create a username to comment.




  • iSeries tutorials's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...