Hi Ondvirg,
This is actually quite tricky to do. It is easy enough to position a
form anywhere on screen using the MoveSize command, the difficult part
is determining where a control is on screen so that the pop-up form
can be positioned there. As far as Windows is concerned, every object
on a form is displayed in its own little window and there is an API
function which can return the co-ordinates of that window. The problem
here is that API calls use pixel co-ordinates whereas Access uses
Twips which means that the pixel values have to be converted to twips
before being passed to the form positioning code. Another complication
is that the number of twips per pixel varies slightly depending on the
screen resolution so the code below has to check for that as well and
even the horizontal and vertical values can be different (especially
on modern wide-screen displays which I haven't tested BTW).
Anyway, the code below should do what you want. First create a new
code Module, copy and paste the code below into the module and save it
as modFormPosn (or whatever you want but don't use a name that is the
same as any existing module or procedure).
'-------------------------- modFormPosn Module Code ---------------
Option Compare Database
Option Explicit
Public gDate As Date 'used by Calendar form
'Store rectangle coordinates.
Public Type FormCoords
lngX1 As Long
lngY1 As Long
lngX2 As Long
lngY2 As Long
End Type
'API Declarations
Declare Sub GetWindowRect Lib "user32" _
(ByVal Hwnd As Long, lpRect As FormCoords)
Declare Function GetDC Lib "user32" _
(ByVal Hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" _
(ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Sub FetchFormCoords(frm As Form, ByRef x1 As Long, _
ByRef y1 As Long, ByRef x2 As Long, ByRef y2 As Long)
'Returns window co-ords of calling form in pixels
'Entry (frm) = Name of form originating this call
' (x1) = Pointer to Left Edge co-ord
' (y1) = Pointer to Top Edge co-ord
' (x2) = Pointer to Right Edge co-ord (not used)
' (y2) = Pointer to Bottom Edge co-ord (not used)
'Exit Variables x1, y1, x2 and y2 filled with form co-ords
Dim rct As FormCoords
'Get the coordinates of the specified form window
GetWindowRect frm.Hwnd, rct
x1 = rct.lngX1 'left edge
y1 = rct.lngY1 'top edge
x2 = rct.lngX2 'right edge (not used)
y2 = rct.lngY2 'bottom edge (not used)
End Sub
Function ConvertRes(vValue As Long, vMode As Boolean, _
vPixToTwip As Boolean) As Long
'Convert Pixels to Twips OR Twips to Pixels
'Entry (vValue) = No of Pixels OR Twips to convert
' (vMode) = False for Horiz axis OR True for Vertical axis
' (vPixToTwip) = False = Pixels->Twips OR True = Twips->Pixels
'Exit (ConvertRes) = Equivalent Twips OR Pixels value
Dim vDC As Long 'Windows Device Context
Dim vPixelsInch As Long 'No of Pixels/Inch for current screen
'Calc No of pixels per inch for Horizontal or Vertical mode
vDC = GetDC(0)
If vMode = False Then
vPixelsInch = GetDeviceCaps(vDC, 88)
Else
vPixelsInch = GetDeviceCaps(vDC, 90)
End If
vDC = ReleaseDC(0, vDC)
'Convert pixels to twips OR twips to pixels
If vPixToTwip = False Then
ConvertRes = (1440 / vPixelsInch) * vValue
Else
ConvertRes = (vValue / 1440) * vPixelsInch
End If
End Function
'----------------- End of Code ---------------------------
The function which returns the x1 (form left edge) and y1 (form top
edge) co-ordinates of the main form also returns the form right edge
(x2) and the form bottom edge (y2) which are not used in this code but
could be used to move the pop-up form if it overlaps the right or
bottom edge of the screen.
The ConvertRes function is used to convert the pixel value from the
API call into twips. This function also converts twips to pixels
although that option is not required in this code, if you should need
that facility just change the third parameter (vPixToTwip) to True and
copy the value in twips into the first parameter (vValue).
To use the code in your project you should add the code below to your
forms. Suppose you have a main form (say frmMain) which holds your
date text boxes and a button to display the calendar form and a
calendar form (say frmCalendar) which holds the calendar. I use a
modified version of Allen Brownes pop up calendar.
In the calendar form you should add the code below to the Form's Open
event :-
'-------------- frmCalendar Open_Event Code ----------------
Private Sub Form_Open(Cancel As Integer)
Dim vArray() As String
vArray = Split(OpenArgs, ",") 'fetch co-ords
DoCmd.MoveSize vArray(0), vArray(1) 'move form into posn
...display your calendar code here
End Sub
'--------------------------------------------------------------------
When the user closes the form they would normally have two options,
cancel the form or accept the new date from the calendar. The selected
date needs to be passed back to the calling main form and the easiest
method is to copy the selected date into a global variable (i.e. gDate
in the module code above) when the user clicks the OK button to accept
the date or set the variable to 0 if they cancel the calendar form.
Something like this :-
'-------- frmCalendar OK & Cancel Buttons Code ------------
Private Sub cmdOk_Click()
gDate = Me.txtDate 'txtDate holds the selected date
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub cmdCancel_Click()
gDate = 0
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
'--------------------------------------------------------------------
The code for the main form is a little bit trickier. I normally have
one (or more) text boxes on a form which hold a date (say
txtStartDate) and a small button alongside each text box to open the
calendar form (say cmdStartDate). The calendar form opens with the top
left corner of the pop up form at the same co-ordinates as the top
left corner of the button.
First, add these two lines to the start of the code for the main form
(i.e. before any sub-routines so that they can be used by any
routine). The actual values used are discussed below.
Const x_offset = 50
Const y_offset = 440
Add the code below for the cmdStartDate button click event.
'---------------- frmMain Start Date Button Code ----------------
Private Sub cmdStartDate_Click()
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
FetchFormCoords Me, x1, y1, x2, y2 'fetch XY co-ords of main
form (in pixels)
x1 = ConvertRes(x1, False, False) + Me.cmdStartDate.Left +
x_offset 'calc left posn in twips
y1 = ConvertRes(y1, True, False) + Me.cmdStartDate.Top + y_offset
'calc top posn in twips
DoCmd.OpenForm "frmCalendar", , , , , acDialog, x1 & "," & y1 If
gDate <> 0 Then 'if valid date returned then
txtStartDate = gDate 'copy date to field
End If
End Sub
'--------------------------------------------------------------------
Watch out for line wrapping, there are just seven lines of code.
The FetchFormCoords function fetches the left, top, right and bottom
co-ordinates of the current form (frmMain) and copies them into the
four variables x1, y1, x2 and y2 (x2 and y2 are not used here).
The ConvertRes function then converts the pixel co-ordinates to twips
and adds in the offset co-ordinates of the button for the left (x) and
top (y) edges.
The co-ordinates returned for the main form define the outside edge of
the form window but, as all windows have a border, the width and
height of the borders have to be added to the co-ordinates in order to
position the pop-up form correctly. The constants, x_offset and
y_offset, are used to store these values which can vary depending on
what type of border is being used for the main form. There is probably
another API function which can return these values but as they are
usually defined at design time it is easier to just set them as
constants.
My tests give the following values but you may need to adjust them
slightly for your forms.
Form Border Style x_offset y_offset
None 5 5
Thin 50 440
Sizable 70 470
Dialog 50 440
If you have the form Record Selectors property set to Yes then you
need to add another 300 to the x co-ordinate as this affects the
position of the controls.
If you have a Form Header on the main form you will also need to add
the header size to the y co-ordinate, this can be done automatically
like this :-
y1 = ConvertRes(y1, True, False) + Me.cmdStartDate.Top +
Me.FormHeader.Height + y_offset
but you must not include the Me.FormHeader.Height value in the code if
the header is not enabled as the code will then fail to compile.
The DoCmd can then open the calendar form and the x and y co-ordinates
are passed to it as OpenArgs (as described above). Note that you must
open the form with the acDialog parameter as (for some reason that
escapes me) the co-ordinate calculations do not work properly on
non-modal forms. Setting the Pop Up property of the calendar form to
Yes will also work OK but setting the Modal property to Yes does not
work on its own, i.e. you must use acDialog and/or Pop Up = Yes.
When the calendar form is closed the next lines of code retrieve the
selected date from the global variable (gDate) or ignore it if it has
been set to zero.
For more information on code to calculate screen sizes, manipulating
windows, and a whole lot more have a look at Window Manipulation
Examples in the Free Downloads section of :-
http://www.peterssoftware.com/
(Not my Web site BTW).
HTH
Peter Hibbs.
