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