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:[EMAIL PROTECTED];
TTextRec(Output).FlushFunc:[EMAIL PROTECTED];
End;
End;
End;
Result:=OpenResult;
End;
Procedure AssignMemo(Var F: Text);
Begin
Assign(F,'');
TTextRec(F).OpenFunc:[EMAIL PROTECTED];
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:[EMAIL PROTECTED];
TTextRec(Output).FlushFunc:[EMAIL PROTECTED];
End;
initialization
Init;
end.