Option Explicit
 
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_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 ENUM_CURRENT_SETTINGS = &HFFFF - 1
 
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 Dev As DEVMODE
Private MergeSCREENX As Integer
Private MergeSCREENY As Integer
 
Private Const SCREENWIDTH As Integer = 1024
Private Const SCREENHEIGHT As Integer = 768
 
'Diese Prozedur wird automatisch ausgeführt, wenn die
'Anwendung gestartet wird ....
Private Sub Auto_Open()
      Dim JN As Variant  
 
      Application.Visible = False
 
      EnumDisplaySettings(0&,ENUM_CURRENT_SETTINGS, Dev)
 
      If Dev.dmPelsWidth < SCREENWIDTH Then
              JN = Msgbox ("Das vorliegende Programm wurde für eine " & _
                      "Bildschirmauflösung von 1024 x 768 Punkten optimiert. " _
                      & _
                      "Ihre gegenwärtige Bildschirmauflösung ist jedoch" & _
                      "kleiner. " & _
                     String(2, vbCrLf) & _
                      "Bitte vergewissern Sie sich, ob Ihre Hardware," & _
                      "insbesondere "& _
                      "Ihr Monitor mit dieser Auflösung arbeiten kann." & _
                      "Bestätigen Sie " & _
                      "mit JA, wenn dies der Fall ist und NEIN wenn Sie sich" & _
                      "nicht  2& _
                      "Sicher sind oder Ihr Monitor diese Auflösung nicht" & _
                      "verarbeiten kann. "& _
                      String(2, vbCrLf) & _
                      "Sollten Sie fortfahren, wird für evtl. Schäden an der" & _
                      "Hardware keine "& _
                     "Haftung übernommen!",
                     vbQuestion + vbyesno, "W A R N H I N W E I S")
 
               If JN = vbNo Then
                     Application.Visible = True
                     Exit Sub
               Else
                     JN = MsgBox("Soll die Auflösung wirklich geändert" & _
                       "werden?", _
                                 vbExclamation + vbyesno,"Auflösung wird" & _
                                 "geändert")
                      If JN = vbNo then
                          Application.Visible = True
                          Exit Sub
                      End If
               End If   
      End IF
 
      MergeSCREENX = Dev.dmPelsWidth
      MergeSCREENY = Dev.dmPelsHeight
 
      If Dev.dmPelsWidth <> SCREENWIDTH Then
               SetScreen(SCREENWIDTH,SCREENHEIGHT)
      End If
 
      'Hier in das Programm einspringen
      UserForm1.Show
End Sub
 
Private Sub Auto_Close()
     'Evtl. alte Bildschirmauflösung wieder herstellen
 
     If Dev.dmPelsWidth <> MergeSCREENX
           SetScreen(MergeSCREENX, MergeSCREENY)
     End If     
End Sub
 
Private Sub SetScreen(ByVal x&, ByVal y&)
    Dim Result&
 
    Dev.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    Dev.dmPelsWidth = x
    Dev.dmPelsHeight = y
 
    Result = ChangeDisplaySettings(Dev, CDS_TEST)
    ChangeDisplay
End Sub