VBA Tipp: Accessfenster an Auflösung anpassen

Aus DBWiki
Wechseln zu: Navigation, Suche

Problemstellung

Mit Access 2000 soll die Größe des Accessfensters mittels API Funktionen angepasst werden. Oder: Es soll eine Accessanwendung geschrieben werden, die für verschiedene Bildschirmauflösungen automatisch angepasst werden sollte.

Was man beachten muss

Es ändert sich lediglich die Größe des Accessfensters. Die Formulare bleiben gleich groß. Um die Anwendung so kompatibel wie möglich zu verschiedenen Bildschirmauflösungen zu machen, sollte man die Formulare für die kleinste Bildschirmauflösung die man unterstützen möchte anpassen. Je größer die Auflösung wird, umso kleiner wird das Accessfenster.

Die API Funktionen stammen von der MSDN Webseite.

Declare Function apiGetActiveWindow Lib "user32" _
        Alias "GetActiveWindow" () As Long
Declare Function apiGetParent Lib "user32" _
        Alias "GetParent" (ByVal hwnd As Long) As Long
Declare Function apiShowWindow Lib "user32" _
        Alias "ShowWindow" (ByVal hwnd As Long, _
        ByVal nCmdShow As Long) As Long
Declare Function apiIsZoomed Lib "user32" _
        Alias "IsZoomed" (ByVal hwnd As Long) As Long
Declare Function apiIsIconic Lib "user32" _
        Alias "IsIconic" (ByVal hwnd As Long) As Long
Declare Function apiMoveWindow Lib "user32" _
        Alias "MoveWindow" (ByVal hwnd As Long, _
        ByVal x As Long, ByVal y As Long, ByVal _
        nWidth As Long, ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" _
        (ByVal hwnd As Long, rectangle As RECT) As Long
 
Global Const SW_MAXIMIZE = 3
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
 
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

In diesem Abschnitt wurden die API Funktionen definiert. Die Variable RECT dient zur Festlegung der Fenstergröße. Die Konstanten SW_MAXIMIZE, SW_SHOWNORMAL, SW_SHOWMINIMIZED sind für die Funktion apiShowWindow und stehen für die unterschiedlichen Status eines Anwendungsfensters.

Function GetScreenResolution() As String
'Diese Funktion gibt die Bildschirmauflösung als String aus.
 
Dim R As RECT
Dim hwnd As Long
Dim RetVal As Long
 
hwnd = GetDesktopWindow()
RetVal = GetWindowRect(hwnd, R)
GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
 
End Function
 
Function GetAccesshWnd()
Dim hwnd As Long
Dim hWndAccess As Long
 
' Get the handle to the currently active window.
hwnd = apiGetActiveWindow()
hWndAccess = hwnd
 
' Find the top window (which has no parent window).
While hwnd <> 0
hWndAccess = hwnd
hwnd = apiGetParent(hwnd)
Wend
 
GetAccesshWnd = hWndAccess
 
End Function
 
Function AccessMinimize()
AccessMinimize = apiShowWindow(GetAccesshWnd(), SW_SHOWMINIMIZED)
End Function
 
Function AccessMaximize()
AccessMaximize = apiShowWindow(GetAccesshWnd(), SW_MAXIMIZE)
End Function
 
Function AccessRestore()
AccessRestore = apiShowWindow(GetAccesshWnd(), SW_SHOWNORMAL)
End Function
 
 
Function IsAccessMaximized()
If apiIsZoomed(GetAccesshWnd()) = 0 Then
  IsAccessMaximized = False
 Else
  IsAccessMaximized = True
End If
End Function
 
Function IsAccessMinimized()
If apiIsIconic(GetAccesshWnd()) = 0 Then
  IsAccessMinimized = False
 Else
  IsAccessMinimized = True
End If
End Function
 
Function IsAccessRestored()
If IsAccessMaximized() = False And _
   IsAccessMinimized() = False Then
  IsAccessRestored = True
 Else
  IsAccessRestored = False
End If
End Function
 
Function AccessMoveSize(iX As Integer, iY As Integer, _
         iWidth As Integer, iHeight As Integer)
apiMoveWindow GetAccesshWnd(), iX, iY, iWidth, iHeight, True
End Function

Nachdem jetzt die Funktionen definiert und die Aktionen festgelegt sind, muss man überlegen wie das Modul in das Programm eingebunden werden soll. Dafür gibt es mehrere Möglichkeiten. Es ist ratsam, im Modul direkt bestimmte Subs oder Funktionen zu schreiben und diese aus Formularen oder anderen Modulen anzusprechen. Man könnte auch im Formular die Funktionen des Moduls direkt ansprechen. Ein Beispiel für diese Methode wäre:

Public Sub Bildschirm_anpassen()
 
Call mdl_grafik.GetAccesshWnd
 
If mdl_grafik.IsAccessMaximized = True Then
  Call mdl_grafik.AccessRestore 'Normales Fenster
End If
 
If mdl_grafik.IsAccessMinimized = True Then
  Call mdl_grafik.AccessRestore 'Normales Fenster
End If
 
If mdl_grafik.IsAccessMinimized = True Then
  Call mdl_grafik.AccessRestore 'Normales Fenster
End If
 
End Sub