DeleteBegin:

' ********************************************
' *                 PAR Real                 *
' *   Copyright (C) 1986, PAR Software, Inc. *
' *            All Rights Reserved           *
' ********************************************

1000 REM This is the Beginning
' file = RF/IncomeStatement
ON ERROR GOTO ErrorFix
BREAK ON
ON BREAK GOSUB ReturnUser
DIM SHARED Lin(30),Strt(30),MaxLength(30),Fieldlength(30),Use$(6)
DIM SHARED UseIndex(30),Saved$(30),Saved#(30),Prompt$(30),BGColor(30)
DIM SHARED SavedBack#(30),Default#(15),Expenses#(17)
DIM SHARED FileList$(25)
DIM SHARED how%(8)
GOSUB Menus12On
GOSUB KBRMenuOff
MENU ON
ON MENU GOSUB MenuCheck 
Extension$ = ".INC"
DirNames$ = "RF/IncomeStatement.Index"
IF File$ = "" THEN
WindowName$ = "Income Statement"
ELSE
WindowName$ = "Income Statement: " + left$(File$,len(File$)-4)
END IF
 
Start:
GOSUB ColorOff
WINDOW 1,WindowName$,(0,1) - (580,186),22
CursorColor = 3
Use$(1) = " &"
Use$(2) = " $$############,.##"
Use$(3) = " $$#########,.##"

Initialize:
FOR lcv = 0 TO 8: READ how%(lcv): NEXT lcv
DATA 110,0,175,0,22200,64,10,1,0
Speech1$="The result is to large to output"
Cur$ = " "
FOR lcv = 1 TO 16
READ Lin(lcv) :READ Strt(lcv) :READ Fieldlength(lcv)
READ MaxLength(lcv) :READ Prompt$(lcv)
READ UseIndex(lcv)
READ BGColor(lcv)
NEXT lcv
GOSUB PrintScreenOne
GOSUB ColorOn
IF File$ <> "" THEN GOSUB LoadRoutine
IF File$ <> "" THEN GOSUB PrintValues

InCheck:
a$ = "":MoveCursorFlag = 0 : EnterFlag = 0:SaveAsFlag = 0
WHILE a$ = ""
IF TIMER - NewTime >= .3 THEN CALL FlashCursor
a$ = INKEY$
WEND
CALL GetRoutine (Word$)

Main:  
Value# = VAL(Word$)
BackUp$ = Saved$(Index)
IF EnterFlag = 1 THEN 
Saved$(Index) = Word$:Saved#(Index) = Value#
IF Index > 2 AND VAL(Saved$(Index)) >= 10000000 THEN
Word$ = BackUp$
phrase$ = "the val you enterd must be less than ten mill yun"
Speech2$ = "Please try again"
CALL InputError
GOTO Main
END IF
IF Index > 2 AND Index < 5 THEN
GrossProfit# = Saved#(3) - Saved#(4)
ELSEIF Index >= 5 THEN
TotExpenses# = 0
FOR lcv = 5 TO 16:TotExpenses# = TotExpenses# + Saved#(lcv):NEXT
END IF
ProfitLoss# = GrossProfit# - TotExpenses#
COLOR 2,3
LOCATE 21,18:PRINT USING Use$(2); TotExpenses#
LOCATE 23,18:PRINT USING Use$(2); ProfitLoss#;
COLOR 2,1
LOCATE 6,18:PRINT USING Use$(2); GrossProfit#
END IF     
        
IF MoveCursorFlag <> 0  THEN
CursorColor = BGColor(Index)
LOCATE Lin(Index),Strt(Index)
COLOR 2,BGColor(Index)
PRINT SPACE$(Fieldlength(Index))
LOCATE Lin(Index),Strt(Index)
IF UseIndex(Index) = 1 THEN PRINT USING Use$(UseIndex(Index));Saved$(Index)
IF UseIndex(Index) <> 1 AND Saved#(Index) <> 0 THEN PRINT USING Use$(UseIndex(Index));Saved#(Index)
      
IF Index <> LastLine AND MoveCursorFlag = 1 THEN Index = Index + IndexIncrement
IF Index <> 1 AND MoveCursorFlag = -1 THEN Index = Index - IndexIncrement
Idx = 0
IF Index > LastLine THEN Index = LastLine
NewTime = TIMER - 1
SavedBack#(Index) = VAL(Saved$(Index))
END IF   

GOTO InCheck

SUB GetRoutine (Var$) STATIC
SHARED a$, Idx, Index, MoveCursorFlag,IndexIncrement,LeftLines,EnterFlag
IndexIncrement = 1
COLOR 2,1
IF (ASC(a$)>31 AND ASC(a$)<=122) THEN AlphaNum
IF ASC(a$) = 28 THEN CursorUp
IF ASC(a$) = 29 THEN CursorDown
IF ASC(a$) = 13 THEN Enter
IF ASC(a$) = 8 OR ASC(a$) = 127 THEN BackSpace
GOTO EndGetRoutine
                                         
AlphaNum:
' IF UseIndex(Index) <> 1 AND ASC(a$) = 32 THEN GOTO EndGetRoutine
IF Idx = MaxLength(Index) THEN EndGetRoutine
COLOR 2,BGColor(Index)
IF LEN(TempVar$) = 0 THEN
LOCATE Lin(Index), Strt(Index)
PRINT SPACE$(Fieldlength(Index))
END IF
TempVar$ = TempVar$ + a$
LOCATE Lin(Index),Strt(Index):PRINT TempVar$
Idx = Idx + 1
GOTO EndGetRoutine  

CursorDown:
IF Index <> LastLine THEN
MoveCursorFlag = 1
TempVar$ = ""
END IF
Var$ = Saved$(Index)
GOTO EndGetRoutine

CursorUp:                           
IF Index <> 1 AND Index <> 50  THEN
MoveCursorFlag = -1
TempVar$ = ""
END IF
Var$ = Saved$(Index)
GOTO EndGetRoutine

Enter:
IF LEN(TempVar$) <> 0 THEN
Var$ = TempVar$
TempVar$ = ""
Idx = 0
EnterFlag = 1
ELSE
Var$ = Saved$(Index)
END IF
MoveCursorFlag = 1
GOTO EndGetRoutine   

BackSpace:
IF Idx <> 0 THEN
TempVar$ = LEFT$(TempVar$,LEN(TempVar$)-1)
COLOR ,BGColor(Index)
LOCATE Lin(Index),Strt(Index)+Idx:PRINT " "; CHR$(8);
Idx = Idx - 1
' LOCATE Lin(Index),Strt(Index):PRINT TempVar$;
END IF
GOTO EndGetRoutine
 
EndGetRoutine:
END SUB

SUB FlashCursor STATIC 
SHARED Index,CursorColor,Cur$,NewTime,Idx
IF CursorColor = 2 THEN CursorColor = BGColor(Index) ELSE CursorColor = 2
LOCATE Lin(Index),Strt(Index)+Idx
COLOR ,CursorColor
PRINT Cur$
NewTime = TIMER
END SUB   

PrintScreenOne:     
COLOR 1,2
LOCATE 6:PRINT " GROSS PROFIT "
LOCATE 8:PRINT " EXPENSES "
LOCATE 21:PRINT " TOTAL EXPENSES "
LOCATE 23:PRINT " PROFIT/LOSS ";
color 1,3
locate 21,18:PRINT "                    "
locate 23,18:PRINT "                    ";
color 1,1
locate 6,18:PRINT  "                    "
TempStart:    
FOR lcv = 1 TO 16
COLOR 1,0
LOCATE Lin(lcv),Strt(lcv)-LEN(Prompt$(lcv)): PRINT Prompt$(lcv);
COLOR 1,BGColor(lcv)
PRINT SPACE$(Fieldlength(lcv))
NEXT lcv
COLOR 1,2
Index = 1 : LastLine = 16
RETURN

SaveRoutine:
TrySave = 1
IF File$ = "" THEN  SaveAs
OPEN File$ FOR OUTPUT AS #4
PRINT #4,"***** AUTOMATICALLY CREATED FILE - DO NOT EDIT !!!!! *****"
FOR lcv = 1 TO 16
PRINT #4,Saved$(lcv)
NEXT lcv
CLOSE #4
OPEN File$+".KBR" FOR OUTPUT AS #5
PRINT #5,"***** AUTOMATICALLY CREATED FILE - DO NOT EDIT !!!!! *****"
PRINT #5, Saved$(2)
PRINT #5, Saved$(3)
PRINT #5, Saved$(4)
PRINT #5, str$(GrossProfit#)
PRINT #5, str$(TotExpenses#)
PRINT #5, str$(ProfitLoss#)
CLOSE #5
Kill File$+".KBR.info"
TrySave = 0
2500 GOTO EndMenuCheck

LoadRoutine:
TryLoad = 1
OPEN File$ FOR INPUT AS #4
INPUT #4, dummy$
FOR lcv = 1 TO 16
LINE INPUT #4,Saved$(lcv)
Saved#(lcv) = val(Saved$(lcv))
NEXT lcv
CLOSE #4
TryLoad = 0
3000 RETURN  

PrintValues:
FOR lcv = 1 to 16
LOCATE Lin(lcv),Strt(lcv)
COLOR 2,BGColor(lcv)
IF len(Saved$(lcv)) <> 0 THEN
IF UseIndex(lcv) = 1 THEN
PRINT USING Use$(UseIndex(lcv));Saved$(lcv)
ELSE
PRINT USING Use$(UseIndex(lcv));Saved#(lcv)
END IF
END IF
NEXT lcv
TotExpenses# = 0
For lcv = 5 to 16
TotExpenses# = TotExpenses# + Saved#(lcv)
Next lcv
GrossProfit# = Saved#(3) - Saved#(4)
ProfitLoss# = GrossProfit# - TotExpenses#
COLOR 2,1
LOCATE 6,18:PRINT USING Use$(2); GrossProfit#
COLOR 2,3
LOCATE 21,18:PRINT USING Use$(2); TotExpenses#
LOCATE 23,18:PRINT USING Use$(2); ProfitLoss#;
RETURN

PrinterOutput:
GOTO PrinterRequester

PrintRoutine:
FOR lcv = 1 TO 8
print #3,""
NEXT lcv
PRINT #3,"       ";Prompt$(1);" ";
PRINT #3,USING Use$(1);Saved$(1)
PRINT #3,"       ";Prompt$(2);" ";
PRINT #3,USING Use$(1);Saved$(2)
PRINT #3,"":PRINT #3,""

PRINT #3,Prompt$(3);" ";
PRINT #3,USING Use$(3);Saved#(3)
PRINT #3,Prompt$(4);" ";
PRINT #3,USING Use$(3);Saved#(4)
PRINT #3,space$(20);"-------------"
PRINT #3,"GROSS PROFIT      ";
PRINT #3,USING Use$(3);GrossProfit#
PRINT #3,""
PRINT #3,"    EXPENSES"

PRINT #3,Prompt$(5);" ";
PRINT #3,USING Use$(3);Saved#(5)
PRINT #3,Prompt$(6);" ";
PRINT #3,USING Use$(3);Saved#(6)
PRINT #3,Prompt$(7);" ";
PRINT #3,USING Use$(3);Saved#(7)
PRINT #3,Prompt$(8);" ";
PRINT #3,USING Use$(3);Saved#(8)
PRINT #3,Prompt$(9);" ";
PRINT #3,USING Use$(3);Saved#(9)
PRINT #3,Prompt$(10);" ";
PRINT #3,USING Use$(3);Saved#(10)
PRINT #3,Prompt$(11);" ";
PRINT #3,USING Use$(3);Saved#(11)
PRINT #3,Prompt$(12);" ";
PRINT #3,USING Use$(3);Saved#(12)
PRINT #3,Prompt$(13);" ";
PRINT #3,USING Use$(3);Saved#(13)
PRINT #3,Prompt$(14);" ";
PRINT #3,USING Use$(3);Saved#(14)
PRINT #3,Prompt$(15);" ";
PRINT #3,USING Use$(3);Saved#(15)
PRINT #3,Prompt$(16);" ";
PRINT #3,USING Use$(3);Saved#(16)
print #3,space$(20);"-------------"

PRINT #3,"TOTAL EXPENSES    ";
PRINT #3,USING Use$(3);TotExpenses#
PRINT #3,""
PRINT #3,"PROFIT/LOSS       ";
PRINT #3,USING Use$(3);ProfitLoss#
PRINT #3,CHR$(12)
GOTO 100

Barchart:
Expenses#(1) = Saved#(3)
Expenses#(2) = Saved#(4)
Expenses#(3) = GrossProfit#
FOR Loop2 = 5 TO 16 :Expenses#(Loop2-1) = Saved#(Loop2):NEXT Loop2
Expenses#(16) = TotExpenses#
Expenses#(17) = ProfitLoss#
Largest# = 0
FOR lcv = 1 to 17
IF Largest# < ABS(Expenses#(lcv)) THEN
Largest# = ABS(Expenses#(lcv))
END IF
NEXT lcv
CompareTo# = Largest#
GOSUB DrawBarChart
GOTO EndMenuCheck

DrawBarChart:
IF CompareTo# <= 0 THEN
phrase$ = "There must be pausitive val yous enterd to see the bar chart"
Speech2$ = "Please try again"
CALL InputError
RETURN
END IF
WINDOW 6,"BAR CHART: Income Statement",(0,0)-(631,180),22
xaxis% = 92
barwidth% = 16
baroutline% = 2
barcolor% = 3
GOSUB DrawAxis
GOSUB DisplayLabels
GOSUB DrawBars
ExitLoc=20
ExitL=10:ExitT=164:ExitR=61:ExitB=178
PrtL=80:PrtT=164:PrtR=139:PrtB=178
PrtLoc=90
GOSUB PrintOrExit
RETURN

DrawAxis:
COLOR 1,0:LOCATE 1,1:PRINT TAB(7);" $ ";
LargPerC = INT((Largest#/CompareTo#)*100)
Start% = INT(((LargPerC-1)/10)+1) * 10
IF Start% = 0 THEN Start% = 10
LINE (97,12) - (97,xaxis%),1
LINE (98,12) - (98,xaxis%),1
LINE (98,xaxis%)-(620,xaxis%),1
LINE (99,xaxis%-1)-(98+(.5*barwidth%),xaxis%-4),2
LINE (98+(.5*barwidth%),xaxis%-4)-(620,xaxis%-4),2
LINE (97+(.5*barwidth%),9)-(97+(.5*barwidth%),xaxis%-4),2
LINE (98+(.5*barwidth%),9)-(98+(.5*barwidth%),xaxis%-4),2
LOCATE 2,1:PRINT USING "##########,";(Start%/100)*Largest#;
LINE (98,xaxis%-81)-(98+(.5*barwidth%),xaxis%-84),2
LINE (100+(.5*barwidth%),xaxis%-84)-(620,xaxis%-84),1
yDown%=3
FOR k = 73 TO 9 STEP -8
LINE (98,xaxis%-k)-(98+(.5*barwidth%),xaxis%-k-3),2
LINE (100+(.5*barwidth%),xaxis%-k-3)-(620,xaxis%-k-3),1
LOCATE yDown%,1:PRINT USING "##########,";((Start% * (k-1)/80)/100)*Largest#
yDown%=yDown%+1
NEXT k
RETURN

DisplayLabels:
COLOR ,0
LOCATE 13,1
BegLab = 109
PRINT PTAB(BegLab);" G ";PTAB(BegLab+30);" S ";PTAB(BegLab+60);" G ";PTAB(BegLab+90);" S ";
PRINT PTAB(BegLab+120);" A ";PTAB(BegLab+150);" B ";PTAB(BegLab+180);" C ";PTAB(BegLab+210);" D ";PTAB(BegLab+240);" I ";
PRINT PTAB(BegLab+270);" I ";PTAB(BegLab+300);" L ";PTAB(BegLab+330);" M ";PTAB(BegLab+360);" O" ; PTAB(BegLab+390);" R ";
PRINT PTAB(BegLab+420);" U ";PTAB(BegLab+450);" T ";PTAB(BegLab+480);" P "
  
PRINT PTAB(BegLab);" R ";PTAB(BegLab+30);" A ";PTAB(BegLab+60);" R  ";PTAB(BegLab+90);" A ";
PRINT PTAB(BegLab+120);" D ";PTAB(BegLab+150);" A ";PTAB(BegLab+180);" O ";PTAB(BegLab+210);" E ";PTAB(BegLab+240);" N ";
PRINT PTAB(BegLab+270);" N ";PTAB(BegLab+300);" E ";PTAB(BegLab+330);" I ";PTAB(BegLab+360);" F"; PTAB(BegLab+390);" E ";
PRINT PTAB(BegLab+420);" T ";PTAB(BegLab+450);" O ";PTAB(BegLab+480);" R "

PRINT PTAB(BegLab);" S ";PTAB(BegLab+30);" L ";PTAB(BegLab+60);" S ";PTAB(BegLab+90);" L ";
PRINT PTAB(BegLab+120);" V ";PTAB(BegLab+150);" D ";PTAB(BegLab+180);" M ";PTAB(BegLab+210);" P ";PTAB(BegLab+240);" S ";
PRINT PTAB(BegLab+270);" T ";PTAB(BegLab+300);" G ";PTAB(BegLab+330);" S ";PTAB(BegLab+360);" F ";PTAB(BegLab+390);" P " ;
PRINT PTAB(BegLab+420);" I ";PTAB(BegLab+450);" T ";PTAB(BegLab+480);" F "
PRINT PTAB(BegLab);" S ";PTAB(BegLab+30);" E ";PTAB(BegLab+60);"   ";PTAB(BegLab+90);" A ";
PRINT PTAB(BegLab+120);" E ";PTAB(BegLab+150);"   ";PTAB(BegLab+180);" M ";PTAB(BegLab+210);" R ";PTAB(BegLab+240);" U ";
PRINT PTAB(BegLab+270);" E ";PTAB(BegLab+300);" A ";PTAB(BegLab+330);" C ";PTAB(BegLab+360);" I ";PTAB(BegLab+390);" A " ;
PRINT PTAB(BegLab+420);" L ";PTAB(BegLab+450);"   ";PTAB(BegLab+480);"   "

PRINT PTAB(BegLab);"   ";PTAB(BegLab+30);" S ";PTAB(BegLab+60);" P ";PTAB(BegLab+90);" R ";
PRINT PTAB(BegLab+120);" R ";PTAB(BegLab+150);" D ";PTAB(BegLab+180);" I ";PTAB(BegLab+210);" E ";PTAB(BegLab+240);" R ";
PRINT PTAB(BegLab+270);" R ";PTAB(BegLab+300);" L ";PTAB(BegLab+330);"   ";PTAB(BegLab+360);" C ";PTAB(BegLab+390);" I ";
PRINT PTAB(BegLab+420);" I ";PTAB(BegLab+450);" E ";PTAB(BegLab+480);" L "

PRINT PTAB(BegLab);" I ";PTAB(BegLab+30);"   ";PTAB(BegLab+60);" R ";PTAB(BegLab+90);" I ";
PRINT PTAB(BegLab+120);" T ";PTAB(BegLab+150);" E ";PTAB(BegLab+180);" S ";PTAB(BegLab+210);" C ";
PRINT PTAB(BegLab+270);" E ";PTAB(BegLab+300);"   ";PTAB(BegLab+330);"   ";PTAB(BegLab+360);" E ";PTAB(BegLab+390);" R ";
PRINT PTAB(BegLab+420);" T ";PTAB(BegLab+450);" X ";PTAB(BegLab+480);" O "

PRINT PTAB(BegLab);" N ";PTAB(BegLab+30);"   ";PTAB(BegLab+60);" O ";PTAB(BegLab+90);" E ";
PRINT PTAB(BegLab+120);"   ";PTAB(BegLab+150);" B ";PTAB(BegLab+180);" S ";
PRINT PTAB(BegLab+270);" S ";PTAB(BegLab+300);"   ";PTAB(BegLab+330);"   "                ;PTAB(BegLab+390);" S ";
PRINT PTAB(BegLab+420);" Y ";PTAB(BegLab+450);" P ";PTAB(BegLab+480);" S "

PRINT PTAB(BegLab);" C ";                      PTAB(BegLab+60);" F ";PTAB(BegLab+90);" S ";
PRINT ;               PTAB(BegLab+150);" T ";
PRINT PTAB(BegLab+270);" T ";PTAB(BegLab+300);"   ";
PRINT PTAB(BegLab+420);"   ";PTAB(BegLab+450);" S ";PTAB(BegLab+480);" S "
RETURN

DrawBars:
leftx = 85
COLOR barcolor%
leftx = leftx + 24
FOR lcv = 1 TO 17
IF lcv = 3 OR lcv = 17 THEN
tempNum# = Expenses#(lcv)
Expenses#(lcv) = ABS(Expenses#(lcv))
END IF
lefty = xaxis% - INT((Expenses#(lcv)/((Start%/100)*CompareTo#))*80)
IF xaxis% - lefty = 0 AND Expenses#(lcv) > 0 THEN lefty = xaxis%-1
IF lefty < xaxis% THEN
IF lcv = 3 OR lcv = 17 THEN
LOCATE (INT((lefty-4)/8)),1
IF tempNum# > 0 THEN
PRINT PTAB(leftx+4);"(+)"
ELSE
PRINT PTAB(leftx+4);"(-)"
END IF
END IF
LINE (leftx,lefty-1)-(leftx+barwidth%,xaxis%-1),baroutline%,b
LINE (leftx+(1.5*barwidth%),lefty-4)-(leftx+(1.5*barwidth%),xaxis%-4),baroutline%
LINE (leftx+barwidth%,lefty-1)-(leftx+(1.5*barwidth%),lefty-4),baroutline%
LINE (leftx+barwidth%,xaxis%-1)-(leftx+(1.5*barwidth%),xaxis%-4),baroutline%
LINE (leftx+(.5*barwidth%),lefty-4)-(leftx+(1.5*barwidth%),lefty-4),baroutline%
LINE (leftx,lefty-1)-(leftx+(.5*barwidth%),lefty-4),baroutline%
LINE (leftx+barwidth%,lefty-1)-(leftx+(1.5*barwidth%),lefty-4),baroutline%
IF xaxis%-lefty >= 2 THEN
AREA (leftx+1,lefty)
AREA (leftx+1,xaxis%-2)
AREA (leftx+barwidth%-1,xaxis%-2)
AREA (leftx+barwidth%-1,lefty)
AREAFILL

AREA (leftx+barwidth%+1,lefty)
AREA (leftx+barwidth%+1,xaxis%-2)
AREA (leftx+(1.5*barwidth%-1),xaxis%-5)
AREA (leftx+(1.5*barwidth%-1),lefty-3)
AREAFILL

ELSE
LINE (leftx+1,xaxis%-1)-(leftx+barwidth%-1,xaxis%-1),barcolor%
END IF
  
AREA (leftx+4,lefty-2)
AREA (leftx+barwidth%-1,lefty-2)
AREA (leftx+(1.5*barwidth%-4),lefty-3)
AREA (leftx+(.5*barwidth%+1),lefty-3)
AREAFILL
END IF
IF lcv = 3 OR lcv = 17 THEN
Expenses#(lcv) = tempNum#
END IF
leftx = leftx + 30
NEXT lcv
RETURN

    DATA 1,24,40,39,"Income Statement For ",1,3
    DATA 2,24,40,39,"              Period ",1,1
    DATA 4,18,18,10,"Gross Income     ",3,1
    DATA 5,18,18,10,"Cost of Sales    ",3,3
    DATA 9,18,18,10,"Salaries & Wages ",3,3
    DATA 10,18,18,10,"Advertising      ",3,1
    DATA 11,18,18,10,"Bad Debts        ",3,3
    DATA 12,18,18,10,"Commissions      ",3,1
    DATA 13,18,18,10,"Depreciation     ",3,3
    DATA 14,18,18,10,"Insurance        ",3,1
    DATA 15,18,18,10,"Interest         ",3,3
    DATA 16,18,18,10,"Legal/Accounting ",3,1
    DATA 17,18,18,10,"Miscellaneous    ",3,3
    DATA 18,18,18,10,"Office           ",3,1
    DATA 19,18,18,10,"Repairs/Maint.   ",3,3
    DATA 20,18,18,10,"Utilities        ",3,1
9999 REM This is the end of the program.
DeleteEnd: