home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / DOCDEMO.ZIP / COLLECT2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-03  |  3.1 KB  |  131 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Collect2;
  9.  
  10. uses Objects;
  11.  
  12. type
  13.   PClient = ^TClient;
  14.   TClient = object(TObject)
  15.     Account, Name, Phone: PString;
  16.     constructor Init(NewAccount, NewName, NewPhone: String);
  17.     destructor Done; virtual;
  18.     procedure Print; virtual;
  19.   end;
  20.  
  21.   PClientCollection = ^TClientCollection;
  22.   TClientCollection = object(TSortedCollection)
  23.     function KeyOf(Item: Pointer): Pointer; virtual;
  24.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  25.   end;
  26.  
  27. { TClient }
  28. constructor TClient.Init(NewAccount, NewName, NewPhone: String);
  29. begin
  30.   Account := NewStr(NewAccount);
  31.   Name := NewStr(NewName);
  32.   Phone := NewStr(NewPhone);
  33. end;
  34.  
  35. destructor TClient.Done;
  36. begin
  37.   DisposeStr(Account);
  38.   DisposeStr(Name);
  39.   DisposeStr(Phone);
  40. end;
  41.  
  42. procedure TClient.Print;
  43. begin
  44.   Writeln('  ',
  45.     Account^, '':10-Length(Account^),
  46.     Name^, '':20-Length(Name^),
  47.     Phone^, '':16-Length(Phone^));
  48. end;
  49.  
  50. { TClientCollection }
  51. function TClientCollection.KeyOf(Item: Pointer): Pointer;
  52. begin
  53.   KeyOf := PClient(Item)^.Account;
  54. end;
  55.  
  56. function TClientCollection.Compare(Key1, Key2: Pointer): Integer;
  57. begin
  58.   if PString(Key1)^ = PString(Key2)^ then
  59.     Compare := 0
  60.   else if PString(Key1)^ < PString(Key2)^ then
  61.     Compare := -1
  62.   else
  63.     Compare := 1;
  64. end;
  65.  
  66.  
  67. { Use ForEach iterator to display client information }
  68.  
  69. procedure PrintAll(C: PCollection);
  70.  
  71. procedure CallPrint(P : PClient); far;
  72. begin
  73.   P^.Print;                   { Call Print method }
  74. end;
  75.  
  76. begin { Print }
  77.   Writeln;
  78.   Writeln;
  79.   Writeln('Client list:');
  80.   C^.ForEach(@CallPrint);     { Print each client }
  81. end;
  82.  
  83. { Use FirstThat iterator to search non-key field }
  84.  
  85. procedure SearchPhone(C: PCollection; PhoneToFind: String);
  86.  
  87. function PhoneMatch(Client: PClient): Boolean; far;
  88. begin
  89.   PhoneMatch := Pos(PhoneToFind, Client^.Phone^) <> 0;
  90. end;
  91.  
  92. var
  93.   FoundClient: PClient;
  94.  
  95. begin { SearchPhone }
  96.   Writeln;
  97.   FoundClient := C^.FirstThat(@PhoneMatch);
  98.   if FoundClient = nil then
  99.     Writeln('No client met the search requirement')
  100.   else
  101.   begin
  102.     Writeln('Found client:');
  103.     FoundClient^.Print;
  104.   end;
  105. end;
  106.  
  107. var
  108.   ClientList: PClientCollection;
  109.  
  110. begin
  111.   ClientList := New(PClientCollection, Init(10, 5));
  112.  
  113.   { Build collection }
  114.   with ClientList^ do
  115.   begin
  116.     Insert(New(PClient, Init('91-100', 'Anders, Smitty', '(406) 111-2222')));
  117.     Insert(New(PClient, Init('90-167', 'Smith, Zelda', '(800) 555-1212')));
  118.     Insert(New(PClient, Init('90-177', 'Smitty, John', '(406) 987-4321')));
  119.     Insert(New(PClient, Init('90-160', 'Johnson, Agatha', '(302) 139-8913')));
  120.   end;
  121.  
  122.   { Use ForEach iterator to print all }
  123.   PrintAll(ClientList);
  124.  
  125.   { Use FirstThat iterator to find match with search pattern }
  126.   SearchPhone(ClientList, '(406)');
  127.  
  128.   { Clean up }
  129.   Dispose(ClientList, Done);
  130. end.
  131.