home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PARADIS1 / STRBUF.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-23  |  2KB  |  90 lines
  1. (6900)  Thu 20 Feb 92  4:57
  2. By: Trevor Carlsen
  3. To: Mike Hindle
  4. Re: Re: Variable number of parameters
  5. St:
  6. ---------------------------------------------------------------------------
  7. @EID:5c87 18542727
  8. @TCID:29f4ff54 5a1c
  9.  MH> Taking this one step further, I would like a routine capable
  10.  MH> of buffering output. Ie: a Write procedure allowing cursor
  11.  MH> positioning keeping the output in a buffer until a Writeln
  12.  MH> is used. Two benefits: Compact code and elimination of
  13.  MH> padding strings or using Spaces(# - Length(var)) or similar
  14.  
  15. This is simple to do using a text file device driver (TFDD).  Here's a unit
  16. that will do that.  So if you want a formatted string just include this unit in
  17. your uses declaration and -
  18.  
  19.   OpenFStr(f); { f must be declared as type text }
  20.   write(f,'This will be formatted',r:8:2);
  21.   FormattedStr := GetFStr(f);
  22.  
  23.  
  24. unit filestr;
  25.  
  26. { Create a text file device driver to allow a formatted string }
  27.  
  28. interface
  29.  
  30. uses dos;
  31.  
  32. function GetFstr(var f: text): string;
  33. procedure OpenFStr(var f: text);
  34.  
  35. {-----------------------------------------------------------------}
  36. implementation
  37.  
  38. var
  39.   FStrBuff     : string;
  40.  
  41. function GetFStr(var f: text): string;
  42.   begin
  43.     GetFStr     := FStrBuff;
  44.     FStrBuff[0] := #0;
  45.     TextRec(f).BufPos := 0;
  46.   end; { GetFStr }
  47.  
  48. {$F+}
  49. function FStrOpen(var f: TextRec):word;
  50.   { This does nothing except return zero to indicate success }
  51.   begin
  52.     FStrOpen := 0;
  53.   end; { FStrOpen }
  54.  
  55. function FStrInOut(var f: TextRec):word;
  56.   begin
  57.     FStrBuff[0] := chr(F.BufPos);
  58.     FStrInOut   := 0;
  59.   end; { FStrInOut }
  60.  
  61. {$F-}
  62.  
  63. procedure OpenFStr(var f: text);
  64.   begin
  65.     with TextRec(f) do begin
  66.       mode      := fmClosed;
  67.       BufSize   := Sizeof(buffer);
  68.       OpenFunc  := @FStrOpen;
  69.       InOutFunc := @FStrInOut;
  70.       FlushFunc := @FStrInOut;
  71.       CloseFunc := @FStrOpen; { no need for special close function }
  72.       BufPos    := 0;
  73.       BufEnd    := 0;
  74.       BufPtr    := @FStrBuff[1];
  75.       Name[0]   := #0;
  76.     end; { with }
  77.     FStrBuff[0] := #0;
  78.     rewrite(f);
  79.   end;  { OpenFStr }
  80.  
  81. end. { FileStr }
  82.  
  83. TeeCee
  84.  
  85.  
  86. --- TC-ED   v2.01
  87.  * Origin: The Pilbara's Pascal Centre (+61 91 732569) (3:690/644)
  88.  
  89. @PATH: 690/644 640/821 209/209 396/1 170/400 512/0 1007 
  90.