Scherm resulutie controle/wijzigen

• 

  Sander

  09-12-2004 15:50

  Hoe kan ik bij het opstarten van Access een controle krijgen voor de schermresolutie?

  Mijn formulieren zijn gemaakt bij 1024 x 768 en sommige gebruikers hebben hun scherm staan op 800 x 600.

  Ik wil dus een pop-up scherm krijgen, waarbij de waarschuwing komt en dan overschakelen naar 1024 x 768.

  Bij het afsluiten moet deze dan weer terug naar 800 x 600, en dan enkel en alleen bij die gebruikers die dit voordat Access gestart is gewijzigd is.

  Wie heeft hiervoor de VB code?

  Michael
• 

  Eric B

  09-12-2004 22:40

  'zet deze code in een module

  Option Compare Database

  Option Explicit

  Const WM_DISPLAYCHANGE = &H7E

  Const HWND_BROADCAST = &HFFFF&

  Const EWX_LOGOFF = 0

  Const EWX_SHUTDOWN = 1

  Const EWX_REBOOT = 2

  Const EWX_FORCE = 4

  Const CCDEVICENAME = 32

  Const CCFORMNAME = 32

  Const DM_BITSPERPEL = &H40000

  Const DM_PELSWIDTH = &H80000

  Const DM_PELSHEIGHT = &H100000

  Const CDS_UPDATEREGISTRY = &H1

  Const CDS_TEST = &H4

  Const DISP_CHANGE_SUCCESSFUL = 0

  Const DISP_CHANGE_RESTART = 1

  Const BITSPIXEL = 12

  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

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

  Declare Function EnumDisplaySettings Lib “user32” Alias “EnumDisplaySettingsA” (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

  Declare Function ChangeDisplaySettings Lib “user32” Alias “ChangeDisplaySettingsA” (lpDevMode As Any, ByVal dwFlags As Long) As Long

  Declare Function ExitWindowsEx Lib “user32” (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

  Declare Function GetDeviceCaps Lib “gdi32” (ByVal hdc As Long, ByVal nIndex As Long) As Long

  Declare Function CreateDC Lib “gdi32” Alias “CreateDCA” (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long

  Declare Function DeleteDC Lib “gdi32” (ByVal hdc As Long) As Long

  Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

  Global OldX As Long

  Global OldY As Long

  Global nDC As Long

  Sub ChangeRes(X As Long, Y As Long, Bits As Long)

  Dim DevM As DEVMODE, ScInfo As Long, erg As Long, an As VbMsgBoxResult

  erg = EnumDisplaySettings(0&, 0&, DevM)

  ‘This is what we’re going to change

  DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL

  DevM.dmPelsWidth = X 'ScreenWidth

  DevM.dmPelsHeight = Y 'ScreenHeight

  DevM.dmBitsPerPel = Bits '(can be 8, 16, 24, 32 or even 4)

  'Now change the display and check if possible

  erg = ChangeDisplaySettings(DevM, CDS_TEST)

  'Check if succesfull

  Select Case erg&

  Case DISP_CHANGE_RESTART

  an = MsgBox(“Computer herstarten??”, vbYesNo + vbDefaultButton2 + vbQuestion, “Vraag”)

  If an = vbYes Then

  erg& = ExitWindowsEx(EWX_REBOOT, 0&)

  End If

  Case DISP_CHANGE_SUCCESSFUL

  erg = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

  ScInfo = Y * 2 ^ 16 + X

  'Notify all the windows of the screen resolution change

  SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo

  Case Else

  MsgBox “Mode wordt niet ondersteund”, vbOKOnly + vbSystemModal, “Error”

  End Select

  End Sub

  Sub SetScreenResolution()

  Dim nDC As Long

  ‘retrieve the screen’s resolution

  OldX = GetSystemMetrics(0)

  OldY = GetSystemMetrics(1) 'Create a device context, compatible with the screen

  If OldX <> 1024 And OldY <> 768 Then

  nDC = CreateDC(“DISPLAY”, vbNullString, vbNullString, ByVal 0&)

  ‘Change the screen’s resolution

  ChangeRes 1024, 768, GetDeviceCaps(nDC, BITSPIXEL)

  End If

  End Sub

  Sub RestoreScreenResolution()

  If OldX <> 1024 And OldY <> 768 Then

  'restore the original screen resolution

  ChangeRes OldX, OldY, GetDeviceCaps(nDC, BITSPIXEL)

  DeleteDC nDC 'delete our device context

  End If

  End Sub

  Je roept aan met SetScreenResolution

  en herstelt met RestoreScreenResolution

  Suc6 Eric B
• 

  Sander

  10-12-2004 12:06

  Eric,

  Bedankt, deze code werkt.

  Bij de gebruikers die nu nog op 800 x 600 werken, gaat bij het openen van Access meteen over naar 1024 x 768, en bij het afsluiten weer terug naar 800 x 600.

  Echt mooi. Nogmaals bedankt voor je posting.
• 

  Wim T

  08-06-2005 10:51

  Ik gebruik Access 2000 en heb de instructie van Eric B uitgevoerd, maar bij mij gaat het niet goed; er gebeurt helemaal niets.

  Iemand een idee wat ik er aan kan doen om het toch te laten werken?