PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue156/delphi/BookStream/bs.pas

Pascal/Delphi Source File | 1999-06-09 | 13.5 KB | 485 lines

unit bs;
{ PC Plus sample Delphi program.
  Illustrates the basic techniques for declaring a class and
  constructing and destroying objects.
  Also shows how to create a simple object hierarchy.
}

{ Note specific BookOb descendants' CreateFromStream calls their ancestor
BookOb CreateFromStream. This calls ReadFromStream (which is overridden so it
calls the descendent's ReadFromStream! ) Trace execution to understand! }


interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;


type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    BookEd: TEdit;
    AuthorEd: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    AddBtn: TButton;
    ClearBtn: TButton;
    ExitBtn: TButton;
    ShowBtn: TButton;
    ComboBox1: TComboBox;
    ExtraLabel: TLabel;
    ExtraEdit: TEdit;
    GoreScoreCombo: TComboBox;
    SaveBtn: TButton;
    LoadBtn: TButton;
    procedure ExitBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure AddBtnClick(Sender: TObject);
    procedure ShowBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { --- My declarations --- }
    procedure AddBookOb;
    procedure AddHorrorBookOb;
    procedure AddRefBookOb;
    procedure ShowObList;
  end;

{ declare a fixed-length string                 }
  bkstr = string[70];
  cnstr = string[15]; // to store the class name
{ declare a gorerating for HorrorBookOb         }
  gorerating = 0..10;

{ declare a BookOb class        }
  BookOb = class(TObject)
    name   : bkstr;
    author : bkstr;
    cn     : cnstr; // name of the class
    constructor Create( aName, anAuthor : bkstr );
    constructor CreateFromStream( cname : cnstr; fs : TFileStream );
    destructor Destroy; override;
    function Describe : bkstr;  virtual;
    procedure WriteToStream( fs : TFileStream ); virtual; { XXX }
    procedure ReadFromStream( fs: TFileStream); virtual; { XXX }
  end;

{ declare a HorrorBookOb class }
  HorrorBookOb = class(BookOb)
    gorescore : integer;
    constructor Create( aName, anAuthor : bkstr; aGorescore : gorerating );
    destructor Destroy; override;
    function Describe : bkstr; override;
    procedure WriteToStream( fs : TFileStream ); override; { XXX }
    procedure ReadFromStream( fs: TFileStream); override; { XXX }
  end;

{ declare a RefBookOb class }
  RefBookOb = class(BookOb)
    reftype : bkstr;
    constructor Create( aName, anAuthor, aReftype : bkstr);
    destructor Destroy; override;
    function Describe : bkstr; override;
    procedure WriteToStream( fs : TFileStream );  override; { XXX }
    procedure ReadFromStream( fs: TFileStream);   override; { XXX }
  end;

  { BookObList is a special BookOb-managing TList }
  BookObList = class(TList)
    constructor Create;
    destructor Destroy; override;
    procedure FreeObs;
    procedure SaveObList( fname : string );
    procedure LoadObList( fname: string);
  end;

const
  SAVEFILE = 'Library.sav';
var
  Form1: TForm1;
  ObList : BookObList; { declare a TList to hold our objects }

implementation

{$R *.DFM}

// ===========================================
// TFORM1 Start...
// ===========================================

procedure TForm1.ShowObList;
{ Show each ob's ID (its name and author) in the ListBox }
{ also show extra data for HorrorBookObs and RefBookObs  }
var
   i :integer;
begin
{  ListBox1.Clear; }
  if ObList.Count = 0 then
    ListBox1.Items.Add( 'No books in the list!' )
  else
  for i := 0 to ObList.Count - 1 do
      ListBox1.Items.Add( BookOb(ObList.Items[i]).Describe );
end;

procedure TForm1.SaveBtnClick(Sender: TObject);
begin
  ObList.SaveObList( SAVEFILE );
  ListBox1.Items.Add( 'Saved' );
end;

procedure TForm1.LoadBtnClick(Sender: TObject);
begin
  if not FileExists( SAVEFILE ) then
     ShowMessage( SAVEFILE + ' not found!' )
  else
  begin
    ObList.LoadObList( SAVEFILE );
    ShowObList;
  end;
end;

procedure TForm1.ExitBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Create a BookObList called ObList when the main form is created }
  ObList := BookObList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ObList.FreeObs;     { Free the objects in the ObList, then...      }
  ObList.Free;        { Free the ObList when the main form is closed }
end;

{ ----- add specific types of objects ----- }
procedure TForm1.AddBookOb;
{ add an ordinary BookOb to the ObList and display its data on the List box }
var
  book : BookOb;
begin
  book := BookOb.Create( BookEd.Text, AuthorEd.Text );
  ObList.Add( book );
end;

procedure TForm1.AddRefBookOb;
{ add a RefBookOb to the ObList and display its data on the List box        }
var
  book : RefBookOb;
begin
  if (ExtraEdit.Text = '') then
        MessageDlg('You must enter a book type (e.g. "Physics" or "Art") ',
                    mtInformation, [mbOk], 0)
  else
  begin
    book := RefBookOb.Create( BookEd.Text, AuthorEd.Text, ExtraEdit.Text );
    ObList.Add( book );
  end;
end;

procedure TForm1.AddHorrorBookOb;
{ add a HorrorBookOb to the ObList and display its data on the List box     }
var
  book  : HorrorBookOb;
  score : integer;
  ok    : boolean;
begin
  ok := true;
  { First check that a valid gorescore has been entered                     }
  { try to convert the contents of ExtraEdit to an integer                  }
  try
    score := StrToInt(GoreScoreCombo.Text);
  except
     on EConvertError do     { Error if user did not enter an integer }
     begin                   { recover from this by setting score to  }
       score := 0;           { 0 and displaying a message             }
       MessageDlg('Invalid gorescore entry!', mtInformation,[mbOk], 0);
      ok := false;
     end;
  end;
  if ok then                { if the integer is valid, is it 0..10?  }
     if (score < 0) or (score > 10) then
        MessageDlg('The score must be a number from 0 to 10!', mtInformation,
                   [mbOk], 0)
  else
  begin                     { if all is ok, create the object       }
    book := HorrorBookOb.Create( BookEd.Text, AuthorEd.Text, score );
    ObList.Add( book );
  end;
end;

procedure TForm1.AddBtnClick(Sender: TObject);
{ User wants to add a book object. Determine the type of object         }
{ by the Combo box item that's been selected, then call an appropriate  }
{ method.                                                               }
begin
  if ((BookEd.Text = '') or (AuthorEd.Text = '')) then
        MessageDlg('You must enter a book and an author!', mtInformation,
      [mbOk], 0)
  else
  if ComboBox1.Text = 'Horror' then
    AddHorrorBookOb
  else
  if ComboBox1.Text = 'Reference' then
    AddRefBookOb
  else
    AddBookOb;
end;

procedure TForm1.ShowBtnClick(Sender: TObject);
begin
  ShowObList;
end;

procedure TForm1.ClearBtnClick(Sender: TObject);
begin
  ObList.FreeObs;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
{ When a change (normally a selection) is made in the ComboBox, see if the    }
{ selected item indicates a special type of book. If so, display a label      }
{ and text entry field to allow the user to enter the additional data needed  }
{ to create an object of the specified type.                                  }
begin
  if ComboBox1.Text = 'Horror' then
  begin
    ExtraLabel.Caption := 'Enter Gore score [1 to 10]';
    ExtraLabel.Show;
    ExtraEdit.Hide;
    GoreScoreCombo.Show;
    GoreScoreCombo.SetFocus;
  end
  else if ComboBox1.Text = 'Reference' then
  begin
    ExtraLabel.Caption := 'Enter the type of reference book';
    ExtraEdit.Text := 'General';
    ExtraLabel.Show;
    ExtraEdit.Show;
    GoreScoreCombo.Hide;
    ExtraEdit.SetFocus;
  end
  else
  begin   { if it's an ordinary book, don't display the extra edit box       }
    ExtraLabel.Hide;
    ExtraEdit.Hide;
    GoreScoreCombo.Hide;
  end;
end;


// ===========================================
// BOOKOBLIST Start...
// ===========================================
procedure BookObList.SaveObList( fname : string );
var
   fs : TFileStream;
    i : integer;
begin
   fs := TFileStream.Create(fname, fmCreate );
   try
     for i := 0 to ObList.Count - 1 do
         BookOb(ObList[i]).WriteToStream( fs ); { call VIRTUAL method!!! }
   finally;
     fs.Free;
   end;
end;

procedure BookObList.LoadObList( fname : string );
var
   fs : TFileStream;
   cn : cnstr;
begin
   ObList.FreeObs;
   fs := TFileStream.Create(fname, fmOpenRead );
   try
    Form1.ListBox1.Items.Add( Format('fs.Position = %d, fs.Size = %d',
                                    [fs.Position,fs.Size] ));
   while fs.Position < fs.Size do
   begin     { read classname and call appropriate constructor }
       fs.ReadBuffer(cn, sizeof(cn));
       if cn = 'HorrorBookOb' then
          ObList.Add(HorrorBookOb.CreateFromStream(cn,fs))
       else if cn = 'RefBookOb' then
          ObList.Add(RefBookOb.CreateFromStream(cn,fs))
       else
          ObList.Add(BookOb.CreateFromStream(cn,fs));
   end;
   finally;
     fs.Free;
   end;
end;

procedure BookObList.FreeObs;
{ Free the objects in the ObList  }
var
  i : integer;
begin
  for i := 0 to ObList.Count - 1 do
      if ObList.Items[i] <> nil then
      begin
         Form1.ListBox1.Items.Add( 'Call to FREE Ob: ' +
                             BookOb(ObList.Items[i]).Describe );
         BookOb(ObList.Items[i]).Free;
      end;
  ObList.Clear;
end;

// constructor
constructor BookObList.Create;
begin
  inherited Create;
end;

// destructor
destructor BookObList.Destroy;
begin
   inherited Destroy;
end;
// ...BOOKOBLIST End



// ===========================================
// BOOKOB FAMILY TREE Start...
// ===========================================

// BOOKOB

constructor BookOb.Create( aName, anAuthor : bkstr );
{ a standard BookOb. Call default initialisation, then init the 2 fields }
begin
  inherited Create;
  Form1.ListBox1.Items.Add( 'CONSTRUCTOR: BookOb.Create' );
  cn   := self.className;
  name := aName;
  author := anAuthor;
end;

// alternative constructor.
// creates itself using data read from stream
constructor BookOb.CreateFromStream( cname : cnstr; fs: TFileStream);
begin
   inherited Create;
   Form1.ListBox1.Items.Add( 'CONSTRUCTOR: ' + cname + '.CreateFromStream' );
   cn := cname;
   ReadFromStream( fs );
end;

destructor BookOb.Destroy;
begin
  Form1.ListBox1.Items.Add( 'DESTRUCTOR: BookOb.Destroy' );
  name := '';
  author := '';
  cn := '';
  inherited Destroy;
end;

procedure BookOb.WriteToStream( fs : TFileStream );
begin
  fs.WriteBuffer(cn, sizeof(cn));
  fs.WriteBuffer(author, sizeof(author) );
  fs.WriteBuffer(name, sizeof(name ) );
end;

procedure BookOb.ReadFromStream( fs : TFileStream );
begin
  fs.ReadBuffer(author, sizeof(author) );
  fs.ReadBuffer(name, sizeof(name ) );
end;

function BookOb.Describe : bkstr;
begin
  result := Format( '[General Book] %s by %s', [name,author]);
end;

// HORRORBOOKOB
constructor HorrorBookOb.Create( aName, anAuthor : bkstr; aGorescore : gorerating );
{ a HorrorBookOb. Call its ancestor (BookOb) constructor, then init gorescore }
begin
  inherited Create(aName, anAuthor);
  Form1.ListBox1.Items.Add( 'CONSTRUCTOR: HorrorBookOb.Create' );
  gorescore := aGorescore;
end;

destructor HorrorBookOb.Destroy;
begin
  Form1.ListBox1.Items.Add( 'DESTRUCTOR: HorrorBookOb.Destroy' );
  gorescore := 0;
  inherited Destroy;
end;

procedure HorrorBookOb.WriteToStream( fs : TFileStream );
begin
  fs.WriteBuffer(cn, sizeof(cn));
  fs.WriteBuffer(author, sizeof(author) );
  fs.WriteBuffer(name, sizeof(name ) );
  fs.WriteBuffer(gorescore, sizeof(gorescore ) );
end;

procedure HorrorBookOb.ReadFromStream( fs : TFileStream );
begin
  fs.ReadBuffer(author, sizeof(author) );
  fs.ReadBuffer(name, sizeof(name ) );
  fs.ReadBuffer(gorescore, sizeof(gorescore ) );
end;

function HorrorBookOb.Describe : bkstr;
begin
  result := Format( '[Horror Book] %s by %s. Gore Score: %d',
                    [name,author,gorescore]);
end;

// REFBOOKOB
constructor RefBookOb.Create( aName, anAuthor, aReftype : bkstr );
{ a RefBookOb. Call its ancestor (BookOb) constructor, then init reftype      }
begin
  inherited Create(aName, anAuthor);
  Form1.ListBox1.Items.Add( 'CONSTRUCTOR: RefBookOb.Create' );
  reftype := aReftype;
end;

destructor RefBookOb.Destroy;
begin
  Form1.ListBox1.Items.Add( 'DESTRUCTOR: RefBookOb.Destroy' );
  reftype := '';
  inherited Destroy;
end;

procedure RefBookOb.WriteToStream( fs : TFileStream );
begin
  fs.WriteBuffer(cn, sizeof(cn));
  fs.WriteBuffer(author, sizeof(author) );
  fs.WriteBuffer(name, sizeof(name ) );
  fs.WriteBuffer(reftype, sizeof(reftype ) );
end;

procedure RefBookOb.ReadFromStream( fs : TFileStream );
begin
  fs.ReadBuffer(author, sizeof(author) );
  fs.ReadBuffer(name, sizeof(name ) );
  fs.ReadBuffer(reftype, sizeof(reftype ) );
end;

function RefBookOb.Describe : bkstr;
begin
result := Format( '[Reference Book] %s by %s. Book type: %s',
                    [name,author,reftype]);
end;

// ...BOOKOB FAMILY TREE End


end.