137 lines
2.8 KiB
Plaintext
137 lines
2.8 KiB
Plaintext
|
||
{ Turbo Cardfile }
|
||
{ Copyright (c) 1989 by Borland International, Inc. }
|
||
|
||
program CardFile;
|
||
{ Turbo Pascal 5.5 object-oriented example.
|
||
Demonstrates the use of the CARDS unit.
|
||
Refer to OOPDEMOS.DOC for an overview of this program.
|
||
}
|
||
|
||
{$S-}
|
||
{$M 8192, 65536, 655360}
|
||
|
||
uses Crt, Objects, Forms, Sliders, Cards;
|
||
|
||
const
|
||
Signature: Longint = $44524143;
|
||
|
||
var
|
||
F: Form;
|
||
C: CardList;
|
||
S: FStream;
|
||
|
||
procedure Error(Message: String);
|
||
begin
|
||
WriteLn(Message, ': ', ParamStr(1));
|
||
Halt(1);
|
||
end;
|
||
|
||
procedure ReadCards;
|
||
var
|
||
Header: Longint;
|
||
begin
|
||
S.Init(ParamStr(1), SOpen, 1024);
|
||
if S.Status <> 0 then Error('Cannot open file');
|
||
S.Read(Header, SizeOf(Longint));
|
||
if Header <> Signature then Error('File format error');
|
||
F.Load(S);
|
||
C.Load(S);
|
||
if S.Status <> 0 then Error('Disk read error');
|
||
S.Done;
|
||
end;
|
||
|
||
function EditCards: Boolean;
|
||
var
|
||
Ch: Char;
|
||
Start, Stop: Boolean;
|
||
|
||
function EditForm: Boolean;
|
||
begin
|
||
Color(ForeColor);
|
||
GotoXY(1, 25);
|
||
Write(' Edit '#179' F2-Accept Esc-Cancel');
|
||
ClrEol;
|
||
EditForm := F.Edit = CSave;
|
||
end;
|
||
|
||
function Confirm(Message: String): Boolean;
|
||
begin
|
||
Color(ForeColor);
|
||
GotoXY(1, 25);
|
||
Write(' ', Message, ' (Y/N)? ');
|
||
ClrEol;
|
||
Confirm := UpCase(ReadChar) = 'Y';
|
||
end;
|
||
|
||
begin
|
||
Color(BackColor);
|
||
ClrScr;
|
||
Color(ForeColor);
|
||
GotoXY(1, 1);
|
||
Write(' File ', ParamStr(1));
|
||
ClrEol;
|
||
Start := True;
|
||
Stop := False;
|
||
repeat
|
||
if C.Count = 0 then F.Clear else F.Put(C.CardData^);
|
||
F.Show(Start);
|
||
Color(ForeColor);
|
||
GotoXY(69, 1);
|
||
Write(C.Count: 5, ' Cards');
|
||
GotoXY(1, 25);
|
||
Write(' Browse '#179' '#25'-Next '#24'-Prev Enter-Edit ' +
|
||
'Ins-Insert Del-Delete Esc-Exit ');
|
||
ClrEol;
|
||
Ch := ReadChar;
|
||
if (Ch = CEnter) and (C.Count = 0) then Ch := CIns;
|
||
case Ch of
|
||
CNext: C.Next;
|
||
CPrev: C.Prev;
|
||
CEnter: if EditForm then F.Get(C.CardData^);
|
||
CIns:
|
||
begin
|
||
F.Clear;
|
||
F.Show(False);
|
||
if EditForm then
|
||
begin
|
||
C.Insert;
|
||
F.Get(C.CardData^);
|
||
end;
|
||
end;
|
||
CDel:
|
||
if C.Count > 0 then
|
||
if Confirm('Delete this card') then C.Delete;
|
||
CEsc: Stop := True;
|
||
else
|
||
Beep;
|
||
end;
|
||
Start := False;
|
||
until Stop;
|
||
EditCards := Confirm('Update card file');
|
||
NormVideo;
|
||
ClrScr;
|
||
end;
|
||
|
||
procedure WriteCards;
|
||
begin
|
||
S.Init(ParamStr(1), SCreate, 1024);
|
||
if S.Status <> 0 then Error('Cannot create file');
|
||
S.Write(Signature, SizeOf(Longint));
|
||
F.Store(S);
|
||
C.Store(S);
|
||
S.Flush;
|
||
if S.Status <> 0 then Error('Disk write error');
|
||
S.Done;
|
||
end;
|
||
|
||
begin
|
||
if ParamCount <> 1 then
|
||
begin
|
||
WriteLn('Usage: CARDFILE filename');
|
||
Halt(1);
|
||
end;
|
||
ReadCards;
|
||
if EditCards then WriteCards;
|
||
end.
|
||
|