I have to roll out a 2007 application with most users having only runtime
Acces on their machines and the missing zoombox feature is an issue. I have
so far done the following as an alternative:

1. Set up a global procedure that opens a popup, modal form with a single
text box containing the text in the source control:

Public Sub ProcMyZoombox(StrZoomText, StrZoomControl, StrOpenForm As String)
On Error GoTo ProcMyZoombox_Err
'Open Popup Zoombox form, load with relevant text
DoCmd.OpenForm "FrmPopup_MyZoomBox"
Forms![FrmPopup_MyZoomBox]![TxtTextField] = StrZoomText

ProcMyZoombox_Exit:
Exit Sub

ProcMyZoombox_Err:
MsgBox Error$
Resume ProcMyZoombox_Exit

End Sub

I call the proc using a standard call:

ProcMyZoombox Me.ActiveControl, Me.ActiveControl.Name, Me.Name

2. Set up the OnClose event of the popup form to run this code:

Forms(StrOpenForm).Controls(StrZoomControl) = Me!TxtTextField

This is the line that gives me the problem., error message "The setting you
entered isn't valid for this property"

Works fine on a standalone form but I have a main form (Frm_Master) with a
tabbed control and a series of subforms (such as
FrmSubFrm_WhitePage_Details - both Form and Subform Control name) on the
tab pages, from all of which I want to be able to use the zoombox
alternative. If I try my code from a text box on the main form all is
well but I get an error when the calling text box is on a page of the tabbed
control or on a subform on such a page - I don't seem to be able to
reference the target text box correctly. To eliminate the syntax issues
related to addressing a control on a subform I tried using a control on a
tab of the tabbed control - no subform involved - and the code fails. If
I temporarily replace the "generic" code with something specific such as :

Forms![Frm_Master]![FrmSubFrm_WhitePage_Details].Form![Notes] =
Me!TxtTextField

then all is well but as soon as I try to substitute the more general version
of the code, it fails. Can anybody please point me in the right
direction?

Many thanks!
Malcolm

On 25/02/2011 12:58:19, "Malcolm" wrote:
Try This (Courtesy of Stephen Lebans)

Create a blank form with the timer interval set at 50

Then copy & paste this

Option Compare Database
Option Explicit

'Copyright: Lebans Holdings Ltd. 1999
'Author: Stephen Lebans
'Date: Sep 06,1999
'Time: 1:12:25 am

'Notes:
'Please feel free to use any part of this code in your projects.
'If you do please include my 1 line Copyright notice. That's it.
'This code may not be repackaged and/or sold in its current state.
'Who'd want to buy it anyway? :-)
'
'I tried to GetDc and RleaseDC on every paint to my Window
'This caused some problems in mismatched DC's
'so I gave it up and Assign it in Load and
'release it in Unload.
'
'Contact:
'Stephen Lebans
'macarthu@ nbnet.nb.ca
'http://www.geocities.com/CapeCanaveral/Galaxy/2767/

'Why Bother:
' For FUN! :-)

'What's Missing:
'I don't know...
'Enjoy - SL

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Type RECTL
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Get Instance of Access by KEN GETZ
' required for CreateWindowEx hInstance
' Put this in the declarations area of a standard module.
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias
"GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Const GWL_HINSTANCE = (-6)

Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As
POINTAPI) As Long

Private Declare PtrSafe Function CreateWindowEx Lib "user32.dll" _
Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String, _
ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hWndParent As Long, ByVal hMenu As Long, _
ByVal hInstance As Long, lpParam As Any) As Long

Private Declare PtrSafe Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) As Long

Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As
Long, _ ByVal hWndNewParent As Long) As Long

Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As
Long

Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As
Long) As Long

Private Declare PtrSafe Function apiGetDC Lib "user32" _
Alias "GetDC" (ByVal hwnd As Long) As Long

Private Declare PtrSafe Function apiReleaseDC Lib "user32" _
Alias "ReleaseDC" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long

Private Declare PtrSafe Function apiGetStockObject Lib "gdi32" Alias
"GetStockObject" _ (ByVal nIndex As Long) As Long

Private Declare PtrSafe Function apiDeleteObject Lib "gdi32" _
Alias "DeleteObject" (ByVal hObject As Long) As Long

Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare PtrSafe Function MulDiv Lib "kernel32" (ByVal nNumber As
Long, _ ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare PtrSafe Function CreateIC Lib "gdi32" Alias "CreateICA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As String, lpInitData As Any) As Long

Private Declare PtrSafe Function RestoreDC Lib "gdi32" (ByVal hdc As Long, _
ByVal nSavedDC As Long) As Long

Private Declare PtrSafe Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare PtrSafe Function SelectPalette Lib "gdi32" _
(ByVal hdc As Long, ByVal hPalette As Long, _
ByVal bForceBackground As Long) As Long

Private Declare PtrSafe Function FillRect Lib "user32" _
(ByVal hdc As Long, lpRect As RECTL, ByVal hBrush As Long) As Long

Private Declare PtrSafe Function SetRectEmpty Lib "user32" (lpRect As RECTL)
As Long

Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare PtrSafe Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long

Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long


' Stock Logical Objects
Private Const WHITE_BRUSH = 0

' Window Style Flags
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_TRANSPARENT = &H20&
Private Const WS_EX_MDICHILD = &H40

' Static Control Constants
Const SS_BITMAP = &HE

' Ternary raster operations
Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Const WHITENESS = &HFF0062

' Used to ask System for the:
Const LOGPIXELSY = 90 ' Logical pixels/inch in Y axis
Const HORZRES = 8 ' Horizontal width in pixels
Const VERTRES = 10 ' Vertical width in pixels

Private hWndCreate As Long
Private hDcCreate As Long
Private lngRet As Long
Private myRect As RECTL
Private hBrush As Long
'Private sPt As POINTAPI
Private sngCurMag As Single
Private intTwipsPerPixel As Integer
Private MaxXRes As Integer
Private MaxYRes As Integer
Private hFormDC As Long

Private Sub Form_Activate()
DrawMyForm
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
MsgBox "DataErr:" & DataErr
DoCmd.Close acForm, Me.FormName, acSaveNo
End Sub

Private Sub Form_GotFocus()
DrawMyForm
End Sub

Private Sub Form_Load()

' Initialize module level variables
hFormDC = apiGetDC(0)

' DEFAULT Magnification
sngCurMag = 2

' Initialize MAX Hortizontal and Vertical vars
GetRes

Me.Caption tion = "Left Mouse Btn to increase Mag, Right Mouse Btn to
decrease Mag. CurrentX:" & CInt(sngCurMag) hBrush =
apiGetStockObject(WHITE_BRUSH)

' Find out current resolution
intTwipsPerPixel = TwipsperPixel

' Let's Create the Window
MakeWindow
DrawMyForm

End Sub

Private Sub Detail_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single) ' If Left Mouse Button->Increase Magnification
' If Right Mouse Button->Decrease Magnification

If Button = acLeftButton Then
sngCurMag = (sngCurMag) + 1
Else:
sngCurMag = (sngCurMag) - 1
End If

If sngCurMag <= 0 Then sngCurMag = 1
If sngCurMag > 10 Then sngCurMag = 10

' Debug.Print "sngCurMag:" & sngCurMag
Me.Caption tion = "Left Mouse Btn to increase Mag, Right Mouse Btn to
decrease Mag. CurrentX:" & CInt(sngCurMag)

End Sub

Private Sub Form_Resize()

MakeWindow
DrawMyForm

End Sub

Private Sub Form_Timer()

DrawMyForm

End Sub

Private Sub Form_UnLoad(Cancel As Integer)

On Error Resume Next

' Cleanup Time
If hDcCreate <> 0 Then
lngRet = apiReleaseDC(hWndCreate, hDcCreate)
End If

If hWndCreate <> 0 Then
Call DestroyWindow(hWndCreate)
End If

If hFormDC <> 0 Then
lngRet = apiReleaseDC(0&, hFormDC)
End If

End Sub

Sub DrawMyForm()

Dim lngRet As Long
Static sPt As POINTAPI
Dim sPtCurrent As POINTAPI

lngRet = GetCursorPos(sPtCurrent)

' Has the Cursor moved since last event
' If not then exit sub - do nothing
If sPt.X = sPtCurrent.X Then
If sPt.Y = sPtCurrent.Y Then
Exit Sub
End If
End If

'Save values for comparison next event
sPt.X = sPtCurrent.X
sPt.Y = sPtCurrent.Y

' Let's check cursor position
' Requires bounds checking
' Let's slide viewing are in reverse as user
' gets to the right or bottom edge of screen
With myRect
If sPtCurrent.X > MaxXRes - (.Right \ sngCurMag) Then
sPtCurrent.X = MaxXRes - (.Right \ sngCurMag)
End If
If sPtCurrent.Y > MaxYRes - (.Bottom \ sngCurMag) Then
sPtCurrent.Y = MaxYRes - (.Bottom \ sngCurMag)
End If

lngRet lngRet = StretchBlt(hDcCreate, 0, 0, .Right - .Left, .Bottom - .Top, _
hFormDC, hFormDC, sPtCurrent.X, sPtCurrent.Y, (.Right - .Left) \ sngCurMag, _
(.Bottom - .Top) \ sngCurMag, SRCCOPY)
End With

End Sub

Private Function TwipsperPixel() As Integer
' Modified to allow for different screen resolutions

Dim lngIC As Long
Dim lngYdpi As Long

lngIC = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)
If lngIC <> 0 Then
lngYdpi = GetDeviceCaps(lngIC, LOGPIXELSY)
DeleteDC (lngIC)
Else
lngYdpi = 120 'Default average value
End If
TwipsperPixel = 1440 \ lngYdpi

End Function

Private Sub GetRes()
' Modified to allow for different screen resolutions

Dim lngIC As Long
Dim TempResX As Integer
Dim TempResY As Integer

lngIC = CreateIC("DISPLAY", vbNullString, vbNullString, vbNullString)
If lngIC <> 0 Then
TempResX = GetDeviceCaps(lngIC, HORZRES)
TempResY = GetDeviceCaps(lngIC, VERTRES)
DeleteDC (lngIC)
Else
TempResX = 640 'Default value
TempResY = 480 'Default value
End If

' These are module level variables
MaxXRes = TempResX
MaxYRes = TempResY

End Sub

Private Sub MakeWindow()
Dim lngExStyle As Long
Dim lngStyle As Long
Dim hInstance As Long

lngStyle = WS_POPUP Or WS_VISIBLE Or SS_BITMAP
lngExStyle = 0

' Let's Check and see if Window already exists
' if so then Delete it and clean it up
If hDcCreate <> 0 Then
lngRet = apiReleaseDC(hWndCreate, hDcCreate)
End If
If hWndCreate <> 0 Then
Call DestroyWindow(hWndCreate)
End If

' Put this code wherever you need the instance handle.
hInstance = GetWindowLong(Application.hWndAccessApp, GWL_HINSTANCE)

' Create rectangle to cover entire FORM
With myRect
.Left = 0
.Top = 0
.Right = Me.InsideWidth \ intTwipsPerPixel
.Bottom = Me.InsideHeight \ intTwipsPerPixel '

' Create our new window of Class "static"
hWndCreate = CreateWindowEx(lngExStyle, "static", "", lngStyle, _
Left, .Left, .Top, .Right - .Left, .Bottom - .Top, Me.hwnd, 0&, hInstance,
ByVal 0&) End With

' Set the calling Form as the Parent
lngRet = SetParent(hWndCreate, Me.hwnd)
'Application.hWndAccessApp)
hDcCreate = apiGetDC(hWndCreate)

End Sub

Phil

"Phil" <phil (AT) stantonfamily (DOT) co.uk> wrote


Thanks for that Phil, much obliged. It is overkill for my requirements, if
I could only get the addressing syntax for the controls on the subform on a
tab page right I would be home and hosed with my code - and I'd like to get
it right anyway for future reference.

My problem in summary is that code like this works:

Forms![Frm_Master]![FrmSubFrm_WhitePage_Details].Form![Notes] =
Me!TxtTextField

- but the following doesn't - even when there is no subform involved, just a
textbox on a page of the Tab control:

Forms(StrOpenForm).Controls(StrZoomControl) = Me!TxtTextField

(Please see original post for details)

Cheers
Malcolm

On 26/02/2011 01:16:10, "Malcolm" wrote:
Plan B

Form called ZoomBox with a text field Text0 (Nice big font)

Here is the code

Option Compare Database
Option Explicit
Dim Frm As Form
Dim CtlName As String

Private Sub Form_Close()

Frm.Controls(CtlName) = Text0

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim FrmName As String

Debug.Print Nz(Me.OpenArgs)
FrmName = strDField(Nz(Me.OpenArgs), "~", 1)
CtlName = strDField(Nz(Me.OpenArgs), "~", 2)
Set Frm = Forms(FrmName)

End Sub

Module Called Module 1 - I'm incredibly lazy)
Option Compare Database
Option Explicit

Sub ZoomIt(Frm As Form, CtlName As String, Txt As String)

DoCmd.OpenForm "ZoomBox", , , , , , Frm.Name & "~" & CtlName

Forms!Zoombox!Text0 = Txt

End Sub

Public Function strDField(MyText As String, Delim As String, GroupNum As
Integer) As String

' Returnds a group extract from a string via a delimter.
' Hence to grab "cat" from the string dog-cat you get:
' strDField("dog-cat","-",2)

Dim StartPos As Integer, EndPos As Integer
Dim GroupPtr As Integer, Chptr As Integer

Chptr = 1
StartPos = 0
For GroupPtr = 1 To GroupNum - 1
Chptr = InStr(Chptr, MyText, Delim)
If Chptr = 0 Then
strDField = ""
Exit Function
Else
Chptr = Chptr + 1
End If
Next GroupPtr
StartPos = Chptr
If Mid(MyText, StartPos, 1) = Delim Then
strDField = ""
Else
EndPos = InStr(StartPos + 1, MyText, Delim)
If EndPos = 0 Then
EndPos = Len(MyText) + 1
End If
strDField = Mid$(MyText, StartPos, EndPos - StartPos)
End If

End Function


On the form that you want to open the zoombox

Private Sub MyField_DblClick(Cancel As Integer)

Call ZoomIt(Me, ActiveControl.Name, ActiveControl)

End Sub


Phil

Hi Phil,

Your Plan B is almost the same as I use.

The most important difference is the definition of Zoom_it. I do:

Sub Zoom_it(Frm As Form)
DoCmd.OpenForm “ZoomBox”,,,,,,Frm.Name
End Sub

And then in the OnOpen event of Zoom_form:

Private Form_Open(Cancel As Integer)
‘ instead of Frm I would use prevFrm to accentuate the form where
you came from
Dim prevFrmName As String

prevFrmName = Me.OpenArgs ‘or eventually your strDField function
if OpenArgs is more complex
Set prevFrm = Forms(prevFrmName)
Me!Text0 = prevFrm.ActiveControl

End Sub


On the ZoomBox form I have a “+”-button and a “-“-button, that
increases or decreases Me!Text0.FontSize,
In that way you are “really” zooming. Fun!

By placing both the ZoomBox form and the Sub Zoom_it in a reference
database, you can have this functionality available in every
application.

Imb.

Malcolm wrote:

Maybe I'm missing a key point in there, but it seems to me
that this is almost the same problem as a custom input box.
If I'm right about that, the important point is to open
MyZoom in dialog mode passing the data to be edited in
OpenArgs and have the calling form pull the data from the
input form instead of messing about pushing the data back
back and forth. At least this way the MyZoom form does not
have to know anything about the calling form or the control
with the data.

The calling form's code would look like:

DoCmd.OpenForm "MyZoom", _
WindowMode:= acDialog, _
OpenArgs:= Me.Notes
If CurrentProject.AllForms!MyZoom.IsLoaded Then
Me.Notes = Forms!MyZoom.txtfield
DoCmd.Close acForm, "MyZoom", acSaveNo
End Sub

And the code in MyZoom would be like:

Sub Form_Load()
Me.txtfield = Me.OpenArgs
End Sub

Sub btnOK_Click()
Me.Visible = False
End Sub

Sub btnCancel_Click()
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

--
Marsh

On 26/02/2011 13:40:22, imb wrote:
Don't personally use the second routine that I suggested; I use the full zoom
box with the right & left mouse button controling the magnification as posted
in my first reply. Needless to say the form is in the reference Db. I open it
using an Autokeys macro - primitive but then it needs no coding.

Phil

Hi Marsh,

I do not know if you are referring to Phil’s reply or mine.

In principle it is enough just to pass the the text value to the
Zoom_form. And IF (but I do not know) the OpenArgs parameter is an
ByRef parameter, you could return the edited value through OpenArgs.

For just editing the text it is enough, and you do not have to know
anything of the form and the controls on the form.
For generalization purposes I have found that it is advantagous the
pass the calling forms name in OpenArgs. But, it is a way of working.

With the knowledge of the form, and so of the control to be edited,
you can do some checking in the Zoom_form.
Some controls on the calling form can be blocked or not, so may not be
edited or may. It is not necessary to have this kind of decisions at
each calling of the Zoom_form, but you can handle this from within the
Zoom_form, by blocking the control in Zoom_form in the same way as in
the calling form. Because of “knowledge” of the form, and so without
additional information in OpenArgs.
If you want to edit dates, you can display in the Zoom_form the date
in your own format instead of the standard table format, because you
know the control on the calling form is a date.
Because you know what datatype you are editing, you can already check
if the edited text is valid, that is correspoding to the datatype.
And you can set a warning when the maximum size of a text is reached.

Just my opinion.

Imb.

imb wrote:
Actually I was replying to Malcom's post, but more to the
thread than any particlar post.

I prefer for a zoom box kind of thingie to be as dumb as
possible, just like the built-in zoom box. I don't think I
would ever provide a custom edit box for any thing other
than a Text or Memo field so checking the type of the bound
field in the calling form is a really low priority in my
list of needs.

OpenArgs is an argument of OpenForm and is read only. So
that is not a viable way to return a value.

--
Marsh

<<< SNIP >>>

Thanks to all for the responses - I have used your idea Marsh because like
you, I believe that the "zoombox" should be as dumb as possible. The
game-changer was to think in terms of the calling control pulling the data
back from the zoombox form, rather than trying to make the zoombox form
bright enough to know where to push the data to. The idea of hiding the
zoombox form and allowing the calling code to close it after retrieving the
data was brilliant, simple and elegant. Many thanks!

Malcolm