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.