Access VBA - Cool Autocenter Solution
Ive been looking how to Autocenter Forms in Access (Emergent Forms but not necesarily modal), with Access Functions the Autocenter depends of the position of the Access Mother Window... to avoid this I have mixed the solutions found in the net (thanks to the people) and create a quick-easy way to manage windows in VB. If you like you can test it with this easy Copy-Paste tutorial
First of all, load the form and know the dimensions in pixels:
Module Code:
Code:
' 2 APIS
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Integer) As Integer
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 Long) As Long
Function ScreenX() As Long
ScreenX = GetSystemMetrics(0)
End Function
Function ScreenY() As Long
ScreenY = GetSystemMetrics(1)
End Function
Function MyDimensions(MyForm As Form) 'Hwnd should be better :o
Dim Height As String, Width As String
Height = MyForm.WindowHeight / 15 'twips --> pixels
Width = MyForm.WindowWidth / 15
MyDimensions = "Height: " & Height & " pixels" & vbCrLf & "Width: " & Width & " pixels"
End Function
You First need the Form Width and Height
So now in the Form-Load, temporally call MyDimensions Function
Code:
Private Sub Form_Load()
MsgBox(My Dimensions(Me))
End Sub
Create two Constants and fill the information.
PixelsFormWidth and PixelsFormHeight (for example)
Second, Autocenter the form when is loaded:
Lets see in the Form Code Consts and Variables:
Code:
'Dimensions in pixels! (1Twip=1/15 pixels) aprox
'this works in any resolution
Private Const PixelsFormWidth As Long = 'type here the Widthpixels'
Private Const PixelsFormHeight As Long = 'type here the height pixels'
' little Geometry Maths
' The Autocenter:
' CenterLeft(pixels) = [ResolutionH-FormWidth]/X
' CenterTop(pixels) = [ResolutionV-FormHeight]/X
' X its a Factor of the ScreenResolution (thats why it works with any resolution)
' if X = 2 we will put the form in the very center of the image
' Writing in a paper you will see it better
Private Const XCenterLeft As Single = 2
Private Const XCenterTop As Single = 2.285123 'a little up (you will need testing for setting this Top Const)
' Variables
Dim CenterLeft As Long
Dim CenterTop As Long
And Then Finally we write in the Form_Load Code:
NOTE: remove the MsgBox(MyDimensions(Me)) calling
Code:
Private Sub Form_Load()
CenterLeft = (ScreenX() - FormWidth) / XCenterLeft
CenterTop = (ScreenY() - FormHeight) / XCenterTop
MoveWindow Me.hwnd, CenterLeft, CenterTop, PixelsFormWidth, PixelsFormHeight, 1
End Sub
It´s done.
'**********************:afrog:**********************'
For those who want to place the form in the 'cool place' and then get the coordenates of the current position window pressing a button (for example).
Back to module Code:
Code:
' 1 API
Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
'The API is declared. Now it needs some curious friends to put it on
Type POINTAPI
X As Long
Y As Long
End Type
Type RECT '****'
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT '****'
End Type
Dim WinEst As WINDOWPLACEMENT
Dim rtn As Long
Dim Rectan As RECT
' Functions came after the variables definitions, if not it will not compile
' And now then the function that a Form can call easily
Function GetWindowPos(ByVal hwnd As Long) As RECT
WinEst.Length = Len(WinEst)
rtn = GetWindowPlacement(hwnd, WinEst)
Rectan = WinEst.rcNormalPosition ' Coordenadas de la window (campo "rcNormalPosition")
GetWindowPos = Rectan
End Function
You can define this last function and variables in the Form if you want, but if you have more than one form, then its better to have it in the module I think :rolleyes:
Now in a CommandButton_Onclick:
Code:
Sub Button_Click()
Dim Window As RECT
Window = GetWindowPos(Me.hwnd) 'pixels
MsgBox "Left: " & Rectan.Left & vbCrLf & "Top: " & Rectan.Top & vbCrLf & _
"Right: " & Rectan.Right & vbCrLf & "Bottom: " & Rectan.Bottom, _
vbInformation + vbOKOnly, "Window Position (Pixels)"
End Sub
All of this Works perfectly in Access XP, So I suppose latest versions will accept this code.
Windows XP Prof SP3
Hope you like it!
Re: Access VBA - Cool Autocenter Solution
