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