home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WDOCDEMO.ZIP / COLLECT3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  3.1 KB  |  128 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { Read a file and add each unique word to a sorted
  9.   collection of PChar. Use the ForEach iterator method
  10.   to traverse the collection and print out each word. }
  11.  
  12. program Collect3;
  13.  
  14. uses Objects, WinCrt, WinDos, Strings;
  15.  
  16. const
  17.   FileToRead = 'COLLECT3.PAS';
  18.   MaxWordLen = 20;
  19.  
  20. { ********************************** }
  21. { ***********  Iterator  *********** }
  22. { ********************************** }
  23.  
  24. { Given the entire collection, use the ForEach
  25.   iterator to traverse and print all the words. }
  26.  
  27. procedure Print(C: PCollection);
  28.  
  29. { Must be a local, far procedure. Receives one collection
  30.   element at a time--a pointer to a string--to print. }
  31.  
  32. procedure PrintWord(P : PChar); far;
  33. begin
  34.   Writeln(P);
  35. end;
  36.  
  37. begin { Print }
  38.   Writeln;
  39.   Writeln;
  40.   C^.ForEach(@PrintWord);                 { Call PrintWord }
  41. end;
  42.  
  43. { ********************************** }
  44. { **********    Globals    ********* }
  45. { ********************************** }
  46.  
  47. { Abort the program and give a message }
  48.  
  49. procedure Abort(Msg, FName: PChar);
  50. begin
  51.   Writeln;
  52.   Writeln(Msg, ' (', FName, ')');
  53.   Writeln('Program aborting');
  54.   Halt(1);
  55. end;
  56.  
  57. { Given an open text file, read it and return the next word }
  58.  
  59. function GetWord(S: PChar; var F : Text): PChar;
  60. var
  61.   C : Char;
  62.   I: Integer;
  63. begin
  64.   I := 0;
  65.   C := #0;
  66.   { find first letter }
  67.   while not Eof(F) and not (UpCase(C) in ['A'..'Z']) do
  68.     Read(F, C);
  69.   { special test in case end of file }
  70.   if Eof(F) and (UpCase(C) in ['A'..'Z']) then
  71.   begin
  72.     if (I < MaxWordLen) then S[I] := C;
  73.   end
  74.   else
  75.     { read chars from file, append to S }
  76.     while (UpCase(C) in ['A'..'Z']) and not Eof(F) do
  77.     begin
  78.       if I < MaxWordLen then
  79.       begin
  80.         S[I] := C;
  81.         Inc(I);
  82.       end;
  83.       Read(F, C);
  84.     end;
  85.   S[I] := #0;
  86.   GetWord := S;
  87. end;
  88.  
  89. { ********************************** }
  90. { **********  Main Program ********* }
  91. { ********************************** }
  92.  
  93. var
  94.   WordList: PCollection;
  95.   WordFile: Text;
  96.   WordFileName: array[0..79] of Char;
  97.   WordRead: array[0..MaxWordLen] of Char;
  98. begin
  99.   { Initialize collection to hold 10 elements first, then grow by 5's }
  100.   WordList := New(PStrCollection, Init(10, 5));
  101.  
  102.   { Open file of words }
  103.   if GetArgCount = 1 then GetArgStr(WordFileName, 1, 79)
  104.   else StrCopy(WordFileName, FileToRead);
  105.   Assign(WordFile, WordFileName);
  106.   {$I-}
  107.   Reset(WordFile);
  108.   {$I+}
  109.   if IOResult <> 0 then
  110.     Abort('Cannot find file', WordFileName);
  111.  
  112.   { Read each word into the collection }
  113.   repeat
  114.     if GetWord(WordRead, WordFile)^ <> #0 then
  115.       WordList^.Insert(StrNew(WordRead));
  116.   until WordRead[0] = #0;
  117.   Close(WordFile);
  118.  
  119.   ScreenSize.X := MaxWordLen;
  120.   ScreenSize.Y := WordList^.Count + 1;
  121.  
  122.   { Display collection contents }
  123.   Print(WordList);
  124.  
  125.   { Cleanup }
  126.   Dispose(WordList, Done);
  127. end.
  128.