UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Center a form using VBA    
 
   
Livens
post Apr 13 2007, 12:07 PM
Post#1



Posts: 77
Joined: 13-April 07



Hi,
I am trying to center a form within the main Access window. I tried using the forms property setting "autocenter" but that only centers the form horizontally, not vertically. If I open another form from my main form it opens a few inches higher, and each successive form keeps opening higher and higher. I want the forms to always open right in the center of the Access window.
Ive tried using DoCmd.MoveSize, but I cannot get a Width or Height of the main Access window. If I had that I could simply divide the window width by 2 and subtract half of my forms width...
Can anyone help me please sad.gif
Thanks,
Livens
Go to the top of the page
 
schroep
post Apr 13 2007, 02:21 PM
Post#2


UtterAccess VIP
Posts: 5,202
Joined: 21-July 05
From: Athens, Georgia [USA]


Welcome to UtterAccess!
This is a bit tricky, requiring some API calls and such. Here's some code I have in my library for this purpose; create a NEW CODE MODULE and insert this:
CODE
' API declarations:
Private Declare Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As typRect) As Long
Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As typRect) As Long
Private Declare Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
' Type declarations:
Private Type typRect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
' Constant declarations:
Private Const SW_RESTORE = 9
Private Const SWP_NOSIZE = &H1 ' Don't alter the size
Private Const SWP_NOZORDER = &H4 ' Don't change the Z-order
Private Const SWP_SHOWWINDOW = &H40 ' Display the window
' **************************************
' * Center a form in the Access window *
' **************************************
' Created 1-22-2002 by Peter M. Schroeder
Public Function gfncCenterForm(parForm As Form) As Boolean
    Dim varAccess As typRect, varForm As typRect
    Dim varX As Long, varY As Long
    
    On Error GoTo CenterForm_Error
    Call apiGetClientRect(hWndAccessApp, varAccess) ' Get the Access client area coordinate
    Call apiGetWindowRect(parForm.hwnd, varForm) ' Get the form window coordinates
    varX = CLng((varAccess.Left + varAccess.Right) / 2) - CLng((varForm.Right - varForm.Left) / 2) ' Calculate a new left for the form
    varY = CLng((varAccess.Top + varAccess.Bottom) / 2) - CLng((varForm.Bottom - varForm.Top) / 2) ' Calculate a new top for the form
    varY = varY - 45 ' Adjust top for true center
    varY = varY - 20 ' Adjust top for appearance
    Call apiShowWindow(parForm.hwnd, SW_RESTORE) ' Restore form window
    Call apiSetWindowPos(parForm.hwnd, 0, varX, varY, (varForm.Right - varForm.Left), (varForm.Bottom - varForm.Top), SWP_NOZORDER Or SWP_SHOWWINDOW Or SWP_NOSIZE) ' Set new form coordinates
    gfncCenterForm = True
    Exit Function
    
CenterForm_Error:
    gfncCenterForm = False
End Function

Save this module. Now, in the form you want to center, put the following code into the form's OPEN procedure:
CODE
Call gfncCenterForm(Me)
Go to the top of the page
 
LPurvis
post Apr 13 2007, 02:22 PM
Post#3


UtterAccess Editor
Posts: 16,344
Joined: 27-June 06
From: England (North East / South Yorks)


Results depending on whether your forms are popups or not - you can examine the Access window's dimensions and position using API calls as provided in this class here
Go to the top of the page
 
Livens
post Apr 13 2007, 04:58 PM
Post#4



Posts: 77
Joined: 13-April 07



Thanks for the responses!
chroep, I tried your code as is and it did not work. Everything compiled OK, but the form did not move. The call to the function gfncCenterForm just didt do anything.
LPurvis, I tried that code too. but when I tried to compile the .bas file they have I got an error on the last part, the "Public Property Get Parent() As clFormWindow". I am not familiar with that type of declaration so I was not able to debug it.
Odid however use pieces of schroep's code to get something working. I used the API apiGetClientRect and the typeRect type to get the .bottom of the access window. From there I wrote a small function to center the form vertically:
CODE
  
Private Sub Form_Center()
Dim varAccess As typRect
Dim nTop As Integer
Call apiGetClientRect(hWndAccessApp, varAccess)
nTop = (varAccess.Bottom / 2) - 175
If nTop < 0 Then
  nTop = 0
End If
DoCmd.MoveSize , (nTop * 15)
End Sub

In the module I made everything public so the form could use the API and the Type. And the 175 is an approximation of half the heigh of the form. I could use the other API to get the form bottom and top too, but for now this is working for me OK. Its not perfect... I multiplied by 15 to convert out of twips, which I read isnt the proper way as it may not be exactly 15 and its not always the same depending on the monitor and resolution...
But for what I need I think its good.
Thank you very much for the information!
Livens
Go to the top of the page
 
schroep
post Apr 13 2007, 05:48 PM
Post#5


UtterAccess VIP
Posts: 5,202
Joined: 21-July 05
From: Athens, Georgia [USA]


Livens -
can guarantee it works (I've been using it for years), perhaps there is something in your implementation. I am attaching a very simple example as proof of concept, perhaps it will help.
It opens up a form with a button on it that says "CENTER THIS FORM". Drag that form anywhere on the screen, then click the button.
Attached File(s)
Attached File  CenterForm.zip ( 13.92K )Number of downloads: 556
 
Go to the top of the page
 
Livens
post Apr 16 2007, 09:14 AM
Post#6



Posts: 77
Joined: 13-April 07



Thanks schroep!
I have no idea why it didnt work for me the first time, but I tried again after seeing your demo and now it works perfectly sad.gif
Go to the top of the page
 
schroep
post Apr 16 2007, 03:27 PM
Post#7


UtterAccess VIP
Posts: 5,202
Joined: 21-July 05
From: Athens, Georgia [USA]


Glad you got it working.
Go to the top of the page
 
spinjector
post Aug 30 2017, 12:50 PM
Post#8



Posts: 7
Joined: 26-June 06
From: Buffalo, New York, USA


Thank you for this code - 10 years after you posted it. Worked perfectly for me.
Go to the top of the page
 
jagster234
post Oct 9 2018, 09:55 AM
Post#9



Posts: 1
Joined: 9-October 18



Thank you so, so very much for this code (11 years later thumbup.gif )
Go to the top of the page
 
WebbyM
post Apr 12 2019, 11:32 PM
Post#10



Posts: 1
Joined: 12-April 19



Hai, for me its failing that code should be updated to 64bit windows am using. kindly assist
Go to the top of the page
 
theDBguy
post Apr 13 2019, 12:21 AM
Post#11


UA Moderator
Posts: 78,444
Joined: 19-June 07
From: SunnySandyEggo


Hi,

Welcome to UtterAccess!
welcome2UA.gif

Updated versions of some popular APIs are available in the Wiki like this one.

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 
Nak
post Jan 26 2020, 10:30 AM
Post#12



Posts: 71
Joined: 10-January 11



13 years later. It works for me too. hat_tip.gif
Go to the top of the page
 
Mickjav
post Mar 31 2020, 06:27 AM
Post#13



Posts: 95
Joined: 25-November 18



It works for me I have made a few edits for the way I need to use it plus have updated for 64 bit at present untested
A example will be available soon with DD's Charitable Contributions
CODE
'Credit: https://www.UtterAccess.com/forum/index.php?showtopic=1397380

' Type declarations:
Private Type typRect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' API declarations:
#If VBA7 Then
    Private Declare PtrSafe Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As LongPtr, lpRect As typRect) As Long
    Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As LongPtr, lpRect As typRect) As Long
    Private Declare PtrSafe Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
#Else
    Private Declare Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As typRect) As Long
    Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As typRect) As Long
    Private Declare Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#End If

' Constant declarations:
Private Const SW_RESTORE = 9
Private Const SWP_NOSIZE = &H1 ' Don't alter the size
Private Const SWP_NOZORDER = &H4 ' Don't change the Z-order
Private Const SWP_SHOWWINDOW = &H40 ' Display the window


Public Function gfncCenterForm(parForm As Form, T As Boolean) As Boolean
    'T Added By M Javes of Database Dreams on 31/03/2020 Allow the form to center at top of screen
    Dim varAccess As typRect, varForm As typRect
    Dim varX As Long, varY As Long
    
    On Error GoTo CenterForm_Error
    Call apiGetClientRect(hWndAccessApp, varAccess) ' Get the Access client area coordinate
    Call apiGetWindowRect(parForm.hwnd, varForm) ' Get the form window coordinates
    varX = CLng((varAccess.Left + varAccess.Right) / 2) - CLng((varForm.Right - varForm.Left) / 2) ' Calculate a new left for the form
    If T = True Then varY = 80 'M Javes edit 31.03.2020
    If T = False Then varY = CLng((varAccess.Top + varAccess.Bottom) / 2) - CLng((varForm.Bottom - varForm.Top) / 2) ' Calculate a new top for the form
    varY = varY - 45 ' Adjust top for true center
    varY = varY - 20 ' Adjust top for appearance
    Call apiShowWindow(parForm.hwnd, SW_RESTORE) ' Restore form window
    Call apiSetWindowPos(parForm.hwnd, 0, varX, varY, (varForm.Right - varForm.Left), (varForm.Bottom - varForm.Top), SWP_NOZORDER Or SWP_SHOWWINDOW Or SWP_NOSIZE) ' Set new form coordinates
    gfncCenterForm = True
    Exit Function
    
CenterForm_Error:
    gfncCenterForm = False
End Function

This post has been edited by Mickjav: Mar 31 2020, 06:28 AM

--------------------
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    4th July 2020 - 04:23 AM