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

Hale, Jim Jim.Hale at FleetPride.com
Mon Jan 8 15:50:10 CST 2007


I think this does what you want. I wish I could take credit for it but Mike
Toole is the genius behind it. 
<shift><F2> or <alt><Z> to pop up a zoom box in any text box where your
cursor is and you have "Set mclsZoomText.TextBox = ActiveControl"
HTH
Jim Hale

in your form:
Private mclsZoomText As mtZoomText

Private Sub Form_Open(Cancel As Integer)
    Set mclsZoomText = New mtZoomText
End Sub

in each text field you want the zoom box to work:

Private Sub Description_Enter()
Set mclsZoomText.TextBox = ActiveControl
End Sub

Here is the magic class: (create a class module and drop in this code)
Option Compare Database
Option Explicit

' Helper class to Zoom a textbox
' Copyright Mike Toole Office IT Limited 2004
' You are free to adapt this code for your own applications,
' but please include a credit
Const cPopUpFormName As String = "frmZoom"

Private mfrmPopUp As Access.Form
Private WithEvents mTextBox As Access.TextBox
Private WithEvents mCmdSave As Access.CommandButton
Private mScreenWidth As Long
Private mScreenheight As Long
Private mTwipsPerPixelX As Long
Private mTwipsPerPixelY As Long
Public Property Set TextBox(TextBox As TextBox)
    Set mTextBox = TextBox
    ' Make sure the Keypress event is hooked
    mTextBox.OnKeyDown = "[Event Procedure]"
End Property

Private Sub Class_Initialize()
    GetScreenSize
End Sub

Private Sub mCmdSave_Click()
    
    If Nz(mTextBox) <> Nz(mfrmPopUp.txtZoom) Then mTextBox.Value =
mfrmPopUp.txtZoom
    DoCmd.Close acForm, cPopUpFormName

End Sub

Private Sub mTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
       
    If (Shift And acShiftMask) And (KeyCode = vbKeyF2) Or _
        (Shift And acAltMask) And (KeyCode = vbKeyZ) Then
        ' Throw away the Keycode so that the Access
        ' Zoom function isn't triggered as well
        KeyCode = 0
        ' Get the control's co-ordinates while it still has the focus
        Dim ctlRect As RECT_Type
        apiGetWindowRect GetFocus(), ctlRect
        'Open the zoom form, hidden to prevent any flash on repositioning
        DoCmd.OpenForm cPopUpFormName, WindowMode:=acHidden
        Set mfrmPopUp = Forms(cPopUpFormName)
        With mfrmPopUp
            ' Hook-on to the form's keystrokes
            Set mCmdSave = Nothing
            Set mCmdSave = .Controls!cmdSave
            mCmdSave.OnClick = "[Event Procedure]"
            ' Assign the current value of the zoomed text box to the zoom
form's text box
            .txtZoom.Value = mTextBox.Text
            .txtZoom.FontName = mTextBox.FontName
            .txtZoom.FontSize = mTextBox.FontSize
            .txtZoom.SelLength = 0
            ' Position the zoom form on the zoomed control
            MoveSizeZoom ctlRect
            ' Show it
            mfrmPopUp.Visible = True
        End With
    End If
End Sub

PART 2 TO FOLLOW



***********************************************************************
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