** Program : PopCalc7.prg ** Purpose : Pop-up Calculator ** dBASE : dBASE IV version 1.1 ** Written : 05/10/89 ** Author : Richard Price ... ATBBS: HAMMETT ** ... CIS: 71157,762 ** Revised : 05/10/89 - PopCalc3 ... Tape and Paste ** : 06/13/89 - PopCalc4 ... Added shadowing. ** : 08/08/90 - PopCalc5 ... Moving Windows. ** : 12/12/90 - PopCalc6 ... Renamed variables ** using standardized conventions. ** Modified shadow effects. ** Removed all @..GET/READS. ** Instigated use of a memory file. ** Re-configurable at runtime. ** Exploding Windows/Shadows. ** Opaque or transparent shadows ** provided for move/nomove ** windowing capabilities. ** Modified to run from within ** any dB4 1.1 application without ** changes to either PopCalc7 ** or the calling program. ** : 12/17/90 PopCalc7 ... Renamed to avoid ** confusion with PopCalc6.ZIP on ** the BBS's ** Added UDF TrimZero() to trim ** trailing 0's and decimal point ** from numbers passed by paste ** routines. ** All user input in PopCalc7 is via INKEY(0). ** Processing is based upon either its ASCII value ** or its string representation. ** Processing the calculator's inkey(0) and ** chr(inkey()) is as follows: ** Key ACTION ** ------- --------------------------------- ** 0-9 Numerical input. ** . " " ** M Activate Memory Processing ** T Activate Tape Display ** P Activate Paste Display ** C Clear current entry and answer, ** and reset operators ** E Clear current entry only. ** + Add ** - Subtract ** / Division ** * Multiplication ** ^ Exponentiation ** = Provides total/clears operator. ** ENTER Same as = ** R "R"econfigure PopCalc7 options. ** Opens a dialog box to enable/ ** disable Shadow Windows, Window ** Movement, Exploding Opening ** Window, and resetting the tape ** size. ** F1 HELP ** Processing from within Memory mode follows: ** Key ACTION ** ------- --------------------------------- ** R Recall value held in Memory ** C Clear Memory ** + Add to Memory ** - Subtract from Answer ** / Divide memory ** * Multiply memory ** ^ Exponentiate memory ** = Provides a total and clears the ** memory operator. ** F1 HELP ** NOTE: Memvars which will be saved to PopCalc7.MEM ** are designated as m_ ** ml_ = logical memvars ** mn_ = numerical memvars ** mc_ = character memvars ** ma_ = array memvars ** There are four (4) "configuration" memvars ** which the user may change from within PopCalc7. ** ml_Shadow = .t. for shadow usage ** ml_Explode = .t. for exploding windows ** ml_Move = .t. enables moving windows. ** mn_TapeSiz = Number used to declare the ** tape array. ** These memvars can be changed by pressing ** "R" while in the main calculator window. ** NOTE: If movement is not enabled, then ** shadowing routine is different. ** In order to move windows with shadows, ** the shadow must be in the form of ** a window, and the shadow is opaque ** and the underlying screen is hidden. ** ** If movement is disabled, then the ** shadow can be transparent, and the ** underlying screen will be dimmed, ** but visible. ** All shadowing will be exploded, ** when shadowing is enabled. ** WHY? Because I like it that way! PROCEDURE PopCalc7 ** Save the current screen and activate. SAVE SCREEN TO POPSCR_1 ACTIVATE SCREEN ** Save and set the environment. IF SET("TALK")="ON" SET TALK OFF lc_PCTalk = "ON" ELSE SET TALK OFF lc_PCTalk = "OFF" ENDIF ll_PCStat = (SET("STATUS")="ON") lc_PCBell = SET("BELL") lc_PCEsc = SET("ESCAPE") lc_PCDelim = SET("DELIMITER") lc_PCCurs = SET("CURSOR") SET BELL OFF SET ESCAPE OFF SET DELIMITERS OFF SET CURSOR OFF SET BORDER TO IF TYPE("gc_PopCalc")="U".OR..NOT.FILE("PopCalc7.MEM") PUBLIC gc_PopCalc STORE .t. TO ml_Shadow, ml_Move STORE .f. TO ml_Explode STORE 0 TO mn_CalcAns, mn_Mem, mn_TapeCnt STORE 0 TO mn_TapeNum, mn_TapeEnd ** PCW.... (P)op (C)alc6 (W)indow settings mn_PCWRow1 = 1 mn_PCWCol1 = 24 mn_PCWRow2 = 16 mn_PCWCol2 = 53 ** PTW.... (P)op (T)ape (W)indow settings mn_PTWRow1 = 3 mn_PTWCol1 = 49 mn_PTWRow2 = 20 mn_PTWCol2 = 68 mc_KeyStr = " " mc_Operatr = "+" mc_Entry = space(14) mn_TapeSiz = 100 DECLARE ma_Tape[mn_TapeSiz,2] DO TapeInit ELSE RESTORE FROM PopCalc7 ADDITIVE ENDIF ll_Reset = .t. DO WHILE ll_Reset ll_Reset = .f. ll_ShadWin = (ml_Shadow .AND. ml_Move) ** Display the calculator window. DO CalcDisp ** Obtain and process user input. DO Calc_Key ** Restore the screen RESTORE SCREEN FROM POPSCR_1 ENDDO ** Restore the working environment. RELEASE SCREEN POPSCR_1 lc_PCSafe = SET("SAFETY") SET SAFETY OFF SAVE TO PopCalc7 ALL LIKE M?_* SET SAFETY &lc_PCSafe. SET BELL &lc_PCBell. SET DELIM &lc_PCDelim. SET CURSOR &lc_PCCurs. SET ESCAPE &lc_PCEsc. SET TALK &lc_PCTalk. RETURN PROCEDURE CalcDisp ** Build the PopCalc7 calculator display. ** Specifying the color on the @ .. SAY lines is ** required due to a known dBASE IV 1.1 bug which, ** under certain circumstances, the default window ** colors are changed by the calling program. ** Also, I happen to like highlighting the ** available keys for display purposes. ** Actually, the whole window PopCalc7 could be ** smaller and the only area one truly needs is ** the ANSWER line with possibly the MEMORY line ** added to view the current value held in MEMORY. ** Verify Window Limits (and fix if necessary). ** REASON: If PopCalc7 was entered previously with ** shadowing disabled, AND window(s) were ** positioned on line 24, OR column > 78 ** AND the next entry to PopCalc7 is with ** shadowing on, a window definition error ** would occur for the shadowing windows. ln_MaxRow = IIF(ll_PCStat,23,24) - ; IIF(ml_Shadow,1,0) ln_AdjWin = ; IIF(mn_PCWRow2>ln_MaxRow,mn_PCWRow2-ln_MaxRow,0) mn_PCWRow1 = mn_PCWRow1 - ln_AdjWin mn_PCWRow2 = mn_PCWRow2 - ln_AdjWin ln_AdjWin = ; IIF(ml_Shadow,IIF(mn_PCWCol2>78,; IIF(mn_PCWCol2=79,2,1),0),0) mn_PCWCol1 = mn_PCWCol1 - ln_AdjWin mn_PCWCol2 = mn_PCWCol2 - ln_AdjWin ln_AdjWin = ; IIF(mn_PTWRow2>ln_MaxRow,mn_PTWRow2-ln_MaxRow,0) mn_PTWRow1 = mn_PTWRow1 - ln_AdjWin mn_PTWRow2 = mn_PTWRow2 - ln_AdjWin ln_AdjWin = ; IIF(ml_Shadow,IIF(mn_PTWCol2>78,; IIF(mn_PTWCol2=79,2,1),0),0) mn_PTWCol1 = mn_PTWCol1 - ln_AdjWin mn_PTWCol2 = mn_PTWCol2 - ln_AdjWin RELEASE ln_AdjWin, ln_MaxRow DEFINE WINDOW PopCalc7 ; FROM mn_PCWRow1, mn_PCWCol1 ; TO mn_PCWRow2,mn_PCWCol2 ; DOUBLE color w+/rg,rg/rg,w+/rg DO CASE CASE ml_Explode ** Do an exploding window routine. DO Exp_Main CASE ml_Shadow ** Provide an exploding shadow when ** shadowing is enabled. DO EXPSHADO with ; mn_PCWRow1 , mn_PCWCol1, mn_PCWRow2,mn_PCWCol2 IF ml_Move DEFINE WINDOW ShadCalc ; FROM mn_PCWRow1 + 1, mn_PCWCol1 + 2 ; TO mn_PCWRow2 + 1, mn_PCWCol2 + 2 ; PANEL color w/n,w/n,n/w DEAC WINDOW PopCalc7 RESTORE SCREEN FROM POPSCR_1 ACTIVATE SCREEN ACTIVATE WINDOW ShadCalc ENDIF ACTIVATE WINDOW PopCalc7 OTHERWISE ACTIVATE WINDOW PopCalc7 ENDCASE @ 0,8 SAY "< PopCalc7 >" color rg+/RG @ 1,3 SAY "Entry :" color w+/RG @ 1,11 SAY mc_Entry pict "#########.####" color N/w @ 2,0 to 2,27 color w+/rg @ 3,3 SAY "Answer:" color w+/rg @ 3,11 SAY mn_CalcAns PICT "#########.####" color n/w @ 4,0 to 4,27 DOUB color w+/rg @ 4,3 SAY " Memory " color w+/rg @ 4,14 SAY "ั" color w+/rg && CHR(209) @ 4,17 SAY " Numeric "color w+/rg @ 5,14 TO 11,14 color w+/rg @ 12,0 to 12,27 doub color w+/rg @ 12,14 SAY "ฯ" color w+/rg && CHR(207) @ 8,0 TO 8,13 color w+/rg @ 8,14 SAY "ด" color w+/rg && CHR(180) @ 8,4 SAY " Mem= " color w+/rg @ 9,0 SAY mn_Mem pict "@Z #########.####" color B/w @ 10,0 TO 10,13 color w+/rg @ 10,14 SAY "ด" color w+/rg && CHR(180) @ 11,1 SAY "T" color n/w @ 11,2 SAY "ape" color w+/rg @ 11,6 SAY "I" color n/w @ 11,7 SAY "m" color w+/rg @ 11,8 SAY "P" color n/w @ 11,9 say "aste" color w+/rg @ 6,1 SAY "M" color b/w @ 5,4 SAY "R + - *" color n/w @ 7,4 SAY "C / ^" color n/w @ 5,5 fill to 7,5 color w/rg @ 5,7 fill to 7,7 color w/rg @ 5,9 fill to 7,9 color w/rg @ 5,17 SAY "= 7 8 9 -" color n/w @ 7,17 SAY "/ 4 5 6 +" color n/w @ 9,17 SAY "* 1 2 3 ^" color n/w @ 5,18 fill to 9,18 color w/rg @ 5,20 fill to 9,20 color w/rg @ 5,22 fill to 9,22 color w/rg @ 5,24 fill to 9,24 color w/rg @ 11,18 SAY " 0 " color n/w @ 11,22 SAY " . " color n/w @ 13,1 SAY "Esc" color n/w @ 13,5 say "R" color n/w @ 13,6 say "econfigure" color w+/rg @ 13,18 SAY "C" color n/w @ 13,21 SAY "C" color n/rg @ 13,22 SAY "E" color n/w @ 13,25 SAY CHR(17)+"ู" color n/w && CHR(217) RETURN PROCEDURE Calc_Key ** Loop thru calculator routine infinitly ** until is pressed. DO WHIL .T. lc_LastStr = mc_KeyStr mc_KeyStr = " " ** Re-initialize the TAPE array if needed. IF mn_TapeNum = mn_TapeSiz DO TapeInit ENDI ** Memvar mc_Entry is a string ** representation of the numerical ** value being entered. @ 1,11 SAY mc_Entry color N/w ln_CalcKey = inkey(0) ln_CalcKey = IIF(ln_CalcKey=13,61,ln_CalcKey) mc_KeyStr = UPPER(CHR(ln_CalcKey)) DO CASE CASE ln_CalcKey = 27 ** Escape has been pressed (Exit PopCalc) EXIT CASE ln_CalcKey = 28 ** F1 - HELP DO CalcHelp with 1 mc_KeyStr = lc_LastStr CASE ln_CalcKey < 32 .AND. ml_Move DO Move_Win with ln_Calckey, mn_PCWRow1,; mn_PCWRow2, mn_PCWCol1, mn_PCWCol2 mc_KeyStr = lc_LastStr CASE mc_KeyStr = "M" @ 1,26 SAY "M" color w+/rg @ 6,1 SAY "M" color W*/N mc_KeyStr = UPPER(CHR(INKEY(0))) IF mc_KeyStr $ "CR+-*/=^" ** If there is a value displayed in the ** ENTRY window, perform the requested ** operation using that value, else ** use the value held in ANSWER. ln_CalcNum = IIF(lc_LastStr$".0123456789",; VAL(mc_Entry),mn_CalcAns) DO MathCalc ; WITH mc_KeyStr, ln_CalcNum, mn_Mem DO MemAns mc_KeyStr = lc_LastStr ELSE ?? chr(7) ENDIF @ 6,1 SAY "M" color b/w @ 1,26 SAY mc_Operatr color w+/rg CASE mc_KeyStr="." .AND. "."$mc_Entry ** Limit number to one decimal point. ?? chr(7) mc_KeyStr = lc_LastStr CASE mc_KeyStr $ "0123456789." ** A numerical type of entry was made. ** Concatenate the string mc_KeyStr ** to mc_Entry. ** If maximum length (14) of mc_Entry ** has been reached, beep and don't ** concatenate IF LEN(LTRIM(mc_Entry)) < 14 mc_Entry = RIGHT(mc_Entry,13) ; + mc_KeyStr ELSE ?? CHR(7) ENDIF ** If the old operator was "=", reset ** the Answer value to 0, increment the ** tape counter, and update the tape. IF mc_Operatr = "=" mn_TapeNum=mn_TapeNum+1 mc_Operatr="+" mn_CalcAns=0 ENDIF CASE ln_CalcKey = 127 ** BackSpace pressed. ** Clear last keyed entry and delete ** last number entered from mc_Entry. mc_Entry = " " + LEFT(mc_Entry,13) mc_KeyStr = " " CASE mc_KeyStr = "=" .AND. mc_Operatr = "=" ** Enter or = has been keyed repeatedly. ** No entry has been made, so reset the ** operators to previous values and loop. mc_KeyStr=lc_LastStr CASE mc_KeyStr $ "+-/*^=" ** Perform the calculations, ** update the operators and the tape. @ 1,26 SAY mc_KeyStr color w+/rg ln_CalcNum = VAL(mc_Entry) ** Update tape to indicate that the next ** value will be used in conjunction ** with the value held in Answer ** (mn_CalcAns) when the previous total ** had been requested via the ENTER key ** or "=" key, followed by an operator ** (+-*/^) rather than a numerical entry. IF ma_Tape[mn_TapeNum,1] = "=" ; .AND. ma_Tape[mn_TapeNum,2] = 0 ; .AND. mc_Operatr # "=" ma_Tape[mn_TapeNum,1] = " " ma_Tape[mn_TapeNum,2] = mn_CalcAns ENDIF ** Increment and update the tape. mn_TapeNum = mn_TapeNum + 1 ma_Tape[mn_TapeNum,1] = mc_Operatr ma_Tape[mn_TapeNum,2] = ln_CalcNum ** Perform the requested calculations. DO MathCalc ; WITH mc_Operatr, ln_CalcNum, mn_CalcAns ** If ENTER or "=" has been pressed, ** update the tape to show the answer. IF mc_KeyStr="=" mn_TapeNum=mn_TapeNum+1 ma_Tape[mn_TapeNum,1]="=" ma_Tape[mn_TapeNum,2]=mn_CalcAns ENDIF ** Display the calculated answer. DO CalcAns ** Assign the math operator and clear ** current entry string mc_Entry. mc_Operatr=mc_KeyStr mc_Entry=SPAC(14) CASE mc_KeyStr = "I" ** Exit PopCalc7 and KEYBOARD the answer lc_CalcAns = ltrim(str(mn_CalcAns,14,4)) lc_CalcAns = TrimZero(lc_CalcAns) KEYBOARD lc_CalcAns EXIT CASE mc_KeyStr = "R" ** User wishes to reset PopCalc7 parameters ll_reset = .f. DO PC_Param with ll_reset IF ll_reset * Parameters have changed, must exit * before new params take effect! EXIT ENDIF CASE mc_KeyStr = "T" ** Request Tape Viewing DO TAPEDISP mc_KeyStr = lc_LastStr CASE mc_KeyStr = "P" ** Request for Paste Function DO PASTEVAL mc_KeyStr = lc_LastStr CASE mc_KeyStr = "E" ** Clear the current entry only mc_Entry=SPACE(14) mc_KeyStr=lc_LastStr CASE mc_KeyStr = "C" ** Clear the current entry, answer, and ** reset the associated memvars. mc_KeyStr = "=" mc_Operatr = "+" mc_Entry = SPACE(14) mn_CalcAns = 0 mn_TapeNum = mn_TapeNum + 1 ma_Tape[mn_TapeNum,1] = "C" ** Now that the associated memvars are ** cleared, refresh the display. @ 1,26 SAY mc_KeyStr color w+/rg DO CalcAns OTHERWISE mc_KeyStr = lc_LastStr ENDCASE ENDDO RELEASE WINDOW PopCalc7 IF ll_ShadWin RELEASE WIND ShadCalc ENDIF RETURN PROCEDURE MathCalc PARAMETERS OPERATOR, VALUE, ANSWER PRIVATE OPERATOR, VALUE, ANSWER ** Calculate the answer for main display ** and MEMORY display. DO CASE CASE OPERATOR="+" ANSWER = ANSWER + VALUE CASE OPERATOR="-" ANSWER = ANSWER - VALUE CASE OPERATOR = "*" ANSWER = ANSWER * VALUE CASE OPERATOR="/" ANSWER = ANSWER / FLOAT(VALUE) CASE OPERATOR = "^" .AND..NOT. ; (ANSWER<0 .AND. VALUE<1) ANSWER = ANSWER ^ VALUE CASE OPERATOR = "^" .AND. ; (ANSWER<0 .AND. VALUE<1) * Negative number to "root" ?? chr(7)+chr(7) CASE OPERATOR = "C" ANSWER=0 CASE OPERATOR="R" IF mc_Operatr = "=" mn_CalcAns = 0 mc_Operatr = "+" ENDI mc_Entry = STR(ANSWER,14,4) ENDCASE RETURN PROCEDURE CalcAns ** Diplay the calculated answer DO CASE CASE mn_CalcAns<0 ** Highlite if negative. @ 3,11 SAY mn_CalcAns PICT "#########.####" ; color R/w OTHERWISE @ 3,11 SAY mn_CalcAns PICT "#########.####" ; color n/w ENDCASE RETURN PROCEDURE MemAns ** Diplay the calculated Memory value DO CASE CASE mn_Mem<0 && Highlite if negative. @ 9,0 SAY mn_Mem pict "#########.####" ; color R/w OTHERWISE @ 9,0 SAY mn_Mem pict "#########.####" ; color B/w ENDCASE RETURN PROCEDURE TapeInit ** INITIALIZE TAPE ARRAY mn_TapeNum = 0 DO WHIL mn_TapeNum < mn_TapeSiz mn_TapeNum = mn_TapeNum+1 ma_Tape[mn_TapeNum,1] = " " STORE 0 TO ma_Tape[mn_TapeNum,2] ENDDO mn_TapeNum = 1 mn_TapeCnt = 1 RETURN PROCEDURE Exp_Main ** Explode the main calculator window. ** (Explode its shadow if enabled) ln_Win_R1 = ; INT((mn_PCWRow2-mn_PCWRow1)/2) + mn_PCWRow1 ln_Win_R2 = ln_Win_R1+1 ln_Win_C1 = ; INT((mn_PCWCol2-mn_PCWCol1)/2) + mn_PCWCol1 ln_Win_C2 = ln_Win_C1+1 DO WHIL .t. ln_Win_R1 = IIF(ln_Win_R1 > mn_PCWRow1, ; ln_Win_R1 -1, mn_PCWRow1) ln_Win_R2 = IIF(ln_Win_R2 < mn_PCWRow2, ; ln_Win_R2 +1, mn_PCWRow2) ln_Win_C1 = IIF(ln_Win_C1 > mn_PCWCol1, ; ln_Win_C1 -1, mn_PCWCol1) ln_Win_C2 = IIF(ln_Win_C2 < mn_PCWCol2, ; ln_Win_C2 +1, mn_PCWCol2) RELEASE WINDOW PopCalc7 IF ml_Shadow IF ml_Move DEACTIVATE WINDOW ShadCalc DEFINE WINDOW ShadCalc ; FROM ln_Win_R1+1,ln_Win_C1+2 ; TO ln_Win_R2+1,ln_Win_C2+2 ; color w/n,w/n,n/n panel ACTIVATE WINDOW ShadCalc ELSE ACTIVATE SCREEN @ ln_Win_R1+1, ln_Win_C1+2 ; fill to ln_Win_R2+1,ln_Win_C2+2 ; COLOR w/n ENDIF ENDIF DEFINE WIND PopCalc7 ; FROM ln_Win_R1, ln_Win_C1 ; TO ln_Win_R2, ln_Win_C2 ; DOUB color w+/rg,rg/rg,w+/rg ACTIVATE WINDOW PopCalc7 IF ln_Win_R1=mn_PCWRow1 ; .AND. ln_Win_R2=mn_PCWRow2 ; .AND. ln_Win_C1=mn_PCWCol1 ; .AND. ln_Win_C2=mn_PCWCol2 ** Maximum window size has been reached! EXIT ENDIF ENDDO RETURN PROCEDURE Expshado PARAMETERS ln_Win_R1, ln_Win_C1, ln_Win_R2, ln_Win_C2 ** Exploding Shadow - Top right to bottom left. ln_Shad_R2 = ln_Win_R1 +1 ln_Shad_C2 = ln_Win_C1 + 2 ACTIVATE SCREEN DO WHILE .t. ln_Shad_R2 = IIF(ln_Shad_R2 to exit!" color n/w ** Initialize display specific memvars. mn_TapeCnt = mn_TapeNum mn_TapeEnd = mn_TapeNum mn_TapeNum=1 ln_TapeTop=0 IF mn_TapeCnt>10 mn_TapeNum=mn_TapeCnt-9 ENDIF DO WHIL .T. ln_TapeLin=2 IF ln_TapeTop # mn_TapeNum ** Display only if required. ln_TapeTop = mn_TapeNum ** If there are numbers "above" currently ** displayed tape, indicate so, otherwise, ** redraw the line where "More" displays. IF mn_TapeNum > 1 .AND. mn_TapeEnd>9 @ 1,10 SAY " More" + CHR(24) + " " ; color RG+/W ELSE @ 1,10 TO 1,17 color n/w ENDIF ** "List" the tape array in the window. DO WHIL mn_TapeNum <= mn_TapeEnd @ ln_TapeLin,1 say ma_Tape[mn_TapeNum,1] ; color n/w @ ln_TapeLin,3 say ma_Tape[mn_TapeNum,2] ; pict "#########.####" color n/w ln_TapeLin=ln_TapeLin+1 mn_TapeNum=mn_TapeNum+1 ENDDO ** If there are numbers "below" currently ** displayed tape, indicate so, otherwise, ** redraw the line where "More" displays. IF mn_TapeNum mn_TapeCnt ** Check for logical end of tape. mn_TapeNum = ln_TapeTop ENDIF IF (mn_TapeNum+9) < mn_TapeCnt mn_TapeEnd = mn_TapeNum+9 ELSE mn_TapeNum = ; IIF(mn_TapeCnt-9>0,mn_TapeCnt-9,1) mn_TapeEnd = mn_TapeCnt ENDIF ENDDO mn_TapeNum = mn_TapeCnt ** Get rid of tape window - restore the screen. DO PC_Clos2 RETURN PROCEDURE TapePrnt IF .NOT. printstatus() ?? chr(7)+chr(7)+chr(7) RETURN ENDIF SET CONS OFF SET PRINT ON ? "PopCalc7 Tape Listing" AT 5 ? "---------------------" AT 5 ln_TapeLin=1 DO WHIL ln_TapeLin<=mn_TapeCnt ? ma_Tape[ln_TapeLin,1] AT 6, ?? ma_Tape[ln_TapeLin,2] pict "#########.####" ; AT 8 ln_TapeLin=ln_TapeLin+1 ENDDO ? "---------------------" AT 5 ? " End of Tape " AT 5 SET PRINT OFF SET CONS ON EJECT RETURN PROCEDURE PasteVal ** Assign a function key as a paste key. ** Open the secondary window. DO PC_OPEN2 @ 0,2 SAY "PopCalc7 Paste" color b/w @ 1,0 TO 1,17 DOUB color n/w @ 2,0 SAY " PRESS " color n/w @ 3,0 SAY " Function Key " color n/w @ 4,0 to 4,17 doub color n/w @ 5,0 SAY " Range" color n/w @ 6,0 SAY " From Thru" color n/w @ 7,0 TO 7,17 color n/w @ 8,0 say " F2 F10" color n/w @ 9,0 say "Shift-F1 Shift-F9" color n/w @ 10,0 say " Ctrl-F1 Ctrl-F10" color n/w @ 11,0 TO 11,17 doub color n/w @ 14,0 to 14,17 color n/w @ 15,0 SAY " to Abort!" color r/w ln_FuncKey=0 ** Test for a valid key press. DO WHILE .t. @ 3,16 ln_FuncKey=inkey(0) DO CASE CASE ln_FuncKey=27 .OR. ; (ln_FuncKey < 0 .AND. ln_FuncKey> -29) EXIT CASE ln_FuncKey = 28 ** F1 - HELP DO CalcHelp with 5 CASE ln_FuncKey < 32 .AND. ml_Move DO Move_Win with ln_Funckey, mn_PTWRow1, ; mn_PTWRow2, mn_PTWCol1, mn_PTWCol2 OTHERWISE ?? chr(7)+chr(7) @ 12,0 say " INVALID KEY!" color r*/w @ 13,0 say " Re-Enter " color rg+/w ENDCASE ENDDO mn_FuncKey = -1 * ln_FuncKey + 1 + ; int((ln_FuncKey)/10)*10 lc_FuncVal = LTRIM(STR(mn_CalcAns,14,4)) lc_FuncVal = TrimZero(lc_FuncVal) DO CASE CASE ln_FuncKey < 0 .AND. ln_FuncKey > -10 ** Function key was pressed. SET FUNC mn_FuncKey TO lc_FuncVal CASE ln_FuncKey < -9 .AND. ln_FuncKey > -20 ** Ctrl-Function key was pressed. lc_funcstr = ; ltrim(trim(str(mn_funckey,2,0))) SET FUNCTION CTRL-F&lc_funcstr. ; TO lc_FuncVal CASE ln_FuncKey<-19 .AND. ln_FuncKey>-29 ** Shift-Function key was pressed lc_funcstr = ; ltrim(trim(str(mn_funckey,2,0))) SET FUNCTION SHIFT-F&lc_funcstr. ; TO lc_FuncVal ENDCASE ** Close the secondary window DO PC_Clos2 RETURN FUNCTION TrimZero PARAMETER lc_TrimZer ** Trim trailing zeros and decimal point. DO WHILE RIGHT(lc_TrimZer,1)$"0" ln_LenStr = LEN(lc_TrimZer) - 1 lc_TrimZer = LEFT(lc_TrimZer,ln_LenStr) ENDDO ln_LenStr = LEN(lc_TrimZer) - 1 lc_TrimZer = IIF(RIGHT(lc_TrimZer,1)=".",; LEFT(lc_TrimZer,ln_LenStr),lc_TrimZer) RETURN (lc_TrimZer) ** EOF TrimZero() PROCEDURE PC_Open2 IF ml_Shadow DO EXPSHADO WITH mn_PTWRow1 , mn_PTWCol1,; mn_PTWRow2, mn_PTWCol2 IF ml_Move DEFINE WINDOW ShadTape ; FROM mn_PTWRow1 + 1, mn_PTWCol1 + 2 ; TO mn_PTWRow2 + 1, mn_PTWCol2 + 2 ; PANEL color w/n,w/n,n/w ACTIVATE WINDOW ShadTape ENDIF ENDIF DEFINE WINDOW POPTAPE FROM mn_PTWRow1,mn_PTWCol1 ; TO mn_PTWRow2,mn_PTWCol2 DOUBLE color N/W,W/W,r/W ACTIVATE WINDOW POPTAPE RETURN PROCEDURE PC_Clos2 RELEASE WINDOW PopTape IF ll_Shadwin RELEASE WINDOW ShadTape ENDIF RETURN PROCEDURE Move_Win PARAMETERS ln_key, ln_WRow1, ln_WRow2, ln_WCol1,; ln_WCol2 DO CASE CASE ln_key = 19 ** Left Arrow, move the window left by 1. ln_MoveRow = 0 ln_MoveCol = -1 CASE ln_key = 1 .OR. ln_key = 5 ** CTRL-LeftArrow / UP arrow. ln_MoveRow = -1 ln_MoveCol = 0 CASE ln_key = 4 ** RightArrow, move the window right by 1. ln_MoveRow = 0 ln_MoveCol = 1 CASE ln_key = 6 .OR. ln_Key = 24 ** CTRL-RightArrow / DOWN arrow. ln_MoveRow = 1 ln_MoveCol = 0 CASE ln_key = 9 .OR. ln_key = 2 ** Tab / End ln_MoveRow = 0 ln_MoveCol = 79 - ln_WCol2 - ; IIF(ml_Shadow,2,0) CASE ln_key = -400 .OR. ln_key = 26 ** Shift Tab / Home ln_MoveRow = 0 ln_MoveCol = -ln_WCol1 CASE ln_key = 18 ** PgUp - move to TOP Row ln_MoveRow = -ln_WRow1 ln_MoveCol = 0 CASE ln_key=31 ** Ctrl-PageUp ** Move window to top right of screen ln_MoveRow = -ln_WRow1 ln_MoveCol = 79 - ln_WCol2 - ; IIF(ml_Shadow,2,0) CASE LASTKEY() = 3 ** PgDown - move to BOTTOM Row ln_MoveRow = IIF(ll_PCStat,23,24) -ln_WRow2 -; IIF(ml_Shadow,1,0) ln_MoveCol = 0 CASE ln_key=30 ** Ctrl-PgDn ** Move window to bottom right of screen ln_MoveRow = IIF(ll_PCStat,23,24) - ln_WRow2-; IIF(ml_Shadow,1,0) ln_MoveCol = 79 -ln_WCol2 - IIF(ml_Shadow,2,0) CASE ln_key = 29 ** Ctrl-Home - move to upper LEFT corner ln_MoveRow = -ln_WRow1 ln_MoveCol = -ln_WCol1 CASE ln_key = 23 ** Ctrl-End - move to lower LEFT corner ln_MoveRow = IIF(ll_PCStat,23,24) - ln_WRow2-; IIF(ml_Shadow,1,0) ln_MoveCol = -ln_WCol1 OTHERWISE RETURN ENDCASE IF ln_WRow1 + ln_MoveRow < 0 ; .OR. ln_WCol1 + ln_MoveCol < 0 .OR. ; ln_WRow2 +ln_MoveRow > IIF(ll_PCStat,23,24) - ; IIF(ml_Shadow,1,0) .OR. ; ln_WCol2 + ln_MoveCol > IIF(ml_Shadow,77,79) @ 0,0 SAY CHR(7) + CHR(7) RETURN ENDIF ln_WRow1 = ln_WRow1 + ln_MoveRow ln_WCol1 = ln_WCol1 + ln_MoveCol ln_WRow2 = ln_WRow2 + ln_MoveRow ln_WCol2 = ln_WCol2 + ln_MoveCol DO CASE CASE Window() = "POPCALC7" IF ml_Shadow MOVE WINDOW ShadCalc ; BY ln_MoveRow,ln_MoveCol ENDIF MOVE WINDOW PopCalc7 BY ln_MoveRow,ln_MoveCol CASE Window() = "POPTAPE" IF ml_Shadow MOVE WINDOW ShadTape ; BY ln_MoveRow,ln_MoveCol ENDIF MOVE WINDOW PopTape BY ln_MoveRow,ln_MoveCol ENDCASE RETURN PROCEDURE PC_Param PARAMETER ll_Test ** Enable restting of PopCalc7 parameters. ** (Tape_Size,Shadow,Move,Explode) ** NOTE: To get fancy, you might want to expand ** on this code to enable resetting the ** color settings. DECLARE la_Param[4] la_Param[1] = ml_Shadow la_Param[2] = ml_Explode la_Param[3] = ml_Move la_Param[4] = str(mn_TapeSiz,3,0) DEFINE WINDOW PC_PARAM from 4,23 to 13,52 ; DOUBLE color N/W,W+/N,R/W IF ml_shadow DO EXPSHADO with 4, 23, 13, 52 ENDIF ACTIVATE WINDOW PC_Param @ 0,4 say "Reconfigure PopCalc7" color n/w @ 1,0 to 1,27 color n/w @ 2,1 say "Shadows............. " + ; IIF(la_Param[1],"Yes","No ") color n/w @ 3,1 say "Exploding windows... " + ; IIF(la_Param[2],"Yes","No ") color n/w @ 4,1 say "Moving windows...... " + ; IIF(la_Param[3],"Yes","No ") color n/w @ 5,1 say "Tape size (20-580).. " + ; la_Param[4] color n/w @ 6,0 to 6,27 color n/w @ 7,3 say "Press Esc when done..." color r/w ln_x = 1 ln_ParKey = 0 DO WHILE .NOT. (ln_ParKey=23 .OR. ln_ParKey = 27) IF ln_X<>4 @ ln_x+1,22 SAY ; IIF(la_Param[ln_x],"Yes","No ") color w/n ln_ParKey = INKEY(0) lc_ParKey = UPPER(CHR(ln_ParKey)) ** Allow for space bar toggle. CHR(32) la_Param[ln_x] = iif(lc_ParKey=" ",; (.NOT.la_Param[ln_x]),la_Param[ln_x]) la_Param[ln_x] = iif(lc_parKey$"YN",; (lc_ParKey="Y"),la_Param[ln_x]) @ ln_x+1,22 SAY ; IIF(la_Param[ln_x],"Yes","No ") color n/w ELSE lc_PassNum = la_Param[ln_x] DO ParamNum with lc_PassNum la_Param[ln_x] = lc_PassNum @ ln_x+1,22 SAY la_Param[ln_x] color N/w ENDIF DO CASE CASE ln_ParKey = 28 ** F1 - HELP DO CalcHelp with 2 CASE ln_ParKey = 5 .OR. ln_ParKey = 19 ; .OR. ln_ParKey = 1 .OR. ln_ParKey = -400 ** UpArrow or LeftArrow ** Ctrl-LeftArrow or Shift Tab ln_x = ln_x - 1 CASE ln_ParKey = 26 .OR. ln_ParKey = 18 .OR. ; ln_ParKey = 29 .OR. ln_ParKey = 31 ** Home or PgUp or Ctrl-Home or Ctrl-PgUp ln_x = 1 CASE ln_ParKey = 2 .OR. ln_ParKey = 3 .OR. ; ln_ParKey = 30 ** End or PgDn or Ctrl-PgDn ln_x = 4 CASE ln_ParKey = 4 .OR. ln_ParKey = 24 .OR. ; ln_ParKey = 13 .OR. ln_ParKey = 6 .OR. ; ln_ParKey = 9 ** DownArrow/RightArrow/Enter ** Ctrl-RightArrow/Tab ln_x = ln_x + 1 ENDCASE ln_x = IIF(ln_x>4,1,IIF(ln_x<1,4,ln_x)) ENDDO ll_test = (la_Param[1] # ml_Shadow) ll_test = IIF(ll_Test,.t.,; (la_Param[2] # ml_Explode)) ll_test = IIF(ll_Test,.t.,; (la_Param[3] # ml_Move)) ll_test = IIF(ll_Test,.t.,; (VAL(la_Param[4]) # mn_TapeSiz)) lc_Choice = iif(ln_ParKey=23 .AND. ; ll_test,"Y",iif(ll_test,"M","N")) IF lc_Choice="M" ** Maybe... ?? CHR(7) @ 7,3 say " Keep changes (Y/N) " COLOR R/W lc_Choice = UPPER(CHR(INKEY(0))) ENDIF IF lc_choice="Y" IF VAL(la_Param[4]) <> mn_TapeSize @ 7,3 say " Initializing tape... " mn_TapeSiz = VAL(la_Param[4]) DECLARE ma_Tape[mn_TapeSiz,2] DO TapeInit ENDIF ml_Shadow = la_Param[1] ml_explode = la_Param[2] ml_move = la_Param[3] ELSE ll_Test = .f. ENDIF RELEASE WINDOW PC_PARAM RETURN PROCEDURE ParamNum PARAMETER lc_ParNum @ 7,3 say "(+) (-) (Enter=Accept)" color r/w DO WHILE .t. @ 5,22 SAY lc_ParNum color W/N ln_ParKey = inkey(0) lc_PKeyStr = UPPER(CHR(ln_ParKey)) DO CASE CASE ln_ParKey = 27 ** Escape has been pressed. ** Reset tape size to old size ** and exit. lc_ParNum = str(mn_TapeSiz,3,0) @ 5,22 SAY lc_ParNum color W/N EXIT CASE ln_ParKey = 28 ** F1 - HELP DO CalcHelp WITH 2 CASE ln_ParKey <32 ** Enter or any other "navigation" ** key has been pressed. EXIT CASE lc_PKeyStr = "+" ** Upper array limit = 585 ** But, to keep to clean, limit to 580 IF lc_ParNum<="570" lc_ParNum = str(val(lc_parnum)+10,3,0) ELSE ?? chr(7) ENDIF CASE lc_PKeyStr = "-" ** Prevent tape from being to small. ** Too much time wasted in continually ** re-initializing a very small tape. IF lc_ParNum>=" 30" lc_ParNum = str(val(lc_parnum)-10,3,0) ELSE ?? chr(7) ENDIF ENDCASE ENDDO ** Prevent escaping from PROCEDURE PC_Param loop. ln_ParKey = iif(ln_ParKey=27,4,ln_ParKey) @ 7,3 say "Press Esc when done..." color r/w RETURN PROCEDURE CalcHelp PARAMETER ln_HelpScr ** Simple help text... SAVE SCREEN TO CalcHelp ACTIVATE SCREEN IF ml_shadow DEFINE WINDOW ShadHelp FROM 2,6 TO 23,76 ; color w/n,w/n,n/w panel ACTIVATE WINDOW ShadHelp ENDIF DEFINE WINDOW CalcHelp from 1,4 to 22,74 color N/bg,,W+/bg ACTIVATE WINDOW CalcHelp DO WHILE ln_HelpScr <=6 CLEAR DO CASE CASE ln_HelpScr = 1 TEXT Operations PopCalc7 Help อออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออ Welcome to PopCalc7's HELP Facility อออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออ PopCalc7 operates much the same as most other calculators. You can add, subtract, multiply, divide, and exponentiate both with "keyed" entries and values held in "memory". To Exit PopCalc7, or any associated windows, press . You also have the ability to view and print the current "tape", assign a value to a "paste" key, perform an immediate paste, move the windows, and you may re-configure PopCalc7's display characteristics and tape size. To EXIT this help system at any point, press . More.... Page 1 ENDTEXT CASE ln_HelpScr = 2 TEXT Configuration PopCalc7 Help อออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออ You may "re-configure" PopCalc7 by pressing "R" from within in the main calculator. You may enable/disable the following: Shadows for all windows. (YES/no) Exploding windows. (YES/no) Moving windows. (YES/no) You may change the "Tape size" within the range 20 to 580. CAUTION: Changing the tape size will reset the current tape. To change the tape size, press: + Increases. - Decreases. More.... Page 2 ENDTEXT CASE ln_HelpScr = 3 TEXT Configuration (continued) PopCalc7 Help อออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออ If both "moving windows" and "shadowing" are enabled, shadows will be opaque. Otherwise, transparent shadowing is in effect. "Exploding windows" effects only the main calculator window. When "shadowing" is enabled, all shadowing will be of an "explosive" variety. With "exploding windows" and "shadowing", the calculator shadow and window explode from the center. If "shadowing" and not "exploding", the shadow will explode from upper left to lower right for the calculator window. All shadowing for other windows is exploded from upper left to lower right. More.... Page 3 ENDTEXT CASE ln_HelpScr = 4 TEXT Key Press Calc & Paste Tape Window Tape Display ฤฤฤฤฤฤฤฤฤฤฤฤ ฤฤฤฤฤฤฤฤฤฤฤ ฤฤฤฤฤฤฤฤฤฤฤ ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ UpArrow Up n/a Up One Line DnArrow Down n/a Down One Line Ctrl-RtArrow Up Up n/a Ctrl-LtArrow Down Down n/a LtArrow Left Left n/a RtArrow Right Right n/a Tab Far Right Far Right n/a End Far Right n/a End of Tape Shift-Tab Far Left Far Left n/a Home Far Left n/a Top of Tape PgUp Top n/a Back 10 Lines PgDn Bottom n/a Down 10 Lines Ctrl-PgUp Upper Right Upper Right n/a Ctrl-PgDn Lower Right Lower Right n/a Ctrl-Home Upper Left Upper Left n/a Ctrl-End Lower Left Lower Left n/a ฤฤฤฤฤฤฤฤฤฤฤฤ ฤฤฤฤฤฤฤฤฤฤฤ ฤฤฤฤฤฤฤฤฤฤฤ ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ More.... Page 4 ENDTEXT CASE ln_HelpScr = 5 ** NOTE TO PROGRAMERS: ** You should adjust this help screen to ** reflect keys applicable to your code. TEXT PASTE KEYS PopCalc7 Help อออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออ Press "P" while in the main calculator to enable the paste function. A paste key will allow you to use place the calculated answer into a data entry field. A window will appear and prompt you to press a key which is to be used as the paste key: F2 thru F10 Shift-F1 thru Shift-F9 Ctrl-F1 thru Ctrl-F10 Once you have returned to your application, a press of the paste key will then enter the stored number into your data entry field. NOTE: Pressing "I" from within calculator screen will immediately exit PopCalc7 and paste the answer to the current field. More.... Page 5 ENDTEXT CASE ln_HelpScr = 6 TEXT TAPE PopCalc7 Help อออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออ Pressing "T" in the main calculator window will open a "tape" of your calculator activity. The last entries will be shown initially. If there are more than ten (10) entries, "More" will be indicated on the top line. You may scroll through the tape by pressing the appropriate keys as detailed proviously in this help session. While in the tape window: Press "P" to print the tape to an attached printer. Press "C" to clear the tape. Press "Esc" to return to the calculator window. -*- END -*- Page 6 ENDTEXT ENDCASE ln_HelpKey = INKEY(0) DO CASE CASE ln_HelpKey = 5 .OR. ln_HelpKey = 19 ; .OR. ln_HelpKey = 18 .OR. ln_HelpKey =1; .OR. ln_HelpKey = -400 ** UpArrow or LeftArrow or PgUp ** Ctrl-LeftArrow or Shift Tab ln_HelpScr = ln_HelpScr - 1 CASE ln_HelpKey = 26 .OR. ; ln_HelpKey = 29 .OR. ln_HelpKey = 31 ** Home or Ctrl-Home or Ctrl-PgUp ln_HelpScr = 1 CASE ln_HelpKey = 2 .OR. ln_HelpKey = 30 ** End or Ctrl-PgDn ln_HelpScr = 6 CASE ln_HelpKey = 27 .OR. ln_HelpKey = 23 ** Escape or Ctrl-End EXIT OTHERWISE ln_HelpScr = ln_HelpScr + 1 ENDCASE IF ln_HelpScr>6 .or. ln_HelpScr<1 ?? CHR(7) ENDIF ln_HelpScr = IIF(ln_HelpScr>6,6,iif(ln_HelpScr<1,1,ln_HelpScr)) ENDDO RELEASE WINDOW CalcHelp IF ml_shadow RELEASE WINDOW ShadHelp ENDIF RESTORE SCREEN FROM CalcHelp RELEASE SCREEN CalcHelp RETURN