Delphi Programming Unleashed/Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso/chap16/linklst2/main.pas

Pascal/Delphi Source File | 1995-03-21 | 6.9 KB | 321 lines

unit Main;

{ Program copyright (c) 1995 by Charles Calvert }
{ Project Name: LINKLST2 }

{ This a simple linked list program. It supports Adding,
  Deleting and Searching.

  The first time you run this program you should
  choose Create New List from the File menu. Then
  choose Read Data. Thereafter you should
  always choose Read Data after starting the program. }

interface

uses
  WinTypes, WinProcs, Classes,
  Graphics, Forms, Controls,
  Menus, StdCtrls, MakeData, SysUtils;

type
  TDataForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    CreateList1: TMenuItem;
    Save1: TMenuItem;
    Lists1: TMenuItem;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    ReadData1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    First: TButton;
    Next: TButton;
    Count1: TMenuItem;
    Button1: TButton;
    Last: TButton;
    Find1: TMenuItem;
    Help1: TMenuItem;
    procedure CreateList1Click(Sender: TObject);
    procedure ReadData1Click(Sender: TObject);
    procedure FirstClick(Sender: TObject);
    procedure NextClick(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Count1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure LastClick(Sender: TObject);
    procedure Find1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure Help(Sender: TObject);
  private
    FirstNode,
    Current: PMyNode;
    procedure CreateNewFile;
    procedure ShowRecord;
    procedure NewNode(var Item: PMyNode);
    function ReadFile(var First, Current: PMyNode): Boolean;
    procedure ReadTextFile(var FirstNode, Current: PMyNode);
    procedure Working;
    procedure GoLast;
    function Find(S: String): PMyNode;
    procedure DeleteNode(var Node: PMyNode);
  public
    { Public declarations }
  end;

var
  DataForm: TDataForm;

implementation

uses
  Entry,
  Dialogs;

{$R *.DFM}

procedure TDataForm.CreateNewFile;
var
  F: File of TMyNode;
  Head: PMyNode;
begin
  Head := FirstNode;
  System.Assign(F, FileName);
  ReWrite(F);
  while Head^.Next <> nil do begin
    Write(F, Head^);
    Head := Head^.Next;
  end;
  Write(F, Head^);
  System.Close(F);
end;

procedure TDataForm.NewNode(var Item: PMyNode);
begin
  New(Item);
  Item^.Next := nil;
  Item^.Name := '';
  Item^.Flight := 0;
  Item^.Day := '';
end;

function TDataForm.ReadFile(var First, Current: PMyNode): Boolean;
var
  F: File of TMyNode;
  Prev: PMyNode;
begin
  ReadFile := False;
  System.Assign(F, FileName);
  {$I-} Reset(F); {$I+}
  if IOResult <> 0 then Exit;
  NewNode(Current);
  Read(F, Current^);
  FirstNode := Current;
  while not Eof(F) do begin
    Prev := Current;
    NewNode(Current);
    Read(F, Current^);
    Prev^.Next := Current;
  end;
  System.Close(F);
  ReadFile := True;
end;

{ Read a Text File }
procedure TDataForm.ReadTextFile(var FirstNode, Current: PMyNode);
var
  F: System.Text;
  Prev: PMyNode;
  i: Integer;
begin
  System.Assign (F, 'data.txt');
  {$I-} Reset(F); {$I+}
  if (IOResult <> 0) then begin
    MessageBox(Handle, 'error Reading File', nil, mb_Ok);
    Halt;
  end;
  NewNode(Current);
  ReadLn(F, Current^.Name);
  ReadLn(F, Current^.Flight);
  ReadLn(F, Current^.Day);
  FirstNode := Current;
  i := 0;
  while not Eof(F) do begin
    Prev := Current;
    NewNode(Current);
    ReadLn(F, Current^.Name);
    ReadLn(F, Current^.Flight);
    ReadLn(F, Current^.Day);
    Prev^.Next := Current;
    Inc(i);
  end;
  System.Close(F);
  CreateNewFile;
end;

procedure TDataForm.ShowRecord;
begin
  Edit1.Text := Current^.Name;
  Edit2.Text := IntToStr(Current^.Flight);
  Edit3.Text := Current^.Day;
end;

procedure TDataForm.CreateList1Click(Sender: TObject);
begin
  CreateData;
end;

procedure TDataForm.Working;
begin
  Edit1.Text := 'Please wait';
  Edit2.Text := 'Working';
  Edit3.Text := '';
  Application.ProcessMessages;
end;

procedure TDataForm.ReadData1Click(Sender: TObject);
begin
  Working;
  if not ReadFile(FirstNode, Current) then
    ReadTextFile(FirstNode, Current);
  Current := FirstNode;
  ShowRecord;
end;

procedure TDataForm.FirstClick(Sender: TObject);
begin
  Current := FirstNode;
  ShowRecord;
end;

procedure TDataForm.NextClick(Sender: TObject);
begin
  if Current^.Next <> nil then
    Current := Current^.Next;
  ShowRecord;
end;

procedure TDataForm.Save1Click(Sender: TObject);
begin
  CreateNewFile;
end;

procedure TDataForm.Count1Click(Sender: TObject);
var
  i: Integer;
  Head: PMyNode;
begin
  i := 1;
  Head := FirstNode;
  while Head^.Next <> nil do begin
    Head := Head^.Next;
    Inc(i);
  end;
  MessageDlg('Total = ' + IntToStr(i), mtInformation, [mbOk], 0);
end;

procedure TDataForm.GoLast;
begin
  while Current^.Next <> nil do
    Current := Current^.Next;
end;

procedure TDataForm.Button1Click(Sender: TObject);
var
  Temp: PMyNode;
begin
  NewNode(Temp);
  if EntryForm.Add(Temp) then begin
    GoLast;
    Current^.Next := Temp;
    Current := Temp;
  end;
end;

procedure TDataForm.LastClick(Sender: TObject);
begin
  GoLast;
  ShowRecord;
end;

function TDataForm.Find(S: String): PMyNode;
var
  Head,
  Temp: PMyNode;
begin
  Head := FirstNode;
  Temp := nil;
  while Head^.Next <> nil do begin
    if Head^.Name = S then begin
      Temp := Head;
      break;
    end;
    Head := Head^.Next;
  end;
  if Head^.Name = S then Temp := Head;
  Find := Temp;
end;

procedure TDataForm.Find1Click(Sender: TObject);
var
  S: String;
begin
  S := '';
  InputQuery('Search', 'Search for: ', S);
  Current := Find(S);
  ShowRecord;
end;

procedure TDataForm.DeleteNode(var Node: PMyNode);
var
  Temp: PMyNode;
begin
  Temp := FirstNode;
  if Temp = Node then begin           { First Node? }
    Temp := Temp^.Next;
    FirstNode := Temp;
  end else
    while Temp^.Next <> Node do
      Temp := Temp^.Next;
  Current := Temp;
  if Temp^.Next^.Next <> nil then     { A Middle Node? }
    Temp^.Next := Temp^.Next^.Next
  else
    Temp^.Next := nil;                { Last Node? }
  Dispose(Node);
end;

procedure TDataForm.Delete1Click(Sender: TObject);
var
  S: String;
  Temp: PMyNode;
begin
  if MessageBox(Handle, 'Delete node?', 'Question', mb_YesNo) = idNo then Exit;
  S := Edit1.Text;
  Temp := Find(S);
  if Temp <> nil then
    DeleteNode(Temp);
  ShowRecord;
end;

procedure TDataForm.Help(Sender: TObject);
var
  S: string;
begin
  S := 'The first time you run the program ' +
       'choose Create New List from the File menu, ' +
       'then choose Read Data. Thereafter, you must always choose ' +
       'Read Data from the File menu when you start the program. ';
  ShowMessage(S);
end;

end.