Программа
PROGRAM CustomerBase;
USES CRT,DOS;
TYPE String8=string[8];
String10=string[10];
HeadFieldType=(Nul,Name,Address);
HeadType=record
Name:string[54];
Address:string[54]
end;
DealType=record
Date:String8;
Ware:String10;
CreditBill:longint;
Total:longint;
PaymentBill:longint;
Payment:longint;
end;
CONST Deal0:DealType=(date :'00.00.00';
Ware :'**********';
CreditBill :0;
Total :0;
PaymentBill :0;
Payment :0);
VAR Exit:boolean;
Condition:(Files,Heading,Deal);
FileName:String8;
AttrBuf:byte;
HeadField:HeadFieldType;
Head:HeadType;
RecordNumber:longint;
FirstVisibleRecord:longint;
PROCEDURE InputString(XStart,YStart,LenWin,LenStr:byte;var Str:String);
Const InsertFlag:boolean=TRUE;
Var BufStr:String;
Exit:boolean;
EscFlag:boolean;
NumberFirstViewSymbol,Position:integer;
ChangeString:boolean;
Ch:char;
Procedure GoToX;
begin
GoToXY(XStart+Position-NumberFirstViewSymbol,YStart)
end;
Procedure WriteString;
var i:integer;
begin
GoToXY(XStart,YStart);
for i:=NumberFirstViewSymbol to NumberFirstViewSymbol+LenWin-2
do if i<=Length(Str) then Write(Str[i]) else Write(' ');
GoToX
end;
Begin
Exit:=FALSE; ChangeString:=FALSE;
BufStr:=Str;
if XStart+LenWin>81 then LenWin:=81-XStart;
NumberFirstViewSymbol:=1; Position:=1;
WriteString;
repeat
Ch:=ReadKey;
case Ch of
#0: case ReadKey of
#82: InsertFlag:=not InsertFlag;
#83: begin
if not ChangeString
then begin
Str:='';
Position:=1;
NumberFirstViewSymbol:=1
end
else Delete(Str,Position,1);
WriteString
end;
#75: begin
ChangeString:=TRUE;
if Position>1
then begin
Dec(Position);
if Position<NumberFirstViewSymbol
then begin
Dec(NumberFirstViewSymbol);
WriteString
end
end;
GoToX
end;
#77: begin
ChangeString:=TRUE;
if Position<=Length(Str)
then begin
Inc(Position);
if Position=NumberFirstViewSymbol+LenWin
then begin
Inc(NumberFirstViewSymbol);
WriteString
end
end;
GoToX
end;
#71: begin
ChangeString:=TRUE; Position:=1;
NumberFirstViewSymbol:=1; WriteString
end;
#79: begin
ChangeString:=TRUE; Position:=Length(Str)+1;
if Position>=NumberFirstViewSymbol+LenWin then
begin
NumberFirstViewSymbol:=Position-LenWin+1;
WriteString
end;
GoToX
end
end;
#8: begin
ChangeString:=TRUE;
if Position>1
then begin
Dec(Position);
Delete(Str,Position,1);
if NumberFirstViewSymbol>1 then Dec(NumberFirstViewSymbol);
WriteString
end
end;
#13: begin Exit:=TRUE; EscFlag:=FALSE end;
#27: begin Exit:=TRUE; EscFlag:=TRUE end;
#9:;
else begin
if not ChangeString then begin
Str:='';
ChangeString:=TRUE
end;
if (Position<=LenStr)
and
((Length(Str)<LenStr) and InsertFlag
or
(Length(Str)<=LenStr) and not InsertFlag)
then
begin
if InsertFlag or (Position>Length(Str))
then Insert(Ch,Str,Position)
else Str[Position]:=Ch;
Inc(Position);
if Position=NumberFirstViewSymbol+LenWin
then Inc(NumberFirstViewSymbol);
WriteString
end
else Write(#7)
end
end
until Exit;
if EscFlag then begin
Str:=BufStr; Position:=1;
NumberFirstViewSymbol:=1; WriteString
end;
End;
TYPE DealFile=file of DealType;
FieldType=(Date,Ware,CreditBill,Total,PaymentBill,Payment);
FUNCTION GetBalance(var F:DealFile;RecordNumber:longint):longint;
Const RecordNumberPred:longint=0; BalancePred:longint=0;
Var Buf:DealType; i:longint;
Begin
if RecordNumber-1<>RecordNumberPred then
begin
BalancePred:=0; Seek(F,0);
for i:=0 to RecordNumber-1 do
begin Read(F,Buf); BalancePred:=BalancePred+Buf.Total-Buf.Payment; end
end;
Seek(F,RecordNumber); Read(F,Buf);
BalancePred:=BalancePred+Buf.Total-Buf.Payment;
GetBalance:=BalancePred; RecordNumberPred:=RecordNumber
End;
Procedure WriteTotal(Total:longint);
var MinusFlag:boolean;
begin
MinusFlag:=Total<0;
if MinusFlag and (Total div 100>-1) then Write('│','-0.':8)
else Write('│',Total div 100:7,'.');
if MinusFlag then Total:=-Total;
if (Total mod 100)<10 then Write('0');
Write(Total mod 100)
end;
PROCEDURE OutField(Field:FieldType;FirstVisibleRecord,RecordNumber:longint;Flash:boolean;Buf:DealType);
Var AttrBuf:byte;
Begin
if Flash then begin AttrBuf:=TextAttr; TextAttr:=LightGray*16 end;
case Field of
Date :begin
GoToXY(1,9+RecordNumber-FirstVisibleRecord);
Write('║',Buf.Date:8,'│')
end;
Ware :begin
GoToXY(10,9+RecordNumber-FirstVisibleRecord);
Write('│',Buf.Ware:10,'│')
end;
CreditBill :begin
GoToXY(21,9+RecordNumber-FirstVisibleRecord);
Write('│',Buf.CreditBill:7,'│')
end;
Total :begin
GoToXY(29,9+RecordNumber-FirstVisibleRecord);
WriteTotal(Buf.Total); Write('│')
end;
PaymentBill:begin
GoToXY(40,9+RecordNumber-FirstVisibleRecord);
Write('│',Buf.PaymentBill:7,'│')
end;
Payment :begin
GoToXY(48,9+RecordNumber-FirstVisibleRecord);
WriteTotal(Buf.Payment); Write('│')
end
end;
if Flash then TextAttr:=AttrBuf
End;
FUNCTION GetMonth(RecordNumber:longint;Month:byte;var F:DealFile):byte;
Var MonthBuf:byte;
Code:integer;
Buf:DealType;
Begin
if (0<=RecordNumber)and(RecordNumber<FileSize(F))
then begin
Seek(F,RecordNumber);
Read(F,Buf);
Val(Copy(Buf.Date,3,2),MonthBuf,Code)
end;
if (Code=0)and(MonthBuf in [1..12]) then GetMonth:=MonthBuf
else GetMonth:=0
End;
{!!}PROCEDURE OutDeal(FirstVisibleRecord,RecordNumber:longint;var F:DealFile;Flash:boolean);
Var Buf:DealType; AttrBuf:byte; YBase:byte; i:integer;
RecordNumberVar:longint;
Month:byte;
Begin
YBase:=RecordNumber-FirstVisibleRecord+9;
RecordNumberVar:=RecordNumber;
OutRecord(YBase,RecordNumberVar,F,Flash);
Month:=GetMonth(RecordNumberVar,Month,F); { Пост защ по -1 записи }
RecordNumber:=RecordNumberVar-1;
for i:=YBase-1 downto 9 do
if RecordNumber>=0
then
if Month=GetMonth(RecordNumberVar,Month,F)
then begin
OutRecord(i,RecordNumberVar,F,False);
Dec(RecordNumberVar)
end
else begin
Month:=GetMonth(RecordNumberVar,Month,F); { Пост защ по -1 записи }
OutSum(i,Month,F)
end
else OutRecord(i,RecordNumberVar,F,False);
RecordNumberVar:=RecordNumber;
Month:=GetMonth(RecordNumberVar,Month,F); { Пост защ по -1 и +1 записям }
RecordNumber:=RecordNumberVar+1;
for i:=YBase+1 to 22 do
if RecordNumber<FileSize(F)
then
if Month=GetMonth(RecordNumberVar,Month,F)
then begin
OutRecord(i,RecordNumberVar,F,False);
Inc(RecordNumberVar)
end
else begin
OutSum(i,Month,F);
Month:=GetMonth(RecordNumberVar,Month,F)
end
else OutRecord(i,RecordNumberVar,F,False);
End;
PROCEDURE OutHead(FiledHead:HeadFieldType);
Var AttrBuf:byte;
Begin
AttrBuf:=TextAttr;
if FiledHead=Name then TextAttr:=LightGray*16 else TextAttr:=LightGray;
GoToXY(3,2); Write('Name________',Head.Name);
if FiledHead=Address then TextAttr:=LightGray*16 else TextAttr:=LightGray;
GoToXY(3,3); Write('Address_____',Head.Address);
TextAttr:=AttrBuf;
End;
PROCEDURE LoadHead;
Var F:file of HeadType;
Begin
Assign(F,FileName+'.HD'); Reset(F); Seek(F,0); Read(F,Head); Close(F);
with Head do begin
while Length(Name)<54 do Name:=Name+' ';
while Length(Address)<54 do Address:=Address+' '
end;
OutHead(Nul)
End;
PROCEDURE PrintFiles;
Var Head:file of HeadType; Deal:DealFile; PRN:text;
HeadBuf:HeadType; DealBuf:DealType;
i:longint;
Procedure WriteTotal(Total:longint);
var MinusFlag:boolean;
begin
MinusFlag:=Total<0;
if MinusFlag and (Total div 100>-1) then Write(PRN,'-0.':8)
else Write(PRN,Total div 100:7,'.');
if MinusFlag then Total:=-Total;
if (Total mod 100)<10 then Write(PRN,'0');
Write(PRN,Total mod 100)
end;
Begin
i:=0;
Assign(Head,FileName+'.HD'); Assign(Deal,FileName+'.DL'); Assign(PRN,'LPT1');
Reset(Head); Reset(Deal); Rewrite(PRN); Read(Head,HeadBuf);
while Length(HeadBuf.Name)<54 do HeadBuf.Name:=HeadBuf.Name+' ';
while Length(HeadBuf.Address)<54 do HeadBuf.Address:=HeadBuf.Address+' ';
WriteLn(PRN,'╔════════════════════════════════════════════════════════════════════╗');
WriteLn(PRN,'║ Name________',HeadBuf.Name,' ║');
WriteLn(PRN,'║ Address_____',HeadBuf.Address,' ║');
WriteLn(PRN,'╚════════════════════════════════════════════════════════════════════╝');
WriteLn(PRN,'╔════════╤══════════╤═══════╤══════════╤═══════╤══════════╤══════════╗');
WriteLn(PRN,'║ Date │ Descript.│Credit │ Total │Payment│ Payment │ Balance ║');
WriteLn(PRN,'║ │ │bill N°│ Rs │bill N°│ Rs │ ║');
WriteLn(PRN,'╠════════╪══════════╪═══════╪══════════╪═══════╪══════════╪══════════╣');
while not EOF(Deal) do
begin
Seek(Deal,i); Read(Deal,DealBuf);
with DealBuf do
begin
Write(PRN,'║',Date,'│',Ware:10,'│',CreditBill:7,'│');
WriteTotal(Total); Write(PRN,'│',PaymentBill:7,'│');
WriteTotal(Payment); Write(PRN,'│');
WriteTotal(GetBalance(Deal,i)); WriteLn(PRN,'║')
end;
i:=i+1
end;
WriteLn(PRN,'╚════════╧══════════╧═══════╧══════════╧═══════╧══════════╧══════════╝');
Close(Head); Close(Deal); Close(PRN)
End;
PROCEDURE FilesProcess;
Const CurrentNumberFile:word=1; NumberFirstFile:word=1;
Type FileList=^FileNameType;
FileNameType=record
Name:String[12];
Next:FileList
end;
Var FileNameP,FileNamePBuf:FileList;
NumberFile:word;
Ch:char;
ExitProcess:boolean;
AttrBuf:byte;
HeadF:file of HeadType; DealF:file of DealType;
Procedure DisposerTurn(var S:FileList);
begin if S<>nil then begin DisposerTurn(S^.NEXT); Dispose(S); S:=nil end end;
Procedure SortList(var P:FileList);
function SecondElementIsMin(First,Second:FileNameType):boolean;
begin SecondElementIsMin:=Second.Name<First.Name end;
Var Ref,RefPred,RefMin,RefPredMin:FileList;
Begin
RefMin:=P; RefPredMin:=nil; Ref:=RefMin;
while Ref^.Next<>nil do
begin
RefPred:=Ref; Ref:=Ref^.Next;
if SecondElementIsMin(RefMin^,Ref^) then
begin RefMin:=Ref; RefPredMin:=RefPred end
end;
if RefPredMin<>nil then
begin RefPredMin^.Next:=RefMin^.Next; RefMin^.Next:=P; P:=RefMin end;
if P^.Next<>nil then SortList(P^.Next)
End;
Procedure ReadDir;
var S:SearchRec; FileNamePPredBuf:FileList;
begin
FileNameP:=nil;
FindFirst('*.HD',$00,S);
while DosError=0 do
begin
FileNamePBuf:=nil;
New(FileNamePBuf);
FileNamePBuf^.Next:=FileNameP;
FileNamePBuf^.Name:=S.Name;
FileNameP:=FileNamePBuf;
FindNext(S)
end;
if FileNameP<>nil then
begin
FileNamePPredBuf:=FileNameP;
FileNamePBuf:=FileNamePPredBuf^.Next;
while FileNamePBuf<>nil do
begin
FindFirst(Copy(FileNamePBuf^.Name,1,Pos('.',FileNamePBuf^.Name))+'DL',$00,S);
if DosError=0 then begin
FileNamePPredBuf:=FileNamePBuf;
FileNamePBuf:=FileNamePBuf^.Next
end
else begin
FileNamePPredBuf^.Next:=FileNamePBuf^.Next;
Dispose(FileNamePBuf); FileNamePBuf:=nil;
FileNamePBuf:=FileNamePPredBuf^.Next
end;
end;
FindFirst(Copy(FileNameP^.Name,1,Pos('.',FileNameP^.Name))+'DL',$00,S);
if DosError<>0 then begin
FileNamePBuf:=FileNameP^.Next;
Dispose(FileNameP); FileNameP:=nil;
FileNameP:=FileNamePBuf
end
end
end;
Procedure OutFiles(NumberFirstFile,NumberCurrentFile:word);
var P:FileList;
i:word;
AttrBuf:byte;
NameBuf:String8;
begin
P:=FileNameP;
i:=1;
while (i<NumberFirstFile) do begin Inc(i); P:=P^.Next end;
for i:=NumberFirstFile to NumberFirstFile+16 do
begin
GoToXY(72,i+4-NumberFirstFile);
if P<>nil then begin
NameBuf:=Copy(P^.Name,1,Length(P^.Name)-3);
if i=NumberCurrentFile then
begin
AttrBuf:=TextAttr;
TextAttr:=LightGray*16;
FileName:=Copy(P^.Name,1,Length(P^.Name)-3)
end;
while Length(NameBuf)<8 do NameBuf:=NameBuf+' ';
Write(NameBuf);
if i=NumberCurrentFile then begin
TextAttr:=AttrBuf;
GoToXY(72,22);
Write(NameBuf)
end;
P:=P^.Next
end
else Write(' ');
end;
end;
Procedure GetNumberFiles(Ref:FileList);
begin
NumberFile:=0;
while Ref<>nil do begin Inc(NumberFile); Ref:=Ref^.Next end;
if CurrentNumberFile>NumberFile then CurrentNumberFile:=NumberFile
end;
Procedure MakeFile;
var Name:string;
HeadFile:file of HeadType; DealFile:file of DealType;
begin
Name:='';
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(72,22,9,8,Name);
TextAttr:=AttrBuf;
if Name<>'' then begin
with Head do
begin Name:=''; Address:='' end;
Assign(HeadFile,Name+'.HD'); Assign(DealFile,Name+'.DL');
Rewrite(HeadFile); Rewrite(DealFile);
Write(HeadFile,Head);
Close(HeadFile); Close(DealFile)
end
end;
Procedure ViewFiles;
Var Name:string;
i:word;
F:DealFile;
begin
LoadHead;
Assign(F,FileName+'.DL');
Reset(F);
OutDeal(0,0,F,FALSE);
Close(F)
end;
Begin
AttrBuf:=TextAttr;
GoToXY(1,24);
TextAttr:=White; Write(' Esc'); TextAttr:=LightGray; Write(' Exit ');
TextAttr:=White; Write(#24#25); TextAttr:=LightGray; Write(' Choose file ');
TextAttr:=White; Write('Tab'); TextAttr:=LightGray; Write(' Switch panels ');
TextAttr:=White; Write('F7'); TextAttr:=LightGray; Write(' New ');
TextAttr:=White; Write('Del'); TextAttr:=LightGray; Write(' Delete ');
TextAttr:=White; Write(#17#196#217); TextAttr:=LightGray; Write(' View ');
GoToXY(32,25);
TextAttr:=White; Write('Ctrl+PrtSr'); TextAttr:=LightGray; Write(' Print');
TextAttr:=AttrBuf;
ReadDir;
if FileNameP<>nil then SortList(FileNameP);
GetNumberFiles(FileNameP);
ExitProcess:=FALSE;
repeat
OutFiles(NumberFirstFile,CurrentNumberFile);
Ch:=ReadKey;
if Ch=#0 then Ch:=ReadKey
else if not (Ch in [#9,#13,#27]) then Ch:=#0;
case Ch of
#72 :begin
if CurrentNumberFile>1 then Dec(CurrentNumberFile);
if NumberFirstFile>CurrentNumberFile then Dec(NumberFirstFile);
if NumberFirstFile=0 then NumberFirstFile:=1
end;
#80 :begin
if CurrentNumberFile<NumberFile then Inc(CurrentNumberFile);
if NumberFirstFile+16<CurrentNumberFile then Inc(NumberFirstFile)
end;
#9 :if FileName<>'' then
begin Condition:=Heading; ExitProcess:=TRUE; ViewFiles end;
#15 :if FileName<>'' then
begin Condition:=Deal; ExitProcess:=TRUE; ViewFiles end;
#114:if FileName<>'' then PrintFiles;
#13 :if FileName<>'' then ViewFiles;
#65 :begin
MakeFile;
DisposerTurn(FileNameP);
ReadDir;
if FileNameP<>nil then SortList(FileNameP);
GetNumberFiles(FileNameP);
if CurrentNumberFile=0 then CurrentNumberFile:=1
end;
#83 :if FileName<>'' then
begin
Assign(HeadF,FileName+'.HD'); Assign(DealF,FileName+'.DL');
Erase(HeadF); Erase(DealF);
DisposerTurn(FileNameP);
FileName:='';
ReadDir;
if FileNameP<>nil then SortList(FileNameP);
GetNumberFiles(FileNameP);
if NumberFile<CurrentNumberFile then CurrentNumberFile:=NumberFile
end;
#27 :Exit:=TRUE
end;
ExitProcess:=ExitProcess and (FileNameP<>nil)
until Exit or ExitProcess;
OutFiles(NumberFirstFile,0);
DisposerTurn(FileNameP);
GoToXY(32,25);
Write(' ')
End;
PROCEDURE SaveHead;
Var F:file of HeadType;
Begin
Assign(F,FileName+'.HD'); Reset(F);
Seek(F,0); Write(F,Head); Close(F);
OutHead(Nul)
End;
PROCEDURE HeadingProcess;
Var ExitProcess:boolean;
Ch:char;
StrBuf:string;
Begin
ExitProcess:=FALSE;
AttrBuf:=TextAttr;
GoToXY(1,24);
TextAttr:=White; Write(' Esc'); TextAttr:=LightGray; Write(' Exit ');
TextAttr:=White; Write(#24#25); TextAttr:=LightGray; Write(' Choose field ');
TextAttr:=White; Write('Tab'); TextAttr:=LightGray; Write(' Switch panels ');
TextAttr:=White; Write(#17#196#217); TextAttr:=LightGray; Write(' Edit ');
TextAttr:=AttrBuf;
if FileName<>'' then LoadHead;
HeadField:=Name;
repeat
OutHead(HeadField);
Ch:=ReadKey;
if Ch=#0 then Ch:=ReadKey
else if not (Ch in [#9,#13,#27]) then Ch:=#0;
case Ch of
#72:if HeadField<>Name then HeadField:=Pred(HeadField);
#80:if HeadField<>Address then HeadField:=Succ(HeadField);
#9 :begin Condition:=Deal; ExitProcess:=TRUE end;
#15:begin Condition:=Files; ExitProcess:=TRUE end;
#13:begin
case HeadField of
Name:StrBuf:=Head.Name;
Address:StrBuf:=Head.Address
end;
while (Length(StrBuf)>0) and (StrBuf[Length(StrBuf)]=' ')
do StrBuf:=Copy(StrBuf,1,Length(StrBuf)-1);
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(15,1+Ord(HeadField),55,54,StrBuf);
while Length(StrBuf)<54 do StrBuf:=StrBuf+' ';
case HeadField of
Name:Head.Name:=StrBuf;
Address:Head.Address:=StrBuf
end;
TextAttr:=AttrBuf;
end;
#27:Exit:=TRUE
end
until Exit or ExitProcess;
SaveHead
End;
PROCEDURE DealProcess;
Var ExitProcess:boolean;
Ch:char;
F:DealFile;
Buf:DealType;
Procedure StatStringDeal;
begin
AttrBuf:=TextAttr;
GoToXY(1,24);
TextAttr:=White; Write('Esc'); TextAttr:=LightGray; Write(' Exit ');
TextAttr:=White; Write(#24#25); TextAttr:=LightGray; Write(' Choose record ');
TextAttr:=White; Write('Tab'); TextAttr:=LightGray; Write(' Switch panels ');
TextAttr:=White; Write(#17#196#217); TextAttr:=LightGray; Write(' Edit ');
TextAttr:=White; Write('Ins'); TextAttr:=LightGray; Write(' Insert ');
TextAttr:=White; Write('Del'); TextAttr:=LightGray; Write(' Delete ');
TextAttr:=AttrBuf;
end;
Procedure EditRecord(FirstVisibleRecord,RecordNumber:longint;var F:DealFile);
var Field:FieldType;
InputStringBuf:string;
Ch:char;
ChangeFlag:boolean;
procedure ConvertDate(S:string;var Pred:String8);
var DateString,MonthString,YearString:string;
DateInteger,MonthInteger,YearInteger:integer;
DateCode,MonthCode,YearCode:integer;
begin
DateString:='';
while (S[1]<>'.')and(Length(S)>0) do
begin DateString:=DateString+S[1]; Delete(S,1,1) end;
Delete(S,1,1);
MonthString:='';
while (S[1]<>'.')and(Length(S)>0) do
begin MonthString:=MonthString+S[1]; Delete(S,1,1) end;
Delete(S,1,1);
YearString:='';
while Length(S)>0 do
begin YearString:=YearString+S[1]; Delete(S,1,1) end;
if Length(DateString)=1 then DateString:='0'+DateString;
if Length(MonthString)=1 then MonthString:='0'+MonthString;
if Length(YearString)=1 then YearString:='0'+YearString;
Val(DateString,DateInteger,DateCode);
Val(MonthString,MonthInteger,MonthCode);
Val(YearString,YearInteger,YearCode);
if (DateCode=0)and(MonthCode=0)and(YearCode=0)and((YearInteger in [0..99])
and (MonthInteger in [1..12])
and ((DateInteger in [1..28])or(DateInteger in [1..29])and(YearInteger mod 4 =0)
or(DateInteger in [1..30])and(MonthInteger in [4,6,9,11])
or(DateInteger in [1..31])and(MonthInteger in [1,3,5,7,8,10,12])))
then Pred:=DateString+'.'+MonthString+'.'+YearString
else Write(#7);
end;
procedure ConvertWare(S:string;var Pred:String10);
begin
case S[1] of
'1':Pred:=' L.S. ';
'2':Pred:=' G.M. ';
'3':Pred:=' L.M. ';
'4':Pred:=' B.S. ';
'5':Pred:=' B.F. ';
'6':Pred:=' C.F. '
end
end;
procedure ConvertTotal(S:string;var Pred:longint);
var IntBuf,FracBuf:longint;
CodeInt,CodeFrac:integer;
MinusFlag:boolean;
begin
MinusFlag:=S[1]='-';
if MinusFlag then Delete(S,1,1);
if Pos('.',S)>0
then begin
Val(Copy(S,1,Pos('.',S)-1),IntBuf,CodeInt);
Val(Copy(S,Pos('.',S)+1,Length(S)-Pos('.',S)),FracBuf,CodeFrac)
end
else begin Val(S,IntBuf,CodeInt); CodeFrac:=0; FracBuf:=0 end;
if (CodeInt>0) or (CodeFrac>0) or (FracBuf>99) or (IntBuf<0) or (FracBuf<0)
then Write(#7)
else begin
Pred:=IntBuf*100+FracBuf;
if MinusFlag then Pred:=-Pred
end
end;
procedure ConvertBill(S:string;var Pred:longint);
var IntBuf:longint;
Code:integer;
begin
Val(S,IntBuf,Code);
if (Code>0)or(IntBuf<=0)or(IntBuf>9999999) then Write(#7)
else Pred:=IntBuf
end;
procedure OutStatusString;
begin
AttrBuf:=TextAttr;
GoToXY(1,24);
TextAttr:=White; Write(' Esc'); TextAttr:=LightGray; Write(' End Edit ');
TextAttr:=White; Write('Tab/Shift+Tab'); TextAttr:=LightGray; Write(' Switch field ');
TextAttr:=White; Write(#17#196#217); TextAttr:=LightGray; Write(' Edit ');
TextAttr:=AttrBuf;
end;
begin
OutStatusString;
Field:=Date;
Seek(F,RecordNumber); Read(F,Buf);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf);
ChangeFlag:=FALSE;
repeat
Ch:=ReadKey;
if Ch=#0 then Ch:=ReadKey
else if not (Ch in [#9,#13,#27]) then Ch:=#0;
case Ch of
#9 :if Field<Payment then
begin
OutField(Field,FirstVisibleRecord,RecordNumber,FALSE,Buf);
Field:=Succ(Field);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf)
end;
#15:if Field>Date then
begin
OutField(Field,FirstVisibleRecord,RecordNumber,FALSE,Buf);
Field:=Pred(Field);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf)
end;
#13:begin
ChangeFlag:=TRUE;
InputStringBuf:='';
case Field of
Date :begin
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(2,9+RecordNumber-FirstVisibleRecord,9,8,InputStringBuf);
TextAttr:=AttrBuf;
ConvertDate(InputStringBuf,Buf.Date);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf)
end;
Ware :begin
AttrBuf:=TextAttr;
TextAttr:=White;
GoToXY(11,9+RecordNumber-FirstVisibleRecord);
Write(' ');
TextAttr:=AttrBuf;
{(11,9+RecordNumber-FirstVisibleRecord);}
AttrBuf:=TextAttr;
GoToXY(1,24);
TextAttr:=White; Write(' Esc'); TextAttr:=LightGray; Write(' Exit ');
TextAttr:=White; Write('1'); TextAttr:=LightGray; Write(' L.S. ');
TextAttr:=White; Write('2'); TextAttr:=LightGray; Write(' G.M. ');
TextAttr:=White; Write('3'); TextAttr:=LightGray; Write(' L.M. ');
TextAttr:=White; Write('4'); TextAttr:=LightGray; Write(' B.S. ');
TextAttr:=White; Write('5'); TextAttr:=LightGray; Write(' B.F. ');
TextAttr:=White; Write('6'); TextAttr:=LightGray; Write(' C.F. ');
TextAttr:=AttrBuf;
InputStringBuf:=ReadKey;
ConvertWare(InputStringBuf,Buf.Ware);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf);
OutStatusString
end;
CreditBill :begin
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(22,9+RecordNumber-FirstVisibleRecord,8,7,InputStringBuf);
TextAttr:=AttrBuf;
ConvertBill(InputStringBuf,Buf.CreditBill);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf);
end;
Total :begin
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(30,9+RecordNumber-FirstVisibleRecord,11,10,InputStringBuf);
TextAttr:=AttrBuf;
ConvertTotal(InputStringBuf,Buf.Total);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf);
end;
PaymentBill:begin
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(41,9+RecordNumber-FirstVisibleRecord,8,7,InputStringBuf);
TextAttr:=AttrBuf;
ConvertBill(InputStringBuf,Buf.PaymentBill);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf);
end;
Payment :begin
AttrBuf:=TextAttr;
TextAttr:=White;
InputString(49,9+RecordNumber-FirstVisibleRecord,11,10,InputStringBuf);
TextAttr:=AttrBuf;
ConvertTotal(InputStringBuf,Buf.Payment);
OutField(Field,FirstVisibleRecord,RecordNumber,TRUE,Buf);
end
end
end;
#27:ExitProcess:=TRUE
end
until ExitProcess;
if ChangeFlag then begin
Seek(F,RecordNumber); Write(F,Buf);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE);
end;
StatStringDeal
end;
Procedure InsertRecord(FirstVisibleRecord,RecordNumber:longint;var F:DealFile);
var TempF:DealFile;
i:longint;
begin
Assign(TempF,'$$TEMP$$');
Rewrite(TempF); Seek(F,RecordNumber);
for i:=RecordNumber to FileSize(F)-1 do
begin Read(F,Buf); Write(TempF,Buf) end;
Seek(F,RecordNumber);
Truncate(F);
Write(F,Deal0);
Seek(TempF,0);
while not EOF(TempF) do
begin Read(TempF,Buf); Write(F,Buf) end;
Close(TempF);
Erase(TempF);
for i:=RecordNumber to FirstVisibleRecord+13 do OutDeal(FirstVisibleRecord,i,F,FALSE);
EditRecord(FirstVisibleRecord,RecordNumber,F)
end;
Procedure DeleteRecord(FirstVisibleRecord,RecordNumber:longint;var F:DealFile);
var i:longint;
begin
if RecordNumber<FileSize(F) then
begin
Seek(F,RecordNumber);
for i:=RecordNumber to FileSize(F)-2 do
begin Seek(F,i+1); Read(F,Buf); Seek(F,i); Write(F,Buf) end;
Seek(F,FileSize(F)-1);
Truncate(F);
for i:=RecordNumber to FirstVisibleRecord+13 do OutDeal(FirstVisibleRecord,i,F,FALSE);
end
end;
Begin
ExitProcess:=FALSE;
StatStringDeal;
Assign(F,FileName+'.DL');
Reset(F);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE);
repeat
Ch:=ReadKey;
if Ch=#0 then Ch:=ReadKey
else if not (Ch in [#9,#13,#27]) then Ch:=#0;
case Ch of
#72:begin
OutDeal(FirstVisibleRecord,RecordNumber,F,FALSE);
if RecordNumber>0 then Dec(RecordNumber);
if FirstVisibleRecord>RecordNumber then Dec(FirstVisibleRecord);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#71:begin
RecordNumber:=0; FirstVisibleRecord:=0;
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#79:begin
RecordNumber:=FileSize(F);
FirstVisibleRecord:=RecordNumber-13;
if FirstVisibleRecord<0 then FirstVisibleRecord:=0;
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#73:begin
RecordNumber:=RecordNumber-13;
if RecordNumber<0 then RecordNumber:=0;
FirstVisibleRecord:=FirstVisibleRecord-13;
if FirstVisibleRecord<0 then FirstVisibleRecord:=0;
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#81:begin
RecordNumber:=RecordNumber+13;
FirstVisibleRecord:=FirstVisibleRecord+13;
if FirstVisibleRecord>FileSize(F) then
begin
FirstVisibleRecord:=FirstVisibleRecord-13;
if FirstVisibleRecord<0 then FirstVisibleRecord:=0;
end;
if RecordNumber>FileSize(F) then RecordNumber:=FileSize(F);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#80:begin
OutDeal(FirstVisibleRecord,RecordNumber,F,FALSE);
if RecordNumber<FileSize(F) then Inc(RecordNumber);
if FirstVisibleRecord+13<RecordNumber then Inc(FirstVisibleRecord);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#82:begin
OutDeal(FirstVisibleRecord,RecordNumber,F,FALSE);
InsertRecord(FirstVisibleRecord,RecordNumber,F);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#83:begin
OutDeal(FirstVisibleRecord,RecordNumber,F,FALSE);
DeleteRecord(FirstVisibleRecord,RecordNumber,F);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#9 :begin Condition:=Files; ExitProcess:=TRUE end;
#15:begin Condition:=Heading; ExitProcess:=TRUE end;
#13:begin
OutDeal(FirstVisibleRecord,RecordNumber,F,FALSE);
if RecordNumber=FileSize(F)
then InsertRecord(FirstVisibleRecord,RecordNumber,F)
else EditRecord(FirstVisibleRecord,RecordNumber,F);
OutDeal(FirstVisibleRecord,RecordNumber,F,TRUE)
end;
#27:begin Exit:=TRUE end
end
until Exit or ExitProcess;
OutDeal(FirstVisibleRecord,RecordNumber,F,FALSE);
Close(F)
End;
BEGIN
AttrBuf:=TextAttr;
ClrScr;
TextAttr:=LightGray;
Write('╔════════════════════════════════════════════════════════════════════╗╔════════╗',
'║ Name________ ║║ Files ║',
'║ Address_____ ║╟────────╢',
'╚════════════════════════════════════════════════════════════════════╝║ ║',
'╔════════╤══════════╤═══════╤══════════╤═══════╤══════════╤══════════╗║ ║',
'║ Date │ Descript.│Credit │ Total │Payment│ Payment │ Balance ║║ ║',
'║ │ │bill N°│ Rs │bill N°│ Rs │ ║║ ║',
'╠════════╪══════════╪═══════╪══════════╪═══════╪══════════╪══════════╣║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║║ ║',
'║ │ │ │ │ │ │ ║╟────────╢',
'║ │ │ │ │ │ │ ║║ ║',
'╚════════╧══════════╧═══════╧══════════╧═══════╧══════════╧══════════╝╚════════╝');
Exit:=FALSE;
FilesProcess;
RecordNumber:=0; FirstVisibleRecord:=0;
while not Exit do case Condition of
Files :begin
RecordNumber:=0;
FirstVisibleRecord:=0;
FilesProcess
end;
Heading:HeadingProcess;
Deal :DealProcess
end;
TextAttr:=AttrBuf;
ClrScr
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию