Redirect console output to TMemo?

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:

unit LogMemoTest;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, LogMemo;

type
TForm1 = class(TForm)
LogMemo1: TLogMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

Type
POpenText= ^TOpenText;
TOpenText= Function (var F: Text; Mode: word): integer; far;

Var
PtrOpenText: POpenText;
HConsoleInput: THandle;
HConsoleOutput: THandle;

{ }
{ This function handles the Write and WriteLn commands }
{ }
Function TextOut( var F: Text ): integer; far;
var
str1 : string;
Begin
With TTExtRec(F) Do Begin
str1 := string(BufPtr);
setlength(str1,BufPos);
Form1.LogMemo1.Addline(str1);
BufPos:=0;
End;
Result:=0;
End;

Function OpenText(var F: Text; Mode: word): integer; far;
Var
OpenResult: integer;
Begin
OpenResult:=102; { Text not assigned }
If Assigned(PtrOpenText) Then Begin
TTextRec(F).OpenFunc:=PtrOpenText;
OpenResult:=PtrOpenText^(F, Mode);
If OpenResult=0 Then Begin
If Mode=fmInput Then
HConsoleInput:=TTextRec(F).Handle
Else Begin
HConsoleOutput:=TTextRec(F).Handle;
TTextRec(Output).InOutFunc:=TextOut;
TTextRec(Output).FlushFunc:=TextOut;
End;
End;
End;
Result:=OpenResult;
End;

Procedure AssignMemo(Var F: Text);
Begin
Assign(F,'');
TTextRec(F).OpenFunc:=OpenText;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
Writeln('This is a test of Writeln');
end;

Procedure Init;
Begin
PtrOpenText:= TTextRec(Output).OpenFunc;
ReWrite(Output);
HConsoleOutput:= TTextRec(Output).Handle;
TTextRec(Output).InOutFunc:=TextOut;
TTextRec(Output).FlushFunc:=TextOut;
End;

initialization
Init;

end.

Messages in this topic (1) Reply (via web post) | Start a new topic

.