home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WDOCDEMO.ZIP / COLLECT2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  3.0 KB  |  126 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Collect2;
  9.  
  10. uses Objects, WinCrt, Strings;
  11.  
  12. type
  13.   PClient = ^TClient;
  14.   TClient = object(TObject)
  15.     Account, Name, Phone: PChar;
  16.     constructor Init(NewAccount, NewName, NewPhone: PChar);
  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: PChar);
  29. begin
  30.   Account := StrNew(NewAccount);
  31.   Name := StrNew(NewName);
  32.   Phone := StrNew(NewPhone);
  33. end;
  34.  
  35. destructor TClient.Done;
  36. begin
  37.   StrDispose(Account);
  38.   StrDispose(Name);
  39.   StrDispose(Phone);
  40. end;
  41.  
  42. procedure TClient.Print;
  43. begin
  44.   Writeln('  ',
  45.     Account, '':10 - StrLen(Account),
  46.     Name, '':20 - StrLen(Name),
  47.     Phone, '':16 - StrLen(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.   Compare := StrIComp(PChar(Key1), PChar(Key2));
  59. end;
  60.  
  61.  
  62. { Use ForEach iterator to display client information }
  63.  
  64. procedure PrintAll(C: PCollection);
  65.  
  66. procedure CallPrint(P : PClient); far;
  67. begin
  68.   P^.Print;                   { Call Print method }
  69. end;
  70.  
  71. begin { Print }
  72.   Writeln;
  73.   Writeln;
  74.   Writeln('Client list:');
  75.   C^.ForEach(@CallPrint);     { Print each client }
  76. end;
  77.  
  78. { Use FirstThat iterator to search non-key field }
  79.  
  80. procedure SearchPhone(C: PCollection; PhoneToFind: PChar);
  81.  
  82. function PhoneMatch(Client: PClient): Boolean; far;
  83. begin
  84.   PhoneMatch := StrPos(Client^.Phone, PhoneToFind) <> nil;
  85. end;
  86.  
  87. var
  88.   FoundClient: PClient;
  89.  
  90. begin { SearchPhone }
  91.   Writeln;
  92.   FoundClient := C^.FirstThat(@PhoneMatch);
  93.   if FoundClient = nil then
  94.     Writeln('No client met the search requirement')
  95.   else
  96.   begin
  97.     Writeln('Found client:');
  98.     FoundClient^.Print;
  99.   end;
  100. end;
  101.  
  102. var
  103.   ClientList: PClientCollection;
  104.  
  105. begin
  106.   ClientList := New(PClientCollection, Init(10, 5));
  107.  
  108.   { Build collection }
  109.   with ClientList^ do
  110.   begin
  111.     Insert(New(PClient, Init('91-100', 'Anders, Smitty', '(406) 111-2222')));
  112.     Insert(New(PClient, Init('90-167', 'Smith, Zelda', '(800) 555-1212')));
  113.     Insert(New(PClient, Init('90-177', 'Smitty, John', '(406) 987-4321')));
  114.     Insert(New(PClient, Init('90-160', 'Johnson, Agatha', '(302) 139-8913')));
  115.   end;
  116.  
  117.   { Use ForEach iterator to print all }
  118.   PrintAll(ClientList);
  119.  
  120.   { Use FirstThat iterator to find match with search pattern }
  121.   SearchPhone(ClientList, '(406)');
  122.  
  123.   { Clean up }
  124.   Dispose(ClientList, Done);
  125. end.
  126.