home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug141.arc
/
PACCTS.LBR
/
ACCTS1.IQC
/
ACCTS1.INC
Wrap
Text File
|
1979-12-31
|
6KB
|
226 lines
{This is the first INCLUDE file to ACCTS.PAS}
Overlay Procedure SingleAccount;
Var
A,B,C : Integer;
Index : Char;
Flag : Boolean;
Begin
Gotoxy(1,7); Write('ACCOUNTS:');
A:=15; B:=7; C:=1;
While C<=EndCode do
Begin
If A>71 then
Begin
A:=1; B:=B + 1;
end;
Gotoxy(A,B); Write(Code[C],'-',Accounts[C]);
A:=A + 14; C:=C + 1;
end; {While C}
Writeln; Line(80,#45);
Repeat
Gotoxy(20,B+2); Write('Select Account code: ');
Read(Kbd,Index); Flag:=False;
For A:=1 to EndCode do
Begin
If Index=Code[A] then
Begin
C:=A; Write(Index); Flag:=True;
end;
end;
Until Flag=True;
If not Shown then
Begin
LastLine(Message); Close(Dev);
Assign(Dev,'LST:');Reset(Dev);
end else
Begin
Assign(Dev,'CON:'); Reset(Dev);
Clear(3,23); Gotoxy(1,3)
end;
Headings; AccTitle(C); Bal:=0;
For A:=0 to LastRec do
If Found(A,C) then ProcessLine(A);
AccBal; Close(Dev);
If Shown then LastLine(Message);
Clear(3,23);
end;
Overlay Procedure AllAccounts;
Var
A,B : Integer;
Flag : Boolean;
Begin
If not Shown then
Begin
LastLine(Message);
Assign(Dev,'LST:'); Reset(Dev);
end else
Begin
Assign(Dev,'CON:'); Reset(Dev);
Clear(3,23); Gotoxy(1,3)
end;
Flag:=True; Bal:=0; Headings;
For B:=1 to EndCode do
Begin
For A:=0 to LastRec do
Begin
If Found(A,B) then
Begin
If Flag = True then AccTitle(B);
ProcessLine(A);
Flag:=False
end;
end;
If Flag=False then AccBal;
Flag:=True
end;
Close(Dev);
If Shown then LastLine(Message);
Clear(3,23);
end;
Overlay Procedure AccountsBalance;
Var
A,B : Integer;
Begin
If not Shown then
Begin
LastLine(Message);
Assign(Dev,'LST:'); Reset(Dev);
end else
Begin
Assign(Dev,'CON:'); Reset(Dev);
Clear(3,23); Gotoxy(1,3);
end;
Total:=0; Bal:=0; Headings;
For B:=1 to EndCode do
Begin
For A:=0 to LastRec do
If Found(A,B) then Bal:=Bal+Ledger[A].Amount;
CheckRow(Y); Write(Dev,' ',Accounts[B]);
Pline(50-Length(Accounts[B]),#32);
If Bal<0 then
Begin
Write(Dev,'|',Abs(Bal):10:2,'|');
Pline(10,#32);
Writeln(Dev,'|');
end else
Begin
Write(Dev,'|'); Pline(10,#32);
Write(Dev,'|',Bal:10:2);
Writeln(Dev,'|');
end; {If Bal =>0}
Total:=Total+Bal; Bal:=0;
end; {For B}
CheckRow(Y); Pline(55,#32); Write(Dev,'+');
Pline(10,#45); Write(Dev,'+');
Pline(10,#45); Writeln(Dev,'+');
CheckRow(Y);
Pline(49,#32); Write(Dev,'Total |');
If Total < 0 then
Begin
Write(Dev,Abs(Total):10:2,'|');
Pline(10,#32);
Writeln(Dev,'|');
end else
Begin
Pline(10,#32);
Writeln(Dev,'|',Total:10:2,'|');
end;
Pline(55,#32); Pline(23,#61); Close(Dev);
If Shown then LastLine(Message);
Clear(3,23);
end;
Overlay Procedure CashBook;
Var
J:Integer;
Begin
If not Shown then
Begin
LastLine(Message);
Assign(Dev,'LST:'); Reset(Dev);
end else
Begin
Assign(Dev,'CON:'); Reset(Dev);
Clear(3,20); Gotoxy(1,3)
end;
Headings; Bal:=0;
For J:=0 to LastRec do ProcessLine(J);
AccBal; Close(Dev);
If Shown then LastLine(Message);
Clear(3,23);
end;
Overlay Procedure Load;
Var J : Byte;
A : Char;
Temp : AccName;
Begin
Gotoxy(20,6); Write('Enter file name: ');
BufLen:=14; Read(FileName);
If Pos('.',FileName)=0 then
FileName:=FileName + '.PAC';
For K:=1 to Length(FileName) do
FileName[K]:=UpCase(FileName[K]);
Assign(EntryFile,FileName);
{$I-}
Reset(EntryFile);
{$I+}
If IOresult<>0 then
Begin
Close(EntryFile);
LastLine('Could not find file.'); Halt
end;
Clear(6,6); LastRec:=0; Gotoxy(36,1);
LowVideo; Write(FileName); NormVideo;
While not EOF(EntryFile) do
Begin
Read(EntryFile,Ledger[LastRec]);
LastRec:=Succ(LastRec);
end;
Close(EntryFile); LastRec:=Pred(LastRec); FileName2:=FileName;
Delete(FileName2,Pos('.',FileName2),4);
FileName2:=FileName2 + '.ACC';
Assign(AccFile,FileName2);
Reset(AccFile); K:=0;
While not EOF(AccFile) do
Begin
K:=K+1;
Readln(AccFile,Accounts[K]);
Temp:=Accounts[K]; A:=Temp[1];
Code[K]:=Char(Ord(A)+32);
end;
Close(AccFile); EndCode:=K;
If EndCode > 1 then
Begin
For K:=2 to EndCode do
Begin
For J:=K downto 2 do
If Code[K]=Code[J-1] then Code[K]:=Char(Ord(Code[K])-32);
end;
end;
end;
Overlay Procedure Save;
Begin
Rewrite(EntryFile);
For K:=0 to LastRec do
Write(EntryFile,Ledger[K]);
Close(EntryFile);
end;