Posted by: computoman | June 12, 2009

A to do list for a spreadsheet or how software evolves.

An electronic spreadsheet is sort of a calculator and an accountants worksheet all built into one. Here is the original code that I found for an old cpm operating system (control process for microcomputers) written for the original version of the basic language interpreter:

Original code:


1000 '
1010 ' lizzycalc .01
1020 '
1030 ' for zbasic but could be converted to other basics
1040 ' updated march 1993 by computoman
1050 '
1060 ' commands:
1070 ' "text" : enter text in a current cell
1080 ' =expression : enter number or formula in a current cell
1090 ' cxxx : evaluate expressions and update screen
1100 ' arrow keys : move cursor in indicated direction
1110 '
1120 ' expressions:
1130 ' numeric constant or cell id in form
1140 ' above items separated by operators +,-,*, or /
1150 ' evaluation is from left to right without operator preference
1160 ' expressions are evaluated on entery and on the "C" command.
1170 '
1180 '
1190 DEFINT I,N,W,X,Y : KEY OFF
1200 SCRDEPTH = 20
1210 SCRWIDTH = 80
1220 COLWIDTH = 10
1230 MAXCOL=INT(SCRWIDTH/(COLWIDTH + 1))
1240 MAXROWS = SCRDEPTH
1250 DIM D(MAXCOL,MAXROWS)
1260 DIM D$(MAXCOL,MAXROWS)
1270 NUMOPS = 5
1280 DIM O$(NUMOPS)
1290 O$(1) = "=" : O$(2) = "+" : O$(3) = "-" : O$(4) = "*" : O$(5) = "/"
1300 '
1310 '************* init ************
1320 FOR X = 1 TO MAXCOL
1330 D$(X,0) = SPACE$(COLWIDTH - 1) + CHR$(X+ASC("A")-1)
1340 NEXT X
1350 FOR Y =1 TO MAXROWS
1360 D$(0,Y) = SPACE$(COLWIDTH-2)+RIGHT$(STR$(Y),2)
1370 NEXT Y
1380 GOSUB 1610
1390 CRSX = 1 : CRSY = 1 : GOSUB 1890
1400 COLOR 0,7 : LOCATE YLOC,XLOC : PRINT SPACE$(COLWIDTH); : COLOR 7,0
1410 '
1420 ' command loop
1430 '
1440 WHILE 0<1
1450 LOCATE 23,1 : PRINT SPACE$(79);: IN$="" : IK = 0
1460 LOCATE 23,1 : PRINT"CMD: ";
1470 WHILE IK 13
1480 I$= INKEY$ : IF I$ = "" THEN 1480
1490 IK = ASC(I$)
1500 IF LEN(I$) = 2 THEN GOSUB 9000: GOSUB 2100:GOSUB 1720 ELSE IF IK = 8 THEN GOSUB 1940 ELSE IF IK 13 THEN PRINT I$;: IN$ = IN$ + I$
1510 WEND
1520 C$ = LEFT$(IN$,1)
1530 LOCATE 24,1 : PRINT SPACE$(79);
1540 LOCATE 24,1 : PRINT IN$;
1550 IF C$ = CHR$(34) THEN GOSUB 1990 ELSE IF C$="=" THEN GOSUB 2050 ELSE IF C$="C" THEN GOSUB 2740 ELSE IF C$ = "F" THEN GOSUB 4000 ELSE ER$ = "BAD INPUT: "+IN$: GOSUB 2660
1560 WEND
1570 '
1580 '
1590 '
1600 ' sub to print screen
1610 CLS : DD = 0 : TEMPY = CRSY : TEMPX = CRSX
1620 LOCATE 25,31: PRINT "LIZZYCALC .01" : LOCATE 1,1
1630 FOR CRSY = 0 TO MAXROWS
1640 FOR CRSX = 0 TO MAXCOL
1650 GOSUB 2100 : PRINT V$;
1660 NEXT CRSX
1670 NEXT CRSY
1680 CRSX = TEMPX : CRSY = TEMPY
1690 RETURN
1700 '
1710 'sub to move cursor
1720 ON IK-71 GOSUB 1850,0,0,1790,0,1810,0,0,1830
1730 LOCATE YLOC,XLOC : PRINT V$;
1740 LOCATE 24,1 : PRINT SPACE$(79);
1750 LOCATE 24,1 : PRINT D$(CRSX,CRSY);
1760 GOSUB 2890
1770 LOCATE 23,LEN(IN$)+5
1780 RETURN
1790 ' move left
1800 IF CRSX > 1 THEN CRSX = CRSX - 1 : RETURN ELSE RETURN
1810 'move right
1820 IF CRSX < MAXCOL THEN CRSX = CRSX + 1 : RETURN ELSE RETURN
1830 ' move down
1840 IF CRSY 1 THEN CRSY = CRSY -1 : RETURN ELSE RETURN
1870 '
1880 ' sub to compute screen postion
1890 XLOC = (COLWIDTH * CRSX)+1
1900 YLOC = CRSY + 1
1910 RETURN
1920 '
1930 ' sub to process backspace on command line
1940 NEWLEN = LEN(IN$)-1
1950 IF NEWLEN >=0 THEN PRINT CHR$(8);: IN$ = LEFT$(IN$,NEWLEN)
1960 RETURN
1970 '
1980 ' sub to formulate input
1990 D(CRSX,CRSY)=0:TEXTLEN=LEN(IN$)-1:IF TEXTLEN<1 THEN TEXTLEN=1
2000 IF RIGHT$(IN$,1)=CHR$(34) THEN TEXTLEN = TEXTLEN-1
2010 D$(CRSX,CRSY) = LEFT$(MID$(IN$,2,TEXTLEN),COLWIDTH)
2015 GOSUB 2890
2020 RETURN
2030 '
2040 'sub to formula input
2050 V$ = IN$ : GOSUB 2140
2060 IF ERRFLAG = 0 THEN D$(CRSX,CRSY) = IN$
2065 GOSUB 2890
2070 RETURN
2080 '
2090 'SUB TO PREPARE OUTPUT
2100 IF LEFT$(D$(CRSX,CRSY),1)="=" THEN V$=RIGHT$(SPACE$(COLWIDTH)+STR$(D(CRSX,CRSY)),COLWIDTH) ELSE V$=LEFT$(D$(CRSX,CRSY)+SPACE$(COLWIDTH),COLWIDTH)
2110 RETURN
2120 '
2130 ' SUB TO EVALUATE EXPRESSION
2140 ERRFLAG = 0 : VI$ = V$
2150 WHILE V$""
2160 GOSUB 2310
2170 IF ERRFLAG 0 THEN ER$="BAD OPERATOR IN:"+VI$: GOSUB 2660 : RETURN
2180 GOSUB 2400
2190 IF ERRFLAG 0 THEN ER$="BAD FORMULA:"+VI$: GOSUB 2660: RETURN
2200 ON OPCODE GOSUB 2240,2250,2260,2270,2280
2210 WEND
2220 D(CRSX,CRSY) = VL
2230 RETURN
2240 VL = V : RETURN
2250 VL = VL + V : RETURN
2260 VL = VL - V : RETURN
2270 VL = VL * V : RETURN
2280 VL = VL / V : RETURN
2290 '
2300 ' SUB TO DECODE OPERATOR
2310 OP$ = LEFT$(V$,1)
2320 OPCODE = 0
2330 FOR I = 1 TO NUMOPS
2340 IF OP$=O$(I) THEN OPCODE = I : I = NUMOPS:V$=MID$(V$,2)
2350 NEXT I
2360 IF OPCODE = 0 THEN ERRFLAG = 1
2370 RETURN
2380 '
2390 'SUB TO DECODE OPERAND
2400 V = VAL(V$) : C$=LEFT$(V$,1) : ERRFLAG = 0 : T = 0
2410 IF V = 0 AND C$"0" THEN GOSUB 2530 ELSE GOSUB 2450
2420 RETURN
2430 '
2440 'SUB TO PROCESS AS A CONSTANT
2450 IX=1:IF C$="-" THEN C$="0"
2460 WHILE (C$>="0" AND C$ 32 THEN C = C - 32
2540 IF C MAXCOL THEN ERRFLAG = 1 : RETURN
2550 XC=C : C = 0
2560 WHILE V$"" AND C>=0 AND C<=9
2570 V$=MID$(V$,2)
2580 IF V$"" THEN C=ASC(V$)-ASC("0") : IF C>=0 AND C MAXROWS THEN ERRFLAG = 1 : RETURN
2610 YC = T
2620 V = D(XC,YC)
2630 RETURN
2640 '
2650 ' SUB TO GENERATE GENERAL ERROR REPORT
2660 LOCATE 24,1 : PRINT ER$+" ";
2670 BEEP
2680 WHILE INKEY$="" : WEND
2690 LOCATE 24,1 : PRINT SPACE$(79);
2700 LOCATE 24,1 : PRINT D$(CRSX,CRSY);
2710 RETURN
2720 '
2730 ' sub to update formula values
2740 LOCATE 24,1 : PRINT SPACE$(79);
2750 LOCATE 24,1 : PRINT"Caculating!";
2760 TEMPY=CRSY: TEMPX = CRSX
2770 FOR CRSY = 1 TO MAXROWS
2780 FOR CRSX = 1 TO MAXCOL
2790 IF LEFT$(D$(CRSX,CRSY),1)="=" THEN V$=D$(CRSX,CRSY): GOSUB 2140 : GOSUB 1890 : LOCATE YLOC,XLOC: GOSUB 2100: PRINT V$;
2800 NEXT CRSX
2810 NEXT CRSY
2820 CRSX = TEMPX : CRSY = TEMPY : GOSUB 1890
2830 GOSUB 2890
2840 LOCATE 24,1 : PRINT STRING$(79," ");
2850 LOCATE 24,1 : PRINT D$(CRSX,CRSY);
2860 RETURN
2870 '
2880 ' sub to show current cell value
2890 GOSUB 1890 : GOSUB 2100 : COLOR 0,7
2900 LOCATE YLOC,XLOC: PRINT V$;: COLOR 7,0
2910 RETURN
4000 '--
4001 ' (F)ile routine
4002 '--
4010 LOCATE 23,1 : PRINT SPACE$(79);
4020 LOCATE 23,1 : INPUT"Enter (L)oad or (S)ave data: ",QQ$
4030 LOCATE 24,1 : PRINT SPACE$(79);
4040 LOCATE 24,1 : INPUT"Enter file name: ",DATUM$
4050 WHILE QQ$="L"
4060 OPEN DATUM$ FOR INPUT AS #1
4070 FOR AY = 1 TO MAXROWS
4080 FOR AX = 1 TO MAXCOL
4090 INPUT#1,D(AX,AY),D$(AX,AY)
4100 NEXT AX
4110 NEXT AY
4120 CLOSE#1
4140 QQ$=""
4150 WEND
5050 WHILE QQ$="S"
5060 OPEN DATUM$ FOR OUTPUT AS #1
5070 FOR AY = 1 TO MAXROWS
5080 FOR AX = 1 TO MAXCOL
5090 PRINT#1,D(AX,AY),D$(AX,AY)
5100 NEXT AX
5110 NEXT AY
5120 CLOSE#1
5140 QQ$=""
5150 WEND
9000 '
9010 ' fix i$
9020 IK = ASC(RIGHT$(I$,1))
9030 RETURN

This code eventually became:


' lizzycalc version -1
'
' updated March 1995 by computoman 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
' 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
Cr = &HD
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 Cr
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 Cr 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$(Cr)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ CHR$(Cr) THEN
PRINT QQ$
END IF
IF QQ$ = "Q" OR QQ$ = CHR$(Cr) 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 " Edward Kent dba"
PRINT " Kent Independent Support Services"
PRINT " 872 Strey Lane, Suite 518"
PRINT " Houston, Texas 77024"
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 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$ 32 THEN
C = C - 32
END IF
IF 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 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$(Cr)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ CHR$(Cr) 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$(Cr)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ CHR$(Cr) THEN
PRINT QQ$
END IF
IF QQ$ = "Q" OR QQ$ = CHR$(Cr) 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$ "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$ "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
"
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 "]Eddie Kent"
PRINT "]Kent Independent Support Services"
PRINT
PRINT "Press any key to continue: _";
Booboo$ = ""
WHILE Booboo$ = ""
Booboo$ = INKEY$
SOUND 500, .1
FOR x& = 1 TO 40000
NEXT x&
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$(Cr)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ CHR$(Cr) THEN
PRINT QQ$
END IF
IF QQ$ = "P" AND (QQ$ "Q" OR QQ$ CHR$(Cr)) 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 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$) "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)
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$(Cr)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ CHR$(Cr) THEN
PRINT QQ$
END IF
IF QQ$ = "S" AND (QQ$ "Q" OR QQ$ CHR$(Cr)) 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 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$(Cr)
QQ$ = UCASE$(INPUT$(1))
WEND
IF QQ$ CHR$(Cr) THEN
PRINT QQ$
END IF
IF QQ$ = "Q" OR QQ$ = CHR$(Cr) 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) + LTRIM$(RTRIM$(STR$(Scrdepth)))
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$ "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$ "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"
Insertrow = 0
WHILE Insertrow = 0
LOCATE Scrdepth + 3, 1
PRINT SPACE$(79);
LOCATE Scrdepth + 3, 1
INPUT "Enter row where to insert: ", Insertrow
WEND
Rowstart$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(Insertrow))), 2)
Cellstart$ = "A" + Rowstart$
Cellend$ = CHR$(Maxcols + 1 + 64) + LTRIM$(RTRIM$(STR$(Scrdepth)))
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$ "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$ "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
RESUME Fileroutine
END SELECT
END

Like lizzydb, lizzyclc has evolved also and actually both have much improved versions since the ones you see here in the blog. Oh to do lists can become involved! Though this code does not allow your computer to run around and get into sumo wrestling contests, there is definate benefit. Programs like Excel and Access all started this way. they only had a few features at the beginning and then eventually grew what they are today.

Posted in Uncategorized

«
»

Leave a response






Your response:

Categories