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