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.