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.