Solved

1024x768  1024x768  1024x768  1024x768  1024x768  1024x768

Posted on 2002-07-15
4
139 Views
Last Modified: 2010-05-02
Dear Experts,

One of my VB Application needs
screen resolution 1024x768 pixels.
It is 800x600 pixels by default.

After exiting the program I have to
change it to 800X600 pixels.

How can I change screen resolution
at VB-runtime?

Srin
0
Comment
Question by:eesrinivaassan
4 Comments
 
LVL 18

Expert Comment

by:mdougan
ID: 7154262
I'm not sure that there is a way to do that programatically, but even if there is, I do not recommend that you do so.  Some computers may not be able to handle that resolution, that is why when you switch between resolutions, the display driver forces you to "test" the new resolution.

You might switch someone into that mode, and then they can't see anything on their computer screen, and then they can't switch themselves back to another resolution (and they might not know what your program did, so they don't even know where to begin).

There are two things that you could do that would be good design choices.  First, you could redesign the application to fit 800X600.  This is a safe resolution to develop for.

If this is not possible, you can check to see what resolution they are in, and if they are not in 1024X768 you can display a message to the user that the application requires this display mode, and then don't let them run the application until they manually set the mode themselves.
0
 
LVL 18

Accepted Solution

by:
deighton earned 100 total points
ID: 7154395
so, startup is sub main, then in your main form (form1) you need

Private Sub Form_Unload(Cancel As Integer)
    ExRes lWidth, lHeight, lDepth
End Sub


then a bas module with

Option Explicit

Public lWidth As Long
Public lHeight As Long
Public lDepth As Long


Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1


Private Declare Function ChangeDisplaySettings Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, _
ByVal dwflags As Long) As Long

Private Declare Function EnumDisplaySettings Lib _
"user32" Alias "EnumDisplaySettingsA" _
(ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
lpDevMode As Any) As Boolean

'Screen Resolution
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32

Private Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H2
Const CDS_FULLSCREEN = &H4
Const CDS_GLOBAL = &H8
Const CDS_SET_PRIMARY = &H10
Const CDS_RESET = &H40000000
Const CDS_SETRECT = &H20000000
Const CDS_NORESET = &H10000000
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const DISP_CHANGE_FAILED = -1
Const DISP_CHANGE_BADMODE = -2
Const DISP_CHANGE_NOTUPDATED = -3
Const DISP_CHANGE_BADFLAGS = -4
Const DISP_CHANGE_BADPARAM = -5

Private 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

Private Const BITSPIXEL = 12
Private Const PLANES = 14

Private Declare Function CreateIC Lib "gdi32" _
Alias "CreateICA" (ByVal lpDriverName As String, _
ByVal lpDeviceName As Any, ByVal lpOutput As Any, _
ByVal lpInitData As Any) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long

Public Sub CrapRes()


    Dim lTemp As Long, tDevMode As DEVMODE, lIndex As Long, tDevMode2 As DEVMODE
    lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
   
    Dim lMin As Long
   
    lMin = 2000000000
    lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
    Do Until lTemp = 0
       
        With tDevMode
            If .dmPelsWidth * .dmPelsHeight < lMin Then
                tDevMode2 = tDevMode
                lMin = .dmPelsWidth * .dmPelsHeight
            End If
        End With
        lIndex = lIndex + 1
        lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
       
    Loop
   
    ChangeDisplaySettings tDevMode2, 0
   
End Sub
Public Sub MaxRes()


    Dim lTemp As Long, tDevMode As DEVMODE, lIndex As Long, tDevMode2 As DEVMODE
    lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
   
    Dim lMin As Long
   
    lMin = 0
    lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
    Do Until lTemp = 0
       
        With tDevMode
            If .dmPelsWidth * .dmPelsHeight > lMin Then
                tDevMode2 = tDevMode
                lMin = .dmPelsWidth * .dmPelsHeight
            End If
        End With
        lIndex = lIndex + 1
        lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
       
    Loop
   
    ChangeDisplaySettings tDevMode2, 0
   
End Sub

Public Function ExRes(lWidth As Long, lHeight As Long, Optional lDepth As Long) As Long


    Dim lTemp As Long, tDevMode As DEVMODE, lIndex As Long, tDevMode2 As DEVMODE
    lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
   
    Dim bGo As Boolean
   
    Dim lMin As Long
   
    lMin = 0
    lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
    Do Until lTemp = 0
       
        With tDevMode
       
            If lDepth = 0 Or .dmBitsPerPel = lDepth Then
       
                If .dmPelsWidth = lWidth And .dmPelsHeight = lHeight Then
                    tDevMode2 = tDevMode
                    bGo = True
                    Exit Do
                End If
               
            End If
                           
        End With
        lIndex = lIndex + 1
        lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
       
    Loop
   
    If bGo Then
        ChangeDisplaySettings tDevMode2, 0
        ExRes = True
    Else
        ExRes = False
    End If
       
       
   
End Function

Public Function GetAvailableColours() As Long
Dim lHdc As Long, lPlanes As Long, lBitsPerPixel As Integer
'Declare variables
lHdc = CreateIC("DISPLAY", 0&, 0&, 0&)
'Create the device context for the display
If lHdc = 0 Then
  'An error has occurred and the function will exit
  GetAvailableColours = "Error"
Exit Function
End If

lPlanes = GetDeviceCaps(lHdc, PLANES)
'Return info on number of planes

lBitsPerPixel = GetDeviceCaps(lHdc, BITSPIXEL)
'Use display device
'context to return info on the
'number of pixels

lHdc = DeleteDC(lHdc)
'Delete the device context

Select Case lPlanes

Case 1

'1 plane is available. This
'will be the same for most
'computer systems

GetAvailableColours = lBitsPerPixel

Case 4
GetAvailableColours = 16
'If there are 4 planes then the availible
'colours will be 16-bit
Case Else

GetAvailableColours = -1
'The number of colours could not bee determined

End Select

End Function

Sub main()

lDepth = GetAvailableColours

lWidth = GetSystemMetrics(SM_CXSCREEN)

lHeight = GetSystemMetrics(SM_CYSCREEN)

If lWidth <> 1024 Then
   
    If Not ExRes(1024, 768, lDepth) Then
        ExRes 1024, 768
    End If
   
End If

Form1.Show

End Sub
0
 
LVL 100

Expert Comment

by:mlmcc
ID: 7154450
learning
0
 

Author Comment

by:eesrinivaassan
ID: 7157401
Thank you deighton,
It works fine.

Srin
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now