Hale, Jim
Jim.Hale at FleetPride.com
Mon Jan 8 15:58:03 CST 2007
PART 2
PART 2
Sub MoveSizeZoom(ctlRect As RECT_Type)
' Popup=Yes must be set on the zoom form mfrmPopUp
' ------------------------------------------------
' Border width for the pop-up
Const cBorderPixels As Long = 1
' Width for the Anchor control
Const cAnchorWidthPixels As Long = 4
' Get the co-ords of the midpoint of the zoomed control
Dim lngOffsetX As Long
Dim lngOffsetY As Long
lngOffsetX = (ctlRect.Right - ctlRect.Left) / 2
Dim lngBorderTwipsX As Long
Dim lngBorderTwipsY As Long
lngBorderTwipsX = cBorderPixels * mTwipsPerPixelX
lngBorderTwipsY = cBorderPixels * mTwipsPerPixelY
Dim lngPopWidth As Long, lngPopHeight As Long
Dim lngPopX As Long
Dim lngPopY As Long
With mfrmPopUp
' Round the zoom text box size to a number of pixels
.txtZoom.Height = (.txtZoom.Height \ mTwipsPerPixelY) *
mTwipsPerPixelY
.txtZoom.Width = (.txtZoom.Width \ mTwipsPerPixelX) *
mTwipsPerPixelX
' Round the command button heights to a number of pixels
.cmdSave.Height = (.cmdSave.Height \ mTwipsPerPixelY) *
mTwipsPerPixelY
.cmdCancel.Height = .cmdSave.Height
' Set the Anchor width
.shpAnchor.Width = cAnchorWidthPixels * mTwipsPerPixelX
' Set the anchor height
.shpAnchor.Height = (ctlRect.Bottom - ctlRect.Top) * mTwipsPerPixelY
' Set the form width
.Width = .txtZoom.Width + lngBorderTwipsX + .shpAnchor.Width
' Position the zoom textbox and the command buttons
.txtZoom.Top = lngBorderTwipsY + mTwipsPerPixelY ' Seem to need an
extra Pixel
.cmdSave.Top = .txtZoom.Top + .txtZoom.Height + 3 * mTwipsPerPixelY
.cmdCancel.Top = .cmdSave.Top
' Make sure that the Anchor's out of the way before resizing
.shpAnchor.Top = 0
'Set the Detail height to fit the zoom textbox, the command buttons
and some space
.Section(acDetail).Height = .txtZoom.Height + lngBorderTwipsY +
.cmdCancel.Height + (6 * mTwipsPerPixelY)
' Fix the window width/height to fit the detail section
lngPopWidth = .Width / mTwipsPerPixelX
lngPopHeight = (.Section(acDetail).Height / mTwipsPerPixelY)
' Find the vertical position for the pop-up form
If ctlRect.Top + lngOffsetY + lngPopHeight <= mScreenheight Then
' The zoom form orients downwards of the zoomed control
lngPopY = ctlRect.Top
' Put the Anchor at the top
mfrmPopUp.shpAnchor.Top = 0
Else
' The zoom form orients upwards of the zoomed control
lngPopY = ctlRect.Bottom - lngPopHeight
' Put the Anchor at the bottom
mfrmPopUp.shpAnchor.Top = .Section(acDetail).Height -
.shpAnchor.Height
End If
' Find the horizontal position for the pop-up form
If ctlRect.Left + lngOffsetX + lngPopWidth <= mScreenWidth Then
' Attach left corner of Popup
lngPopX = ctlRect.Left + lngOffsetX
' Show the anchor on the left
.shpAnchor.Left = 0
' Leave room for the Anchor
.txtZoom.Left = .shpAnchor.Width '+ mTwipsPerPixelX
Else
' Attach right corner
lngPopX = ctlRect.Left - lngPopWidth + lngOffsetX
' Show the anchor on the right
mfrmPopUp.shpAnchor.Left = mfrmPopUp.Width - mfrmPopUp.shpAnchor.Width +
mTwipsPerPixelX
' Move the zoom textbox to the left,leaving some background as a border
.txtZoom.Left = lngBorderTwipsX + mTwipsPerPixelX
End If
' Position and size the window
apiMoveWindow .hwnd, lngPopX, lngPopY, lngPopWidth, lngPopHeight,
True
End With
End Sub
Sub GetScreenSize()
Dim dc As Long
Dim lngDPIx As Long
Dim lngDPIy As Long
Const HWND_DESKTOP = 0
dc = GetDC(HWND_DESKTOP)
lngDPIx = GetDeviceCaps(dc, 88)
lngDPIy = GetDeviceCaps(dc, 90)
mTwipsPerPixelX = 1440 / lngDPIx
mTwipsPerPixelY = 1440 / lngDPIy
' Release the information context.
Call ReleaseDC(HWND_DESKTOP, dc)
mScreenWidth = GetSystemMetrics(0) ' width in points
mScreenheight = GetSystemMetrics(1) ' height in points
End Sub
***********************************************************************
The information transmitted is intended solely for the individual or
entity to which it is addressed and may contain confidential and/or
privileged material. Any review, retransmission, dissemination or
other use of or taking action in reliance upon this information by
persons or entities other than the intended recipient is prohibited.
If you have received this email in error please contact the sender and
delete the material from any computer. As a recipient of this email,
you are responsible for screening its contents and the contents of any
attachments for the presence of viruses. No liability is accepted for
any damages caused by any virus transmitted by this email.