Паскаль. Класс для представления телефонного справочника - Помощь студентам

Армана · 22.02.2009, 18:27

Мне было необходимо создать класс для представления телефонного справочника. Учесть, что у человека может быть несколько телефонов. Реализовать добавление, удаление, поиск информации (по номеру и по фамилии). Необходимо предусмотреть возможность тестирования класса при помощи консольного приложения.
Программу я написала. Работает хорошо. Только мне бы хотелось узнать, как можно сделать все более красиво. Может есть что-нибудь интересное, что можно было бы применить.
Вот код:

Код:

program PhoneBookprjct;

{$APPTYPE CONSOLE}

{%ToDo 'PhoneBookprjct.todo'}

uses
  SysUtils,
  Classes,
  ClassUnit in 'ClassUnit.pas',
  Unit1 in 'Unit1.pas';

var
  PhoneBook : TPhoneBook;

function DrawMenu() : integer;
begin
  Writeln;
  Writeln('What do you want?');
  Writeln('1) View phone book');
  Writeln('2) Add a new person');
  Writeln('3) Find a person by Phone');
  Writeln('4) Find a person by Name');
  Writeln('0) Exit');
  Readln(Result);
end;

function ViewPhone : TData;
var
  S : string;
begin
  Writeln('Please, Enter Phone:');
  Readln(S);
  Result:= PhoneBook.GetbyPhone(S);
end;

function ViewName : TData;
var
  N, S : string;
begin
  Writeln('Please, Enter Surname:');
  Readln(S);
  Writeln('Please, Enter Name:');
  Readln(N);
  Result:= PhoneBook.GetbyName(N, S);
end;

procedure DrawData(Data : TData);
var
  i : integer;
begin
  Writeln( Data.SurName+' '+Data.Name );
  for i:= 0 to Data.PhonesCount - 1 do
    writeln(IntToStr(i+1)+') '+Data.Phones[i]);
  writeln('--------');
end;

procedure DrawAll();
var
  List : TStringList;
  i : integer;
begin
  Writeln;
  Writeln('Phone Book: ');
  Writeln;
  List:= TStringList.Create;
  PhoneBook.PrintAll( List );
  for i := 0 to List.Count - 1 do
    writeln(List[i]);
end;

procedure SubMenu(Data : TData);
var
  Chs : integer;
  Phone : string;
begin
  Writeln;
  if Data <> nil then
  repeat
    DrawData(Data);
    Writeln('What to do:');
    Writeln('1) Add phone');
    Writeln('2) Delete Record');
    Writeln('3) Delete phone #');
    Writeln('0) Exit');
    Readln(Chs);
    Case Chs of
    1:
      begin
        Writeln('Please, enter phone:');
        Readln(Phone);
        PhoneBook.AddPhone( Data, Phone);
      end;
    2:
      begin
        PhoneBook.Delete( Data );
        Chs := 0;
      end;
    3:
      begin
        Writeln('Please, enter # :');
        Readln(Chs);
        PhoneBook.DelPhone(Data, Chs-1);
      end;
    End;
  until Chs = 0
  else
  writeln('Nothing found!');
end;

procedure AddName;
var
  N, S : string;
  C : Char;
  Rec : TData;
begin
  Writeln;
  Writeln('Please, Enter Surname: ');
  Readln(S);
  Writeln('Please, Enter Name: ');
  Readln(N);
  Rec:= PhoneBook.AddName( N, S );
  repeat
    Writeln('Please, Enter phone number: ');
    Readln(S);
    PhoneBook.AddPhone(Rec, S);
    Writeln('Add one more phone? (y/n)');
    Readln(C);
  until (UpCase(C) = 'N');
end;

var
  Select : integer;

begin
  PhoneBook:= TPhoneBook.Create;

  Select := DrawMenu;
  while Select<>0 do
  begin
    case Select of
      1: DrawAll;
      2: AddName;
      3: SubMenu(ViewPhone);
      4: SubMenu(ViewName);
    end;
    Select:= DrawMenu;
  end;
  PhoneBook.Free;
end.

Армана · 22.02.2009, 18:29

Код:

unit Unit1;

interface

type

  TNode = class;

  TPhone = record
    Left, Right, Parent: TNode;
    LeftID, RightID, ParentID: integer;
    Value : string;
  end;

  TNode = class
  private
    fName, fSurName : string;
    fPhones: array of TPhone;
    procedure DelPhone(ID: integer);
    function GetPhone(ID: integer) : string;
  public
    property Name : string read fName write fName;
    property SurName: string read fSurName write fSurName;
    property Phones[i: integer] : string read GetPhone;
    constructor Create(NName, NSurName : string);
    destructor Destroy;
  end;

implementation

{ TNode }

constructor TNode.Create(NName, NSurName: string);
begin
  fName:= NName;
  fSurName:= NSurName;
  SetLength(fPhones, 0);
end;

procedure TNode.DelPhone(ID: integer);
var
  i, Len: integer;
begin
  Len:= Length(fPhones);
  for i := ID to Len - 2 do
    fPhones[i]:= fPhones[i+1];
  SetLength(fPhones, Len-1);
end;

destructor TNode.Destroy;
begin

end;

function TNode.GetPhone(ID: integer): string;
begin
  Result:= fPhones[ID].Value;
end;

end.

Армана · 22.02.2009, 18:33

Код:

unit ClassUnit;

interface

uses Classes, SysUtils;

type

  TCompareResult = (cLower, cEqual, cHigher);

  TData = class;

  TNameNode = class
  private
    fLeft, fRight, fParent : TNameNode;
    fOwner : TData;
  public
    property Left : TNameNode read fLeft write fLeft;
    property Right : TNameNode read fRight write fRight;
    property Parent : TNameNode read fParent write fParent;
    property Owner : TData read fOwner;
    procedure SwapChild(Old, New : TNameNode);
    constructor Create(NParent : TNameNode; Dta : TData);
    destructor Destroy;override;
  end;

  TPhoneNode = class
  private
    fLeft, fRight, fParent : TPhoneNode;
    fOwner : TData;
    fIndex : integer;
    function GetPhone : string;
  public
    property Left : TPhoneNode read fLeft write fLeft;
    property Right : TPhoneNode read fRight write fRight;
    property Parent : TPhoneNode read fParent write fParent;
    property Phone : string read GetPhone;
    property Owner : TData read fOwner;
    procedure SwapChild(Old, New : TPhoneNode);
    property Index : integer read fIndex write fIndex;
    constructor Create(NParent : TPhoneNode; NOwner : TData);
    destructor Destroy;override;
  end;

  TPhoneRec = record
    Phone : string;
    Node : TPhoneNode;
  end;

  TData = class
  private
    fName, fSurName : string;
    fPhones: array of TPhoneRec;
    fPhonesCnt : integer;
    fNameNode : TNameNode;
    procedure DelPhone(ID: integer);
    function AddPhone(Phone : string; Node : TPhoneNode) : integer;
    function GetPNode(ID : integer) : TPhoneNode;
    function GetPhone(ID: integer) : string;
    property NameNode : TNameNode read fNameNode write fNameNode;
  public
    property Name : string read fName write fName;
    property SurName: string read fSurName write fSurName;
    property Phones[i: integer] : string read GetPhone;
    property PhonesCount : integer read fPhonesCnt;
    constructor Create(NName, NSurName : string);
    destructor Destroy;override;
  end;

  TPhoneBook = class
  private
    fRoot : TNameNode;
    fPhoneRoot : TPhoneNode;
  public
    function GetbyPhone(Phn: string) : TData;
    function GetbyName(Name, SurName: string) : TData;
    function AddName(Name, SurName : string) : TData;
    procedure Delete(Node : TData);
    procedure AddPhone(Node : TData; NPhone : string);
    procedure DelPhone(Node : TData; ID : integer);
    procedure PrintAll(List : TStringList);
    constructor Create;
    destructor Destroy;override;
  end;

implementation

// higher  means that 1st is higher!!
function Compare(S1, N1, S2, N2 : string) : TCompareResult;
begin
  S1 := AnsiUpperCase( S1 );
  N1 := AnsiUpperCase( N1 );
  S2 := AnsiUpperCase( S2 );
  N2 := AnsiUpperCase( N2 );

  if (S1 > S2)or(S1 = S2)and(N1 > N2) then
    Result := cHigher
    else
    if (S1 = S2)and(N1 = N2) then
      Result := cEqual
      else
        Result := cLower; 
end;

{ TData }

function TData.AddPhone(Phone : string; Node : TPhoneNode) : integer;
begin
  inc(fPhonesCnt);
  SetLength( fPhones, fPhonesCnt);
  fPhones[fPhonesCnt-1].Phone:= Phone;
  fPhones[fPhonesCnt-1].Node:= Node;
  Result:= fPhonesCnt-1;
end;

constructor TData.Create(NName, NSurName: string);
begin
  fPhonesCnt:= 0;
  fName:= NName;
  fSurName:= NSurName;
  SetLength(fPhones, 0);
end;

procedure TData.DelPhone(ID: integer);
var
  i : integer;
begin
  if (ID<0)or(ID>=fPhonesCnt) then
    exit;
  for i := ID to fPhonesCnt - 2 do
  begin
    fPhones[i]:= fPhones[i+1];
    fPhones[i].Node.Index := i;
  end;
  dec(fPhonesCnt);
  SetLength(fPhones, fPhonesCnt);
end;

destructor TData.Destroy;
begin
  inherited;
end;

function TData.GetPhone(ID: integer): string;
begin
  Result:= fPhones[ID].Phone;
end;

function TData.GetPNode(ID: integer): TPhoneNode;
begin
  Result := fPhones[ID].Node;
end;

{ TNameNode }

constructor TNameNode.Create(NParent: TNameNode; Dta: TData);
begin
  fParent:= NParent;
  fOwner:= Dta;
end;

destructor TNameNode.Destroy;
begin
  fLeft.Free;
  fRight.Free;
  fOwner.Free;
  inherited;
end;

procedure TNameNode.SwapChild(Old, New: TNameNode);
begin
  if fLeft = Old then
  begin
    fLeft := New;
    if New<>nil then New.Parent := Self;
  end
      else
      begin
        fRight := New;
        if New<>nil then New.Parent := Self;
      end;
end;

{ TPhoneNode }

constructor TPhoneNode.Create(NParent : TPhoneNode; NOwner : TData);
begin
  fParent:= NParent;
  fIndex := 0;
  fOwner:= NOwner;
end;

destructor TPhoneNode.Destroy;
begin
  fLeft.Free;
  fRight.Free;
  inherited;
end;

Армана · 22.02.2009, 18:34

Код:

function TPhoneNode.GetPhone: string;
begin
  Result:= Owner.Phones[ fIndex ];
end;

procedure TPhoneNode.SwapChild(Old, New: TPhoneNode);
begin
  if fLeft = Old then
  begin
    fLeft := New;
    if New<>nil then New.Parent := Self;
  end
      else
      begin
        fRight := New;
        if New<>nil then New.Parent := Self;
      end;
end;

{ TPhoneBook }

function TPhoneBook.AddName(Name, SurName: string): TData;
var
  Curr, Prev : TNameNode;
begin
  Curr:= fRoot.Left;
  Prev:= fRoot;
  while Curr<>nil do
  begin
    Prev:= Curr;
    if Compare(Curr.Owner.SurName, Curr.Owner.Name, SurName, Name) = cHigher then
        Curr:= Curr.Left
        else
          Curr:= Curr.Right;
  end;
  Result:= TData.Create(Name, SurName);
  Curr:= TNameNode.Create(Prev, Result);
  Result.NameNode := Curr;
  if (Prev = fRoot)or
     (Compare(Prev.Owner.SurName, Prev.Owner.Name, SurName, Name) = cHigher)then
        Prev.Left:= Curr
        else
          Prev.Right:= Curr;
end;

procedure TPhoneBook.AddPhone(Node: TData; NPhone: string);
var
  Curr, Prev : TPhoneNode;
begin
  Curr:= fPhoneRoot.Left;
  Prev:= fPhoneRoot;
  while Curr<>nil do
  begin
    Prev:= Curr;
    if( Curr.Phone > NPhone ) then
      Curr:= Curr.Left
      else
        Curr:= Curr.Right;
  end;

  Curr:= TPhoneNode.Create(Prev, Node );
  Curr.Index:=  Node.AddPhone(NPhone, Curr);
  if (Prev = fPhoneRoot)or(Prev.Phone > NPhone) then
    Prev.Left:= Curr
    else
      Prev.Right:= Curr;
end;

constructor TPhoneBook.Create;
begin
  fRoot:= TNameNode.Create(nil, nil);
  fPhoneRoot:= TPhoneNode.Create(nil, nil);
end;

procedure TPhoneBook.Delete(Node : TData);
var
  DelNode, Tmp : TNameNode;
  i : integer;
begin
  if Node<>nil then
  begin
    DelNode:= Node.NameNode;
    if DelNode<>nil then
    begin
      for i := 0 to DelNode.Owner.PhonesCount - 1 do
        DelPhone( DelNode.Owner, i );
      if(DelNode.Left = nil) then
        DelNode.Parent.SwapChild(DelNode, DelNode.Right)
        else
        if(DelNode.Right = nil) then
          DelNode.Parent.SwapChild(DelNode, DelNode.Left)
          else
          begin
            Tmp:= DelNode.Left;   // Take Left Rightmost
            while Tmp.Right<>nil do
              Tmp:= Tmp.Right;
            Tmp.Parent.SwapChild(Tmp, nil);
            DelNode.Parent.SwapChild( DelNode, Tmp );
            Tmp.Right := DelNode.Right;
            Tmp.Right.Parent := Tmp;
          end;
      DelNode.Left := nil;
      DelNode.Right := nil;
      DelNode.Free;
    end;
  end;
end;

procedure TPhoneBook.DelPhone(Node: TData; ID: integer);
var
  DelNode, Tmp : TPhoneNode;
  GoLeft : boolean;
begin
  if Node<>nil then
  begin
    DelNode := Node.GetPNode(ID);
    Node.DelPhone( ID );
    if DelNode<>nil then
      if(DelNode.Left = nil) then
        DelNode.Parent.SwapChild(DelNode, DelNode.Right)
        else
        if(DelNode.Right = nil) then
          DelNode.Parent.SwapChild(DelNode, DelNode.Left)
          else
          begin
            Tmp:= DelNode.Left;   // Take Left Rightmost
            while Tmp.Right<>nil do
              Tmp:= Tmp.Right;
            Tmp.Parent.SwapChild(Tmp, nil);
            DelNode.Parent.SwapChild( DelNode, Tmp );
            Tmp.Right := DelNode.Right;
            Tmp.Right.Parent := Tmp;
          end;
    DelNode.Left := nil;
    DelNode.Right := nil;
    DelNode.Free;
  end;
end;

destructor TPhoneBook.Destroy;
begin
  fRoot.Free;
  fPhoneRoot.Free;
  inherited;
end;

function TPhoneBook.GetbyName(Name, SurName: string): TData;
var
  Curr : TNameNode;
begin
  Curr:= fRoot.Left;
  while (Curr<>nil)and (Compare(Curr.Owner.SurName, Curr.Owner.Name, SurName, Name) <> cEqual)do
      if Compare(Curr.Owner.SurName, Curr.Owner.Name, SurName, Name) = cHigher then
          Curr:= Curr.Left
          else
            Curr:= Curr.Right;
  if Curr <> nil then
    Result:= Curr.Owner
      else Result:= nil;
end;

function TPhoneBook.GetbyPhone(Phn: string): TData;
var
  Curr : TPhoneNode;
begin
  Curr := fPhoneRoot.Left;
  while (Curr<>nil)and((Curr.Phone<>Phn)) do
    if Curr.Phone > Phn then
      Curr:= Curr.Left
        else
          Curr:= Curr.Right;
  if Curr<>nil then
    Result:= Curr.Owner
    else
      Result:= nil;
end;

procedure TPhoneBook.PrintAll(List: TStringList);
  procedure Go(Node : TNameNode);
  var
    i: integer;
  begin
    if Node<>nil then
    begin
      Go(Node.Left);
      with Node.Owner do
      begin
        List.Add( SurName+' '+Name );
        for i:= 0 to PhonesCount - 1 do
          List.Add(IntToStr(i+1)+') '+Phones[i]);
        List.Add('--------');
      end;
      Go(Node.Right);
    end;
  end;
begin
    List.Clear;
  Go(fRoot.fLeft);
end;

end.

Армана · 22.02.2009, 18:40

Извините за то, что таким образом выкладываю код. Просто я студентка, которая пользуется мобильником как модемом. Интернет медленный и работает плохо, прикреплять я не рискнула

Я понимаю, что трудно будет разобраться в таком длинном коде, но буду очень благодарна любому совету

Serge_Bliznykov · 22.02.2009, 22:12

Цитата:

Сообщение от Армана

Только мне бы хотелось узнать, как можно сделать все более красиво.

Мне кажется, это Вы несерьёзно...
Красивее сделать что - исходный код?
Или интерфейс программы? Если интерфейс - то, например, переписать это с использованием окон (т.е. сделать нормальный (а точнее стандартный) виндузовский интерфейс)...
А тут явно переработанная MS DOS программка... :-)

p.s. на будущее - лучше всё таки паковать и прикреплять исходный текст к сообщению...

Армана · 22.02.2009, 22:38

Под словом красивее я имею в виду вовсе не интерфейс.Честно говоря я и не думала, что программист может это слово именно так интерпретировать. Я имею в виду креативней. Я не хочу ограничеться тем, что прога работает. Хотелось бы нестандартных идей и решений. У меня такого навыка пока не выработано(1 курс), поэтому обратилась к вам.

P.S. И не нужно так грубо. Мне действительно важен подход к задаче

7rubin · 08.04.2012, 06:57

Вот решения, если кому-нибудь кгода- нибудь пригодится!

buytask.ru/task765.html
buytask.ru/task766.html

22.02.2009, 18:40	#5
Армана Пользователь Регистрация: 22.11.2008 Сообщений: 24	Прошу прощение Извините за то, что таким образом выкладываю код. Просто я студентка, которая пользуется мобильником как модемом. Интернет медленный и работает плохо, прикреплять я не рискнула Я понимаю, что трудно будет разобраться в таком длинном коде, но буду очень благодарна любому совету

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
класс для работы с обьектом множества	Kreaman	Помощь студентам	3	26.11.2008 01:02
объявить класс для описания клиеннтского потока. с атрибутами String.	Sargon	Работа с сетью в Delphi	4	23.12.2007 23:36
написание программы-справочника по истории	djusi	Помощь студентам	0	03.12.2007 22:01

22.02.2009, 22:38	#7
Армана Пользователь Регистрация: 22.11.2008 Сообщений: 24	Под словом красивее я имею в виду вовсе не интерфейс.Честно говоря я и не думала, что программист может это слово именно так интерпретировать. Я имею в виду креативней. Я не хочу ограничеться тем, что прога работает. Хотелось бы нестандартных идей и решений. У меня такого навыка пока не выработано(1 курс), поэтому обратилась к вам. P.S. И не нужно так грубо. Мне действительно важен подход к задаче

08.04.2012, 06:57	#8
7rubin Пользователь Регистрация: 18.12.2011 Сообщений: 25	Вот решения, если кому-нибудь кгода- нибудь пригодится! buytask.ru/task765.html buytask.ru/task766.html