Re: [delphi-en] Redirect console output to TMemo?

[Rob Kennedy]

tim11g wrote:
> I have some old code filled with Writeln's that I want to use in a GUI
> application. I would like to redirect STDOUT to a Tmemo, so the
> writeln's would be logged into the Memo.
> 
> Modeling on the code for CRT32, I have written a a replacement for
> TextOut that writes to the Tmemo. I have made a version of AssignCRT
> called AssignMemo, but I don't know where to call it from, or what
> variable to use for the file handle, F.
> 
> If I attempt to run what I have so far, I get "I/O Error 105" on the
> line   ReWrite(Output); during the initialization.
> 
> Here is the code I have so far:

You have sort of the right idea. I've written a unit based on Peter 
Below's StreamIO unit (which is very similar to what ianhinson provided 
in his reply). It's provided below. Call AssignStrings to associate a 
TStrings object (such as TMemo.Lines) with a TextFile variable. Then 
call the normal I/O functions and pass that TextFile variable as the 
first parameter, just as if you were writing to a real file.

If you're still set on using your old WriteLn commands unchanged, then 
let me know and I'll take another look. But if you want to write to 
something other than stdout, a text-file driver with a custom Assign 
command is really the right way to do it.

-- 
Rob

unit StringsIO;

// By Rob Kennedy, 29 December 2006
// See http://www.cs.wisc.edu/~rkennedy/license

// Based on StreamIO by Peter Below
// Subject: Re: Text Files and Streams
// Message-ID: <[EMAIL PROTECTED]>
// borland.public.delphi.objectpascal
// Thu, 04 Jan 2001 17:20:29 +0100
// 
http://groups.google.com/group/borland.public.delphi.objectpascal/msg/d682a8b5a5760ac4

interface

uses Classes;

// Attach a TStrings S to a TextFile F to allow I/O via WriteLn/ReadLn
// S must not be nil
// The TStrings object is not freed when the textfile is closed via
// CloseFile. It has to stay in existence and must not be modified
// through other means as long as the textfile is open.
procedure AssignStrings(var F: TextFile; S: TStrings);

implementation

uses SysUtils, Math;

type
   PInternalData = ^TInternalData;
   TInternalData = record
     Strings: TStrings;
     Text: string;
     Char: Integer;
   end;

// Get the internal data stored in the textrec userdata area
function GetDeviceData(var F: TTextRec): PInternalData;
begin
   Result := PInternalData(@F.UserData);
end;

// Called by Read, ReadLn etc. to fill the textfiles buffer from the
// TStrings object.
function DevIn(var F: TTextRec): Integer;
var
   Data: PInternalData;
begin
   Result := 0;
   Data := GetDeviceData(F);
   if Data.Char <= Length(Data.Text) then begin
     F.BufEnd := Min(F.BufSize, Length(Data.Text) - Pred(Data.Char));
     Move(Data.Text[Data.Char], F.BufPtr^, F.BufEnd);
     Inc(Data.Char, F.BufEnd);
   end else
     F.BufEnd := 0;
   F.BufPos := 0;
end;

// A dummy method, flush on input does nothing.
function DevFlushIn(var F: TTextRec): Integer;
begin
   Result := 0;
end;

// Write the textfile buffers content to the TStrings. Called by Write,
// WriteLn when the buffer becomes full. Also called by Flush.
function DevOut(var F: TTextRec): Integer;
var
   Data: PInternalData;
   s: string;
begin
   Result := 0;
   if F.BufPos <= 0 then
     exit;
   Data := GetDeviceData(F);
   SetString(s, F.BufPtr, F.BufPos);
   Data.Strings.Text := Data.Strings.Text + s;
   F.BufPos := 0;
end;

// Called by CloseFile. Clears the internal record
function DevClose(var F: TTextRec): Integer;
var
   Data: PInternalData;
begin
   Data := GetDeviceData(F);
   Finalize(Data^);
   Result := 0;
end;

// Called by Reset, Rewrite, or Append to prepare the textfile for I/O
function DevOpen(var F: TTextRec): Integer;
var
   Data: PInternalData;
begin
   Result := 0;
   Data := GetDeviceData(F);
   case F.Mode of
     fmInput: begin // Reset
       F.InOutFunc := @DevIn;
       F.FlushFunc := @DevFlushIn;
       F.BufPos := 0;
       F.BufEnd := 0;
       Data.Char := 1;
       Data.Text := Data.Strings.Text;
     end;
     fmOutput: begin // Rewrite
       F.InOutFunc := @DevOut;
       F.FlushFunc := @DevOut;
       F.BufPos := 0;
       F.BufEnd := 0;
       Data.Char := 0;
       Data.Strings.Clear;
     end;
     fmInOut: begin // Append
       F.Mode := fmOutput;
       F.InOutFunc := @DevOut;
       F.FlushFunc := @DevOut;
       F.BufPos := 0;
       F.BufEnd := 0;
       Data.Char := 0;
     end;
   end;
end;

procedure AssignStrings(var F: TextFile; S: TStrings);
var
   Data: PInternalData;
begin
   Assert(Assigned(S));
   TTextRec(F).Mode := fmClosed;
   TTextRec(F).BufSize := SizeOf(TTextRec(F).Buffer);
   TTextRec(F).BufPtr := TTextRec(F).Buffer;
   TTextRec(F).OpenFunc := @DevOpen;
   TTextRec(F).CloseFunc := @DevClose;
   TTextRec(F).Name[0] := #0;
   TTextRec(F).Flags := tfCRLF;
   // Store strings reference into Userdata area
   Data := GetDeviceData(TTextRec(F));
   Initialize(Data^);
   Data.Strings := S;
end;

end.