The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

Spreadsheet App

April 21 2017 at 4:56 PM
Anonymous  (no login)

 
' lizzycalc version -1
'
' updated March 1995 by eddie kent for qbasic.
' last update: January 1996
'
' commands : description
'---------------:-----------------------------------------------
' "/'/^text : enter text in a current cell (left/right/middle just)
' =expression : enter number or formula in a current cell
' text : repeat text up to cell width
' |fun : static special functions i. e. time, date, file
' : smv, or smh
' @func : real-time special functions of above
' c : change column width
' d : numeric data file of certain cells
' f : do file operations (load/save/new)
' h or ? : show this help screen
' i : insert row or column
' j : toggle form feed after print flag
' p : output results to file or printer without the border
' q : quit
' r : replicate a single cell multiple times
' s : output data to file or printer"
' u : toggle update screen flag
' arrow keys : move cursor in indicated direction
' expressions : numeric constant or cell id in form <col letter><row#>
' above items separated by operators +,-,*,^,|, or /
' evaluation is from left to right without operator
' preference. expressions are evaluated on enter and
' on the u command.
Start:
GOSUB Notice
GOSUB Housekeeping
WHILE Quit$ <> "Yes"
GOSUB Command.loop
WEND
GOSUB End.of.job
END

Housekeeping:
' daffinitions
RANDOMIZE (TIMER)
ON ERROR GOTO Checkerror
Badfilename = 53
Quit$ = "No"
Quote$ = CHR$(34)
Equal$ = "="
DEFINT I, N, W-Y
Updateflag = 1
Nilflag = 1
Equal = 1
Plus = 2
Minus = 3
Multiply = 4
Divide = 5
Exponent = 6
Root = 7
Moveup = 72
Moveleft = 75
Moveright = 77
Movedown = 80
Quit = 16
Scrdepth = 20 : REM 20 is default to cga 45 is good for vga.
Scrwidth = 80
DIM Colwidth(27)
Colbase = 7: REM 7 and 10 work fine for 80 col screen.
Colwidth(0) = 4
FOR x = 1 TO 27
Colwidth(x) = Colbase
NEXT x
WIDTH Scrwidth, Scrdepth + 5
Maxcols = 27
Maxrows = Scrdepth
DIM D(Maxcols, Maxrows), D$(Maxcols, Maxrows), Dold$(Maxcols, Maxrows)
Operate$ = "=+-*/^|"
Numops = LEN(Operate$)
DIM O$(Numops)
FOR zz = 1 TO Numops
O$(zz) = MID$(Operate$, zz, 1)
NEXT zz
FOR x = 1 TO Maxcols
D$(x, 0) = CHR$(x + ASC("A") - 1) + SPACE$(Colwidth(Crsx) - 1)
NEXT x
FOR Y = 1 TO Maxrows
D$(0, Y) = SPACE$(Colwidth(Crsx) - 3) + RIGHT$(STR$(Y), 2) + " "
NEXT Y
Maxcols = Scrwidth / (Colwidth(0) + 1)
D$(0, 0) = " U" + SPACE$(Colwidth(Crsx) - 2)
bb = 0
FOR cc = 0 TO Crsx - 1
bb = bb + Colwidth(cc)
NEXT cc
bbb = 0
FOR ccc = 0 TO 27
bbb = bbb + Colwidth(ccc)
IF bbb >= 80 THEN
EXIT FOR
END IF
NEXT ccc
Maxcols = ccc - 1
GOSUB Printscreen
Crsx = 1
Crsy = 1
GOSUB Screenlocate
COLOR 0, 7
LOCATE Yloc, Xloc
PRINT SPACE$(Colwidth(Crsx));
COLOR 7, 0
RETURN

Command.loop:
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
In$ = ""
Ik = 0
LOCATE Scrdepth + 3, 1
PRINT "Command: ";
WHILE Ik <> &HD
i$ = ""
WHILE i$ = ""
i$ = INKEY$
WEND
Ik = ASC(i$)
SELECT CASE LEN(i$)
CASE 2
SELECT CASE ASC(RIGHT$(i$, 1))
CASE 33
GOSUB Fileroutine
GOSUB Printscreen
GOSUB Show.data
LOCATE Scrdepth + 3, 1
PRINT "Command: ";
CASE Quit
Quit$ = "Yes"
RETURN
CASE Moveup, Movedown, Moveleft, Moveright
GOSUB Movecursor
END SELECT
CASE 1
SELECT CASE Ik
CASE 8
GOSUB Processbackspace
CASE ELSE
IF Ik <> &HD THEN
PRINT i$;
In$ = In$ + i$
END IF
END SELECT
CASE 0
REM
END SELECT
WEND
'Evaluate.the.input.string:
C$ = LEFT$(In$, 1)
LOCATE Scrdepth + 4, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 4, 1
PRINT In$;
SELECT CASE UCASE$(C$)
CASE "'"
GOSUB Makeright
CASE "^"
GOSUB Makemiddle
CASE Quote$
GOSUB Forminput
CASE ""
GOSUB Somerepeat
CASE "|"
GOSUB Funkey
CASE "I"
GOSUB Insertitin
CASE "D"
GOSUB Cellfill
CASE "@"
GOSUB Funcit
CASE "="
GOSUB Forminputa
CASE "U"
GOSUB Updatevalues
CASE "R"
GOSUB Replicatecell
CASE "S"
GOSUB Outdata
CASE "P"
GOSUB Hardcopy
CASE "J"
GOSUB SetFFflag
CASE "F"
GOSUB Fileroutine
CASE "H", "?"
GOSUB Do.Help
GOSUB Printscreen
CASE "C"
GOSUB Setcols
CASE "Q"
Quit$ = "Yes"
RETURN
CASE ""
Nilflag = 0
CASE ELSE
ER$ = "BAD input: " + In$
GOSUB Generaterror
END SELECT
LOCATE 1, 1
COLOR 0, 7
PRINT D$(0, 0);
COLOR 7, 0
IF Updateflag = 1 THEN
GOSUB Do.updatevalues
END IF
GOSUB Show.data
RETURN

End.of.job:
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Enter (S)ave data, or (Q)uit: ";
QQ$ = ""
WHILE QQ$ <> "S" AND QQ$ <> "Q" AND QQ$ <> CHR$(1 + 12)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ <> CHR$(1 + 12) THEN
PRINT QQ$
END IF
IF QQ$ = "Q" OR QQ$ = CHR$(1 + 12) THEN
QQ$ = ""
END IF
IF QQ$ <> "" THEN
SELECT CASE UCASE$(QQ$)
CASE "S"
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
Datum$ = ""
INPUT "Enter file name: ", Datumf$
IF Datumf$ = "" THEN
RETURN
END IF
OPEN Datumf$ FOR OUTPUT AS #1
FOR ay = 1 TO 26
PRINT #1, Colwidth(ay)
NEXT ay
PRINT #1, Updateflag
PRINT #1, Nilflag
FOR ay = 1 TO Maxrows
FOR AX = 1 TO Maxcols
PRINT #1, AX
PRINT #1, ay
IF D$(AX, ay) = "" THEN
PRINT #1, D(AX, ay)
PRINT #1, ""
ELSE
PRINT #1, D(AX, ay)
PRINT #1, D$(AX, ay)
END IF
NEXT AX
NEXT ay
CLOSE #1
QQ$ = ""
END SELECT
END IF
CLS
PRINT "Lizzyclc (V.: -1) from Kent Independent Support Services"
PRINT STRING$(79, 196)
PRINT
PRINT "Thank you for using Lizzyclc."
PRINT "If you use this program more than several times and would like to"
PRINT "see more programs like the Lizzywrd, Lizzytrm, Lizzyclc, Lizzydb,"
PRINT "and Lizzycht then please send $1.00 or more to:"
PRINT
PRINT
a$ = ""
WHILE a$ = ""
a$ = INPUT$(1)
WEND
RETURN

'=========================================================================
' subroutines
Movecursor:
'sub to move cursor
GOSUB Fixit
GOSUB Prepareoutput
SELECT CASE Ik
CASE Moveleft
' move left
IF Crsx > 1 THEN
Crsx = Crsx - 1
END IF
CASE Moveright
'move right
IF Crsx < Maxcols THEN
Crsx = Crsx + 1
END IF
CASE Movedown
' move down
IF Crsy < Maxrows THEN
Crsy = Crsy + 1
END IF
CASE Moveup
' move up
IF Crsy > 1 THEN
Crsy = Crsy - 1
END IF
END SELECT
GOSUB Show.data
RETURN

Screenlocate:
' sub to compute screen postion
bb = 0
FOR cc = 0 TO Crsx - 1
bb = bb + Colwidth(cc)
NEXT cc
Xloc = bb + 1
Yloc = Crsy + 1
RETURN

Processbackspace:
' sub to process backspace on command line
NEWLEN = LEN(In$) - 1
IF NEWLEN >= 0 THEN
GOSUB Commandlst
END IF
RETURN

Forminput:
' sub to formulate input
D(Crsx, Crsy) = 0
TEXTLEN = LEN(In$) - 1
IF TEXTLEN < 1 THEN
TEXTLEN = 1
END IF
IF RIGHT$(In$, 1) = Quote$ THEN
TEXTLEN = TEXTLEN - 1
END IF
Dold$(Crsx, Crsy) = In$
D$(Crsx, Crsy) = In$
GOSUB Showcell
RETURN

Forminputa:
'sub to formula input
V$ = In$
GOSUB Evaluateterm
IF ERRFLAG = 0 THEN
D$(Crsx, Crsy) = In$
Dold$(Crsx, Crsy) = In$
END IF
GOSUB Showcell
RETURN

Prepareoutput:
'SUB TO PREPARE OUTPUT
Dold$(Crsx, Crsy) = D$(Crsx, Crsy)
IF LEFT$(Dold$(Crsx, Crsy), 1) <> Quote$ THEN
SELECT CASE LEFT$(D$(Crsx, Crsy), 1)
CASE "="
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + STR$(D(Crsx, Crsy)), Colwidth(Crsx))
IF RIGHT$(Dold$(Crsx, Crsy), 1) = Quote$ THEN
Dold$(Crsx, Crsy) = LEFT$(Dold$(Crsx, Crsy), LEN(Dold$(Crsx, Crsy)) - 1)
END IF
IF RIGHT$(D$(Crsx, Crsy), 1) = Quote$ THEN
D$(Crsx, Crsy) = LEFT$(D$(Crsx, Crsy), LEN(D$(Crsx, Crsy)) - 1)
END IF
CASE "@"
SELECT CASE LCASE$(MID$(D$(Crsx, Crsy), 2, 4))
CASE "time"
V$ = TIME$
CASE "date"
V$ = DATE$
CASE "file"
V$ = Datumf$
CASE "smv("
Cntr1 = ASC(MID$(UCASE$(D$(Crsx, Crsy)), 6, 1)) - 64
Cntr2 = VAL(MID$(D$(Crsx, Crsy), 7, 2))
Cntr3 = VAL(MID$(D$(Crsx, Crsy), 9, 2))
D(Crsx, Crsy) = 0
FOR x = Cntr2 TO Cntr3
D(Crsx, Crsy) = D(Crsx, Crsy) + D(Cntr1, x)
NEXT x
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + STR$(D(Crsx, Crsy)), Colwidth(Crsx))
CASE "smh("
Cntr1 = ASC(MID$(UCASE$(D$(Crsx, Crsy)), 6, 1)) - 64
Cntr2 = VAL(MID$(D$(Crsx, Crsy), 7, 2))
Cntr3 = ASC(MID$(UCASE$(D$(Crsx, Crsy)), 9, 1)) - 64
D(Crsx, Crsy) = 0
FOR x = Cntr1 TO Cntr3
D(Crsx, Crsy) = D(Crsx, Crsy) + D(x, Cntr2)
NEXT x
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + STR$(D(Crsx, Crsy)), Colwidth(Crsx))
END SELECT
CASE ""
Znrepeat$ = ""
Zrepeat$ = RIGHT$(D$(Crsx, Crsy), LEN(D$(Crsx, Crsy)) - 1)
FOR x = 1 TO Colwidth(Crsx)
Znrepeat$ = Znrepeat$ + Zrepeat$
NEXT x
V$ = LEFT$(Znrepeat$, Colwidth(Crsx))
CASE "'"
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + RIGHT$(D$(Crsx, Crsy), LEN(D$(Crsx, Crsy)) - 1), Colwidth(Crsx))
CASE "^"
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + RIGHT$(D$(Crsx, Crsy), LEN(D$(Crsx, Crsy)) - 1), INT(LEN(D$(Crsx, Crsy)) + Colwidth(Crsx)) / 2)
CASE ELSE
V$ = LEFT$(D$(Crsx, Crsy) + SPACE$(Colwidth(Crsx)), Colwidth(Crsx))
END SELECT
ELSE
IF LEN(V$) < Colwidth(Crsx) THEN
V$ = RIGHT$(D$(Crsx, Crsy), LEN(Dold$(Crsx, Crsy)) - 1) + SPACE$(Colwidth(Crsx))
ELSE
V$ = RIGHT$(D$(Crsx, Crsy), LEN(Dold$(Crsx, Crsy)) - 1)
END IF
END IF
IF D$(Crsx, Crsy) = "" THEN
D(Crsx, Crsy) = 0
END IF
V$ = LEFT$(V$ + SPACE$(Colwidth(Crsx)), Colwidth(Crsx))
RETURN

Evaluateterm:
' SUB TO EVALUATE EXPRESSION
ERRFLAG = 0
VI$ = V$
WHILE V$ <> ""
GOSUB Decodeoperator
IF ERRFLAG <> 0 THEN
ER$ = "BAD OPERATOR IN:" + VI$
GOSUB Generaterror
RETURN
END IF
GOSUB Decodeoperand
IF ERRFLAG <> 0 THEN
ER$ = "BAD FORMULA:" + VI$
GOSUB Generaterror
RETURN
END IF
SELECT CASE OPCODE
CASE IS = Equal
VL = V
CASE IS = Plus
VL = VL + V
CASE IS = Minus
VL = VL - V
CASE IS = Multiply
VL = VL * V
CASE IS = Divide
VL = VL / V
CASE IS = Exponent
VL = VL ^ V
CASE IS = Root
VL = VL ^ (1 / V)
END SELECT
WEND
D(Crsx, Crsy) = VL
RETURN

Decodeoperator:
' SUB TO DECODE OPERATOR
Op$ = LEFT$(V$, 1)
OPCODE = 0
FOR i = 1 TO Numops
IF Op$ = O$(i) THEN
OPCODE = i
i = Numops
V$ = MID$(V$, 2)
END IF
NEXT i
IF OPCODE = 0 THEN
ERRFLAG = 1
END IF
RETURN

Decodeoperand:
'SUB TO DECODE OPERAND
V = VAL(V$)
C$ = LEFT$(V$, 1)
ERRFLAG = 0
T = 0
IF V = 0 AND C$ <> "0" THEN
GOSUB Processcellnam
ELSE
GOSUB Processconstant
END IF
RETURN

Processconstant:
'SUB TO PROCESS AS A CONSTANT
IX = 1
IF C$ = "-" THEN
C$ = "0"
END IF
WHILE (C$ >= "0" AND C$ <= "9") OR C$ = "."
IX = IX + 1
C$ = MID$(V$, IX, 1)
WEND
V$ = MID$(V$, IX)
RETURN

Processcellnam:
'SUB TO PROCESS A CELL NAME
C = ASC(C$) - ASC("A") + 1
IF C > 32 THEN
C = C - 32
END IF
IF C < 1 OR C > Maxcols THEN
ERRFLAG = 1
RETURN
END IF
XC = C
C = 0
WHILE V$ <> "" AND C >= 0 AND C <= 9
V$ = MID$(V$, 2)
IF V$ <> "" THEN
C = ASC(V$) - ASC("0")
IF C >= 0 AND C <= 9 THEN
T = T * Colwidth(Crsx) + C
END IF
END IF
WEND
IF T = 0 OR T > Maxrows THEN
ERRFLAG = 1
RETURN
END IF
YC = T
V = D(XC, YC)
RETURN

Generaterror:
' SUB TO GENERATE GENERAL ERROR REPORT
LOCATE Scrdepth + 4, 1
PRINT ER$ + " ";
BEEP
WHILE INKEY$ = ""
WEND
LOCATE Scrdepth + 4, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 4, 1
PRINT CHR$(64 + Crsx); LTRIM$(RTRIM$(STR$(Crsy))); ": "; D$(Crsx, Crsy);
RETURN

Updatevalues:
' sub to update formula values
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Enter Automatic update (O)n or o(F)f: ";
QQ$ = ""
WHILE QQ$ <> "O" AND QQ$ <> "F" AND QQ$ <> "Q" AND QQ$ <> CHR$(1 + 12)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ <> CHR$(1 + 12) THEN
PRINT QQ$
END IF
SELECT CASE UCASE$(QQ$)
CASE "O"
Updateflag = 1
MID$(D$(0, 0), 2, 1) = "U"
CASE "F"
Updateflag = 0
MID$(D$(0, 0), 2, 1) = " "
END SELECT
RETURN

Do.updatevalues:
LOCATE Scrdepth + 4, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 4, 1
PRINT "Caculating!";
LOCATE 1, 1
Tempy = Crsy
Tempx = Crsx
FOR Crsy = 1 TO Maxrows
LOCATE Crsy + 1, Colwidth(0) + 1
FOR Crsx = 1 TO Maxcols
IF LEFT$(Dold$(Crsx, Crsy), 1) <> Quote$ AND LEFT$(Dold$(Crsx, Crsy), 1) <> "" THEN
SELECT CASE LEFT$(D$(Crsx, Crsy), 1)
CASE "="
V$ = D$(Crsx, Crsy)
GOSUB Evaluateterm
END SELECT
ELSE
V$ = RIGHT$(D$(Crsx, Crsy), Colwidth(Crsx))
END IF
GOSUB Screenlocate
LOCATE Yloc, Xloc
GOSUB Prepareoutput
PRINT LEFT$(V$, Colwidth(Crsx));
IF POS(0) + Colwidth(Crsx + 1) > 80 THEN
EXIT FOR
END IF
NEXT Crsx
NEXT Crsy
Crsx = Tempx
Crsy = Tempy
GOSUB Screenlocate
GOSUB Showcell
LOCATE Scrdepth + 4, 1
PRINT STRING$(79, " ");
LOCATE Scrdepth + 4, 1
PRINT CHR$(64 + Crsx); LTRIM$(RTRIM$(STR$(Crsy))); " "; D$(Crsx, Crsy);
RETURN

Showcell:
' sub to show current cell value
GOSUB Screenlocate
GOSUB Prepareoutput
COLOR 0, 7
LOCATE Yloc, Xloc
PRINT V$;
COLOR 7, 0
RETURN

Fileroutine:
'--
' (F)ile routine
'--
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Enter (L)oad data, (S)ave data, (N)ew, or (Q)uit: ";
QQ$ = ""
WHILE QQ$ <> "L" AND QQ$ <> "S" AND QQ$ <> "Q" AND QQ$ <> "N" AND QQ$ <> CHR$(1 + 12)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ <> CHR$(1 + 12) THEN
PRINT QQ$
END IF
IF QQ$ = "Q" OR QQ$ = CHR$(1 + 12) THEN
QQ$ = ""
END IF
IF QQ$ <> "" THEN
IF QQ$ <> "N" THEN
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
Datum$ = ""
INPUT "Enter file name: ", Datumf$
IF Datumf$ = "" THEN
RETURN
END IF
END IF
SELECT CASE UCASE$(QQ$)
CASE "L"
OPEN Datumf$ FOR INPUT AS #1
FOR ay = 1 TO 26
INPUT #1, Colwidth(ay)
NEXT ay
INPUT #1, Updateflag
INPUT #1, Nilflag
WHILE NOT EOF(1)
INPUT #1, FX
INPUT #1, FY
INPUT #1, D(FX, FY)
LINE INPUT #1, D$(FX, FY)
WEND
CLOSE #1
QQ$ = ""
IF Updateflag = 0 THEN
GOSUB Do.updatevalues
END IF
GOSUB Printscreen
CASE "N"
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Are you sure (Y/N): ";
QQ1$ = ""
WHILE QQ1$ <> "Y" AND QQ1$ <> "N"
QQ1$ = UCASE$(INPUT$(1))
WEND
PRINT QQ1$
IF QQ1$ = "Y" THEN
FOR Poo1 = 1 TO Maxcols
FOR Poo2 = 1 TO Maxrows
D(Poo1, Poo2) = 0
D$(Poo1, Poo2) = ""
Dold$(Poo1, Poo2) = ""
NEXT Poo2
NEXT Poo1
GOSUB Do.updatevalues
END IF
CASE "S"
OPEN Datumf$ FOR OUTPUT AS #1
FOR ay = 1 TO 26
PRINT #1, Colwidth(ay)
NEXT ay
PRINT #1, Updateflag
PRINT #1, Nilflag
FOR ay = 1 TO Maxrows
FOR AX = 1 TO Maxcols
PRINT #1, AX
PRINT #1, ay
IF D$(AX, ay) = "" THEN
PRINT #1, D(AX, ay)
PRINT #1, ""
ELSE
PRINT #1, D(AX, ay)
PRINT #1, D$(AX, ay)
END IF
NEXT AX
NEXT ay
CLOSE #1
QQ$ = ""
END SELECT
END IF
RETURN

Printscreen:
' sub to print screen
CLS
DD = 0
Tempy = Crsy
Tempx = Crsx
LOCATE Scrdepth + 5, 11
PRINT "LIZZYCALC version -1 from Kent Independent Support Services"
LOCATE 1, 1
FOR Crsy = 0 TO Maxrows
LOCATE Crsy + 1, 1
FOR Crsx = 0 TO Maxcols
GOSUB Prepareoutput
IF Crsx = 0 OR Crsy = 0 THEN
COLOR 0, 7
ELSE
COLOR 7, 0
END IF
PRINT V$;
IF Crsx = 0 OR Crsy = 0 THEN
COLOR 7, 0
ELSE
COLOR 0, 7
END IF
IF POS(0) + Colwidth(Crsx + 1) > 80 THEN
EXIT FOR
END IF
NEXT Crsx
NEXT Crsy
COLOR 7, 0
Crsx = Tempx
Crsy = Tempy
LOCATE Scrdepth + 2, 1
PRINT SPACE$(79);
RETURN

Commandlst:
In$ = LEFT$(In$, NEWLEN)
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Command: "; In$;
RETURN

Fixit:
' fix i$
Ik = ASC(RIGHT$(i$, 1))
RETURN

It:
REM
RETURN

Show.data:
LOCATE Yloc, Xloc
PRINT V$;
LOCATE Scrdepth + 4, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 4, 1
PRINT CHR$(64 + Crsx); LTRIM$(RTRIM$(STR$(Crsy))); ": "; LTRIM$(RTRIM$(STR$(D(Crsx, Crsy)))); ", "; D$(Crsx, Crsy);
GOSUB Showcell
LOCATE Scrdepth + 3, LEN(In$) + 10
RETURN

Somerepeat:
Znrepeat$ = ""
Zin$ = In$
Zrepeat$ = RIGHT$(In$, LEN(In$) - 1)
FOR x = 1 TO Colwidth(Crsx)
Znrepeat$ = Znrepeat$ + Zrepeat$
NEXT x
V$ = LEFT$(Znrepeat$, Colwidth(Crsx) + 1)
Dold$(Crsx, Crsy) = Zin$
D$(Crsx, Crsy) = Zin$
GOSUB Forminput
RETURN

Replicatecell:
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter cell to replicate: ", Cell$
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to start copy: ", Cellstart$
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to end copy: ", Cellend$
Cellcol = ASC(LEFT$(UCASE$(Cell$), 1)) - 64
Cellrow = VAL(RIGHT$(Cell$, LEN(Cell$) - 1))
Cellstartcol = ASC(LEFT$(UCASE$(Cellstart$), 1)) - 64
Cellstartrow = VAL(RIGHT$(Cellstart$, LEN(Cellstart$) - 1))
Cellendcol = ASC(LEFT$(UCASE$(Cellend$), 1)) - 64
Cellendrow = VAL(RIGHT$(Cellend$, LEN(Cellend$) - 1))
D$(Cellcol, Cellrow) = Dold$(Cellcol, Cellrow)
FOR Cellcountcol = Cellstartcol TO Cellendcol
FOR Cellcountrow = Cellstartrow TO Cellendrow
snaker = Cellcountrow - Cellrow
snakec = Cellcountcol - Cellcol
SELECT CASE LEFT$(D$(Cellcol, Cellrow), 1)
CASE "@"
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), 2, 3)
CASE "smv"
snk1$ = CHR$(ASC(MID$(D$(Cellcol, Cellrow), 6, 1)) + snakec)
snake$ = snk1$ + MID$(D$(Cellcol, Cellrow), 7, 4)
D$(Cellcountcol, Cellcountrow) = "@smv(" + snake$ + ")"
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
CASE "smh"
snk1$ = MID$(D$(Cellcol, Cellrow), 6, 1)
snk2$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(MID$(D$(Cellcol, Cellrow), 7, 2)) + snaker))), 2)
snk3$ = MID$(D$(Cellcol, Cellrow), 9, 1)
snake$ = snk1$ + snk2$ + snk3$
D$(Cellcountcol, Cellcountrow) = "@smh(" + snake$ + ")"
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
END SELECT
CASE "="
Passing$ = ""
FOR x = 1 TO LEN(D$(Cellcol, Cellrow))
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), x, 1)
CASE "+", "=", "-", "*", "/", "^", "|"
Passing$ = Passing$ + MID$(D$(Cellcol, Cellrow), x, 1)
CASE "a" TO "z"
Passing$ = Passing$ + CHR$(ASC(MID$(D$(Cellcol, Cellrow), x, 1)) + snakec)
CASE "0" TO "9"
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), x - 1, 1)
CASE "a" TO "z"
Passingnum$ = ""
FOR Y = x TO LEN(D$(Cellcol, Cellrow))
Passpoo$ = MID$(D$(Cellcol, Cellrow), Y, 1)
IF Passpoo$ < "0" OR Passpoo$ > "9" THEN
EXIT FOR
END IF
Passingnum$ = Passingnum$ + Passpoo$
x = x + 1
NEXT Y
x = x - 1
Passing$ = Passing$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(Passingnum$) + snaker))), 2)
CASE ELSE
Passingnum$ = ""
FOR Y = x TO LEN(D$(Cellcol, Cellrow))
Passpoo$ = MID$(D$(Cellcol, Cellrow), Y, 1)
IF Passpoo$ < "0" OR Passpoo$ > "9" THEN
EXIT FOR
END IF
Passingnum$ = Passingnum$ + Passpoo$
x = x + 1
NEXT Y
x = x - 1
Passing$ = Passing$ + Passingnum$
END SELECT
END SELECT
NEXT x
D$(Cellcountcol, Cellcountrow) = Passing$
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
CASE ELSE
Dold$(Cellcountcol, Cellcountrow) = Dold$(Cellcol, Cellrow)
D$(Cellcountcol, Cellcountrow) = D$(Cellcol, Cellrow)
In$ = D$(Cellcol, Cellrow)
END SELECT
NEXT Cellcountrow
NEXT Cellcountcol
GOSUB Do.updatevalues
RETURN

Do.Help:
CLS
PRINT " LIZZYCALC version -1 HELP screen"
PRINT ""
PRINT " commands : description"
PRINT "---------------:-----------------------------------------------"
PRINT " "; CHR$(34); "/'/^text : enter text (left/right/middle justified) in a current cell"
PRINT " =expression : enter number or formula in a current cell"
PRINT " text : repeat text up to cell width"
PRINT " |fun or @func : functions; i. e. time, date, file, smv(cornr), or smh(corc)"
PRINT " c : change column width"
PRINT " d : numeric data fill of certain cells"
PRINT " f : do file operations (load/save/new)"
PRINT " i : insert column or row"
PRINT " j : toggle form feed after print flag"
PRINT " n : new spreadsheet (wipe away page forever)"
PRINT " p : output results to file or printer without a border"
PRINT " q : quit"
PRINT " r : replicate a single cell multiple times"
PRINT " s : output data to file or printer"
PRINT " u : toggle update screen flag"
PRINT " arrow keys : move cursor in indicated direction"
PRINT " expressions : numeric constant or cell id in form <col letter><row#>"
PRINT " above items separated by operators +,-,*,^,|, or /"
PRINT " evaluation is from left to right without operator preference."
PRINT "--------------------------------------------------------------------------";
Booboo$ = INPUT$(1)
IF Updateflag = 0 THEN
GOSUB Printscreen
END IF
RETURN

Notice:
CLS
PRINT
PRINT
PRINT "] LIZZYCALC Version -1"
PRINT "]"
PRINT "]This is a beta version program."
PRINT "]Please use with caution and patience."
PRINT "]"
PRINT "]Thank you,"
PRINT
PRINT "Press any key to continue: _";
Booboo$ = ""
WHILE Booboo$ = ""
Booboo$ = INKEY$
rem SOUND 500, .1
FOR x& = 1 TO 40000
NEXT x&
rem SOUND 2000, .1
FOR x& = 1 TO 40000
NEXT x&
WEND
PRINT Booboo$
RETURN

Hardcopy:
Tempy = Crsy
Tempx = Crsx
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Enter (P)rint or (Q)uit: ";
QQ$ = ""
WHILE QQ$ <> "P" AND QQ$ <> "Q" AND QQ$ <> CHR$(1 + 12)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ <> CHR$(1 + 12) THEN
PRINT QQ$
END IF
IF QQ$ = "P" AND (QQ$ <> "Q" OR QQ$ <> CHR$(1 + 12)) THEN
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to start print: ", Cellstart$
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to end print: ", Cellend$
Cellstartcol = ASC(LEFT$(UCASE$(Cellstart$), 1)) - 64
Cellstartrow = VAL(RIGHT$(Cellstart$, LEN(Cellstart$) - 1))
Cellendcol = ASC(LEFT$(UCASE$(Cellend$), 1)) - 64
Cellendrow = VAL(RIGHT$(Cellend$, LEN(Cellend$) - 1))
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
Datum$ = ""
INPUT "Enter file name (prn for printer): ", Datum$
Datum$ = LCASE$(Datum$)
IF Datum$ = "" THEN
Datum$ = "prn"
END IF
IF Datum$ = "con" THEN
CLS
END IF
'sub to print screen
OPEN Datum$ FOR OUTPUT AS #2
DD = 0
FOR Cellcountrow = Cellstartrow TO Cellendrow
FOR Cellcountcol = Cellstartcol TO Cellendcol
Crsx = Cellcountcol
Crsy = Cellcountrow
GOSUB Prepareoutput
IF Crsy = 0 OR Crsx = 0 THEN
REM
ELSE
PRINT #2, V$;
END IF
NEXT Cellcountcol
PRINT #2, ""
NEXT Cellcountrow
LOCATE Scrdepth + 2, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 2, 1
IF FFflag = 1 THEN
SELECT CASE Datum$
CASE "prn"
PRINT #2, CHR$(12)
CASE "con"
CLS
CASE ELSE
PRINT #2, CHR$(12)
END SELECT
ELSEIF Datum$ = "con" THEN
PRINT "Press <return> to continue";
doopoo$ = INPUT$(1)
END IF
CLOSE #2
END IF
Crsx = Tempx
Crsy = Tempy
LOCATE Scrdepth + 2, 1
PRINT SPACE$(79);
RETURN

SetFFflag:
IF FFflag = 0 THEN
FFflag = 1
MID$(D$(0, 0), 1, 1) = "J"
ELSEIF FFflag = 1 THEN
FFflag = 0
MID$(D$(0, 0), 1, 1) = " "
END IF
RETURN

Funkey:
SELECT CASE LCASE$(MID$(In$, 2, 3))
CASE "tim"
D$(Crsx, Crsy) = Quote$ + TIME$
Dold$(Crsx, Crsy) = D$(Crsx, Crsy)
CASE "dat"
D$(Crsx, Crsy) = Quote$ + DATE$
Dold$(Crsx, Crsy) = D$(Crsx, Crsy)
CASE "fil"
D$(Crsx, Crsy) = Quote$ + Datumf$
Dold$(Crsx, Crsy) = D$(Crsx, Crsy)
END SELECT
RETURN

Funcit:
D(Crsx, Crsy) = 0
Dold$(Crsx, Crsy) = In$
D$(Crsx, Crsy) = In$
RETURN

Setcols:
Tempy = Crsy
Tempx = Crsx
Colchoose$ = ""
WHILE UCASE$(Colchoose$) < "A" OR UCASE$(Colchoose$) > "Z"
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Column to change: ", Colchoose$
WEND
Colchoose = ASC(UCASE$(Colchoose$)) - 64
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter new cell width: ", Colwidth(Colchoose)
Scrdepth = 45
Crsx = Tempx
Crsy = Tempy
bb = 0
FOR cc = 0 TO Crsx - 1
bb = bb + Colwidth(cc)
NEXT cc
bbb = 0
FOR ccc = 0 TO 27
bbb = bbb + Colwidth(ccc)
IF bbb >= 80 THEN
EXIT FOR
END IF
NEXT ccc
Maxcols = ccc - 1
GOSUB Printscreen
LOCATE Scrdepth + 2, 1
PRINT SPACE$(79);
RETURN

Outdata:
Tempy = Crsy
Tempx = Crsx
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Enter (S)end data or (Q)uit: ";
QQ$ = ""
WHILE QQ$ <> "S" AND QQ$ <> "Q" AND QQ$ <> CHR$(1 + 12)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ <> CHR$(1 + 12) THEN
PRINT QQ$
END IF
IF QQ$ = "S" AND (QQ$ <> "Q" OR QQ$ <> CHR$(1 + 12)) THEN
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to start print: ", Cellstart$
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to end print: ", Cellend$
Cellstartrow = ASC(LEFT$(UCASE$(Cellstart$), 1)) - 64
Cellstartcol = VAL(RIGHT$(Cellstart$, LEN(Cellstart$) - 1))
Cellendrow = ASC(LEFT$(UCASE$(Cellend$), 1)) - 64
Cellendcol = VAL(RIGHT$(Cellend$, LEN(Cellend$) - 1))
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
Datum$ = ""
INPUT "Enter file name (prn for printer): ", Datum$
Datum$ = LCASE$(Datum$)
IF Datum$ = "" THEN
Datum$ = "prn"
END IF
IF Datum$ = "con" THEN
CLS
END IF
'sub to print screen
OPEN Datum$ FOR OUTPUT AS #2
DD = 0
PRINT #2, "File: " + Datumf$
FOR Cellcountrow = Cellstartrow TO Cellendrow
FOR Cellcountcol = Cellstartcol TO Cellendcol
Crsx = Cellcountcol
Crsy = Cellcountrow
IF Crsy = 0 OR Crsx = 0 THEN
REM
ELSE
PRINT #2, CHR$(64 + Cellcountrow) + RTRIM$(LTRIM$(STR$(Cellcountcol))) + ": " + D$(Cellcountrow, Cellcountcol)
END IF
NEXT Cellcountcol
NEXT Cellcountrow
LOCATE Scrdepth + 2, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 2, 1
IF FFflag = 1 THEN
SELECT CASE Datum$
CASE "prn"
PRINT #2, CHR$(12)
CASE "con"
CLS
CASE ELSE
PRINT #2, CHR$(12)
END SELECT
ELSEIF Datum$ = "con" THEN
PRINT "Press <return> to continue";
doopoo$ = INPUT$(1)
END IF
CLOSE #2
END IF
Crsx = Tempx
Crsy = Tempy
LOCATE Scrdepth + 2, 1
PRINT SPACE$(79);
RETURN

Makeright:
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + D$(Crsx, Crsy), Colwidth(Crsx))
GOSUB Forminput
RETURN

Makemiddle:
V$ = RIGHT$(SPACE$(Colwidth(Crsx)) + D$(Crsx, Crsy), INT(LEN(D$(Crsx, Crsy)) + Colwidth(Crsx)) / 2)
GOSUB Forminput
RETURN

Cellfill:
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to start fill: ", Cellstart$
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter where to end fill: ", Cellend$
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter start value: ", Startvalue
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter increment: ", Increment
Cellstartcol = ASC(LEFT$(UCASE$(Cellstart$), 1)) - 64
Cellstartrow = VAL(RIGHT$(Cellstart$, LEN(Cellstart$) - 1))
Cellendcol = ASC(LEFT$(UCASE$(Cellend$), 1)) - 64
Cellendrow = VAL(RIGHT$(Cellend$, LEN(Cellend$) - 1))
Dummyvalue = Startvalue - Increment
FOR Cellcountcol = Cellstartcol TO Cellendcol
FOR Cellcountrow = Cellstartrow TO Cellendrow
Dummyvalue = Dummyvalue + Increment
D$(Cellcountcol, Cellcountrow) = "=" + LTRIM$(RTRIM$(STR$(Dummyvalue)))
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
NEXT Cellcountrow
NEXT Cellcountcol
GOSUB Do.updatevalues
RETURN

Insertitin:
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
PRINT "Insert (C)olumn, or (R)ow: ";
QQ$ = ""
WHILE QQ$ <> "C" AND QQ$ <> "R" AND QQ$ <> "Q" AND QQ$ <> CHR$(1 + 12)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ <> CHR$(1 + 12) THEN
PRINT QQ$
END IF
IF QQ$ = "Q" OR QQ$ = CHR$(1 + 12) THEN
QQ$ = ""
END IF
IF QQ$ <> "" THEN
SELECT CASE QQ$
CASE "C"
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter Column where to insert: ", Insertcol$
Cellstart$ = Insertcol$ + "01"
Cellend$ = CHR$(Maxcols + 1 + 64) + "45"
Cellstartcol = ASC(LEFT$(UCASE$(Cellstart$), 1)) - 64
Cellstartrow = VAL(RIGHT$(Cellstart$, LEN(Cellstart$) - 1))
Cellendcol = ASC(LEFT$(UCASE$(Cellend$), 1)) - 64
Cellendrow = VAL(RIGHT$(Cellend$, LEN(Cellend$) - 1))
FOR Cellcountcol = Cellendcol TO Cellstartcol STEP -1
FOR Cellcountrow = Cellstartrow TO Cellendrow
IF Cellcountcol <> Cellstartcol THEN
Cell$ = D$(Cellcountcol - 1, Cellcountrow)
Cellcol = Cellcountcol - 1
Cellrow = Cellcountrow
snaker = Cellcountrow - Cellrow
snakec = Cellcountcol - Cellcol
SELECT CASE LEFT$(D$(Cellcol, Cellrow), 1)
CASE "@"
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), 2, 3)
CASE "smv"
snk1$ = CHR$(ASC(MID$(D$(Cellcol, Cellrow), 6, 1)) + 1): 'snakec)
snake$ = snk1$ + MID$(D$(Cellcol, Cellrow), 7, 4)
D$(Cellcountcol, Cellcountrow) = "@smv(" + snake$ + ")"
CASE "smh"
snk1$ = MID$(D$(Cellcol, Cellrow), 6, 1)
snk2$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(MID$(D$(Cellcol, Cellrow), 7, 2)) + snaker))), 2)
snk3$ = MID$(D$(Cellcol, Cellrow), 9, 1)
snake$ = snk1$ + snk2$ + snk3$
D$(Cellcountcol, Cellcountrow) = "@smh(" + snake$ + ")"
FOR x = 5 TO LEN(D$(Cellcountcol, Cellcountrow))
garfunc$ = MID$(D$(Cellcountcol, Cellcountrow), x, 1)
SELECT CASE UCASE$(garfunc$)
CASE "A" TO "Z"
MID$(D$(Cellcountcol, Cellcountrow), x, 1) = CHR$(ASC(garfunc$) + 1)
END SELECT
NEXT x
CASE ELSE
D$(Cellcountcol, Cellcountrow) = D$(Cellcountcol - 1, Cellcountrow)
END SELECT
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
CASE "="
Passing$ = ""
FOR x = 1 TO LEN(D$(Cellcol, Cellrow))
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), x, 1)
CASE "+", "=", "-", "*", "/", "^", "|"
Passing$ = Passing$ + MID$(D$(Cellcol, Cellrow), x, 1)
CASE "a" TO "z"
Passing$ = Passing$ + CHR$(ASC(MID$(D$(Cellcol, Cellrow), x, 1)) + snakec)
CASE "0" TO "9"
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), x - 1, 1)
CASE "a" TO "z"
Passingnum$ = ""
FOR Y = x TO LEN(D$(Cellcol, Cellrow))
Passpoo$ = MID$(D$(Cellcol, Cellrow), Y, 1)
IF Passpoo$ < "0" OR Passpoo$ > "9" THEN
EXIT FOR
END IF
Passingnum$ = Passingnum$ + Passpoo$
x = x + 1
NEXT Y
x = x - 1
Passing$ = Passing$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(Passingnum$) + snaker))), 2)
CASE ELSE
Passingnum$ = ""
FOR Y = x TO LEN(D$(Cellcol, Cellrow))
Passpoo$ = MID$(D$(Cellcol, Cellrow), Y, 1)
IF Passpoo$ < "0" OR Passpoo$ > "9" THEN
EXIT FOR
END IF
Passingnum$ = Passingnum$ + Passpoo$
x = x + 1
NEXT Y
x = x - 1
Passing$ = Passing$ + Passingnum$
END SELECT
END SELECT
NEXT x
D$(Cellcountcol, Cellcountrow) = Passing$
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
CASE ELSE
Dold$(Cellcountcol, Cellcountrow) = Dold$(Cellcol, Cellrow)
D$(Cellcountcol, Cellcountrow) = D$(Cellcol, Cellrow)
In$ = D$(Cellcountcol, Cellcountrow)
END SELECT
ELSE
D$(Cellcountcol, Cellcountrow) = ""
D(Cellcountcol, Cellcountrow) = 0
END IF
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
NEXT Cellcountrow
NEXT Cellcountcol
GOSUB Do.updatevalues
CASE "R"
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter row where to insert: ", Insertrow
Rowstart$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Insertrow))), 2)
Cellstart$ = "A" + Rowstart$
Cellend$ = CHR$(Maxcols + 1 + 64) + "45"
Cellstartcol = ASC(LEFT$(UCASE$(Cellstart$), 1)) - 64
Cellstartrow = VAL(RIGHT$(Cellstart$, LEN(Cellstart$) - 1))
Cellendcol = ASC(LEFT$(UCASE$(Cellend$), 1)) - 64
Cellendrow = VAL(RIGHT$(Cellend$, LEN(Cellend$) - 1))
FOR Cellcountcol = Cellstartcol TO Cellendcol
FOR Cellcountrow = Cellendrow TO Cellstartrow STEP -1
IF Cellcountrow <> Cellstartrow THEN
Cell$ = D$(Cellcountcol, Cellcountrow - 1)
Cellcol = Cellcountcol
Cellrow = Cellcountrow - 1
snaker = Cellcountrow - Cellrow
snakec = Cellcountcol - Cellcol
SELECT CASE LEFT$(D$(Cellcol, Cellrow), 1)
CASE "@"
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), 2, 3)
CASE "smv"
snk1$ = CHR$(ASC(MID$(D$(Cellcol, Cellrow), 6, 1)) + snakec)
snake$ = snk1$ + MID$(D$(Cellcol, Cellrow), 7, 4)
D$(Cellcountcol, Cellcountrow) = "@smv(" + snake$ + ")"
MID$(D$(Cellcountcol, Cellcountrow), 7, 2) = RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(MID$(D$(Cellcountcol, Cellcountrow), 7, 2)) + 1))), 2)
MID$(D$(Cellcountcol, Cellcountrow), 9, 2) = RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(MID$(D$(Cellcountcol, Cellcountrow), 9, 2)) + 1))), 2)
CASE "smh"
snk1$ = MID$(D$(Cellcol, Cellrow), 6, 1)
snk2$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(MID$(D$(Cellcol, Cellrow), 7, 2)) + 1))), 2): '+snaker
snk3$ = MID$(D$(Cellcol, Cellrow), 9, 1)
snake$ = snk1$ + snk2$ + snk3$
D$(Cellcountcol, Cellcountrow) = "@smh(" + snake$ + ")"
CASE ELSE
D$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow - 1)
END SELECT
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
CASE "="
Passing$ = ""
FOR x = 1 TO LEN(D$(Cellcol, Cellrow))
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), x, 1)
CASE "+", "=", "-", "*", "/", "^", "|"
Passing$ = Passing$ + MID$(D$(Cellcol, Cellrow), x, 1)
CASE "a" TO "z"
Passing$ = Passing$ + CHR$(ASC(MID$(D$(Cellcol, Cellrow), x, 1)) + snakec)
CASE "0" TO "9"
SELECT CASE MID$(LCASE$(D$(Cellcol, Cellrow)), x - 1, 1)
CASE "a" TO "z"
Passingnum$ = ""
FOR Y = x TO LEN(D$(Cellcol, Cellrow))
Passpoo$ = MID$(D$(Cellcol, Cellrow), Y, 1)
IF Passpoo$ < "0" OR Passpoo$ > "9" THEN
EXIT FOR
END IF
Passingnum$ = Passingnum$ + Passpoo$
x = x + 1
NEXT Y
x = x - 1
Passing$ = Passing$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(VAL(Passingnum$) + snaker))), 2)
CASE ELSE
Passingnum$ = ""
FOR Y = x TO LEN(D$(Cellcol, Cellrow))
Passpoo$ = MID$(D$(Cellcol, Cellrow), Y, 1)
IF Passpoo$ < "0" OR Passpoo$ > "9" THEN
EXIT FOR
END IF
Passingnum$ = Passingnum$ + Passpoo$
x = x + 1
NEXT Y
x = x - 1
Passing$ = Passing$ + Passingnum$
END SELECT
END SELECT
NEXT x
D$(Cellcountcol, Cellcountrow) = Passing$
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
CASE ELSE
Dold$(Cellcountcol, Cellcountrow) = Dold$(Cellcol, Cellrow)
D$(Cellcountcol, Cellcountrow) = D$(Cellcol, Cellrow)
In$ = D$(Cellcol, Cellrow)
END SELECT
ELSE
D$(Cellcountcol, Cellcountrow) = ""
D(Cellcountcol, Cellcountrow) = 0
END IF
Dold$(Cellcountcol, Cellcountrow) = D$(Cellcountcol, Cellcountrow)
In$ = D$(Cellcountcol, Cellcountrow)
NEXT Cellcountrow
NEXT Cellcountcol
GOSUB Do.updatevalues
END SELECT
END IF
RETURN

Checkerror:
SELECT CASE ERR
CASE 52, Badfilename
rem RESUME Fileroutine
END SELECT
END


 
 Respond to this message   
Response TitleAuthor and Date
*This is neat, where did you dig this up?Simmons on May 25
 Copyright © 1999-2017 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums