Access VBA - Cool Autocenter Solution

[Betadine]

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:

' 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


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:

'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


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:

' 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:


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!

[Hack]

Moved To The CodeBank