[AccessD] Create parameter that holds the source control? DOH ! PART 2

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.


More information about the AccessD mailing list