home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / GETSYS.PR_ / GETSYS.PR
Text File  |  1995-06-20  |  38KB  |  1,731 lines
  1. /***
  2. *
  3. *  Getsys.prg
  4. *
  5. *  Standard Clipper 5.3 GET/READ Subsystem
  6. *
  7. *  Copyright (c) 1991-1994, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. *  This version adds the following public functions:
  11. *
  12. *     ReadKill( [<lKill>] )       --> lKill
  13. *     ReadUpdated( [<lUpdated>] ) --> lUpdated
  14. *     ReadFormat( [<bFormat>] )   --> bFormat | NIL
  15. *
  16. *  NOTE: compile with /m /n /w
  17. *
  18. */
  19.  
  20. #include "button.ch"
  21. #include "Inkey.ch"
  22. #include "Getexit.ch"
  23. #include "Set.ch"
  24. #include "SetCurs.ch"
  25. #include "tbrowse.ch"
  26. #include "llibg.ch"
  27.  
  28. /***
  29. *  Nation Message Constants
  30. *  These constants are used with the NationMsg(<msg>) function.
  31. *  The <msg> parameter can range from 1-12 and returns the national
  32. *  version of the system message.
  33. */
  34. #define _GET_INSERT_ON   7     // "Ins"
  35. #define _GET_INSERT_OFF  8     // "   "
  36. #define _GET_INVD_DATE   9     // "Invalid Date"
  37. #define _GET_RANGE_FROM  10    // "Range: "
  38. #define _GET_RANGE_TO    11    // " - "
  39.  
  40. #define K_UNDO          K_CTRL_U
  41.  
  42. //
  43. // State variables for active READ
  44. //
  45. STATIC sbFormat
  46. STATIC slUpdated := .F.
  47. STATIC slKillRead
  48. STATIC slBumpTop
  49. STATIC slBumpBot
  50. STATIC snLastExitState
  51. STATIC snLastPos
  52. STATIC soActiveGet
  53. STATIC scReadProcName
  54. STATIC snReadProcLine
  55. static snNextGet
  56. static snHitCode
  57. static snPos
  58. static OldMessage := NIL
  59. static OldMsgPos := 0
  60.  
  61. // Format of array used to preserve state variables
  62. //
  63. #define GSV_KILLREAD       1
  64. #define GSV_BUMPTOP        2
  65. #define GSV_BUMPBOT        3
  66. #define GSV_LASTEXIT       4
  67. #define GSV_LASTPOS        5
  68. #define GSV_ACTIVEGET      6
  69. #define GSV_READVAR        7
  70. #define GSV_READPROCNAME   8
  71. #define GSV_READPROCLINE   9
  72. #define GSV_NEXTGET        10
  73. #define GSV_HITCODE        11
  74. #define GSV_POS            12
  75.  
  76. #define GSV_COUNT          12
  77.  
  78.  
  79.  
  80. /***
  81. *
  82. *  ReadModal()
  83. *
  84. *  Standard modal READ on an array of GETs
  85. *
  86. */
  87. FUNCTION ReadModal( GetList, nPos, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  88.  
  89.    LOCAL oGet
  90.    LOCAL aSavGetSysVars
  91.    local cOldMsg
  92.    local lMsgFlag
  93.    local cSaveColor
  94.    local lColorFlag
  95.    local cMsg := NIL
  96.    local nForeColor
  97.    local nBackColor
  98.    local nAt
  99.    local nMsgPos
  100.    local nFontRow
  101.  
  102.    IF ( VALTYPE( sbFormat ) == "B" )
  103.       EVAL( sbFormat )
  104.    ENDIF
  105.  
  106.    IF ( EMPTY( GetList ) )
  107.  
  108.       // S'87 compatibility
  109.       SETPOS( MAXROW() - 1, 0 )
  110.       RETURN (.F.)                  // NOTE
  111.  
  112.    ENDIF
  113.  
  114.    // Preserve state variables
  115.    aSavGetSysVars := ClearGetSysVars()
  116.  
  117.    // Set these for use in SET KEYs
  118.    scReadProcName := PROCNAME( 1 )
  119.    snReadProcLine := PROCLINE( 1 )
  120.  
  121.    // Set initial GET to be read
  122.    IF ( VALTYPE( nPos ) == "N" )
  123.       snPos := Settle( GetList, nPos, .T. )
  124.    ELSE
  125.       snPos := Settle( GetList, 0, .T. )
  126.    ENDIF
  127.  
  128.    if     ( ! ValType( nMsgRow ) == "N" )
  129.       lMsgFlag := .f.
  130.  
  131.    elseif ( ! ValType( nMsgLeft ) == "N" )
  132.       lMsgFlag := .f.
  133.  
  134.    elseif ( ! ValType( nMsgRight ) == "N" )
  135.       lMsgFlag := .f.
  136.  
  137.    else
  138.       lMsgFlag := .t.
  139.       cOldMsg := SaveScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight )
  140.       lColorFlag := ( ValType( cMsgColor ) == "C" )
  141.  
  142.    endif
  143.    snNextGet := 0
  144.    snHitCode := 0
  145.  
  146.    WHILE !( snPos == 0 )
  147.  
  148.       oGet := GetList[ snPos ]
  149.       // Get next GET from list and post it as the active GET
  150.          PostActiveGet( oGet )
  151.  
  152.       if ( lMsgFlag )
  153.          if (! _ISGRAPHIC() )
  154.             if ( lColorFlag )
  155.                cSaveColor := SetColor( cMsgColor )
  156.             endif
  157.  
  158.             if ( ValType( oGet:Control ) == "O" )
  159.                @ nMsgRow, nMsgLeft ;
  160.                say PadC( oGet:Control:Message, nMsgRight - nMsgLeft + 1 )
  161.             else
  162.                @ nMsgRow, nMsgLeft ;
  163.                say PadC( oGet:Message, nMsgRight - nMsgLeft + 1 )
  164.             endif
  165.  
  166.             if ( lColorFlag )
  167.                SetColor( cSaveColor )
  168.             endif
  169.  
  170.          else    // Graphic mode
  171.  
  172.             if ( ! lColorFlag )
  173.                cMsgColor := SetColor()
  174.             endif
  175.  
  176.             nForeColor := _GETNUMCOLOR( cMsgColor )
  177.             nAt := AT( "/" , cMsgColor )
  178.             nBackColor := _GETNUMCOLOR( Substr( cMsgColor, nAt + 1, len( cMsgColor ) - nAt) )
  179.  
  180.             if ( ValType( oGet:Control ) == "O" )
  181.                cMsg := oGet:Control:Message
  182.             else
  183.                cMsg := oGet:Message
  184.             endif
  185.  
  186.             nMsgPos := int( (nMsgRight - nMsgLeft) / 2) - int ( len( cMsg ) / 2 ) + 1
  187.             nFontRow := gMode() [ LLG_MODE_FONT_ROW ]
  188.  
  189.             if (OldMessage <> NIL)
  190.                if ( (OldMessage <> cMsg ) .or. ( len( cMsg ) == 0) )
  191.                   gWriteAt( OldMsgPos * 8,;
  192.                             nMsgRow * nFontRow,;
  193.                             OldMessage,;
  194.                             nBackColor,;
  195.                             LLG_MODE_SET )
  196.                   gFrame( nMsgLeft * 8,;
  197.                         ( nMsgRow * nFontRow ) - 1,;
  198.                           nMsgRight * 8,;
  199.                         ((nMsgRow + 1) * nFontRow ) + 1,;
  200.                           nBackColor,;
  201.                           8, 15,;
  202.                           2, 2, 2, 2, LLG_MODE_XOR, LLG_FILL )
  203.                endif
  204.             endif
  205.  
  206.             if ( (OldMessage <> cMsg) .or. ( len( cMsg ) == 0 ) )
  207.                gFrame( nMsgLeft * 8,;
  208.                      ( nMsgRow * nFontRow) -1,;
  209.                        nMsgRight * 8,;
  210.                      ((nMsgRow + 1) * nFontRow) + 1,;
  211.                        nBackColor,;
  212.                        8, 15,;
  213.                        2, 2, 2, 2, LLG_MODE_XOR, LLG_FILL )
  214.                gWriteAt( nMsgPos * 8,;
  215.                          nMsgRow * nFontRow,;
  216.                          cMsg,;
  217.                          nForeColor,;
  218.                          LLG_MODE_SET )
  219.             endif
  220.  
  221.             OldMessage := cMsg
  222.             OldMsgPos := nMsgPos
  223.  
  224.          endif
  225.       endif
  226.  
  227.       // Read the GET
  228.       IF ( VALTYPE( oGet:reader ) == "B" )
  229.          EVAL( oGet:reader, oGet, GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )    // Use custom reader block
  230.       ELSE
  231.          GetReader( oGet, GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor ) // Use standard reader
  232.       ENDIF
  233.  
  234.       // Move to next GET based on exit condition
  235.       snPos := Settle( GetList, snPos, .F. )
  236.  
  237.    ENDDO
  238.  
  239.    if ( lMsgFlag )
  240.       RestScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight, cOldMsg )
  241.    endif
  242.  
  243.    // Restore state variables
  244.    RestoreGetSysVars( aSavGetSysVars )
  245.  
  246.    // S'87 compatibility
  247.    SETPOS( MAXROW() - 1, 0 )
  248.  
  249.    RETURN ( slUpdated )
  250.  
  251.  
  252.  
  253. /***
  254. *
  255. *  GetReader()
  256. *
  257. *  Standard modal read of a single GET
  258. *
  259. */
  260. PROCEDURE GetReader( oGet, GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  261.  
  262.    // Read the GET if the WHEN condition is satisfied
  263.  
  264.    IF ( GetPreValidate( oGet ) )
  265.  
  266.       // Activate the GET for reading
  267.  
  268.       snHitCode := 0
  269.       oGet:setFocus()
  270.  
  271.       WHILE ( oGet:exitState == GE_NOEXIT .AND. !slKillRead )
  272.  
  273.          // Check for initial typeout (no editable positions)
  274.          IF ( oGet:typeOut )
  275.             oGet:exitState := GE_ENTER
  276.          ENDIF
  277.  
  278.          // Apply keystrokes until exit
  279.          WHILE ( oGet:exitState == GE_NOEXIT .AND. !slKillRead )
  280.             GetApplyKey( oGet, inkey( 0 ), GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  281.          ENDDO
  282.  
  283.          // Disallow exit if the VALID condition is not satisfied
  284.          IF ( !GetPostValidate( oGet ) )
  285.             oGet:exitState := GE_NOEXIT
  286.          ENDIF
  287.       ENDDO
  288.  
  289.       // De-activate the GET
  290.  
  291.       oGet:killFocus()
  292.  
  293.    ENDIF
  294.  
  295.    RETURN
  296.  
  297.  
  298.  
  299. /***
  300. *
  301. *  GUIReader()
  302. *
  303. *  Standard modal read of a single GUI-GET
  304. *
  305. */
  306. PROCEDURE GUIReader( oGet, GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  307.    local oGUI
  308.  
  309.    // Read the GET if the WHEN condition is satisfied
  310.    IF ( ! GUIPreValidate( oGet , oGet:Control ) )
  311.    elseif ( ValType( oGet:Control ) == "O" )
  312.  
  313.       // Activate the GET for reading
  314.       oGUI := oGet:Control
  315.       oGUI:Select( oGet:VarGet() )
  316.       oGUI:setFocus()
  317.  
  318.       if ( snHitCode > 0 )
  319.          oGUI:Select( snHitCode )
  320.  
  321.       elseif ( snHitCode == HTCAPTION )
  322.          oGUI:Select()
  323.  
  324.       elseif ( snHitCode == HTCLIENT )
  325.          oGUI:Select( K_LBUTTONDOWN )
  326.  
  327.       elseif ( snHitCode == HTDROPBUTTON )
  328.          oGUI:Open()
  329.  
  330.       elseif ( ( snHitCode >= HTSCROLLFIRST ) .and. ;
  331.                ( snHitCode <= HTSCROLLLAST ) )
  332.          oGUI:Scroll( snHitCode )
  333.       endif
  334.  
  335.       snHitCode := 0
  336.  
  337.       WHILE ( oGet:exitState == GE_NOEXIT .AND. !slKillRead )
  338.  
  339.          // Check for initial typeout (no editable positions)
  340.          IF ( oGUI:typeOut )
  341.             oGet:exitState := GE_ENTER
  342.          ENDIF
  343.  
  344.          // Apply keystrokes until exit
  345.          WHILE ( oGet:exitState == GE_NOEXIT .AND. !slKillRead )
  346.             GUIApplyKey( oGet, oGUI, GetList, inkey( 0 ), oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  347.          ENDDO
  348.  
  349.          // Disallow exit if the VALID condition is not satisfied
  350.  
  351.          IF ( !GUIPostValidate( oGet, oGUI ) )
  352.             oGet:exitState := GE_NOEXIT
  353.          ENDIF
  354.       ENDDO
  355.  
  356.       // De-activate the GET
  357.       oGet:VarPut( oGUI:Buffer )
  358.       oGUI:killFocus()
  359.  
  360.       if ( ! oGUI:ClassName() == "LISTBOX" )
  361.       elseif ( ! oGUI:DropDown )
  362.       elseif ( oGUI:IsOpen )
  363.          oGUI:Close()
  364.       endif
  365.  
  366.    ENDIF
  367.  
  368.    RETURN
  369.  
  370.  
  371.  
  372. /***
  373. *
  374. *  tBrowseReader()
  375. *
  376. *  Standard modal read of a single tBrowse-GET
  377. *
  378. */
  379. PROCEDURE tbReader( oGet, GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  380.    local oTB, nKey, lAutoLite, nCell, nSaveCursor, nProcessed
  381.  
  382.    // Read the GET if the WHEN condition is satisfied
  383.    IF ( ! GUIPreValidate( oGet, oGet:Control ) )
  384.    elseif ( ValType( oGet:Control ) == "O" )
  385.  
  386.       nSaveCursor := SetCursor( SC_NONE )
  387.  
  388.       // Activate the GET for reading
  389.  
  390.       oTB := oGet:Control
  391.  
  392.       lAutoLite := oTB:Autolite
  393.       oTB:Autolite := .T.
  394.       oTB:Hilite()
  395.  
  396.       if ( snHitCode == HTCELL )
  397.          tbMouse( oTB, mRow(), mCol() )
  398.       endif
  399.  
  400.       snHitCode := 0
  401.  
  402.       WHILE ( oGet:exitState == GE_NOEXIT )
  403.  
  404.          // Apply keystrokes until exit
  405.          WHILE ( oGet:exitState == GE_NOEXIT )
  406.             nKey := 0
  407.  
  408.             WHILE ( ( ! oTB:Stabilize() ) .AND. ( nKey == 0 ) )
  409.                nKey := Inkey()
  410.             ENDDO
  411.  
  412.             IF ( nKey == 0 )
  413.                nKey := Inkey(0)
  414.             ENDIF
  415.  
  416.             nProcessed := oTB:ApplyKey( nKey )
  417.             IF ( nProcessed == TBR_EXIT )
  418.                oGet:exitState := GE_ESCAPE
  419.                EXIT
  420.  
  421.             ELSEIF ( nProcessed == TBR_EXCEPTION )
  422.                tbApplyKey( oGet, oTB, GetList, nKey, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  423.  
  424.             ENDIF
  425.  
  426.          ENDDO
  427.  
  428.          // Disallow exit if the VALID condition is not satisfied
  429.  
  430.          IF ( !GUIPostValidate( oGet, oTB ) )
  431.             oGet:exitState := GE_NOEXIT
  432.          ENDIF
  433.       ENDDO
  434.  
  435.       // De-activate the GET
  436.       oTB:Autolite := lAutoLite
  437.       oTB:DeHilite()
  438.       SetCursor( nSaveCursor )
  439.    ENDIF
  440.  
  441.    RETURN
  442.  
  443.  
  444.  
  445. static function HitTest( GetList, MouseRow, MouseCol )
  446.    local nCount, nTotal
  447.  
  448.       snNextGet := 0
  449.       nTotal  := Len( GetList )
  450.  
  451.       for nCount := 1 to nTotal
  452.          if ( ( snHitCode := GetList[ nCount ]:HitTest( MouseRow, MouseCol ) ) != HTNOWHERE )
  453.             snNextGet := nCount
  454.             exit
  455.          endif
  456.       next
  457.  
  458.       if ( snNextGet == 0 )
  459.       elseif ( ValType( GetList[ snNextGet ]:Control ) <> "O" )
  460.       elseif ( ! GUIPreValidate( GetList[ snNextGet ], GetList[ snNextGet ]:Control ) )
  461.          snNextGet := 0
  462.       endif
  463.  
  464.       if ( snNextGet == 0 )
  465.       elseif ( ! GetPrevalidate( GetList[ snNextGet ] ) )
  466.          snNextGet := 0
  467.       endif
  468.  
  469.    return ( snNextGet != 0 )
  470.  
  471.  
  472.  
  473. static function Accelerator( GetList, nKey )
  474.    local nGet, oGet, nHotPos, cKey, cCaption, nStart, nEnd, nItteration
  475.  
  476.       if     ( ( nKey >= K_ALT_Q ) .and. ( nKey <= K_ALT_P ) )
  477.          cKey := SubStr( "qwertyuiop", nKey - K_ALT_Q + 1, 1 )
  478.  
  479.       elseif ( ( nKey >= K_ALT_A ) .and. ( nKey <= K_ALT_L ) )
  480.          cKey := SubStr( "asdfghjkl", nKey - K_ALT_A + 1, 1 )
  481.  
  482.       elseif ( ( nKey >= K_ALT_Z ) .and. ( nKey <= K_ALT_M ) )
  483.          cKey := SubStr( "zxcvbnm", nKey - K_ALT_Z + 1, 1 )
  484.  
  485.       elseif ( ( nKey >= K_ALT_1 ) .and. ( nKey <= K_ALT_0 ) )
  486.          cKey := SubStr( "1234567890", nKey - K_ALT_1 + 1, 1 )
  487.  
  488.       else
  489.          return ( 0 )
  490.  
  491.       endif
  492.  
  493.  
  494.       nStart := snPos + 1
  495.       nEnd  := Len( GetList )
  496.  
  497.       for nItteration := 1 to 2
  498.          for nGet := nStart to nEnd
  499.             oGet := GetList[ nGet ]
  500.  
  501.             if ( ValType( oGet:Control ) == "O" .AND. oGet:Control:ClassName() != "TBROWSE" )
  502.                cCaption := oGet:Control:Caption
  503.             else
  504.                cCaption := oGet:Caption
  505.             endif
  506.  
  507.             if ( ( nHotPos := At( "&", cCaption ) ) == 0 )
  508.             elseif ( nHotPos == Len( cCaption ) )
  509.             elseif ( Lower( SubStr( cCaption, nHotPos + 1, 1 ) ) == cKey )
  510.  
  511.                if ( ! GetPrevalidate( GetList[ nGet ] ) )
  512.                   return ( 0 )                                   /* NOTE! */
  513.                endif
  514.  
  515.                return ( nGet )                                 /* NOTE! */
  516.             endif
  517.          next
  518.  
  519.          nStart := 1
  520.          nEnd := snPos - 1
  521.       next
  522.  
  523.    return ( 0 )
  524.  
  525.  
  526.  
  527. /***
  528. *
  529. *  GetApplyKey()
  530. *
  531. *  Apply a single INKEY() keystroke to a GET
  532. *
  533. *  NOTE: GET must have focus.
  534. *
  535. */
  536. PROCEDURE GetApplyKey( oGet, nKey, GetList, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  537.  
  538.    LOCAL cKey
  539.    LOCAL bKeyBlock
  540.    local MouseRow, MouseColumn
  541.    local nButton
  542.    local nHotItem
  543.  
  544.    // Check for SET KEY first
  545.    IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
  546.       GetDoSetKey( bKeyBlock, oGet )
  547.       RETURN                           // NOTE
  548.    ENDIF
  549.  
  550.    if ( ( ! GetList == NIL ) .AND. ;
  551.         ( ( nHotItem := Accelerator( GetList, nKey ) ) != 0 ) )
  552.       oGet:ExitState := GE_SHORTCUT
  553.       snNextGet := nHotItem
  554.  
  555.    elseif ( oMenu == NIL )
  556.    elseif ( ( nHotItem := oMenu:GetAccel( nKey ) ) != 0 )
  557.       MenuModal( oMenu, nHotItem, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  558.       nKey := 0
  559.    elseif ( IsShortCut( oMenu, nKey )  )
  560.       nKey := 0
  561.    endif
  562.  
  563.    DO CASE
  564.    CASE ( nKey == K_UP )
  565.       oGet:exitState := GE_UP
  566.  
  567.    CASE ( nKey == K_SH_TAB )
  568.       oGet:exitState := GE_UP
  569.  
  570.    CASE ( nKey == K_DOWN )
  571.       oGet:exitState := GE_DOWN
  572.  
  573.    CASE ( nKey == K_TAB )
  574.       oGet:exitState := GE_DOWN
  575.  
  576.    CASE ( nKey == K_ENTER )
  577.       oGet:exitState := GE_ENTER
  578.  
  579.    CASE ( nKey == K_ESC )
  580.       IF ( SET( _SET_ESCAPE ) )
  581.          oGet:undo()
  582.          oGet:exitState := GE_ESCAPE
  583.       ENDIF
  584.  
  585.    CASE ( nKey == K_PGUP )
  586.       oGet:exitState := GE_WRITE
  587.  
  588.    CASE ( nKey == K_PGDN )
  589.       oGet:exitState := GE_WRITE
  590.  
  591.    CASE ( nKey == K_CTRL_HOME )
  592.       oGet:exitState := GE_TOP
  593.  
  594.  
  595. #ifdef CTRL_END_SPECIAL
  596.  
  597.    // Both ^W and ^End go to the last GET
  598.    CASE ( nKey == K_CTRL_END )
  599.       oGet:exitState := GE_BOTTOM
  600.  
  601. #else
  602.  
  603.    // Both ^W and ^End terminate the READ (the default)
  604.    CASE ( nKey == K_CTRL_W )
  605.       oGet:exitState := GE_WRITE
  606.  
  607. #endif
  608.    CASE ( ( nKey == K_LBUTTONDOWN ) .or. ( nKey == K_LDBLCLK ) )
  609.       MouseRow := mrow()
  610.       MouseColumn := mcol()
  611.  
  612.       if ( ! ValType( oMenu ) == "O" )
  613.          nButton := 0
  614.  
  615.       elseif ( ! oMenu:ClassName() == "TOPBARMENU" )
  616.          nButton := 0
  617.  
  618.       elseif ( ( nButton := oMenu:HitTest( MouseRow, MouseColumn ) ) != 0 )
  619.          MenuModal( oMenu, nButton, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  620.          nButton := 1
  621.  
  622.       endif
  623.  
  624.       if ( nButton != 0 )
  625.  
  626.       elseif ( ( nButton := oGet:HitTest( MouseRow, MouseColumn ) ) == HTCLIENT )
  627.          while ( oGet:col + oGet:pos - 1 > MouseColumn )
  628.             oGet:left()
  629.          enddo
  630.  
  631.          while ( oGet:col + oGet:pos - 1 < MouseColumn )
  632.             oGet:right()
  633.          enddo
  634.  
  635.       elseif ( ! nButton == HTNOWHERE )
  636.       elseif ( ( ! GetList == NIL ) .AND. ;
  637.                ( HitTest( GetList, MouseRow, MouseColumn ) ) )
  638.          oGet:exitstate := GE_MOUSEHIT
  639.       else
  640.          oGet:exitstate := GE_NOEXIT
  641.       endif
  642.  
  643.    CASE ( nKey == K_UNDO )
  644.       oGet:undo()
  645.  
  646.    CASE ( nKey == K_HOME )
  647.       oGet:home()
  648.  
  649.    CASE ( nKey == K_END )
  650.       oGet:end()
  651.  
  652.    CASE ( nKey == K_RIGHT )
  653.       oGet:right()
  654.  
  655.    CASE ( nKey == K_LEFT )
  656.       oGet:left()
  657.  
  658.    CASE ( nKey == K_CTRL_RIGHT )
  659.       oGet:wordRight()
  660.  
  661.    CASE ( nKey == K_CTRL_LEFT )
  662.       oGet:wordLeft()
  663.  
  664.    CASE ( nKey == K_BS )
  665.       oGet:backSpace()
  666.  
  667.    CASE ( nKey == K_DEL )
  668.       oGet:delete()
  669.  
  670.    CASE ( nKey == K_CTRL_T )
  671.       oGet:delWordRight()
  672.  
  673.    CASE ( nKey == K_CTRL_Y )
  674.       oGet:delEnd()
  675.  
  676.    CASE ( nKey == K_CTRL_BS )
  677.       oGet:delWordLeft()
  678.  
  679.    CASE ( nKey == K_INS )
  680.       SET( _SET_INSERT, !SET( _SET_INSERT ) )
  681.       ShowScoreboard()
  682.  
  683.    OTHERWISE
  684.  
  685.       IF ( nKey >= 32 .AND. nKey <= 255 )
  686.  
  687.          cKey := CHR( nKey )
  688.  
  689.          IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
  690.             oGet:toDecPos()
  691.          ELSE
  692.  
  693.             IF ( SET( _SET_INSERT ) )
  694.                oGet:insert( cKey )
  695.             ELSE
  696.                oGet:overstrike( cKey )
  697.             ENDIF
  698.  
  699.             IF ( oGet:typeOut )
  700.                IF ( SET( _SET_BELL ) )
  701.                   ?? CHR(7)
  702.                ENDIF
  703.  
  704.                IF ( !SET( _SET_CONFIRM ) )
  705.                   oGet:exitState := GE_ENTER
  706.                ENDIF
  707.             ENDIF
  708.  
  709.          ENDIF
  710.  
  711.       ENDIF
  712.  
  713.    ENDCASE
  714.  
  715.    RETURN
  716.  
  717.  
  718.  
  719. /***
  720. *
  721. *  GUIApplyKey()
  722. *
  723. *  Apply a single INKEY() keystroke to a GET
  724. *
  725. *  NOTE: GET and GUI must have focus.
  726. *
  727. */
  728. PROCEDURE GUIApplyKey( oGet, oGUI, GetList, nKey, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  729.  
  730.    LOCAL cKey
  731.    LOCAL bKeyBlock
  732.    local MouseRow, MouseColumn
  733.    local nButton
  734.    local TheClass
  735.    local nHotItem
  736.    local lClose
  737.  
  738.    // Check for SET KEY first
  739.    IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
  740.       GetDoSetKey( bKeyBlock, oGet )
  741.       RETURN                           // NOTE
  742.    ENDIF
  743.  
  744.    if ( ( nHotItem := Accelerator( GetList, nKey ) ) != 0 )
  745.       oGet:ExitState := GE_SHORTCUT
  746.       snNextGet := nHotItem
  747.  
  748.    elseif ( oMenu == NIL )
  749.    elseif ( ( nHotItem := oMenu:GetAccel( nKey ) ) != 0 )
  750.       MenuModal( oMenu, nHotItem, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  751.       nKey := 0
  752.    elseif ( IsShortCut( oMenu, nKey )  )
  753.       nKey := 0
  754.    endif
  755.  
  756.    if ( nKey == 0 )
  757.    elseif ( ( TheClass := oGUI:ClassName() ) == "RADIOGROUP" )
  758.       if  ( nKey == K_UP )
  759.          oGUI:PrevItem()
  760.          nKey := 0
  761.  
  762.       elseif ( nKey == K_DOWN )
  763.          oGUI:NextItem()
  764.          nKey := 0
  765.  
  766.       elseif ( ( nHotItem := oGUI:GetAccel( nKey ) ) != 0 )
  767.          oGUI:Select( nHotItem )
  768.  
  769.       endif
  770.  
  771.    elseif ( TheClass == "CHECKBOX" )
  772.       if ( nKey == K_SPACE )
  773.          oGUI:Select()
  774.  
  775.       endif
  776.  
  777.    elseif ( TheClass == "PUSHBUTTON" )
  778.       if ( nKey == K_SPACE )
  779.          oGUI:Select( K_SPACE )
  780.  
  781.       elseif ( nKey == K_ENTER )
  782.          oGUI:Select()
  783.          nKey := 0
  784.  
  785.       endif
  786.  
  787.    elseif ( TheClass == "LISTBOX" )
  788.       if  ( nKey == K_UP )
  789.          oGUI:PrevItem()
  790.          nKey := 0
  791.  
  792.       elseif ( nKey == K_DOWN )
  793.          oGUI:NextItem()
  794.          nKey := 0
  795.  
  796.       elseif ( nKey == K_SPACE )
  797.          if ( ! oGUI:DropDown )
  798.          elseif ( ! oGUI:IsOpen )
  799.             oGUI:Open()
  800.             nKey := 0
  801.          endif
  802.  
  803.       elseif ( ( nButton := oGUI:FindText( Chr( nKey ), oGUI:Value + 1, ;
  804.                                            .f., .f. ) ) != 0 )
  805.          oGUI:Select( nButton )
  806.  
  807.       endif
  808.  
  809.    endif
  810.  
  811.    DO CASE
  812.    CASE ( nKey == K_UP )
  813.       oGet:exitState := GE_UP
  814.  
  815.    CASE ( nKey == K_SH_TAB )
  816.       oGet:exitState := GE_UP
  817.  
  818.    CASE ( nKey == K_DOWN )
  819.       oGet:exitState := GE_DOWN
  820.  
  821.    CASE ( nKey == K_TAB )
  822.       oGet:exitState := GE_DOWN
  823.  
  824.    CASE ( nKey == K_ENTER )
  825.       oGet:exitState := GE_ENTER
  826.  
  827.    CASE ( nKey == K_ESC )
  828.       IF ( SET( _SET_ESCAPE ) )
  829.          oGet:exitState := GE_ESCAPE
  830.       ENDIF
  831.  
  832.    CASE ( nKey == K_PGUP )
  833.       oGet:exitState := GE_WRITE
  834.  
  835.    CASE ( nKey == K_PGDN )
  836.       oGet:exitState := GE_WRITE
  837.  
  838.    CASE ( nKey == K_CTRL_HOME )
  839.       oGet:exitState := GE_TOP
  840.  
  841.  
  842. #ifdef CTRL_END_SPECIAL
  843.  
  844.    // Both ^W and ^End go to the last GET
  845.    CASE ( nKey == K_CTRL_END )
  846.       oGet:exitState := GE_BOTTOM
  847.  
  848. #else
  849.  
  850.    // Both ^W and ^End terminate the READ (the default)
  851.    CASE ( nKey == K_CTRL_W )
  852.       oGet:exitState := GE_WRITE
  853.  
  854. #endif
  855.    CASE ( ( nKey == K_LBUTTONDOWN ) .or. ( nKey == K_LDBLCLK ) )
  856.       MouseRow := mrow()
  857.       MouseColumn := mcol()
  858.  
  859.       if ( ! ValType( oMenu ) == "O" )
  860.          nButton := 0
  861.  
  862.       elseif ( ! oMenu:ClassName() == "TOPBARMENU" )
  863.          nButton := 0
  864.  
  865.       elseif ( ( nButton := oMenu:HitTest( MouseRow, MouseColumn ) ) != 0 )
  866.          MenuModal( oMenu, nButton, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  867.          nButton := 1
  868.  
  869.       endif
  870.  
  871.       lClose := .t.
  872.  
  873.       if ( nButton != 0 )
  874.       elseif ( ( nButton := oGUI:HitTest( MouseRow, MouseColumn ) ) == HTNOWHERE )
  875.          if ( HitTest( GetList, MouseRow, MouseColumn ) )
  876.             oGet:exitstate := GE_MOUSEHIT
  877.          else
  878.             oGet:exitstate := GE_NOEXIT
  879.          endif
  880.  
  881.       elseif ( nButton >= HTCLIENT )
  882.          oGUI:Select( nButton )
  883.  
  884.       elseif ( nButton == HTDROPBUTTON )
  885.          if ( ! oGUI:IsOpen )
  886.             oGUI:Open()
  887.             lClose := .f.
  888.  
  889.          endif
  890.  
  891.       elseif ( ( nButton >= HTSCROLLFIRST ) .and. ;
  892.                ( nButton <= HTSCROLLLAST ) )
  893.          oGUI:Scroll( nButton )
  894.          lClose := .f.
  895.  
  896.       endif
  897.  
  898.       if ( ! lClose )
  899.       elseif ( ! TheClass == "LISTBOX" )
  900.       elseif ( ! oGUI:DropDown )
  901.       elseif ( oGUI:IsOpen )
  902.          oGUI:Close()
  903.          oGUI:Display()
  904.       endif
  905.  
  906.    ENDCASE
  907.  
  908.    RETURN
  909.  
  910.  
  911.  
  912. /***
  913. *
  914. *  tBrowseApplyKey()
  915. *
  916. *  default handler for Applying a single INKEY() keystroke to a tBrowse.
  917. *
  918. *  NOTE: GET and tBrowse ought to have focus.
  919. *
  920. */
  921. PROCEDURE tbApplyKey( oGet, oTB, GetList, nKey, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  922.  
  923.    LOCAL cKey
  924.    LOCAL bKeyBlock
  925.    local MouseRow, MouseColumn
  926.    local nButton
  927.    local nHotItem
  928.  
  929.    // Check for SET KEY first
  930.    IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
  931.       GetDoSetKey( bKeyBlock, oGet )
  932.       RETURN                           // NOTE
  933.    ENDIF
  934.  
  935.    if ( ( nHotItem := Accelerator( GetList, nKey ) ) != 0 )
  936.       oGet:ExitState := GE_SHORTCUT
  937.       snNextGet := nHotItem
  938.  
  939.    elseif ( oMenu == NIL )
  940.    elseif ( ( nHotItem := oMenu:GetAccel( nKey ) ) != 0 )
  941.       MenuModal( oMenu, nHotItem, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  942.       nKey := 0
  943.  
  944.    elseif ( IsShortCut( oMenu, nKey )  )
  945.       nKey := 0
  946.  
  947.    endif
  948.  
  949.    DO CASE
  950.    CASE ( nKey == K_TAB )
  951.       oGet:exitState := GE_DOWN
  952.  
  953.    CASE ( nKey == K_SH_TAB )
  954.       oGet:exitState := GE_UP
  955.  
  956.    CASE ( nKey == K_ENTER )
  957.       oGet:exitState := GE_ENTER
  958.  
  959.    CASE ( nKey == K_ESC )
  960.       IF ( SET( _SET_ESCAPE ) )
  961.          oGet:exitState := GE_ESCAPE
  962.       ENDIF
  963.  
  964. #ifdef CTRL_END_SPECIAL
  965.  
  966.    // Both ^W and ^End go to the last GET
  967.    CASE ( nKey == K_CTRL_END )
  968.       oGet:exitState := GE_BOTTOM
  969.  
  970. #else
  971.  
  972.    // Both ^W and ^End terminate the READ (the default)
  973.    CASE ( nKey == K_CTRL_W )
  974.       oGet:exitState := GE_WRITE
  975.  
  976. #endif
  977.    CASE ( ( nKey == K_LBUTTONDOWN ) .or. ( nKey == K_LDBLCLK ) )
  978.       MouseRow := mrow()
  979.       MouseColumn := mcol()
  980.  
  981.       if ( ! ValType( oMenu ) == "O" )
  982.          nButton := 0
  983.  
  984.       elseif ( ! oMenu:ClassName() == "TOPBARMENU" )
  985.          nButton := 0
  986.  
  987.       elseif ( ( nButton := oMenu:HitTest( MouseRow, MouseColumn ) ) != 0 )
  988.          MenuModal( oMenu, nButton, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  989.          nButton := 1
  990.  
  991.       endif
  992.  
  993.       if ( nButton != 0 )
  994.       elseif ( ( nButton := oTB:HitTest( MouseRow, MouseColumn ) ) == HTNOWHERE )
  995.          if ( HitTest( GetList, MouseRow, MouseColumn ) )
  996.             oGet:exitstate := GE_MOUSEHIT
  997.          else
  998.             oGet:exitstate := GE_NOEXIT
  999.          endif
  1000.       endif
  1001.    ENDCASE
  1002.  
  1003.    RETURN
  1004.  
  1005.  
  1006.  
  1007. /***
  1008. *
  1009. *  GetPreValidate()
  1010. *
  1011. *  Test entry condition (WHEN clause) for a GET
  1012. *
  1013. */
  1014. FUNCTION GetPreValidate( oGet )
  1015.  
  1016.    LOCAL lSavUpdated
  1017.    LOCAL lWhen := .T.
  1018.  
  1019.    IF !( oGet:preBlock == NIL )
  1020.  
  1021.       lSavUpdated := slUpdated
  1022.  
  1023.       lWhen := EVAL( oGet:preBlock, oGet )
  1024.  
  1025.       oGet:display()
  1026.  
  1027.       ShowScoreBoard()
  1028.       slUpdated := lSavUpdated
  1029.  
  1030.    ENDIF
  1031.  
  1032.    IF ( slKillRead )
  1033.  
  1034.       lWhen := .F.
  1035.       oGet:exitState := GE_ESCAPE       // Provokes ReadModal() exit
  1036.  
  1037.    ELSEIF ( !lWhen )
  1038.  
  1039.       oGet:exitState := GE_WHEN         // Indicates failure
  1040.  
  1041.    ELSE
  1042.  
  1043.       oGet:exitState := GE_NOEXIT       // Prepares for editing
  1044.  
  1045.    ENDIF
  1046.  
  1047.    RETURN ( lWhen )
  1048.  
  1049.  
  1050.  
  1051. /***
  1052. *
  1053. *  GetPostValidate()
  1054. *
  1055. *  Test exit condition (VALID clause) for a GET
  1056. *
  1057. *  NOTE: Bad dates are rejected in such a way as to preserve edit buffer
  1058. *
  1059. */
  1060. FUNCTION GetPostValidate( oGet )
  1061.  
  1062.    LOCAL lSavUpdated
  1063.    LOCAL lValid := .T.
  1064.  
  1065.  
  1066.    IF ( oGet:exitState == GE_ESCAPE )
  1067.       RETURN ( .T. )                   // NOTE
  1068.    ENDIF
  1069.  
  1070.    IF ( oGet:badDate() )
  1071.       oGet:home()
  1072.       DateMsg()
  1073.       ShowScoreboard()
  1074.       RETURN ( .F. )                   // NOTE
  1075.    ENDIF
  1076.  
  1077.    // If editing occurred, assign the new value to the variable
  1078.    IF ( oGet:changed )
  1079.       oGet:assign()
  1080.       slUpdated := .T.
  1081.    ENDIF
  1082.  
  1083.    // Reform edit buffer, set cursor to home position, redisplay
  1084.    oGet:reset()
  1085.  
  1086.    // Check VALID condition if specified
  1087.    IF !( oGet:postBlock == NIL )
  1088.  
  1089.       lSavUpdated := slUpdated
  1090.  
  1091.       // S'87 compatibility
  1092.       SETPOS( oGet:row, oGet:col + LEN( oGet:buffer ) )
  1093.  
  1094.       lValid := EVAL( oGet:postBlock, oGet )
  1095.  
  1096.       // Reset S'87 compatibility cursor position
  1097.       SETPOS( oGet:row, oGet:col )
  1098.  
  1099.       ShowScoreBoard()
  1100.       oGet:updateBuffer()
  1101.  
  1102.       slUpdated := lSavUpdated
  1103.  
  1104.       IF ( slKillRead )
  1105.          oGet:exitState := GE_ESCAPE      // Provokes ReadModal() exit
  1106.          lValid := .T.
  1107.  
  1108.       ENDIF
  1109.    ENDIF
  1110.  
  1111.    RETURN ( lValid )
  1112.  
  1113.  
  1114. /***
  1115. *
  1116. *  GUIPreValidate()
  1117. *
  1118. *  Test entry condition (WHEN clause) for a GET:GUI
  1119. *
  1120. */
  1121. FUNCTION GUIPreValidate( oGet, oGUI )
  1122.  
  1123.    LOCAL lSavUpdated
  1124.    LOCAL lWhen := .T.
  1125.  
  1126.    IF !( oGet:preBlock == NIL )
  1127.       lSavUpdated := slUpdated
  1128.  
  1129.       lWhen := EVAL( oGet:preBlock, oGet )
  1130.  
  1131.       IF (! ( oGUI:ClassName == "TBROWSE" ) )
  1132.          oGUI:Display()
  1133.       ENDIF
  1134.  
  1135.       ShowScoreBoard()
  1136.  
  1137.       slUpdated := lSavUpdated
  1138.    ENDIF
  1139.  
  1140.    IF (slKillRead)
  1141.  
  1142.       lWhen := .F.
  1143.       oGet:exitState := GE_ESCAPE
  1144.  
  1145.    ELSEIF ( !lWhen )
  1146.  
  1147.       oGet:exitState := GE_WHEN
  1148.  
  1149.    ELSE
  1150.  
  1151.       oGet:exitState := GE_NOEXIT
  1152.  
  1153.    ENDIF
  1154.  
  1155.    RETURN (lWhen)
  1156.  
  1157.  
  1158. /***
  1159. *
  1160. *  GUIPostValidate()
  1161. *
  1162. *  Test exit condition (VALID clause) for a GET:GUI
  1163. *
  1164. */
  1165. FUNCTION GUIPostValidate( oGet, oGUI )
  1166.  
  1167.    LOCAL lSavUpdated
  1168.    LOCAL lValid := .T.
  1169.    LOCAL uOldData, uNewData
  1170.  
  1171.  
  1172.    IF ( oGet:exitState == GE_ESCAPE )
  1173.       RETURN ( .T. )                   // NOTE
  1174.    ENDIF
  1175.  
  1176.    IF ( ! ( oGUI:ClassName == "TBROWSE" ) )
  1177.       uOldData := oGet:VarGet()
  1178.       uNewData := oGUI:Buffer
  1179.    ENDIF
  1180.  
  1181.    // If editing occurred, assign the new value to the variable
  1182.    IF ( ! ( uOldData == uNewData ) )
  1183.       oGet:VarPut( uNewData )
  1184.       slUpdated := .T.
  1185.    ENDIF
  1186.  
  1187.    // Check VALID condition if specified
  1188.    IF !( oGet:postBlock == NIL )
  1189.  
  1190.       lSavUpdated := slUpdated
  1191.  
  1192.       lValid := EVAL( oGet:postBlock, oGet )
  1193.  
  1194.       // Reset S'87 compatibility cursor position
  1195.       SETPOS( oGet:row, oGet:col )
  1196.  
  1197.       ShowScoreBoard()
  1198.       IF ( ! ( oGUI:ClassName == "TBROWSE" ) )
  1199.          oGUI:Select( oGet:VarGet() )
  1200.       ENDIF
  1201.  
  1202.       slUpdated := lSavUpdated
  1203.  
  1204.       IF ( slKillRead )
  1205.          oGet:exitState := GE_ESCAPE      // Provokes ReadModal() exit
  1206.          lValid := .T.
  1207.  
  1208.       ENDIF
  1209.    ENDIF
  1210.  
  1211.    RETURN ( lValid )
  1212.  
  1213.  
  1214.  
  1215. /***
  1216. *
  1217. *  GetDoSetKey()
  1218. *
  1219. *  Process SET KEY during editing
  1220. *
  1221. */
  1222. PROCEDURE GetDoSetKey( keyBlock, oGet )
  1223.  
  1224.    LOCAL lSavUpdated
  1225.  
  1226.    // If editing has occurred, assign variable
  1227.    IF ( oGet:changed )
  1228.       oGet:assign()
  1229.       slUpdated := .T.
  1230.    ENDIF
  1231.  
  1232.    lSavUpdated := slUpdated
  1233.  
  1234.    EVAL( keyBlock, scReadProcName, snReadProcLine, ReadVar() )
  1235.  
  1236.    ShowScoreboard()
  1237.    oGet:updateBuffer()
  1238.  
  1239.    slUpdated := lSavUpdated
  1240.  
  1241.    IF ( slKillRead )
  1242.       oGet:exitState := GE_ESCAPE      // provokes ReadModal() exit
  1243.    ENDIF
  1244.  
  1245.    RETURN
  1246.  
  1247.  
  1248.  
  1249.  
  1250.  
  1251. /***
  1252. *              READ services
  1253. */
  1254.  
  1255.  
  1256.  
  1257. /***
  1258. *
  1259. *  Settle()
  1260. *
  1261. *  Returns new position in array of Get objects, based on:
  1262. *     - current position
  1263. *     - exitState of Get object at current position
  1264. *
  1265. *  NOTES: return value of 0 indicates termination of READ
  1266. *         exitState of old Get is transferred to new Get
  1267. *
  1268. */
  1269. STATIC FUNCTION Settle( GetList, nPos, lInit )
  1270.  
  1271.    LOCAL nExitState
  1272.  
  1273.    IF ( nPos == 0 )
  1274.       nExitState := GE_DOWN
  1275.    ELSEIF ( nPos > 0 .and. lInit)
  1276.       nExitState := GE_NOEXIT
  1277.    ELSE
  1278.       nExitState := GetList[ nPos ]:exitState
  1279.    ENDIF
  1280.  
  1281.    IF ( nExitState == GE_ESCAPE .or. nExitState == GE_WRITE )
  1282.       RETURN ( 0 )               // NOTE
  1283.    ENDIF
  1284.  
  1285.    IF !( nExitState == GE_WHEN )
  1286.       // Reset state info
  1287.       snLastPos := nPos
  1288.       slBumpTop := .F.
  1289.       slBumpBot := .F.
  1290.    ELSE
  1291.       // Re-use last exitState, do not disturb state info
  1292.       nExitState := snLastExitState
  1293.    ENDIF
  1294.  
  1295.    //
  1296.    // Move
  1297.    //
  1298.    DO CASE
  1299.    CASE ( nExitState == GE_UP )
  1300.       nPos--
  1301.  
  1302.    CASE ( nExitState == GE_DOWN )
  1303.       nPos++
  1304.  
  1305.    CASE ( nExitState == GE_TOP )
  1306.       nPos       := 1
  1307.       slBumpTop  := .T.
  1308.       nExitState := GE_DOWN
  1309.  
  1310.    CASE ( nExitState == GE_BOTTOM )
  1311.       nPos       := LEN( GetList )
  1312.       slBumpBot  := .T.
  1313.       nExitState := GE_UP
  1314.  
  1315.    CASE ( nExitState == GE_ENTER )
  1316.       nPos++
  1317.  
  1318.    CASE ( nExitState == GE_SHORTCUT )
  1319.       return ( snNextGet )
  1320.  
  1321.    CASE ( nExitState == GE_MOUSEHIT )
  1322.       return ( snNextGet )
  1323.  
  1324.    ENDCASE
  1325.  
  1326.    //
  1327.    // Bounce
  1328.    //
  1329.    IF ( nPos == 0 )                       // Bumped top
  1330.       IF ( !ReadExit() .and. !slBumpBot )
  1331.          slBumpTop  := .T.
  1332.          nPos       := snLastPos
  1333.          nExitState := GE_DOWN
  1334.       ENDIF
  1335.  
  1336.    ELSEIF ( nPos == len( GetList ) + 1 )  // Bumped bottom
  1337.       IF ( !ReadExit() .and. !( nExitState == GE_ENTER ) .and. !slBumpTop )
  1338.          slBumpBot  := .T.
  1339.          nPos       := snLastPos
  1340.          nExitState := GE_UP
  1341.       ELSE
  1342.          nPos := 0
  1343.       ENDIF
  1344.    ENDIF
  1345.  
  1346.    // Record exit state
  1347.    snLastExitState := nExitState
  1348.  
  1349.    IF !( nPos == 0 )
  1350.       GetList[ nPos ]:exitState := nExitState
  1351.    ENDIF
  1352.  
  1353.    RETURN ( nPos )
  1354.  
  1355.  
  1356.  
  1357. /***
  1358. *
  1359. *  PostActiveGet()
  1360. *
  1361. *  Post active GET for ReadVar(), GetActive()
  1362. *
  1363. */
  1364. STATIC PROCEDURE PostActiveGet( oGet )
  1365.  
  1366.    GetActive( oGet )
  1367.    ReadVar( GetReadVar( oGet ) )
  1368.  
  1369.    ShowScoreBoard()
  1370.  
  1371.    RETURN
  1372.  
  1373.  
  1374.  
  1375. /***
  1376. *
  1377. *  ClearGetSysVars()
  1378. *
  1379. *  Save and clear READ state variables. Return array of saved values
  1380. *
  1381. *  NOTE: 'Updated' status is cleared but not saved (S'87 compatibility)
  1382. */
  1383. STATIC FUNCTION ClearGetSysVars()
  1384.  
  1385.    LOCAL aSavSysVars[ GSV_COUNT ]
  1386.  
  1387.    // Save current sys vars
  1388.    aSavSysVars[ GSV_KILLREAD ]     := slKillRead
  1389.    aSavSysVars[ GSV_BUMPTOP ]      := slBumpTop
  1390.    aSavSysVars[ GSV_BUMPBOT ]      := slBumpBot
  1391.    aSavSysVars[ GSV_LASTEXIT ]     := snLastExitState
  1392.    aSavSysVars[ GSV_LASTPOS ]      := snLastPos
  1393.    aSavSysVars[ GSV_ACTIVEGET ]    := GetActive( NIL )
  1394.    aSavSysVars[ GSV_READVAR ]      := ReadVar( "" )
  1395.    aSavSysVars[ GSV_READPROCNAME ] := scReadProcName
  1396.    aSavSysVars[ GSV_READPROCLINE ] := snReadProcLine
  1397.    aSavSysVars[ GSV_NEXTGET ]      := snNextGet
  1398.    aSavSysVars[ GSV_HITCODE ]      := snHitCode
  1399.    aSavSysVars[ GSV_POS ]          := snPos
  1400.  
  1401.    // Re-init old ones
  1402.    slKillRead      := .F.
  1403.    slBumpTop       := .F.
  1404.    slBumpBot       := .F.
  1405.    snLastExitState := 0
  1406.    snLastPos       := 0
  1407.    scReadProcName  := ""
  1408.    snReadProcLine  := 0
  1409.    slUpdated       := .F.
  1410.    snNextGet       := 0
  1411.    snHitCode       := 0
  1412.    snPos           := 0
  1413.  
  1414.    RETURN ( aSavSysVars )
  1415.  
  1416.  
  1417.  
  1418. /***
  1419. *
  1420. *  RestoreGetSysVars()
  1421. *
  1422. *  Restore READ state variables from array of saved values
  1423. *
  1424. *  NOTE: 'Updated' status is not restored (S'87 compatibility)
  1425. *
  1426. */
  1427. STATIC PROCEDURE RestoreGetSysVars( aSavSysVars )
  1428.  
  1429.    slKillRead      := aSavSysVars[ GSV_KILLREAD ]
  1430.    slBumpTop       := aSavSysVars[ GSV_BUMPTOP ]
  1431.    slBumpBot       := aSavSysVars[ GSV_BUMPBOT ]
  1432.    snLastExitState := aSavSysVars[ GSV_LASTEXIT ]
  1433.    snLastPos       := aSavSysVars[ GSV_LASTPOS ]
  1434.  
  1435.    snNextGet       := aSavSysVars[ GSV_NEXTGET ]
  1436.    snHitCode       := aSavSysVars[ GSV_HITCODE ]
  1437.    snPos           := aSavSysVars[ GSV_POS ]
  1438.  
  1439.    GetActive( aSavSysVars[ GSV_ACTIVEGET ] )
  1440.  
  1441.    ReadVar( aSavSysVars[ GSV_READVAR ] )
  1442.  
  1443.    scReadProcName  := aSavSysVars[ GSV_READPROCNAME ]
  1444.    snReadProcLine  := aSavSysVars[ GSV_READPROCLINE ]
  1445.  
  1446.    RETURN
  1447.  
  1448.  
  1449.  
  1450. /***
  1451. *
  1452. *  GetReadVar()
  1453. *
  1454. *  Set READVAR() value from a GET
  1455. *
  1456. */
  1457. STATIC FUNCTION GetReadVar( oGet )
  1458.  
  1459.    LOCAL cName := UPPER( oGet:name )
  1460.    LOCAL i
  1461.  
  1462.    // The following code includes subscripts in the name returned by
  1463.    // this FUNCTIONtion, if the get variable is an array element
  1464.    //
  1465.    // Subscripts are retrieved from the oGet:subscript instance variable
  1466.    //
  1467.    // NOTE: Incompatible with Summer 87
  1468.    //
  1469.    IF !( oGet:subscript == NIL )
  1470.       FOR i := 1 TO LEN( oGet:subscript )
  1471.          cName += "[" + LTRIM( STR( oGet:subscript[i] ) ) + "]"
  1472.       NEXT
  1473.    END
  1474.  
  1475.    RETURN ( cName )
  1476.  
  1477.  
  1478.  
  1479.  
  1480.  
  1481. /***
  1482. *              System Services
  1483. */
  1484.  
  1485.  
  1486.  
  1487. /***
  1488. *
  1489. *  __SetFormat()
  1490. *
  1491. *  SET FORMAT service
  1492. *
  1493. */
  1494. PROCEDURE __SetFormat( b )
  1495.    sbFormat := IF( VALTYPE( b ) == "B", b, NIL )
  1496.    RETURN
  1497.  
  1498.  
  1499.  
  1500. /***
  1501. *
  1502. *  __KillRead()
  1503. *
  1504. *  CLEAR GETS service
  1505. *
  1506. */
  1507. PROCEDURE __KillRead()
  1508.    slKillRead := .T.
  1509.    RETURN
  1510.  
  1511.  
  1512.  
  1513. /***
  1514. *
  1515. *  GetActive()
  1516. *
  1517. *  Retrieves currently active GET object
  1518. */
  1519. FUNCTION GetActive( g )
  1520.  
  1521.    LOCAL oldActive := soActiveGet
  1522.  
  1523.    IF ( PCOUNT() > 0 )
  1524.       soActiveGet := g
  1525.    ENDIF
  1526.  
  1527.    RETURN ( oldActive )
  1528.  
  1529.  
  1530.  
  1531. /***
  1532. *
  1533. *  Updated()
  1534. *
  1535. */
  1536. FUNCTION Updated()
  1537.    RETURN slUpdated
  1538.  
  1539.  
  1540.  
  1541. /***
  1542. *
  1543. *  ReadExit()
  1544. *
  1545. */
  1546. FUNCTION ReadExit( lNew )
  1547.    RETURN ( SET( _SET_EXIT, lNew ) )
  1548.  
  1549.  
  1550.  
  1551. /***
  1552. *
  1553. *  ReadInsert()
  1554. *
  1555. */
  1556. FUNCTION ReadInsert( lNew )
  1557.    RETURN ( SET( _SET_INSERT, lNew ) )
  1558.  
  1559.  
  1560.  
  1561. /***
  1562. *              Wacky Compatibility Services
  1563. */
  1564.  
  1565.  
  1566. // Display coordinates for SCOREBOARD
  1567. #define SCORE_ROW      0
  1568. #define SCORE_COL      60
  1569.  
  1570.  
  1571. /***
  1572. *
  1573. *  ShowScoreboard()
  1574. *
  1575. */
  1576. STATIC PROCEDURE ShowScoreboard()
  1577.  
  1578.    LOCAL nRow
  1579.    LOCAL nCol
  1580.  
  1581.    IF ( SET( _SET_SCOREBOARD ) )
  1582.       nRow := ROW()
  1583.       nCol := COL()
  1584.  
  1585.       SETPOS( SCORE_ROW, SCORE_COL )
  1586.       DISPOUT( IF( SET( _SET_INSERT ), NationMsg(_GET_INSERT_ON),;
  1587.                                        NationMsg(_GET_INSERT_OFF)) )
  1588.  
  1589.       SETPOS( nRow, nCol )
  1590.    ENDIF
  1591.  
  1592.    RETURN
  1593.  
  1594.  
  1595.  
  1596. /***
  1597. *
  1598. *  DateMsg()
  1599. *
  1600. */
  1601. STATIC PROCEDURE DateMsg()
  1602.  
  1603.    LOCAL nRow
  1604.    LOCAL nCol
  1605.  
  1606.    IF ( SET( _SET_SCOREBOARD ) )
  1607.  
  1608.       nRow := ROW()
  1609.       nCol := COL()
  1610.  
  1611.       SETPOS( SCORE_ROW, SCORE_COL )
  1612.       DISPOUT( NationMsg(_GET_INVD_DATE) )
  1613.       SETPOS( nRow, nCol )
  1614.  
  1615.       WHILE ( NEXTKEY() == 0 )
  1616.       END
  1617.  
  1618.       SETPOS( SCORE_ROW, SCORE_COL )
  1619.       DISPOUT( LEN( NationMsg(_GET_INVD_DATE) ) )
  1620.       SETPOS( nRow, nCol )
  1621.  
  1622.    ENDIF
  1623.  
  1624.    RETURN
  1625.  
  1626.  
  1627.  
  1628. /***
  1629. *
  1630. *  RangeCheck()
  1631. *
  1632. *  NOTE: Unused second param for 5.00 compatibility.
  1633. *
  1634. */
  1635. FUNCTION RangeCheck( oGet, junk, lo, hi )
  1636.  
  1637.    LOCAL cMsg, nRow, nCol
  1638.    LOCAL xValue
  1639.  
  1640.    IF ( !oGet:changed )
  1641.       RETURN ( .T. )          // NOTE
  1642.    ENDIF
  1643.  
  1644.    xValue := oGet:varGet()
  1645.  
  1646.    IF ( xValue >= lo .and. xValue <= hi )
  1647.       RETURN ( .T. )          // NOTE
  1648.    ENDIF
  1649.  
  1650.    IF ( SET(_SET_SCOREBOARD) )
  1651.  
  1652.       cMsg := NationMsg(_GET_RANGE_FROM) + LTRIM( TRANSFORM( lo, "" ) ) + ;
  1653.               NationMsg(_GET_RANGE_TO) + LTRIM( TRANSFORM( hi, "" ) )
  1654.  
  1655.       IF ( LEN( cMsg ) > MAXCOL() )
  1656.          cMsg := SUBSTR( cMsg, 1, MAXCOL() )
  1657.       ENDIF
  1658.  
  1659.       nRow := ROW()
  1660.       nCol := COL()
  1661.  
  1662.       SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
  1663.       DISPOUT( cMsg )
  1664.       SETPOS( nRow, nCol )
  1665.  
  1666.       WHILE ( NEXTKEY() == 0 )
  1667.       END
  1668.  
  1669.       SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
  1670.       DISPOUT( SPACE( LEN( cMsg ) ) )
  1671.       SETPOS( nRow, nCol )
  1672.  
  1673.    ENDIF
  1674.  
  1675.    RETURN ( .F. )
  1676.  
  1677.  
  1678.  
  1679. /***
  1680. *
  1681. *  ReadKill()
  1682. *
  1683. */
  1684. FUNCTION ReadKill( lKill )
  1685.  
  1686.    LOCAL lSavKill := slKillRead
  1687.  
  1688.    IF ( PCOUNT() > 0 )
  1689.       slKillRead := lKill
  1690.    ENDIF
  1691.  
  1692.    RETURN ( lSavKill )
  1693.  
  1694.  
  1695.  
  1696. /***
  1697. *
  1698. *  ReadUpdated()
  1699. *
  1700. */
  1701. FUNCTION ReadUpdated( lUpdated )
  1702.  
  1703.    LOCAL lSavUpdated := slUpdated
  1704.  
  1705.    IF ( PCOUNT() > 0 )
  1706.       slUpdated := lUpdated
  1707.    ENDIF
  1708.  
  1709.    RETURN ( lSavUpdated )
  1710.  
  1711.  
  1712.  
  1713. /***
  1714. *
  1715. *  ReadFormat()
  1716. *
  1717. */
  1718. FUNCTION ReadFormat( b )
  1719.  
  1720.    LOCAL bSavFormat := sbFormat
  1721.  
  1722.    IF ( PCOUNT() > 0 )
  1723.       sbFormat := b
  1724.    ENDIF
  1725.  
  1726.    RETURN ( bSavFormat )
  1727.  
  1728.  
  1729.  
  1730.  
  1731.