Option Compare Database
Option Explicit
Type tRECT
lngX1 As Long
lngY1 As Long
lngX2 As Long
lngY2 As Long
End Type
Declare Function GetParent Lib „user32“ (ByVal Hwnd As Long) As Long
Declare Function GetWindowRect Lib „user32“ (ByVal Hwnd As Long, _
lpRect As tRECT) As Boolean
Declare Function MoveWindow Lib „user32“ (ByVal Hwnd As Long, _
ByVal X As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal brepaint As Boolean) As Boolean
Sub FormPosSave(F As Form)
Dim rectForm As tRECT
Dim rectParent As tRECT
Dim strDBName As String, strSection As String
Dim hWndParent As Long
Dim R As Variant
‚Datenbank-Name ermitteln
strDBName = CurrentDb.Name ‚Laufwerk:\Pfad\Dateiname.Erw
strDBName = NameOnly(strDBName) ‚Laufwerk/Pfad und Erweiterung raus…
‚Handle des Access-Fensters ermitteln
‚hWndParent = Application.hWndAccessApp
hWndParent = GetParent(F.Hwnd)
‚Koordinaten des Formulars bestimmen
R = GetWindowRect(F.Hwnd, rectForm)
If Not R Then
MsgBox „Fehler beim Auslesen der Fensterposition…“, vbCritical, „FormPosSave“
Exit Sub ‚Keine weiteren Aktionen…
End If
‚Koordinaten des Access-Fensters
R = GetWindowRect(hWndParent, rectParent)
If Not R Then
MsgBox „Fehler beim Auslesen der Fensterposition…“, vbCritical, „FormPosSave“
Exit Sub ‚Keine weiteren Aktionen…
End If
‚Werte in Registry speichern
strSection = strDBName & „\“ & F.Name
SaveSetting „FormPos“, strSection, „X1“, rectForm.lngX1 – rectParent.lngX1
SaveSetting „FormPos“, strSection, „Y1“, rectForm.lngY1 – rectParent.lngY1
SaveSetting „FormPos“, strSection, „X2“, rectForm.lngX2 – rectParent.lngX1
SaveSetting „FormPos“, strSection, „Y2“, rectForm.lngY2 – rectParent.lngY1
End Sub
Sub FormPosSet(F As Form)
Dim rectForm As tRECT
Dim strDBName As String, strSection As String
Dim lngBreite As Integer
Dim lngHoehe As Integer
Dim R As Variant
‚Datenbank-Name ermitteln
strDBName = CurrentDb.Name ‚Laufwerk:\Pfad\Dateiname.Erw
strDBName = NameOnly(strDBName) ‚Laufwerk/Pfad und Erweiterung raus…
‚Position/Größe aus Registry lesen
strSection = strDBName & „\“ & F.Name
With rectForm
.lngX1 = Val(GetSetting(„FormPos“, strSection, „X1“, „0“))
If .lngX1 = 0 Then Exit Sub ‚Keine/Ungültige Settings…
.lngY1 = Val(GetSetting(„FormPos“, strSection, „Y1“, „0“))
If .lngY1 = 0 Then Exit Sub ‚Keine/Ungültige Settings…
.lngX2 = Val(GetSetting(„FormPos“, strSection, „X2“, „0“))
If .lngX2 = 0 Then Exit Sub ‚Keine/Ungültige Settings…
.lngY2 = Val(GetSetting(„FormPos“, strSection, „Y2“, „0“))
If .lngY2 = 0 Then Exit Sub ‚Keine/Ungültige Settings…
lngBreite = .lngX2 – .lngX1
lngHoehe = .lngY2 – .lngY1
‚und setzen…
R = MoveWindow(F.Hwnd, .lngX1, .lngY1, lngBreite, lngHoehe, 1)
End With
End Sub
Function NameOnly(strFile As String) As String
Dim L%, X$
NameOnly = „“
X$ = strFile
If InStr(X$, „\“) <> 0 Then
L = Len(X$)
While Mid$(X$, L, 1) <> „\“ And L > 0
L = L – 1
Wend
If L = 1 Then Exit Function
X$ = Mid$(X$, L + 1)
End If
If InStr(X$, „.“) <> 0 Then
L = Len(X$)
While Mid$(X$, L, 1) <> „.“ And L > 0
L = L – 1
Wend
If L = 1 Then Exit Function
X$ = Left$(X$, L – 1)
NameOnly = X$
Else
NameOnly = X$
End If
End Function