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