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 sizbut on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Form loses focus...

Status
Not open for further replies.

SnyAc

Programmer
Jul 25, 2001
272
US
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.

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.
 
It's too early calling this in a forms init, it will do your code, then come back and finally it will show and activate the calling form, true.

Call it from the activate(), but only once, eg

Add a lActivated property to your form, default value .F.

Activate() event code:
Code:
If !thisform.lActivated
   thisform.lActivated = .T.
   F_BROWSTAG(...)
Endif

Bye, Olaf.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top