I am in the process of updating an application that was written and adapted from 2.6 and VFP3 conversion code. It is riddled with @ say get and read commands which I am working on replacing. I have written the following routine to take the place of a browse command that used on key label routines to tag/untag records for selection in the calling routine...
This function works fine standalone (called from the command window) but when it is called from the init method of a form the window is displayed but the calling form ends up with the focus. As you can see my form class is a modal form.
Any/all ideas welcomed.
Andy Snyder
SnyAc Software Services Hyperware Inc.
AmTech Software Inc.
This function works fine standalone (called from the command window) but when it is called from the init method of a form the window is displayed but the calling form ends up with the focus. As you can see my form class is a modal form.
Any/all ideas welcomed.
Code:
**---------------------------------------------------------
**-- F_BROWSTAG function
*-
*- Author: Richard A. Snyder
*-
*- Function: Replacement for 2.6 style lw_window browse item selections tagging code.....
*-
**----------------------------------------------------------
PARAMETERS pcAlias, pcCaption, pcFields, plMultiTag
PRIVATE lnTagged, llFontMetric
lnTagged = 0
LOCAL lc_alias
lc_alias = pcAlias
SELECT (pcAlias)
RELEASE laBrowTag
=AFIELDS(laBrowTag)
PRIVATE ARRAY laFields(1),laDescs(1)
DIMENSION laFields(ALEN(laBrowTag,1))
DIMENSION laDescs(ALEN(laFields))
FOR lnTmp=1 TO ALEN(laBrowTag,1)
laFields(lnTmp)=laBrowTag(lnTmp,1)
laDescs(lnTmp)=':'+ALLTRIM(STR(laBrowTag(lnTmp,3)))+[ :H= ']+PROPER(laBrowTag(lnTmp,1))+[']
ENDFOR
IF PCOUNT()>2
DIMENSION laFields(1)
laFields(1)=SPACE(0)
=ALINES(laFields,CHRTRAN(pcFields,",",CHR(13)))
DIMENSION laDescs(ALEN(laFields))
laFields(1) = IIF( LEFT(laFields(1),7)='FIELDS ', SUBSTR(laFields(1),8), laFields(1) )
FOR lnTmp=1 TO ALEN(laFields)
lcTmp=ALLTRIM(laFields(lnTmp))
laFields(lnTmp)=UPPER(GETWORDNUM(lcTmp,1))
laDescs(lnTmp)=ALLTRIM(SUBSTR(lcTmp,LEN(laFields(lnTmp))+2))
ENDFOR
ENDIF
LOCAL oBrowTag
oBrowTag=NEWOBJECT('BrowseTag')
oBrowTag.SHOW()
oBrowTag = NULL
RELEASE oBrowTag
RETURN lnTagged
*-----------------------------------------------------------------------
DEFINE CLASS BrowseTag AS FORM
TOP = 10
LEFT = 148
HEIGHT = _SCREEN.HEIGHT *.6
WIDTH = _SCREEN.WIDTH * .7
DOCREATE = .T.
SHOWTIPS = .T.
SHOWWINDOW = 0
WINDOWTYPE = 1
MINBUTTON = .F.
MAXBUTTON = .F.
ALWAYSONTOP = .T.
DESKTOP=.F.
LOCKSCREEN=.F.
CLOSABLE=.T.
WINDOWSTATE=0
KEYPREVIEW=.T.
ICON = _SCREEN.ICON
CAPTION = pcCaption
NAME = "BrowseTag"
lc_alias = pcAlias
ll_multitag = plMultiTag
lc_caption = pcCaption
lc_CheckCol = SPACE(0)
lc_deleted = SET('DELETED')
lc_century = SET('CENTURY')
ADD OBJECT grdBrowTag AS grdBrowTag WITH ;
TOP = 0, ;
LEFT = 0, ;
HEIGHT = 100, ;
WIDTH = 375, ;
NAME = "grdBrowTag", ;
COLUMNCOUNT = 1
ADD OBJECT cmdTag AS cmdTag WITH ;
TOP = 0, LEFT = -20, NAME = "cmdTag"
ADD OBJECT cmdExit AS cmdExit WITH ;
TOP = 20, LEFT = -20, NAME = "cmdExit"
PROCEDURE INIT
SET CENTURY ON
THISFORM.grdBrowTag.RECORDSOURCE = THISFORM.lc_alias
THISFORM.lc_caption = THISFORM.CAPTION
LOCAL lc_ctrlsrc, ln_columns, ln_width
ln_columns = ALEN(laFields)
ln_width = 0
THISFORM.grdBrowTag.COLUMNCOUNT = ln_columns
FOR lnTmp=1 TO ln_columns
lcMacro='Column'+ALLTRIM(STR(lnTmp))
WITH THISFORM.grdBrowTag.&lcMacro.
.CONTROLSOURCE = laFields(lnTmp)
IF LEFT(laFields(lnTmp),3)='TAG'
.ADDOBJECT('BtagCheck','imgBrowTag')
.bTagCheck.VISIBLE = .T.
.WIDTH = 20
.bTagCheck.ENABLED = .F.
.SPARSE = .T.
.header1.CAPTION = []
lcMacro = ["IIF(EMPTY(" + laFields(lnTmp) +"), 'Text1', 'bTagCheck')"]
.DYNAMICCURRENTCONTROL = &lcMacro.
.Text1.ENABLED = .T.
ELSE
.SPARSE = .T.
.ENABLED = .T.
.VISIBLE = .T.
.Text1.ENABLED = .T.
.READONLY = .T.
.ADDOBJECT('BtagTxt','txtBrowTag')
.bTagTxt.READONLY = .T.
.bTagTxt.VISIBLE = .T.
.bTagTxt.ENABLED = .T.
.header1.CAPTION = ALLTRIM(SUBSTR(laDescs(lnTmp),AT(":H=",laDescs(lnTmp))+4))
.header1.CAPTION = IIF(LEFT(.header1.CAPTION,1)=['],LEFT(.header1.CAPTION,AT(['],.header1.CAPTION,2)-1),.header1.CAPTION)
.header1.CAPTION = IIF(LEFT(.header1.CAPTION,1)=['],SUBSTR(.header1.CAPTION,2),.header1.CAPTION)
.WIDTH = VAL(SUBSTR(laDescs(lnTmp),2)) * FONTMETRIC( 6, THISFORM.grdBrowTag.FONTNAME, THISFORM.grdBrowTag.FONTSIZE)
.CURRENTCONTROL = 'BTagTxt'
ENDIF
ln_width = ln_width + .WIDTH
ENDWITH
ENDFOR
THISFORM.WIDTH = MIN(THISFORM.WIDTH, ln_width+20)
THISFORM.cmdTag.ENABLED = THISFORM.ll_multitag
THISFORM.REFRESH()
THISFORM.RESIZE()
SELECT (THISFORM.lc_alias)
GOTO TOP
ENDPROC
PROCEDURE KEYPRESS
LPARAMETERS nKeyCode, nShiftAltCtrl
DO CASE
CASE nKeyCode = 13 .OR. nKeyCode = 27
THISFORM.RELEASE()
CASE nKeyCode = 32 && space bar... toggle selected/tagged
THISFORM.tag_untag()
IF !THISFORM.ll_multitag
THISFORM.RELEASE()
ELSE
IF RECNO()=RECCOUNT()
GOTO TOP
ELSE
SKIP
ENDIF
THISFORM.REFRESH()
ENDIF
ENDCASE
ENDPROC
PROCEDURE REFRESH
DODEFAULT()
THISFORM.grdBrowTag.REFRESH()
THISFORM.CAPTION = THISFORM.lc_caption + ' - '+ALLTRIM(STR(lnTagged))+' tagged lines....'
ENDPROC
PROCEDURE RESIZE
THISFORM.grdBrowTag.HEIGHT = THISFORM.HEIGHT
THISFORM.grdBrowTag.WIDTH = THISFORM.WIDTH
ENDPROC
PROCEDURE RELEASE
LOCAL lcMacro
lcMacro = THISFORM.lc_deleted
SET DELETED &lcMacro.
lcMacro = THISFORM.lc_century
SET CENTURY &lcMacro.
ENDPROC
PROCEDURE tag_untag
DO CASE
CASE !THISFORM.ll_multitag
CASE TYPE('TAGGED') = 'C'
REPLACE tagged WITH IIF(EMPTY(tagged), 'X', ' ')
lnTagged = lnTagged + IIF(EMPTY(tagged),-1,1)
CASE TYPE('TAG') = 'C'
REPLACE TAG WITH IIF(EMPTY(TAG), 'X', ' ')
lnTagged = lnTagged + IIF(EMPTY(TAG),-1,1)
ENDCASE
THISFORM.grdBrowTag.REFRESH()
ENDPROC
ENDDEFINE
*-----------------------------------------------------------------------
DEFINE CLASS grdBrowTag AS GRID
RECORDSOURCETYPE = 1
RECORDMARK = .F.
DELETEMARK = .F.
FONTNAME = 'Tahoma'
FONTSIZE = 9
PROCEDURE REFRESH
DODEFAULT()
ENDPROC
ENDDEFINE
*-----------------------------------------------------------------------
DEFINE CLASS imgBrowTag AS IMAGE
PICTURE = 'CheckedBox.jpg'
HEIGHT = 16
WIDTH = 16
VISIBLE = .T.
ENDDEFINE
*-----------------------------------------------------------------------
DEFINE CLASS txtBrowTag AS TEXTBOX
ENABLED = .T.
TABSTOP = .T.
BORDERSTYLE = 0
PROCEDURE KEYPRESS
LPARAMETERS nKeyCode, nShiftAltCtrl
THISFORM.KEYPRESS(nKeyCode,nShiftAltCtrl)
ENDPROC
ENDDEFINE
*-----------------------------------------------------------------------
DEFINE CLASS cmdExit AS COMMANDBUTTON
ENABLED = .T.
TABSTOP = .F.
HEIGHT = 20
WIDTH = 20
VISIBLE = .T.
CAPTION = 'EXIT'
PROCEDURE CLICK
LPARAMETERS nKeyCode, nShiftAltCtrl
THISFORM.KEYPRESS(13,0)
ENDPROC
ENDDEFINE
*-----------------------------------------------------------------------
DEFINE CLASS cmdTag AS COMMANDBUTTON
ENABLED = .F.
TABSTOP = .T.
HEIGHT = 20
WIDTH = 20
VISIBLE = .T.
CAPTION = 'TAG'
PROCEDURE CLICK
LPARAMETERS nKeyCode, nShiftAltCtrl
THISFORM.KEYPRESS(ASC(' '),0)
ENDPROC
ENDDEFINE
*-----------------------------------------------------------------------
Andy Snyder
SnyAc Software Services Hyperware Inc.
AmTech Software Inc.