70140e5aed
* contrib/hbct/tests/ctwtest.prg
* contrib/hbcups/tests/test.prg
* contrib/hbfbird/tests/stress.prg
* contrib/hbnf/aredit.prg
* contrib/hbnf/doc/en/aredit.txt
* contrib/hbnf/menu1.prg
* contrib/hbnf/popadder.prg
* contrib/hbnf/tbwhile.prg
* contrib/hbpgsql/tests/async.prg
* contrib/hbpgsql/tests/cache.prg
* contrib/hbpgsql/tests/stress.prg
* contrib/hbpgsql/tests/test.prg
* contrib/hbtip/tests/tiptest.prg
* contrib/xhb/tests/compress.prg
* doc/en/sayget.txt
* src/rtl/profiler.prg
* tests/ac_test.prg
* tests/boxtst2.prg
* tests/fortest.prg
* tests/menutest.prg
* tests/mt/mttest11.prg
* tests/parseini.prg
* tests/speedold.prg
* tests/tstchbx.prg
* tests/usrrdd/exarr.prg
* tests/videotst.prg
* tests/vidtest.prg
* formatting
! deleted SetMode()s
* CLEAR SCREEN -> CLS
* other minor cleanups
1756 lines
81 KiB
Plaintext
1756 lines
81 KiB
Plaintext
/*
|
||
* $Id$
|
||
*/
|
||
|
||
/*
|
||
* File......: popadder.prg
|
||
* Author....: Keith A. Wire
|
||
* CIS ID....: 73760,2427
|
||
*
|
||
* This is an original work by Keith A. Wire and is placed in the
|
||
* public domain.
|
||
*
|
||
* Modification history:
|
||
* ---------------------
|
||
*
|
||
* Rev 1.4 03 Mar 1994 19:47:22 GLENN
|
||
* Author made some enhancements and modifications.
|
||
*
|
||
* Rev 1.3 19 Jan 1993 19:52:52 GLENN
|
||
* Removed reference to K_SPACE, as this has been defined in Clipper
|
||
* 5.2's inkey.ch.
|
||
*
|
||
* Rev 1.2 17 Aug 1991 15:44:30 GLENN
|
||
* Don Caton fixed some spelling errors in the doc
|
||
*
|
||
* Rev 1.1 15 Aug 1991 23:04:12 GLENN
|
||
* Forest Belt proofread/edited/cleaned up doc
|
||
*
|
||
* Rev 1.0 14 Jun 1991 17:37:54 GLENN
|
||
* Initial revision.
|
||
*
|
||
*/
|
||
|
||
#include "inkey.ch"
|
||
#include "setcurs.ch"
|
||
#include "achoice.ch"
|
||
|
||
// Set up manifest constants to access the window colors in the array aWinColor
|
||
#define W_BORDER 1
|
||
#define W_ACCENT 2
|
||
#define W_PROMPT 3
|
||
#define W_SCREEN 4
|
||
#define W_TITLE 5
|
||
#define W_VARIAB 6
|
||
#define W_CURR NIL
|
||
|
||
// Set up manifest constants to access the Standard screen colors in the array
|
||
// aStdColor
|
||
#define STD_ACCENT 1
|
||
#define STD_ERROR 2
|
||
#define STD_PROMPT 3
|
||
#define STD_SCREEN 4
|
||
#define STD_TITLE 5
|
||
#define STD_VARIABLE 6
|
||
#define STD_BORDER 7
|
||
|
||
#define K_DECIM 46
|
||
#define K_EQUAL 13
|
||
#define K_PLUS 43
|
||
#define K_MINUS 45
|
||
#define K_MULTIPLY 42
|
||
#define K_DIVIDE 47
|
||
#define K_ZERO 48
|
||
#define B_DOUBLE "╔═╗║╝═╚║ "
|
||
#define B_SINGLE "+-+|+-+| "
|
||
|
||
#define CRLF CHR(13)+CHR(10)
|
||
#define nTotTran LEN(aTrans)
|
||
|
||
#command DEFAULT <p> TO <val> [,<pn> TO <valn>] => ;
|
||
<p> := iif(<p> == NIL, <val>, <p>) ;
|
||
[;<pn> := iif(<pn> == NIL, <valn>, <pn>)]
|
||
|
||
#command DISPMESSAGE <mess>,<t>,<l>,<b>,<r> => ;
|
||
_ftPushKeys(); KEYBOARD CHR(K_CTRL_PGDN)+CHR(K_CTRL_W) ;;
|
||
MEMOEDIT(<mess>,<t>,<l>,<b>,<r>, .F., NIL, (<r>)-(<l>)+1) ;;
|
||
_ftPopKeys()
|
||
|
||
#define ASHRINK(ar) ASIZE(ar,LEN(ar)-1)
|
||
|
||
/* This INKEY UDC was posted by Don Caton on NanForum... Thanks Don <g> */
|
||
#command FT_INKEY [ <secs> ] TO <var> ;
|
||
=> ;
|
||
WHILE (.T.) ;;
|
||
<var> := Inkey([ <secs> ]) ;;
|
||
IF Setkey(<var>) # NIL ;;
|
||
Eval( Setkey(<var>), ProcName(), ProcLine(), #<var> ) ;;
|
||
ELSE ;;
|
||
EXIT ;;
|
||
END ;;
|
||
END
|
||
|
||
// Instead of using STATIC variables for these I'm using a LOCAL array
|
||
// and passing aAdder[] all over the place.... Don't let this confuse
|
||
// you. I wrote the Adder using the variable names & now let the
|
||
// PreProcessor do all the work.
|
||
#define nTotal aAdder[1]
|
||
#define nNumTotal aAdder[2]
|
||
#define nSavTotal aAdder[3]
|
||
#define cTotPict aAdder[4]
|
||
#define lClAdder aAdder[5]
|
||
#define lDecSet aAdder[6]
|
||
#define nDecDigit aAdder[7]
|
||
#define nMaxDeci aAdder[8]
|
||
#define lMultDiv aAdder[9]
|
||
#define nAddMode aAdder[10]
|
||
#define lSubRtn aAdder[11]
|
||
#define lTotalOk aAdder[12]
|
||
#define lAddError aAdder[13]
|
||
#define lTape aAdder[14]
|
||
#define lNewNum aAdder[15]
|
||
#define nSavSubTot aAdder[16]
|
||
#define lDivError aAdder[17]
|
||
#define aTrans aAdder[18]
|
||
#define nTopOS aAdder[19]
|
||
#define nLeftOS aAdder[20]
|
||
#define nAddSpace aAdder[21]
|
||
#define nTapeSpace aAdder[22]
|
||
#define cTapeScr aAdder[23]
|
||
|
||
// I still use a few of STATICS, but most are set to NIL when quiting...
|
||
THREAD STATIC lAdderOpen := .F., ;
|
||
aKeys, aWindow, nWinColor, aWinColor, aStdColor
|
||
|
||
#ifdef FT_TEST
|
||
|
||
FUNCTION TEST
|
||
|
||
LOCAL nSickHrs := 0, ;
|
||
nPersHrs := 0, ;
|
||
nVacaHrs := 0, ;
|
||
GetList := {}
|
||
|
||
SET SCOREBOARD OFF
|
||
_ftSetScrColor(STD_SCREEN,STD_VARIABLE)
|
||
CLS
|
||
|
||
SET KEY K_ALT_A TO FT_Adder // Make <ALT-A> call FT_Adder
|
||
|
||
* SIMPLE Sample of program data entry!
|
||
|
||
@ 12,5 SAY "Please enter the total Sick, Personal, and Vacation hours."
|
||
@ 15,22 SAY "Sick hrs."
|
||
@ 15,40 SAY "Pers. hrs."
|
||
@ 15,60 SAY "Vaca. hrs."
|
||
@ 23,20 SAY "Press <ALT-A> to Pop - Up the Adder."
|
||
@ 24,20 SAY "Press <ESC> to Quit the adder Demo."
|
||
DO WHILE .T. // Get the sick, personal, & vaca
|
||
@ 16,24 GET nSickHrs PICTURE "9999.999" // Normally I have a VALID()
|
||
@ 16,43 GET nPersHrs PICTURE "9999.999" // to make sure the value is
|
||
@ 16,63 GET nVacaHrs PICTURE "9999.999" // within the allowable range.
|
||
SET CURSOR ON // But, like I said it is a
|
||
CLEAR TYPEAHEAD // SIMPLE example <g>.
|
||
READ
|
||
SET CURSOR OFF
|
||
IF LASTKEY() == K_ESC // <ESC> - ABORT
|
||
CLEAR TYPEAHEAD
|
||
EXIT
|
||
ENDIF
|
||
ENDDO
|
||
SET CURSOR ON
|
||
|
||
SET KEY K_ALT_A // Reset <ALT-A>
|
||
|
||
RETURN NIL
|
||
#endif
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: FT_Adder() Docs: Keith A. Wire |
|
||
| Description: Pop Up Adder / Calculator with Tape Display |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 11:18:40am Time updated: 11:18:40am |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
| Notes: To make FT_Adder() pop up from any wait state in your |
|
||
| : application just insert the line: |
|
||
| : SET KEY K_ALT_A TO FT_Adder |
|
||
| : at the top of your application |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
FUNCTION FT_Adder()
|
||
|
||
LOCAL nOldDecim, cMoveTotSubTot, cTotal, lDone, nKey, ;
|
||
oGet := GetActive(), ;
|
||
nOldCurs := SETCURSOR(SC_NONE), ;
|
||
nOldRow := ROW(), ;
|
||
nOldCol := COL(), ;
|
||
bOldF10 := SETKEY(K_F10, NIL), ;
|
||
nOldLastKey := LASTKEY(), ;
|
||
lShowRight := .T., ;
|
||
aAdder := ARRAY(23)
|
||
|
||
// Must prevent recursive calls
|
||
IF lAdderOpen
|
||
RETURN NIL
|
||
ELSE
|
||
lAdderOpen := .T.
|
||
ENDIF
|
||
|
||
aTrans := {" 0.00 C "}
|
||
nOldDecim := SET(_SET_DECIMALS,9)
|
||
cTotPict := "999999999999999.99"
|
||
cTapeScr := ""
|
||
nTotal := nNumTotal := nSavTotal := nDecDigit := 0
|
||
lDone := .F. // Loop flag
|
||
nKey := 0
|
||
nMaxDeci := 2 // Initial # of decimals
|
||
nSavSubTot := 0
|
||
lNewNum := .F.
|
||
nAddMode := 1 // Start in ADD mode
|
||
lMultDiv := .F. // Start in ADD mode
|
||
lClAdder := .F. // Clear adder flag
|
||
lDecSet := .F. // Decimal ? - keyboard routine
|
||
lSubRtn := lTotalOk := lTape := lAddError := lDivError := .F.
|
||
|
||
nTopOS := INT((MAXROW()-24)/2) // Using the TopOffSet & LeftOffSet
|
||
nLeftOS := INT((MAXCOL()-79)/2) // the Adder will always be centered
|
||
nAddSpace := iif(lShowRight,40,0)+nLeftOS
|
||
nTapeSpace := iif(lShowRight,0,40)+nLeftOS
|
||
|
||
// Set Up the STATIC variables
|
||
aKeys := {}
|
||
aWindow := {}
|
||
nWinColor := 0
|
||
|
||
_ftAddScreen(aAdder)
|
||
|
||
// Set the decimals to 2 & display a cleared adder
|
||
_ftChangeDec(aAdder, 2)
|
||
@ 4+nTopOS, 7+nAddSpace SAY nTotal PICTURE cTotPict
|
||
|
||
DO WHILE ! lDone // Input key & test loop
|
||
FT_INKEY 0 TO nKey
|
||
DO CASE
|
||
CASE UPPER(CHR(nKey)) $"1234567890."
|
||
_ftProcessNumb(aAdder, nKey)
|
||
CASE nKey == K_PLUS // <+> sign
|
||
_ftAddSub(aAdder, nKey)
|
||
CASE nKey == K_MINUS // <-> sign
|
||
_ftAddSub(aAdder, nKey)
|
||
CASE nKey == K_MULTIPLY // <*> sign
|
||
_ftMultDiv(aAdder, nKey)
|
||
CASE nKey == K_DIVIDE // </> sign
|
||
_ftMultDiv(aAdder, nKey)
|
||
CASE nKey == K_RETURN // <RTN> Total or Subtotal
|
||
_ftAddTotal(aAdder)
|
||
CASE nKey == K_ESC // <ESC> Quit
|
||
SET(_SET_DECIMALS,nOldDecim)
|
||
SETCURSOR(nOldCurs)
|
||
IF lTape
|
||
RESTSCREEN(4+nTopOS,6+nTapeSpace,22+nTopOS,35+nTapeSpace,cTapeScr)
|
||
ENDIF
|
||
_ftPopWin()
|
||
SETPOS(nOldRow,nOldCol)
|
||
_ftSetLastKey(nOldLastKey)
|
||
SETKEY(K_F10, bOldF10)
|
||
lAdderOpen := .F. // Reset the recursive flag
|
||
lDone := .T.
|
||
CASE nKey == 68 .OR. nKey == 100 // <D> Change number of decimal places
|
||
_ftChangeDec(aAdder)
|
||
CASE nKey == 84 .OR. nKey == 116 // <T> Display Tape
|
||
_ftDisplayTape(aAdder, nKey)
|
||
CASE nKey == 77 .OR. nKey == 109 // <M> Move Adder
|
||
IF lTape
|
||
RESTSCREEN(4+nTopOS,6+nTapeSpace,22+nTopOS,35+nTapeSpace,cTapeScr)
|
||
ENDIF
|
||
IF LEFT(SAVESCREEN(6+nTopOS,26+nAddSpace,6+nTopOS,27+nAddSpace),1) ;
|
||
!= " "
|
||
IF LEFT(SAVESCREEN(6+nTopOS,19+nAddSpace,6+nTopOS,20+nAddSpace),1) ;
|
||
== "S"
|
||
cMoveTotSubTot := "S"
|
||
ELSE
|
||
cMoveTotSubTot := "T"
|
||
ENDIF
|
||
ELSE
|
||
cMoveTotSubTot := " "
|
||
ENDIF
|
||
cTotal := _ftCharOdd(SAVESCREEN( 4 + nTopOS, 8 + nAddSpace, 4 + ;
|
||
nTopOS,25+nAddSpace))
|
||
_ftPopWin() // Remove Adder
|
||
lShowRight := !lShowRight
|
||
nAddSpace := iif(lShowRight,40,0)+nLeftOS
|
||
nTapeSpace := iif(lShowRight,0,40)+nLeftOS
|
||
_ftAddScreen(aAdder)
|
||
_ftDispTotal(aAdder)
|
||
IF lTape
|
||
lTape := .F.
|
||
_ftDisplayTape(aAdder, nKey)
|
||
ENDIF
|
||
@ 4+nTopOS, 8+nAddSpace SAY cTotal
|
||
IF !EMPTY(cMoveTotSubTot)
|
||
_ftSetWinColor(W_CURR,W_SCREEN)
|
||
@ 6+nTopOS,18+nAddSpace SAY iif(cMoveTotSubTot=="T", " <TOTAL>", ;
|
||
"<SUBTOTAL>")
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
ENDIF
|
||
CASE (nKey == 83 .OR. nKey == 115) .AND. lTape // <S> Scroll tape display
|
||
IF nTotTran>16 // We need to scroll
|
||
SETCOLOR("GR+/W")
|
||
@ 21+nTopOS,8+nTapeSpace SAY " "+CHR(24)+CHR(25)+"-SCROLL <ESC>-QUIT "
|
||
SETCOLOR("N/W,W+/N")
|
||
ACHOICE(5+nTopOS,7+nTapeSpace,20+nTopOS,32+nTapeSpace,aTrans,.T., ;
|
||
"_ftAdderTapeUDF",nTotTran,20)
|
||
SETCOLOR("R+/W")
|
||
@ 21+nTopOS,8+nTapeSpace TO 21+nTopOS,30+nTapeSpace
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
CLEAR TYPEAHEAD
|
||
ELSE
|
||
_ftError("there are " + iif(nTotTran > 0, "only " + ;
|
||
LTRIM(STR(nTotTran, 3, 0)), "no") + ;
|
||
" transactions entered so far." + ;
|
||
" No need to scroll!")
|
||
ENDIF
|
||
CASE nKey == 7 // Delete - Clear adder
|
||
_ftClearAdder(aAdder)
|
||
CASE nKey == K_F1 // <F1> Help
|
||
_ftAddHelp()
|
||
CASE nKey == K_F10 // <F10> Quit - Return total
|
||
IF lTotalOk // Did they finish the calculation
|
||
IF oGet != NIL .AND. oGet:TYPE == "N"
|
||
SET(_SET_DECIMALS,nOldDecim)
|
||
SETCURSOR(nOldCurs)
|
||
IF lTape
|
||
RESTSCREEN(4+nTopOS,6+nTapeSpace,22+nTopOS,35+nTapeSpace,cTapeScr)
|
||
ENDIF
|
||
_ftPopWin()
|
||
SETPOS(nOldRow,nOldCol)
|
||
_ftSetLastKey(nOldLastKey)
|
||
SETKEY(K_F10, bOldF10)
|
||
oGet:VARPUT(nSavTotal)
|
||
lAdderOpen := .F. // Reset the recursive flag
|
||
lDone := .T.
|
||
ELSE
|
||
_ftError("but I can not return the total from the "+ ;
|
||
"adder to this variable. You must quit the adder using"+ ;
|
||
" the <ESC> key and then enter the total manually.")
|
||
ENDIF
|
||
ELSE
|
||
_ftError("the calculation is not finished yet! You must have"+ ;
|
||
" a TOTAL before you can return it to the program.")
|
||
ENDIF
|
||
ENDCASE
|
||
ENDDO (WHILE .T. Data entry from keyboard)
|
||
|
||
// Reset the STATICS to NIL
|
||
aKeys := aWindow := aWinColor := aStdColor := NIL
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftAddScreen() Docs: Keith A. Wire |
|
||
| Description: Display the Adder |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 11:24:29am Time updated: 11:24:29am |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftAddScreen(aAdder)
|
||
LOCAL nCol
|
||
_ftPushWin(2+nTopOS,2+nAddSpace,22+nTopOS,30+nAddSpace," Adder ", ;
|
||
"<F-1> for Help",,B_DOUBLE)
|
||
nCol := 5+nAddSpace
|
||
@ 7+nTopOS, nCol SAY hb_UTF8ToStr( ' ┌───┐ ┌───┐ ┌───┐' )
|
||
@ 8+nTopOS, nCol SAY hb_UTF8ToStr( ' │ │ │ │ │ │' )
|
||
@ 9+nTopOS, nCol SAY hb_UTF8ToStr( ' └───┘ └───┘ └───┘' )
|
||
@ 10+nTopOS, nCol SAY hb_UTF8ToStr( '┌───┐ ┌───┐ ┌───┐ ┌───┐' )
|
||
@ 11+nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │ │ │' )
|
||
@ 12+nTopOS, nCol SAY hb_UTF8ToStr( '└───┘ └───┘ └───┘ │ │' )
|
||
@ 13+nTopOS, nCol SAY hb_UTF8ToStr( '┌───┐ ┌───┐ ┌───┐ │ │' )
|
||
@ 14+nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │ │ │' )
|
||
@ 15+nTopOS, nCol SAY hb_UTF8ToStr( '└───┘ └───┘ └───┘ └───┘' )
|
||
@ 16+nTopOS, nCol SAY hb_UTF8ToStr( '┌───┐ ┌───┐ ┌───┐ ┌───┐' )
|
||
@ 17+nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │ │ │' )
|
||
@ 18+nTopOS, nCol SAY hb_UTF8ToStr( '└───┘ └───┘ └───┘ │ │' )
|
||
@ 19+nTopOS, nCol SAY hb_UTF8ToStr( '┌─────────┐ ┌───┐ │ │' )
|
||
@ 20+nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │' )
|
||
@ 21+nTopOS, nCol SAY hb_UTF8ToStr( '└─────────┘ └───┘ └───┘' )
|
||
_ftSetWinColor(W_CURR,W_TITLE)
|
||
nCol := 7+nAddSpace
|
||
@ 11+nTopOS, nCol SAY "7"
|
||
@ 14+nTopOS, nCol SAY "4"
|
||
@ 17+nTopOS, nCol SAY "1"
|
||
nCol := 13+nAddSpace
|
||
@ 8+nTopOS,nCol SAY "/"
|
||
@ 11+nTopOS,nCol SAY "8"
|
||
@ 14+nTopOS,nCol SAY "5"
|
||
@ 17+nTopOS,nCol SAY "2"
|
||
nCol := 19+nAddSpace
|
||
@ 8+nTopOS,nCol SAY "X"
|
||
@ 11+nTopOS,nCol SAY "9"
|
||
@ 14+nTopOS,nCol SAY "6"
|
||
@ 17+nTopOS,nCol SAY "3"
|
||
@ 20+nTopOS,nCol SAY "."
|
||
@ 20+nTopOS,10+nAddSpace SAY "0"
|
||
nCol := 25+nAddSpace
|
||
@ 8+nTopOS,nCol SAY "-"
|
||
@ 13+nTopOS,nCol SAY "+"
|
||
@ 18+nTopOS,nCol SAY "="
|
||
@ 19+nTopOS,nCol SAY ""
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
@ 3+nTopOS, 6+nAddSpace, 5+nTopOS, 27+nAddSpace BOX B_DOUBLE
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftChangeDec() Docs: Keith A. Wire |
|
||
| Description: Change the decimal position in the display |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 11:25:17am Time updated: 11:25:17am |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : nNumDec |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftChangeDec(aAdder, nNumDec)
|
||
|
||
LOCAL cDefTotPict := "9999999999999999999"
|
||
|
||
IF nNumDec == NIL
|
||
nNumDec := 0
|
||
|
||
nNumDec := _ftQuest("How many decimals do you want to display?", ;
|
||
nNumDec, "9", {|oGet| _ftValDeci(oGet)})
|
||
|
||
cTotPict := _ftPosRepl(cDefTotPict, ".", 19 - ABS(nNumDec))
|
||
|
||
cTotPict := RIGHT(_ftStuffComma(cTotPict), 19 )
|
||
cTotPict := iif(nNumDec==2 .OR. nNumDec==6, " "+RIGHT(cTotPict,18),cTotPict)
|
||
|
||
nMaxDeci := nNumDec
|
||
|
||
IF lSubRtn
|
||
_ftDispTotal(aAdder)
|
||
ELSE
|
||
_ftDispSubTot(aAdder)
|
||
ENDIF
|
||
|
||
ENDIF
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftDispTotal() Docs: Keith A. Wire |
|
||
| Description: Display total number to Adder Window |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 11:25:58am Time updated: 11:25:58am |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftDispTotal(aAdder)
|
||
|
||
LOCAL cTotStr
|
||
|
||
IF nTotal>VAL(_ftCharRem(",",cTotPict))
|
||
cTotStr := _ftStuffComma(LTRIM(STR(nTotal)))
|
||
@ 4+nTopOS, 8+nAddSpace SAY "**** ERROR **** "
|
||
_ftError("that number is to big to display! I believe the answer was " + ;
|
||
cTotStr+".")
|
||
lAddError := .T.
|
||
_ftUpdateTrans(aAdder, .T., NIL)
|
||
_ftClearAdder(aAdder)
|
||
nTotal := 0
|
||
nNumTotal := 0
|
||
lAddError := .F.
|
||
ELSE
|
||
@ 4+nTopOS, 7+nAddSpace SAY nTotal PICTURE cTotPict
|
||
ENDIF
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftDispSubTot() Docs: Keith A. Wire |
|
||
| Description: Display subtotal number |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 11:26:31am Time updated: 11:26:31am |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftDispSubTot(aAdder)
|
||
|
||
LOCAL cStotStr
|
||
|
||
IF nNumTotal>VAL(_ftCharRem(",",cTotPict))
|
||
cStotStr := _ftStuffComma(LTRIM(STR(nNumTotal)))
|
||
@ 4+nTopOS, 8+nAddSpace SAY "**** ERROR **** "
|
||
_ftError("that number is to big to display! I believe the answer was " + ;
|
||
cStotStr+".")
|
||
lAddError := .T.
|
||
_ftUpdateTrans(aAdder, .T.,nNumTotal)
|
||
_ftClearAdder(aAdder)
|
||
nTotal := 0
|
||
nNumTotal := 0
|
||
lAddError := .F.
|
||
ELSE
|
||
@ 4+nTopOS, 7+nAddSpace SAY nNumTotal PICTURE cTotPict
|
||
ENDIF
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftProcessNumb() Docs: Keith A. Wire |
|
||
| Description: Act on NUMBER key pressed |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 11:38:34am Time updated: 11:38:34am |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : nKey |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftProcessNumb(aAdder, nKey)
|
||
LOCAL nNum
|
||
_ftEraseTotSubTot(aAdder)
|
||
lTotalOk := .F.
|
||
lClAdder := .F. // Reset the Clear flag
|
||
lAddError := .F. // Reset adder error flag
|
||
|
||
IF nKey == Asc( "." ) // Period (.) decimal point
|
||
IF lDecSet // Has decimal already been set
|
||
TONE(800, 1)
|
||
ELSE
|
||
lDecSet := .T.
|
||
ENDIF
|
||
ELSE // It must be a number input
|
||
lNewNum := .T.
|
||
nNum := nKey-48
|
||
IF lDecSet // Decimal set
|
||
IF nDecDigit<nMaxDeci // Check how many decimals are allowed
|
||
nDecDigit := ++nDecDigit
|
||
nNumTotal := nNumTotal+nNum/(10**nDecDigit)
|
||
ENDIF
|
||
ELSE
|
||
nNumTotal := nNumTotal*10+nNum
|
||
ENDIF
|
||
ENDIF
|
||
|
||
_ftDispSubTot(aAdder)
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftAddTotal() Docs: Keith A. Wire |
|
||
| Description: Enter key - SUBTOTAL\TOTAL |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:05:29pm Time updated: 12:05:29pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftAddTotal(aAdder)
|
||
_ftEraseTotSubTot(aAdder)
|
||
lDecSet := .F.
|
||
nDecDigit := 0
|
||
lClAdder := .F. // Reset the Clear flag
|
||
IF lSubRtn // If this was the second time they
|
||
IF !lMultDiv
|
||
_ftSetWinColor(W_CURR,W_SCREEN)
|
||
@ 6+nTopOS, 18+nAddSpace SAY " <TOTAL>"
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
_ftUpdateTrans(aAdder, .T., NIL)
|
||
_ftDispTotal(aAdder)
|
||
lSubRtn := .F. // pressed the total key reset everyting
|
||
nSavTotal := nTotal
|
||
nTotal := 0
|
||
lTotalOk := .T.
|
||
ENDIF
|
||
ELSE // This was the first time they pressed
|
||
IF !lMultDiv .AND. LASTKEY() == K_RETURN // total key
|
||
lSubRtn := .T.
|
||
ENDIF
|
||
IF _ftRoundIt(nTotal,nMaxDeci)!=0 .OR. _ftRoundIt(nNumTotal,nMaxDeci)!=0
|
||
IF !lMultDiv
|
||
_ftSetWinColor(W_CURR,W_SCREEN)
|
||
@ 6+nTopOS, 18+nAddSpace SAY "<SUBTOTAL>"
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
ENDIF
|
||
IF _ftRoundIt(nNumTotal,nMaxDeci)!=0
|
||
lSubRtn := .F.
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
ENDIF
|
||
IF !lMultDiv
|
||
lSubRtn := .T. // total key
|
||
ENDIF
|
||
IF nAddMode == 1 // Add
|
||
nTotal := nTotal+nNumTotal
|
||
ELSEIF nAddMode == 2 // Subtract
|
||
nTotal := nTotal-nNumTotal
|
||
ELSEIF nAddMode == 3 // Multiply
|
||
nTotal := nTotal*nNumTotal
|
||
ELSEIF nAddMode == 4 // Divide
|
||
nTotal := _ftDivide(aAdder, nTotal,nNumTotal)
|
||
IF lDivError
|
||
_ftError("you can't divide by ZERO!")
|
||
lDivError := .F.
|
||
ENDIF
|
||
ENDIF
|
||
ENDIF
|
||
_ftDispTotal(aAdder)
|
||
IF lMultDiv // This was a multiply or divide
|
||
_ftSetWinColor(W_CURR,W_SCREEN)
|
||
@ 6+nTopOS, 18+nAddSpace SAY " <TOTAL>"
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
lSubRtn := .F. // pressed total so key reset everything
|
||
IF !lTotalOk // If you haven't printed total DO-IT
|
||
lTotalOk := .T.
|
||
_ftUpdateTrans(aAdder, .F., NIL)
|
||
ENDIF
|
||
nNumTotal := 0
|
||
nSavTotal := nTotal
|
||
nTotal := 0
|
||
ELSE
|
||
IF !lTotalOk // If you haven't printed total DO-IT
|
||
_ftUpdateTrans(aAdder, .F., NIL)
|
||
nNumTotal := 0
|
||
ENDIF
|
||
ENDIF
|
||
ENDIF
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftAddSub() Docs: Keith A. Wire |
|
||
| Description: Process + or - keypress |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:06:13pm Time updated: 12:06:13pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : nKey |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftAddSub(aAdder, nKey)
|
||
|
||
lMultDiv := .F.
|
||
_ftEraseTotSubTot(aAdder)
|
||
lTotalOk := .F.
|
||
lDecSet := .F.
|
||
nDecDigit := 0
|
||
lSubRtn := .F.
|
||
// They pressed the + or - key to process the previous total
|
||
IF _ftRoundIt(nNumTotal,nMaxDeci)==0 .AND. _ftRoundIt(nTotal,nMaxDeci)==0
|
||
nNumTotal := nSavTotal
|
||
lNewNum := .T.
|
||
ENDIF
|
||
IF nKey == K_PLUS // Add
|
||
nAddMode := 1
|
||
IF !lNewNum // They pressed + again to add the same
|
||
nNumTotal := nSavSubTot // number without re-entering
|
||
ENDIF
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
nTotal := nTotal+nNumTotal
|
||
lNewNum := .F.
|
||
nSavSubTot := nNumTotal // Save this number in case they just press + or -
|
||
nNumTotal := 0
|
||
ELSEIF nKey == K_MINUS // Subtract
|
||
nAddMode := 2
|
||
IF !lNewNum // They pressed + again to add the same
|
||
nNumTotal := nSavSubTot // number without re-entering
|
||
lNewNum := .T.
|
||
ENDIF
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
nTotal := nTotal-nNumTotal
|
||
lNewNum := .F.
|
||
nSavSubTot := nNumTotal // Save this number in case they just press + or -
|
||
nNumTotal := 0
|
||
ENDIF
|
||
|
||
_ftDispTotal(aAdder)
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftMultDiv() Docs: Keith A. Wire |
|
||
| Description: Process * or / keypress |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:06:43pm Time updated: 12:06:43pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : nKey |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftMultDiv(aAdder, nKey)
|
||
|
||
lMultDiv := .T.
|
||
_ftEraseTotSubTot(aAdder)
|
||
lTotalOk := .F.
|
||
lDecSet := .F.
|
||
nDecDigit := 0
|
||
lSubRtn := .F.
|
||
// They pressed the + or - key to process the previous total
|
||
IF _ftRoundIt(nNumTotal,nMaxDeci)==0 .AND. _ftRoundIt(nTotal,nMaxDeci)==0
|
||
nNumTotal := nSavTotal
|
||
ENDIF
|
||
// Get the first number of the product or division
|
||
IF _ftRoundIt(nTotal,nMaxDeci)==0
|
||
IF nKey == K_MULTIPLY // Setup mode
|
||
nAddMode := 3
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
ELSEIF nKey == K_DIVIDE
|
||
nAddMode := 4
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
ENDIF
|
||
nTotal := nNumTotal
|
||
nNumTotal := 0
|
||
ELSE
|
||
IF nKey == K_MULTIPLY // Multiply
|
||
nAddMode := 3
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
nTotal := nTotal*nNumTotal
|
||
nNumTotal := 0
|
||
ELSEIF nKey == K_MULTIPLY // Divide
|
||
nAddMode := 4
|
||
_ftUpdateTrans(aAdder, .F.,nNumTotal)
|
||
nTotal:=_ftDivide(aAdder, nTotal,nNumTotal)
|
||
IF lDivError
|
||
_ftError("you can't divide by ZERO!")
|
||
lDivError := .F.
|
||
ENDIF
|
||
nNumTotal := 0
|
||
ENDIF
|
||
ENDIF
|
||
|
||
_ftDispTotal(aAdder)
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftAddHelp Docs: Keith A. Wire |
|
||
| Description: Help window |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:07:07pm Time updated: 12:07:07pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftAddHelp
|
||
|
||
LOCAL cMess := "This Adder works like a desk top calculator. You may add,"+;
|
||
" subtract, multiply, or divide. " + CRLF + CRLF +;
|
||
"When adding or subtracting, the first entry is entered " +;
|
||
"into the accumulator and each sucessive entry is " +;
|
||
"subtotaled. When you press <ENTER> the SubTotal is also " +;
|
||
"shown on the tape. The second time you press <ENTER> the "+;
|
||
"adder is Totaled. When multiplying or dividing the " +;
|
||
"<ENTER> is a Total the first time pressed." + CRLF + CRLF +;
|
||
"Hot Keys:" +CRLF+;
|
||
" <D>ecimals - change # of decimals" +CRLF+;
|
||
" <M>ove - the Adder from right to left" +CRLF+;
|
||
" <T>ape - turn Tape Display On or Off" +CRLF+;
|
||
" <S>croll - the tape display" + CRLF +CRLF+;
|
||
" <DEL> ---┬-- 1st Clear entry" +CRLF+;
|
||
" +-- 2nd Clear ADDER" +CRLF+;
|
||
" <ESC> - Quit" +CRLF+;
|
||
" <F10> - return a <TOTAL> to the active get"
|
||
|
||
_ftPushMessage(cMess, .T., "ADDER HELP", "press any key to continue...", ;
|
||
"QUIET")
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftClearAdder() Docs: Keith A. Wire |
|
||
| Description: Clear entry / Clear Adder |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:07:33pm Time updated: 12:07:33pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftClearAdder(aAdder)
|
||
|
||
_ftEraseTotSubTot(aAdder)
|
||
lDecSet := .F.
|
||
nDecDigit := 0
|
||
IF lClAdder // If it has alredy been pressed once
|
||
nTotal := 0 // then we are clearing the total
|
||
nSavTotal := 0
|
||
_ftUpdateTrans(aAdder, .F., NIL)
|
||
lClAdder := .F.
|
||
_ftDispTotal(aAdder)
|
||
ELSE
|
||
nNumTotal := 0 // Just clearing the last entry
|
||
lClAdder := .T.
|
||
_ftDispSubTot(aAdder)
|
||
ENDIF
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftUpdateTrans() Docs: Keith A. Wire |
|
||
| Description: Update transactions array |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:07:55pm Time updated: 12:07:55pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : lTypeTotal |
|
||
| : nAmount |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftUpdateTrans(aAdder, lTypeTotal, nAmount)
|
||
|
||
LOCAL lUseTotal := (nAmount == NIL)
|
||
|
||
nAmount := iif(nAmount==NIL,0,nAmount)
|
||
IF lClAdder // Clear the adder (they pressed <DEL> twice
|
||
AADD(aTrans,STR(0,22,nMaxDeci)+" C")
|
||
IF lTape // If there is a tape Show Clear
|
||
_ftDisplayTape(aAdder)
|
||
ENDIF
|
||
RETU NIL
|
||
ENDIF
|
||
|
||
IF lTypeTotal // If lTypeTotal=.T. Update from total
|
||
AADD(aTrans,STR(iif(lUseTotal,nTotal,nAmount),22,nMaxDeci) )
|
||
aTrans[nTotTran] := _ftStuffComma(aTrans[nTotTran], .T.) + " *"+ ;
|
||
iif(lAddError,"ER","")
|
||
|
||
ELSE // If lTypeTotal=.F. Update from nNumTotal
|
||
AADD(aTrans,STR(iif(lUseTotal,nTotal,nAmount),22,nMaxDeci))
|
||
|
||
aTrans[nTotTran] := _ftStuffComma(aTrans[nTotTran], .T.) + ;
|
||
iif(lSubRtn," S",iif(nAddMode==1," +",iif(nAddMode==2," -",IF ;
|
||
(lTotalOk," =",iif(nAddMode==3," X"," /"))))) + iif(lAddError,"ER","")
|
||
|
||
ENDIF
|
||
|
||
IF lTape
|
||
_ftDisplayTape(aAdder)
|
||
ENDIF
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftEraseTotSubTot() Docs: Keith A. Wire |
|
||
| Description: Clear the <TOTAL> & <SUBTOTAL> from Adder |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:08:14pm Time updated: 12:08:14pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftEraseTotSubTot(aAdder)
|
||
_ftSetWinColor(W_CURR,W_SCREEN)
|
||
@ 6+nTopOS, 18+nAddSpace SAY " "
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftRoundIt() Docs: Keith A. Wire |
|
||
| Description: Adder Rounding function |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:09:00pm Time updated: 12:09:00pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: nNumber |
|
||
| : nPlaces |
|
||
| Return Value: INT@( ABS@(nNumber@) @* 10 @^ nPlaces @+ 0@.50 @+ 10 @^ - ;|
|
||
| : 12 @) / 10 @^ nPlaces |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftRoundIt(nNumber, nPlaces)
|
||
nPlaces := iif( nPlaces == NIL, 0, nPlaces )
|
||
RETURN iif(nNumber < 0.0, -1.0, 1.0) * ;
|
||
INT( ABS(nNumber) * 10 ^ nPlaces + 0.50 + 10 ^ -12 ) / 10 ^ nPlaces
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftDivide() Docs: Keith A. Wire |
|
||
| Description: Check divide by zero not allowed |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:10:41pm Time updated: 12:10:41pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : nNumerator |
|
||
| : nDenominator |
|
||
| Return Value: @(nNumerator/nDenominator@) |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftDivide(aAdder, nNumerator,nDenominator)
|
||
IF nDenominator==0.0
|
||
lDivError := .T.
|
||
RETU 0
|
||
ELSE
|
||
lDivError := .F.
|
||
ENDIF
|
||
RETURN(nNumerator/nDenominator)
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftValDeci() Docs: Keith A. Wire |
|
||
| Description: Validate the number of decimals |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:10:56pm Time updated: 12:10:56pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: oGet |
|
||
| Return Value: lRtnValue |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftValDeci(oGet)
|
||
|
||
LOCAL lRtnValue := .T.
|
||
|
||
IF oGet:VarGet() > 8
|
||
_ftError("no more than 8 decimal places please!")
|
||
lRtnValue := .F.
|
||
ENDIF
|
||
|
||
RETURN lRtnValue
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftDisplayTape() Docs: Keith A. Wire |
|
||
| Description: Display the Tape |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:11:28pm Time updated: 12:11:28pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: aAdder |
|
||
| : nKey |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftDisplayTape(aAdder, nKey)
|
||
LOCAL nDispTape, nTopTape := 1
|
||
IF (nKey == 84 .OR. nKey == 116) .AND. lTape // Stop displaying tape
|
||
lTape := .F.
|
||
RESTSCREEN(4+nTopOS,6+nTapeSpace,22+nTopOS,35+nTapeSpace,cTapeScr)
|
||
RETU NIL
|
||
ENDIF
|
||
IF lTape // Are we in the display mode
|
||
SETCOLOR("N/W")
|
||
SCROLL(5+nTopOS,7+nTapeSpace,20+nTopOS,32+nTapeSpace,1)
|
||
IF nTotTran>0 // Any transactions been entered yet?
|
||
@ 20+nTopOS,7+nTapeSpace SAY aTrans[nTotTran]
|
||
ENDIF
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
ELSE // Start displaying tape
|
||
lTape := .T.
|
||
SETCOLOR("N/W")
|
||
cTapeScr := SAVESCREEN(4+nTopOS,6+nTapeSpace,22+nTopOS,35+nTapeSpace)
|
||
_ftShadow(22+nTopOS,8+nTapeSpace,22+nTopOS,35+nTapeSpace)
|
||
_ftShadow(5+nTopOS,33+nTapeSpace,21+nTopOS,35+nTapeSpace)
|
||
SETCOLOR("R+/W")
|
||
@ 4+nTopOS,6+nTapeSpace,21+nTopOS,33+nTapeSpace BOX B_SINGLE
|
||
SETCOLOR("GR+/W")
|
||
@ 4+nTopOS,17+nTapeSpace SAY " TAPE "
|
||
SETCOLOR("N/W")
|
||
IF nTotTran>15
|
||
nTopTape := nTotTran-15
|
||
ENDIF
|
||
FOR nDispTape := nTotTran TO nTopTape STEP -1
|
||
@ 20+nDispTape-nTotTran+nTopOS,7+nTapeSpace SAY aTrans[nDispTape]
|
||
NEXT
|
||
ENDIF
|
||
_ftSetWinColor(W_CURR,W_PROMPT)
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftSetLastKey() Docs: Keith A. Wire |
|
||
| Description: Sets the LASTKEY() value to value of nLastKey |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:12:00pm Time updated: 12:12:00pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: nLastKey |
|
||
| Return Value: NIL |
|
||
| Notes: I use this in most of my Pop-Up routines to reset the |
|
||
| : original value of LASTKEY() when quitting. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftSetLastKey(nLastKey)
|
||
_ftPushKeys()
|
||
KEYBOARD CHR(nLastKey)
|
||
INKEY()
|
||
_ftPopKeys()
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPushKeys Docs: Keith A. Wire |
|
||
| Description: Push any keys in the Keyboard buffer on the array aKeys[] |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:16:09pm Time updated: 12:16:09pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
| Notes: Save any keys in the buffer... for FAST typists <g>. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPushKeys
|
||
DO WHILE NEXTKEY() != 0
|
||
AADD(aKeys,INKEY())
|
||
ENDDO
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPopKeys Docs: Keith A. Wire |
|
||
| Description: Restore the keyboard with any keystrokes that were saved |
|
||
| : with _ftPushKeys |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:17:58pm Time updated: 12:17:58pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPopKeys
|
||
LOCAL cKeys := ""
|
||
IF LEN(aKeys) != 0
|
||
AEVAL(aKeys, {|elem| cKeys += CHR(elem)})
|
||
ENDIF
|
||
KEYBOARD cKeys
|
||
aKeys := {}
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPushMessage() Docs: Keith A. Wire |
|
||
| Description: Display a message on the screen in a window |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:18:53pm Time updated: 12:18:53pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cMessage |
|
||
| : lWait |
|
||
| : cTitle |
|
||
| : cBotTitle |
|
||
| : xQuiet |
|
||
| : nTop |
|
||
| Return Value: NIL |
|
||
| See Also: _ftPopMessage |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPushMessage(cMessage,lWait,cTitle,cBotTitle,xQuiet, nTop)
|
||
LOCAL nMessLen, nNumRows, nWide, nLeft, nBottom, nRight, nKey, cOldDevic, ;
|
||
lOldPrint, ;
|
||
cOldColor := SETCOLOR(), ;
|
||
nOldLastkey := LASTKEY(), ;
|
||
nOldRow := ROW(), ;
|
||
nOldCol := COL(), ;
|
||
nOldCurs := SETCURSOR(SC_NONE), ;
|
||
nWinColor := iif(nWinColor == NIL, W_CURR, nWinColor)
|
||
|
||
cOldDevic := SET(_SET_DEVICE, "SCREEN")
|
||
lOldPrint := SET(_SET_PRINTER, .F.)
|
||
nMessLen := LEN(cMessage)
|
||
nWide := iif(nMessLen>72,72,iif(nMessLen<12,12,nMessLen))
|
||
nNumRows := MLCOUNT(cMessage,nWide)
|
||
|
||
// If they didn't say what the top row is, Center it on the screen
|
||
DEFAULT nTop TO INT((MAXROW()-nNumRows)/2)
|
||
|
||
nBottom := nTop+nNumRows+2
|
||
nLeft := INT((MAXCOL()-nWide)/2)-3
|
||
nRight := nLeft+nWide+4
|
||
lWait := iif(lWait == NIL, .F., lWait)
|
||
|
||
_ftPushWin(nTop,nLeft,nBottom,nRight,cTitle,cBotTitle,nWinColor)
|
||
DISPMESSAGE cMessage,nTop+1,nLeft+2,nBottom-1,nRight-2
|
||
|
||
IF xQuiet == NIL
|
||
TONE(800, 1)
|
||
ENDIF
|
||
IF lWait
|
||
FT_INKEY 0 TO nKey
|
||
_ftPopMessage()
|
||
ENDIF
|
||
|
||
SETCURSOR(nOldCurs)
|
||
SETCOLOR(cOldColor)
|
||
SETPOS(nOldRow,nOldCol)
|
||
SET(_SET_DEVICE, cOldDevic)
|
||
SET(_SET_PRINTER, lOldPrint)
|
||
_ftSetLastKey(nOldLastKey)
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPopMessage Docs: Keith A. Wire |
|
||
| Description: Pop off the Message Box |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:24:22pm Time updated: 12:24:22pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
| See Also: _ftPushMessage() |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPopMessage
|
||
_ftPopWin()
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftQuest() Docs: Keith A. Wire |
|
||
| Description: Push a Question Box on the Screen |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:25:32pm Time updated: 12:25:32pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cMessage |
|
||
| : xVarVal |
|
||
| : cPict |
|
||
| : bValid |
|
||
| : lNoESC |
|
||
| : nWinColor |
|
||
| : nTop |
|
||
| Return Value: xVarVal |
|
||
| Notes: This function will work for all Data Types |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftQuest(cMessage,xVarVal,cPict,bValid,lNoESC,nWinColor,nTop)
|
||
|
||
LOCAL nOldRow, nOldCol, cOldColor, nMessLen, nWide, nNumRows, nBottom, nLeft
|
||
LOCAL nRight, oNewGet, nNumMessRow, nLenLastRow, lGetOnNextLine, nOldCurs
|
||
LOCAL cVarType := VALTYPE(xVarVal)
|
||
LOCAL nVarLen := iif(cVarType=="C",LEN(xVarVal),iif(cVarType=="D",8, ;
|
||
iif(cVarType=="L",1,iif(cVarType=="N",iif(cPict==NIL,9, ;
|
||
LEN(cPict)),0))))
|
||
LOCAL nOldLastKey := LASTKEY()
|
||
LOCAL cOldDevice := SET(_SET_DEVICE, "SCREEN"), ;
|
||
lOldPrint := SET(_SET_PRINTER, .F.)
|
||
|
||
nOldRow := ROW()
|
||
nOldCol := COL()
|
||
nOldCurs := SETCURSOR(SC_NONE)
|
||
cOldColor := SETCOLOR()
|
||
lNoESC := iif(lNoESC==NIL,.F.,lNoESC)
|
||
|
||
nMessLen := LEN(cMessage)+nVarLen+1
|
||
nWide := iif(nMessLen>66,66,iif(nMessLen<12,12,nMessLen))
|
||
|
||
nNumMessRow := MLCOUNT(cMessage,nWide)
|
||
nLenLastRow := LEN(TRIM(MEMOLINE(cMessage,nWide,nNumMessRow)))
|
||
lGetOnNextLine := (nLenLastRow + nVarLen) > nWide
|
||
nNumRows := nNumMessRow + iif(lGetOnNextLine,1,0)
|
||
|
||
// Center it in the screen
|
||
nTop := iif(nTop==NIL,INT((MAXROW() - nNumRows)/2),nTop)
|
||
nBottom := nTop+nNumRows+1
|
||
nLeft := INT((MAXCOL()-nWide)/2)-4
|
||
nRight := nLeft+nWide+4
|
||
|
||
_ftPushWin(nTop,nLeft,nBottom,nRight,"QUESTION ?",iif(VALTYPE(xVarVal)=="C" ;
|
||
.AND. nVarLen>nWide,CHR(27)+" scroll "+ CHR(26),NIL),nWinColor)
|
||
DISPMESSAGE cMessage,nTop+1,nLeft+2,nBottom-1,nRight-2
|
||
|
||
oNewGet := GetNew( iif(lGetOnNextLine,Row()+1,Row()), ;
|
||
iif(lGetOnNextLine,nLeft+2,Col()+1), ;
|
||
{|x| iif(PCOUNT() > 0, xVarVal := x, xVarVal)}, ;
|
||
"xVarVal" )
|
||
|
||
// If the input line is character & wider than window SCROLL
|
||
IF lGetOnNextLine .AND. VALTYPE(xVarVal)=="C" .AND. nVarLen>nWide
|
||
oNewGet:Picture := "@S"+LTRIM(STR(nWide,4,0))+iif(cPict==NIL,""," "+cPict)
|
||
ENDIF
|
||
|
||
IF cPict != NIL // Use the picture they passed
|
||
oNewGet:Picture := cPict
|
||
ELSE // Else setup default pictures
|
||
IF VALTYPE(xVarVal)=="D"
|
||
oNewGet:Picture := "99/99/99"
|
||
ELSEIF VALTYPE(xVarVal)=="L"
|
||
oNewGet:Picture := "Y"
|
||
ELSEIF VALTYPE(xVarVal)=="N"
|
||
oNewGet:Picture := "999999.99" // Guess that they are inputting dollars
|
||
ENDIF
|
||
ENDIF
|
||
|
||
oNewGet:PostBlock := iif(bValid==NIL,NIL,bValid)
|
||
|
||
oNewGet:Display()
|
||
|
||
SETCURSOR(SC_NORMAL)
|
||
DO WHILE .T. // Loop so we can check for <ESC>
|
||
// without reissuing the gets
|
||
ReadModal({oNewGet})
|
||
IF LASTKEY() == K_ESC .AND. lNoESC // They pressed <ESC>
|
||
_ftError("you cannot Abort! Please enter an answer.")
|
||
ELSE
|
||
EXIT
|
||
ENDIF
|
||
|
||
ENDDO
|
||
|
||
_ftPopWin()
|
||
|
||
SETCURSOR(nOldCurs)
|
||
SETCOLOR(cOldColor)
|
||
SETPOS(nOldRow,nOldCol)
|
||
SET(_SET_DEVICE, cOldDevice)
|
||
SET(_SET_PRINTER, lOldPrint)
|
||
_ftSetLastKey(nOldLastKey)
|
||
RETURN xVarVal
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftAdderTapeUDF() Docs: Keith A. Wire |
|
||
| Description: User function for ACHOICE() when scrolling tape |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:26:44pm Time updated: 12:26:44pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: mode |
|
||
| : cur_elem |
|
||
| : rel_pos |
|
||
| Return Value: nRtnVal |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
FUNCTION _ftAdderTapeUDF(mode,cur_elem,rel_pos)
|
||
LOCAL nKey,nRtnVal
|
||
THREAD STATIC ac_exit_ok := .F.
|
||
|
||
HB_SYMBOL_UNUSED( cur_elem )
|
||
HB_SYMBOL_UNUSED( rel_pos )
|
||
|
||
DO CASE
|
||
CASE mode == AC_EXCEPT
|
||
nKey := LASTKEY()
|
||
DO CASE
|
||
CASE nKey == 30
|
||
nRtnVal := AC_CONT
|
||
CASE nKey == K_ESC
|
||
KEYBOARD CHR(K_CTRL_PGDN)+CHR(K_RETURN) // Go to last item
|
||
ac_exit_ok := .T.
|
||
nRtnVal := AC_CONT
|
||
CASE ac_exit_ok
|
||
nRtnVal := AC_ABORT
|
||
ac_exit_ok := .F.
|
||
OTHERWISE
|
||
nRtnVal := AC_CONT
|
||
ENDCASE
|
||
OTHERWISE
|
||
nRtnVal := AC_CONT
|
||
ENDCASE
|
||
RETURN nRtnVal
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftError() Docs: Keith A. Wire |
|
||
| Description: Display an ERROR message in a window |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:27:43pm Time updated: 12:27:43pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cMessage |
|
||
| : xDontReset |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftError(cMessage, xDontReset)
|
||
LOCAL nOldRow,nOldCol,nOldCurs,nTop,nLeft,nBot,nRight,cOldColor, ;
|
||
nOldLastKey,cErrorScr,nMessLen,nWide,nNumRows,nKey, ;
|
||
cOldDevic,lOldPrint, ;
|
||
lResetLKey := iif(xDontReset==NIL, .T., .F.)
|
||
|
||
nOldLastKey := LASTKEY()
|
||
nOldRow := ROW()
|
||
nOldCol := COL()
|
||
nOldCurs := SETCURSOR(SC_NONE)
|
||
cOldColor:= _ftSetSCRColor(STD_ERROR)
|
||
cOldDevic := SET(_SET_DEVICE, "SCREEN")
|
||
lOldPrint := SET(_SET_PRINTER, .F.)
|
||
cMessage := "I'm sorry but, " + cMessage
|
||
nMessLen := LEN(cMessage)
|
||
nWide := iif(nMessLen>66,66,iif(nMessLen<12,12,nMessLen))
|
||
nNumRows := MLCOUNT(cMessage,nWide)
|
||
nTop := INT((MAXROW() - nNumRows)/2) // Center it in the screen
|
||
nBot := nTop+3+nNumRows
|
||
nLeft := INT((MAXCOL()-nWide)/2)-2
|
||
nRight := nLeft+nWide+4
|
||
|
||
cErrorScr:=SAVESCREEN(nTop,nLeft,nBot+1,nRight+2)
|
||
_ftShadow(nBot+1,nLeft+2,nBot+1,nRight+2,8)
|
||
_ftShadow(nTop+1,nRight+1,nBot ,nRight+2,8)
|
||
@ nTop,nLeft,nBot,nRight BOX B_SINGLE
|
||
@ nTop,nLeft+INT(nWide/2)-1 SAY " ERROR "
|
||
@ nBot-1,nLeft+INT(nWide-28)/2+3 SAY "Press any key to continue..."
|
||
DISPMESSAGE cMessage,nTop+1,nLeft+3,nBot-2,nRight-3
|
||
TONE(70,5)
|
||
FT_INKEY 0 TO nKey
|
||
RESTSCREEN(nTop,nLeft,nBot+1,nRight+2,cErrorScr)
|
||
SETCURSOR(nOldCurs)
|
||
SETCOLOR(cOldColor)
|
||
SETPOS(nOldRow,nOldCol)
|
||
|
||
IF lResetLKey
|
||
_ftSetLastKey(nOldLastKey)
|
||
ENDIF
|
||
|
||
SET(_SET_DEVICE, cOldDevic)
|
||
SET(_SET_PRINTER, lOldPrint)
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftStuffComma() Docs: Keith A. Wire |
|
||
| Description: Stuff a Comma in a string |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:28:19pm Time updated: 12:28:19pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cStrToStuff |
|
||
| : lTrimStuffedStr |
|
||
| Return Value: cStrToStuff |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftStuffComma(cStrToStuff,lTrimStuffedStr)
|
||
|
||
LOCAL nDecPosit, x
|
||
|
||
lTrimStuffedStr := iif(lTrimStuffedStr==NIL,.F.,lTrimStuffedStr)
|
||
IF !("." $ cStrToStuff)
|
||
cStrToStuff := _ftPosIns(cStrToStuff,".",iif("C"$cStrToStuff .OR. ;
|
||
"E"$cStrToStuff .OR. "+"$cStrToStuff .OR. "-"$cStrToStuff ;
|
||
.OR. "X"$cStrToStuff .OR. "*"$cStrToStuff .OR. ;
|
||
""$cStrToStuff .OR. "/"$cStrToStuff .OR. "="$cStrToStuff,;
|
||
LEN(cStrToStuff)-1,LEN(cStrToStuff)+1))
|
||
|
||
IF ASC(cStrToStuff) == K_SPACE .OR. ASC(cStrToStuff) == K_ZERO
|
||
cStrToStuff := SUBSTR(cStrToStuff, 2)
|
||
ENDIF
|
||
|
||
ENDIF
|
||
nDecPosit := AT(".",cStrToStuff)
|
||
|
||
IF LEN(LEFT(LTRIM(_ftCharRem("-",cStrToStuff)), ;
|
||
AT(".",LTRIM(_ftCharRem("-",cStrToStuff)))-1))>3
|
||
IF lTrimStuffedStr // Do we trim the number each time we insert a comma
|
||
FOR x := nDecPosit-3 TO 2+_ftCountLeft(cStrToStuff," ") STEP -4
|
||
cStrToStuff := SUBSTR(_ftPosIns(cStrToStuff,",",x),2)
|
||
NEXT
|
||
ELSE
|
||
FOR x := nDecPosit-3 TO 2+_ftCountLeft(cStrToStuff," ") STEP -3
|
||
cStrToStuff := _ftPosIns(cStrToStuff,",",x)
|
||
NEXT
|
||
ENDIF
|
||
ENDIF
|
||
|
||
RETURN cStrToStuff
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftSetSCRColor() Docs: Keith A. Wire |
|
||
| Description: Set the standard screen colors to the color requested. |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:28:48pm Time updated: 12:28:48pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: nStd |
|
||
| : nEnh |
|
||
| : nBord |
|
||
| : nBack |
|
||
| : nUnsel |
|
||
| Return Value: SETCOLOR(aStdColor[nStd] + "," + aStdColor[nEnh] + "," + ; |
|
||
| : aStdColor[nBord] + "," + aStdColor[nBack] + "," + ; |
|
||
| : aStdColor[nUnsel]) |
|
||
| See Also: _ftSetWinColor() |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftSetSCRColor(nStd,nEnh,nBord,nBack,nUnsel)
|
||
|
||
IF EMPTY(aWinColor)
|
||
_ftInitColors()
|
||
ENDIF
|
||
|
||
nStd := iif(nStd == NIL, 8, nStd)
|
||
nEnh := iif(nEnh == NIL, 8, nEnh)
|
||
nBord := iif(nBord == NIL, 8, nBord)
|
||
nBack := iif(nBack == NIL, 8, nBack)
|
||
nUnsel:= iif(nUnsel == NIL, nEnh, nUnsel)
|
||
|
||
RETURN SETCOLOR(aStdColor[nStd]+","+aStdColor[nEnh]+","+aStdColor[nBord]+","+;
|
||
aStdColor[nBack]+","+aStdColor[nUnsel])
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPushWin() Docs: Keith A. Wire |
|
||
| Description: Push a new window on the screen |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:34:38pm Time updated: 12:34:38pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: t |
|
||
| : l |
|
||
| : b |
|
||
| : r |
|
||
| : cTitle |
|
||
| : cBotTitle |
|
||
| : nWinColor |
|
||
| Return Value: NIL |
|
||
| See Also: |
|
||
| Notes: Push a new window on the screen in the position t,l,b,r |
|
||
| : and if cTitle is not NIL print the title for the window |
|
||
| : in centered in the top line of the box. Similarly do |
|
||
| : the same for cBotTitle. If nWinColor==NIL get the next |
|
||
| : window color and use it for all the colors. If |
|
||
| : cTypeBord==NIL use the single line border, else use the |
|
||
| : one they requested. Push the window coordinates, the |
|
||
| : color number, the SAVESCREEN() value, and whether they |
|
||
| : picked the window color they wanted to use. If |
|
||
| : lAutoWindow=.F. then the window color was incremented |
|
||
| : and we will will restore the color number when we pop |
|
||
| : the window off. |
|
||
| : |
|
||
| : nWinColor DEFAULT == _ftNextWinColor() |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPushWin(t,l,b,r,cTitle,cBotTitle,nWinColor)
|
||
|
||
LOCAL lAutoWindow := nWinColor==NIL
|
||
|
||
nWinColor := iif(nWinColor==NIL,_ftNextWinColor(),nWinColor)
|
||
AADD(aWindow,{t,l,b,r,nWinColor,SAVESCREEN(t,l,b+1,r+2),lAutoWindow})
|
||
_ftShadow(b+1,l+2,b+1,r+2)
|
||
_ftShadow(t+1,r+1,b,r+2)
|
||
_ftSetWinColor(nWinColor,W_BORDER)
|
||
@ t,l,b,r BOX B_SINGLE
|
||
|
||
IF cTitle!=NIL
|
||
_ftSetWinColor(nWinColor,W_TITLE)
|
||
_ftWinTitle(cTitle)
|
||
ENDIF
|
||
|
||
IF cBotTitle!=NIL
|
||
_ftSetWinColor(nWinColor,W_TITLE)
|
||
_ftWinTitle(cBotTitle,"bot")
|
||
ENDIF
|
||
|
||
_ftSetWinColor(nWinColor,W_SCREEN,W_VARIAB)
|
||
@ t+1,l+1 CLEAR TO b-1,r-1
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPopWin Docs: Keith A. Wire |
|
||
| Description: Pop a Window off the screen |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 12:52:34pm Time updated: 12:52:34pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
| Notes: Pop the currently active window off the screen by restoring|
|
||
| : it from the aWindow Array and if they pushed a new window|
|
||
| : automatically selecting the color we will roll back the |
|
||
| : current window setting using _ftLastWinColor() and reset |
|
||
| : the color to the color setting when window was pushed. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPopWin
|
||
|
||
LOCAL nNumWindow:=LEN(aWindow)
|
||
|
||
RESTSCREEN(aWindow[nNumWindow,1],aWindow[nNumWindow,2], ;
|
||
aWindow[nNumWindow,3]+1,aWindow[nNumWindow,4]+2, ;
|
||
aWindow[nNumWindow,6])
|
||
|
||
IF aWindow[nNumWindow,7]
|
||
_ftLastWinColor()
|
||
ENDIF
|
||
|
||
ASHRINK(aWindow)
|
||
|
||
IF !EMPTY(aWindow)
|
||
_ftSetWinColor(W_CURR,W_SCREEN,W_VARIAB)
|
||
ELSE
|
||
_ftSetSCRColor(STD_SCREEN,STD_VARIABLE)
|
||
ENDIF
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftSetWinColor() Docs: Keith A. Wire |
|
||
| Description: Set the Color to the Window Colors requested |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:37:32pm Time updated: 01:37:32pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: nWin |
|
||
| : nStd |
|
||
| : nEnh |
|
||
| : nBord |
|
||
| : nBack |
|
||
| : nUnsel |
|
||
| Return Value:SETCOLOR(aWinColor[nStd,nWin]+","+aWinColor[nEnh,nWin]+","+;|
|
||
| : aWinColor[nBord,nWin]+","+aWinColor[nBack,nWin]+","+ ;|
|
||
| : aWinColor[nUnsel,nWin]) |
|
||
| See Also: _ftSetSCRColor() |
|
||
| Notes: If the window number is not passed use the currently active|
|
||
| : window number nWinColor. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftSetWinColor(nWin,nStd,nEnh,nBord,nBack,nUnsel)
|
||
|
||
nWin := iif(nWin == NIL, nWinColor, nWin)
|
||
nStd := iif(nStd == NIL, 7, nStd)
|
||
nEnh := iif(nEnh == NIL, 7, nEnh)
|
||
nBord := iif(nBord == NIL, 7, nBord)
|
||
nBack := iif(nBack == NIL, 7, nBack)
|
||
nUnsel:= iif(nUnsel == NIL, nEnh, nUnsel)
|
||
|
||
RETURN SETCOLOR(aWinColor[nStd,nWin]+","+aWinColor[nEnh,nWin]+","+ ;
|
||
aWinColor[nBord,nWin]+","+aWinColor[nBack,nWin]+","+aWinColor[nUnsel,nWin])
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftShadow() Docs: Keith A. Wire |
|
||
| Description: Create a shadow on the screen in the coordinates given |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:40:56pm Time updated: 01:40:56pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: nTop |
|
||
| : nLeft |
|
||
| : nBottom |
|
||
| : nRight |
|
||
| Return Value: NIL |
|
||
| See Also: _ftPushWin() |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftShadow( nTop, nLeft, nBottom, nRight )
|
||
|
||
LOCAL theShadow := SAVESCREEN(nTop, nLeft, nBottom, nRight)
|
||
|
||
RESTSCREEN( nTop, nLeft, nBottom, nRight, ;
|
||
TRANSFORM( theShadow,REPLICATE("X", LEN(theShadow)/2 ) ) )
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftLastWinColor Docs: Keith A. Wire |
|
||
| Description: Decrement the active window color number and return the |
|
||
| : current value |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:49:19pm Time updated: 01:49:19pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: nWinColor := iif(nWinColor==1,4,nWinColor-1) |
|
||
| Notes: If we are already on window #1 restart count by using # 4. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftLastWinColor
|
||
RETURN nWinColor := iif(nWinColor==1,4,nWinColor-1)
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftNextWinColor Docs: Keith A. Wire |
|
||
| Description: Increment the active window color number and return the |
|
||
| : current value |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:51:12pm Time updated: 01:51:12pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: nWinColor := (iif(nWinColor<4,nWinColor+1,1)) |
|
||
| Notes: If we are already on window #4 restart count by using # 1. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftNextWinColor
|
||
IF EMPTY(aWinColor)
|
||
_ftInitColors()
|
||
ENDIF
|
||
|
||
RETURN nWinColor := (iif(nWinColor<4,nWinColor+1,1))
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftWinTitle() Docs: Keith A. Wire |
|
||
| Description: Print the top or bottom titles on the border of the |
|
||
| : currently active window. |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:52:29pm Time updated: 01:52:29pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cTheTitle |
|
||
| : cTopOrBot |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftWinTitle(cTheTitle,cTopOrBot)
|
||
|
||
LOCAL nCurWin :=LEN(aWindow), ;
|
||
nLenTitle:=LEN(cTheTitle)
|
||
|
||
@ aWindow[nCurWin,iif(cTopOrBot==NIL,1,3)],(aWindow[nCurWin,4]- ;
|
||
aWindow[nCurWin,2]-nLenTitle)/2+aWindow[nCurWin,2] SAY " "+cTheTitle+" "
|
||
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftInitColors Docs: Keith A. Wire |
|
||
| Description: Initilize the colors for the Adder |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 02:59:58pm Time updated: 02:59:58pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: None |
|
||
| Return Value: NIL |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftInitColors
|
||
|
||
aWinColor := { {"GR+/BG","GR+/G", "B+/RB", "G+/R"} , ;
|
||
{"R+/N", "W+/RB","W+/BG","GR+/B"} , ;
|
||
{"GR+/N", "GR+/N","GR+/N", "GR+/N"} , ;
|
||
{ "B/BG","BG+/G", "W+/RB","BG+/R"} , ;
|
||
{ "W+/BG", "W+/G","GR+/RB", "W+/R"} , ;
|
||
{"GR+/B", "GR+/R", "R+/B", "W+/BG"}, ;
|
||
{ "N/N", "N/N", "N/N", "N/N"} }
|
||
|
||
aStdColor := { "BG+*/RB" , ;
|
||
"GR+/R" , ;
|
||
"GR+/N" , ;
|
||
"W/B" , ;
|
||
"GR+/N" , ;
|
||
"GR+/GR" , ;
|
||
{ "W+/B", "W/B","G+/B","R+/B", ;
|
||
"GR+/B","BG+/B","B+/B","G+/B"}, ;
|
||
"N/N" }
|
||
RETURN NIL
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftCharOdd() Docs: Keith A. Wire |
|
||
| Description: Remove all the even numbered characters in a string. |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:41:50pm Time updated: 01:41:50pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cString |
|
||
| Return Value: STRTRAN(cString,"") |
|
||
| Notes: Used for example to strip all the attribute characters |
|
||
| : from a screen save. |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftCharOdd(cString)
|
||
cString := TRANSFORM(cString,REPLICATE("X", LEN(cString)/2 ) )
|
||
RETURN STRTRAN(cString,"")
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPosRepl() Docs: Keith A. Wire |
|
||
| Description: Replace the Character at nPosit in cString with cChar |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:44:21pm Time updated: 01:44:21pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cString |
|
||
| : cChar |
|
||
| : nPosit |
|
||
| Return Value: STRTRAN(cString,"9",cChar,nPosit,1)+"" |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPosRepl(cString,cChar,nPosit)
|
||
RETURN STRTRAN(cString,"9",cChar,nPosit,1)+""
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftCharRem() Docs: Keith A. Wire |
|
||
| Description: Removes all occurances of cChar from cString. |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:45:41pm Time updated: 01:45:41pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cChar |
|
||
| : cString |
|
||
| Return Value: STRTRAN(cString,cChar) |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftCharRem(cChar,cString)
|
||
RETURN STRTRAN(cString,cChar)
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftCountLeft() Docs: Keith A. Wire |
|
||
| Description: Returns the number of spaces on the Left side of the String|
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:47:00pm Time updated: 01:47:00pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cString |
|
||
| Return Value: LEN(cString)-LEN(LTRIM(cString)) |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftCountLeft(cString)
|
||
RETURN LEN(cString)-LEN(LTRIM(cString))
|
||
|
||
/*+- Function ---------------------------------------------------------------+
|
||
| Name: _ftPosIns() Docs: Keith A. Wire |
|
||
| Description: Insert the Character cChar in cString at position nPosit |
|
||
| Author: Keith A. Wire |
|
||
| Date created: 10-03-93 Date updated: 10-03-93 |
|
||
| Time created: 01:48:30pm Time updated: 01:48:30pm |
|
||
| Copyright: None - Public Domain |
|
||
+--------------------------------------------------------------------------+
|
||
| Arguments: cString |
|
||
| : cChar |
|
||
| : nPosit |
|
||
| Return Value: LEFT(cString,nPosit-1)+cChar+SUBSTR(cString,nPosit) |
|
||
+--------------------------------------------------------------------------+
|
||
*/
|
||
STATIC FUNCTION _ftPosIns(cString,cChar,nPosit)
|
||
RETURN LEFT(cString,nPosit-1)+cChar+SUBSTR(cString,nPosit)
|