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.


Reply via email to