PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue149/delphi/copydelp.exe/RecFile/rec1.pas

Pascal/Delphi Source File | 1997-03-03 | 5.8 KB | 208 lines

unit Rec1;
{ PC Plus - sample Delphi program.
  Illustrates reading and writing records to a typed file.
  Note, little error-checking is done, so don't try anything clever! }

interface

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

type
{ For compatibility between Delphi 1 and Delphi 2   }
{ strings are fixed size (you can't write Delphi 2  }
{ dynamic strings to a typed file) and the smallint }
{ data type is used (the size of integer varies     }
{ between Delphi 1 and 2)                           }
ThingRec = record
  name        : string[20];
  description : string [50];
  value       : smallint;
end;




  TForm1 = class(TForm)
    CountBtn: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    FilePosLabel: TLabel;
    RecNumEd: TEdit;
    LoadBtn: TButton;
    SaveBtn: TButton;
    procedure CountBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DisplayRecord( aRecord: ThingRec );
    function FieldsOK : boolean;
  end;



const
  RecFileName = 'Test.dat';

var
  Form1: TForm1;
  RecFile          : File of ThingRec;
  RecPos           : integer;

implementation

{$R *.DFM}
function TForm1.FieldsOK : boolean;
{ Check that the data in the Edit boxes is valid for a ThingRec record }
{ Return true if it is. False otherwise.                               }
{ Call this function before attempting to save a record to disk        }
var
  i   : integer;
  msg : string;
begin
  msg := '';
  { do all 3 edit boxes contain data? }
  if (Edit1.Text = '') or
     (Edit2.Text = '') or
     (Edit3.Text = '') then
        msg := 'You must add data to each of the fields!'
  else
  try   { check that ValEd.Text can be converted to an integer }
    i := StrToInt(Edit3.Text);
    except
      on EConvertError do
      begin
         i := 0;
         msg := 'You must enter an integer into the Value field!';
      end;
  end; { try,except }
  { If no error msg was initialised, the data is OK, return true }
  { Otherwise, there was a problem, return false                 }
  if msg <> '' then
  begin
    MessageDlg(  msg, mtInformation, [mbOk], 0);
    result := false;
  end
  else
    result := true;
end;

procedure TForm1.DisplayRecord( aRecord: Thingrec );
{ Display the fields of record, aRecord in the Edit boxes on the form }
begin
  With aRecord do
  begin
    Edit1.Text := name;
    Edit2.Text := description;
    Edit3.Text := IntToStr(value);
  end;
  FilePosLabel.Caption := IntToStr( RecPos );
end;

procedure TForm1.CountBtnClick(Sender: TObject);
{ Count the records in the data file }
var
   size             : longint;
begin
    size := 0;
    if not FileExists( RecFileName ) then       { Check that input file exists }
        ShowMessage('File: ' + RecFileName + ' not found!')
    else
    begin
      AssignFile(RecFile, RecFileName );
      Reset(RecFile);
      size := FileSize(RecFile);
      CloseFile(RecFile);
      ShowMessage('File: ' + RecFileName + ' contains ' + IntToStr(size)
                                                        + ' records')
    end;
end;

procedure TForm1.LoadBtnClick(Sender: TObject);
var
  RecNum        : integer;
  invalidNumber : boolean;
  aRecord       : ThingRec;
begin
   invalidNumber := false;
   try   { check that ValEd.Text can be converted to an integer }
      RecNum := StrToInt(RecNumEd.Text);
    except
      on EConvertError do
      begin
         RecNum := 0;
         MessageDlg(  '"' + RecNumEd.Text + '" is not a valid integer!',
                      mtInformation, [mbOk], 0);
         invalidNumber := true;
      end
    end; { except }
    if not invalidNumber then
    begin
         if not FileExists( RecFileName ) then
            ShowMessage('File: ' + RecFileName + ' not found!')
         else
         begin
{ ----- Open the file ----- }
           AssignFile(RecFile, RecFileName );
           Reset(RecFile);
           { make sure the specified record number is valid }
           if (RecNum < 0) or (RecNum > (FileSize(RecFile)-1)) then
              ShowMessage('Record Number ' + IntToStr(RecNum) + ' not found!')
           else
           begin
{ ----- Seek and read the record at the specified position -----     }
             Seek( RecFile, RecNum );
                   { update the global var, RecPos                   }
             RecPos := FilePos( RecFile );
             Read( RecFile, aRecord );
                   { calll procedure to display fields in Edit boxes }
             Displayrecord( aRecord );
           end;
           CloseFile(RecFile);
         end;
    end;

end;

procedure TForm1.SaveBtnClick(Sender: TObject);
var
  aRecord : ThingRec;
begin
  if FieldsOK then
  if not FileExists( RecFileName ) then
     ShowMessage('File: ' + RecFileName + ' not found!')
  else
  begin
     { assign values to the record fields }
     aRecord.name := Edit1.Text;
     aRecord.description := Edit2.Text;
     aRecord.value := StrToInt(Edit3.Text);
     { then open file, seek the RecPos (the position of the record that }
     { was last loaded, then write the new record into the file at      }
     { this position                                                    }
     AssignFile(RecFile, RecFileName);
       { Don't Rewrite the file or you'll destroy all existing data }
     Reset(RecFile);
     Seek(RecFile, RecPos );
     Write(RecFile, aRecord);
     CloseFile(RecFile);
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  RecPos := 0;
end;

end.