Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Increasing and reducing memo field with mouseener

Status
Not open for further replies.

manpaul

Technical User
Jan 10, 2005
118
CA
I have a pageframe page with many memo fields what I would like to do is increase the height of one memo field when the mouse is over field and while the field has focus

mouseenter and mouseleave works fine the problem is I want the field to stay then same size if the field has focus even if the mouse is pass over another field and I will reduce the field on lostfocus.
 
Here is an expanding edit box that uses a shortcut menu on right click to expand and change the font:

Code:
**************************************************
*-- Class:        edtbase 
*-- BaseClass:    editbox
*-- Base class edit box - contains right click functionality that allows expanding of edit box and changing of the font This should be all that you will ever need in the way of edit boxes
*
DEFINE CLASS edtbase AS edt


  HEIGHT = 100
  WIDTH = 200
  *-- Set to true if the user can maximize/minimize the edit box by double clicking in it
  lresize = .T.
  *-- Height of edit box at instantiattion
  norigheight = 0
  *-- Widh of edit box at instantiation
  norigwidth = 0
  *-- If this is the current control in a grid column, holds the original row height of the grid
  norigrowheight = 0
  *-- Top of edit box at instantiation
  norigtop = 0
  *-- Editbox.left at instantiation
  norigleft = 0
  NAME = "edtbase"

  *-- Set to true when the editbox is maximized
  lmaximized = .F.

  *-- Set to true if we want to position the cursor at the end of the field when the edit box gets focus. Useful for situations where we want to constantly append to existing memo fields
  lpositionatend = .F.

  *-- When true, strips off unprintable characters at the end of the memo field
  lcleanuponexit = .F.

  *-- Save original column widths of all the columns in the grid that contains this edit box so we can expand the edit box to take up the space of the entire visible portion of the grid
  DIMENSION norigcolwidths[1]


  *-- Called from DblClick if This.lResize = .T. and This.lMaximized = .F.
  PROCEDURE enlarge
  WITH THIS
    .SaveOriginalDimensions()
    DO CASE
    CASE UPPER( .PARENT.BASECLASS ) = 'COLUMN'
      *** If this is the CurrentControl in a grid column, we must expand the current grid cell before
      *** expanding the edit box
      .ExpandGridCell()
      .HEIGHT = .PARENT.PARENT.ROWHEIGHT
      .WIDTH  = .PARENT.WIDTH

    CASE UPPER( .PARENT.BASECLASS ) = 'PAGE'
      *** This is also a special case because pages do not have a height property. The pageframe
      *** has a PageHeight property, so we have to use that to expand the edit box
      .TOP    = 0
      .LEFT   = 0
      .HEIGHT = .PARENT.PARENT.PAGEHEIGHT
      .WIDTH  = .PARENT.PARENT.PAGEWIDTH
      .ZORDER(0)      && Make sure the edit box appears on top of the other objects

    OTHERWISE
      .TOP    = 0
      .LEFT   = 0
      .HEIGHT = .PARENT.HEIGHT
      .WIDTH  = .PARENT.WIDTH
      .ZORDER(0)      && Make sure the edit box appears on top of the other objects

    ENDCASE
    .lmaximized = .T.
  ENDWITH

  ENDPROC


  *-- Called from DblClick if This.lResize = .T. and This.lMaximized = .T.
  PROCEDURE shrink
  WITH THIS
    IF UPPER( .PARENT.BASECLASS ) = 'COLUMN'
      .ShrinkGridCell()
    ENDIF
    .TOP    = .norigtop
    .LEFT   = .norigleft
    .HEIGHT = .norigheight
    .WIDTH  = .norigwidth
    .lmaximized = .F.
  ENDWITH

  ENDPROC


  *-- Saves original dimensions of edit box at instantiation
  PROCEDURE SaveOriginalDimensions
  LOCAL lnCol
  WITH THIS
    .norigbackcolor = .BACKCOLOR
    *** Save the editbox's original dimensions and position
    .norigheight = .HEIGHT
    .norigwidth  = .WIDTH
    .norigtop    = .TOP
    .norigleft   = .LEFT
    *** If it is in a grid, save the grid's rowheight and columnwidths
    IF UPPER( .PARENT.BASECLASS ) = 'COLUMN'
      .norigrowheight = .PARENT.PARENT.ROWHEIGHT
      FOR lnCol = 1 TO .PARENT.PARENT.COLUMNCOUNT
        DIMENSION .norigcolwidths[lnCol]
        .norigcolwidths[lnCol] = .PARENT.PARENT.COLUMNS[lnCol].WIDTH
      ENDFOR
    ENDIF
  ENDWITH
  ENDPROC


  *-- Used to expand the grid cell if the edit box being expanded is the current control in a grid column
  PROCEDURE ExpandGridCell
  LOCAL lnCol
  WITH THIS.PARENT
    FOR lnCol = 1 TO .PARENT.COLUMNCOUNT
      .PARENT.COLUMNS[lnCol].WIDTH = 0
    ENDFOR
    .WIDTH        = .PARENT.WIDTH
    .PARENT.ROWHEIGHT  = .PARENT.HEIGHT - .PARENT.HEADERHEIGHT
    INKEY( .2 )
    *** Now scroll the grid to make the current row the one that is visible in the grid
    DO WHILE .PARENT.RELATIVEROW # 1
      .PARENT.DOSCROLL(1)
    ENDDO
  ENDWITH
  ENDPROC


  *-- Restore grid to its original dimensions if this edit box is the current control in a grid column
  PROCEDURE ShrinkGridCell
  LOCAL lnCol
  WITH THIS
    FOR lnCol = 1 TO .PARENT.PARENT.COLUMNCOUNT
      .PARENT.PARENT.COLUMNS[lnCol].WIDTH = .norigcolwidths[lnCol]
    ENDFOR
    .PARENT.PARENT.ROWHEIGHT = .norigrowheight
  ENDWITH
  ENDPROC


  *-- Strip off unprintable characters
  PROCEDURE cleanup
  LOCAL lcMemoFld, lnChar
  *** This will get rid of the empty lines which occur when the user presses <Enter>
  *** or other strange keys instead of <Tab> to exit the edit box
  WITH THIS
    lcMemoFld = IIF( EMPTY( .VALUE ), '', ALLTRIM( .VALUE ) )
    *** Strip off invalid chars at the end of the MEMO-field.
    *** Loop backwards through the field and get the position of the
    *** first byte which is not a space, TAB or CR/LF or any other
    *** character with an ASCII-value smaller then 28:
    FOR lnChar = LEN( lcMemoFld ) TO 1 STEP -1
      IF ASC( SUBSTR( lcMemoFld, lnChar, 1 ) ) > 32
        EXIT
      ENDIF
    ENDFOR
    IF lnChar > 1
      lcMemoFld = LEFT( lcMemoFld, lnChar )
    ENDIF
    .VALUE = lcMemoFld
  ENDWITH
  ENDPROC


  *-- Show the Right Click menu if applicable
  PROCEDURE showmenu
  LOCAL lcFontString, lcFontStyle, lcFontName, lcFontSize, llBold, llItalic, lnComma1Pos, lnComma2Pos
  PRIVATE pnMenuChoice
  pnMenuChoice = 0
  DO mnuEditbox.mpr
  WITH THIS
    DO CASE
      *** If enlarge was selected, expand the edit box unless it is
      *** already expanded
    CASE pnMenuChoice = 1
      IF !.lmaximized
        .enlarge()
      ENDIF

      *** If shrink was selected, shrink the edit box if it is expanded
    CASE pnMenuChoice = 2
      IF .lmaximized
        .shrink()
      ENDIF

    CASE pnMenuChoice = 3
      lcFontStyle = IIF( .FONTBOLD, 'B', '' ) + IIF( .FONTITALIC, 'I', '' )
      lcFontString = GETFONT(.FONTNAME, .FONTSIZE, lcFontStyle )
      *** parse out the font properties from the returned string
      *** after checking to make sure that the user selected something
      IF ! EMPTY ( lcFontString )
        lnComma1Pos = AT( ',', lcFontString )
        lcFontName = LEFT( lcFontString, lnComma1Pos - 1 )
        lnComma2Pos = RAT( ',', lcFontString )
        lnFontSize = VAL( SUBSTR( lcFontString, lnComma1Pos + 1, lnComma2Pos - lnComma1Pos - 1 ) )
        lcFontStyle = SUBSTR( lcFontString, lnComma2Pos + 1 )
        llBold = IIF( 'B' $ lcFontStyle, .T., .F. )
        llItalic = IIF( 'I' $ lcFontStyle, .T., .F. )
        .FONTNAME = lcFontName
        .FONTSIZE = lnFontSize
        .FONTBOLD = llBold
        .FONTITALIC = llItalic
      ENDIF
    ENDCASE
  ENDWITH
  ENDPROC

  PROCEDURE RIGHTCLICK
  WITH THIS
    IF .lresize
      .showmenu()
    ENDIF
  ENDWITH
  ENDPROC


  PROCEDURE GOTFOCUS
  EDITBOX::GOTFOCUS()
  WITH THIS
    IF .SELECTONENTRY
      .SELSTART  = 0
      .SELLENGTH = LEN( .VALUE )
    ELSE
      IF .lpositionatend
        KEYBOARD '{CTRL + END}'
      ENDIF
    ENDIF
  ENDWITH
  NODEFAULT
  ENDPROC


  PROCEDURE INIT
  THIS.SaveOriginalDimensions()
  ENDPROC


  PROCEDURE VALID
  *** Restore to original size if maximized and the user leaves the edit
  *** box without restoring to original size
  WITH THIS
    *** Strip off unprintable characters if this has been specified
    *** by leaving lCleanUpOnExit = .T.
    IF .lcleanuponexit
      .cleanup()
    ENDIF
    IF .lmaximized
      .shrink()
    ENDIF
  ENDWITH
  ENDPROC

ENDDEFINE

Marcia G. Akins
 
Marcia,

I see you have updated your "edtbase" class since 1001 Things.

Would you be so kind as to post your code for your "edt" class?

Thanks,

Teresa
 
Hi Teresa.

I see you have updated your "edtbase" class since 1001 Things.

You recognized it :) I hope that you found the book useful.

Here is edt:

Code:
**************************************************
*-- Class:        edt 
*-- ParentClass:  editbox
*-- BaseClass:    editbox
*-- Time Stamp:   01/05/00 03:27:12 PM
*-- Abstract edit box directly subclassed from vfp base class. Should never be instantiated directly.
*
DEFINE CLASS edt AS editbox
  Height = 53
  Width = 100
ENDDEFINE


Marcia G. Akins
 
Marcia said:
Height = 53
Width = 100

Okay, I guess that wasn't very complicated. [blush]

I had tried running the code you posted above and ran into trouble, so I thought it was from a newly added property or method in your edt class. I've been able to get the old code from 1001 Things (which yes, has been very helpful over the years) to run, but I'd like to take advantage of any new tweaks you may have added.

It is almost the weekend for me so I will follow-up on this next week.

Teresa
 
Hi Teresa.

I've been able to get the old code from 1001 Things (which yes, has been very helpful over the years) to run, but I'd like to take advantage of any new tweaks you may have added.

I just took a look at the code from the book and guess what? The code that I posted is the same as the class from the book. I guess this is one I actually got right the first time ;-)

Marcia G. Akins
 
Marcia,

I found two minor differences between the 1001 Things code that I had downloaded who knows when and the code you posted above. One is that you have an INKEY(.2) in ExpandGridCell() and the other is that you have a call to SaveOriginalDimensions() in Enlarge(). Is it necessary to have SaveOriginalDimensions() in the Init() and Enlarge()? (If so, why?)

Also, the method descriptions refer to code in DblClick(), but I didn't see any, so I added:
Code:
WITH this
	IF .lresize 
		IF !.lmaximized
			.enlarge()
		ELSE
			.shrink()
		ENDIF 		
	ENDIF 
ENDWITH
Lastly, in case it might be helpful to someone else, this is my code for mnueditbox.mpr:
Code:
DEFINE POPUP shortcut SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF shortcut PROMPT "Enlarge"
DEFINE BAR 2 OF shortcut PROMPT "Shrink"
DEFINE BAR 3 OF shortcut PROMPT "Font"

ON SELECTION POPUP shortcut pnMenuChoice = BAR()

ACTIVATE POPUP shortcut
Teresa
 
Also, the method descriptions refer to code in DblClick(), but I didn't see any, so I added:

That was a bug in the docs ;-) No code belongs in the dblClick(). I was originally going to double-click on the control to expand and shrink it, but changed my mind.

Is it necessary to have SaveOriginalDimensions() in the Init() and Enlarge()? (If so, why?)

Only if you use resizable forms and have re-sized the form.


Marcia G. Akins
 
Sorry Guys I have been on Vacation and it was nice to come back and see the activity on this problem of mine. I have not had a chance to review but will and see if it fits the bill thanks for the input.

Paul
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top