Write und WriteLn umleiten

[MacGuyver]

Moin

Ich habe meine Dos-Anwendung (Turbo Pascal) in Delphi zur Konsolenanwendung konvertiert. Das läuft super, vor allem auch auch 64 Bit. Nun möchte ich meine Fensterapplikation in Ruhe nach und nach umstellen. So zeige ich die nicht umgestellten Teile in einem Kindfenster wie ein Konsolenfenster dar. Das Zeichnen übernehme ich selber, dann pass ich die Schriftgröße der Fenstergröße an. In meinem Quelltext habe ich über 800 Stellen mit Write oder WriteLn, die ich nicht umstellen möchte. Wie leite ich nun diese Ausgabe um?

Ich habe ein paar Sachen gefunden, aber nichts passendes. Das passenste Teil endet mit dem Kommentar, dass es wohl nicht reicht Quelltext einzustellen. Super Fred, kann jeder etwas mit anfangen. Damit nicht wieder Leute weinen, dass ich eine Leiche reanimiere, setzt ich einen frischen Fred auf. Hier nun der Quelltext:

Delphi-Quellcode:

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ButtonWriteLn: TButton;
    Memo1: TMemo;
    ButtonOpen: TButton;
    ButtonClose: TButton;
    ButtonWrite: TButton;
    ButtonCls: TButton;
    procedure ButtonWriteLnClick(Sender: TObject);
    procedure ButtonOpenClick(Sender: TObject);
    procedure ButtonCloseClick(Sender: TObject);
    procedure ButtonWriteClick(Sender: TObject);
    procedure ButtonClsClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure AssignMemo(var F: Text);

  function DeviceOpen(var F: TTextRec): Integer; register;
  begin
    Result := 0;
  end;

  function DeviceClose(var F: TTextRec): Integer; register;
  begin
    Result := 0;
  end;

  function DeviceFlush(var F: TTextRec): Integer; register;
  begin
    Result := 0;
    case F.Mode of
         fmInput:
           begin
             FillChar(F.BufPtr^,F.BufSize,#0);
             F.BufEnd := 1;
             F.BufPos := 0;
           end;

         fmOutput:
           begin
             with Form1.Memo1 do
               Text := Text + F.Buffer; // output F.Buffer here
             FillChar(F.BufPtr^,F.BufSize,#0);
             F.BufEnd := 1;
             F.BufPos := 0;
           end;
    end;
  end;

  function DeviceInOut(var F: TTextRec): Integer; register;
  begin
    Result := 0;
  end;

begin
  with TTextRec(F) do
  begin
    FillChar(F, SizeOf(F), 0);
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @DeviceOpen;
    InOutFunc := @DeviceInOut;
    FlushFunc := @DeviceFlush;
    CloseFunc := @DeviceClose;
  end;
end;

procedure TForm1.ButtonWriteClick(Sender: TObject);
begin
  Write(Edit1.Text);
end;

procedure TForm1.ButtonWriteLnClick(Sender: TObject);
begin
  Writeln(Edit1.Text);
end;

procedure TForm1.ButtonOpenClick(Sender: TObject);
begin
  AssignMemo(Output);
  //Reset(Output); Wenn man hier Reset ausführt, schließt er beim ersten
  //               write und öffnet neu. So kann man sich das Reset hier sparen.
  ButtonWrite.Enabled := True;
  ButtonWriteLn.Enabled := True;
  ButtonOpen.Enabled := False;
  ButtonClose.Enabled := True;
end;

procedure TForm1.ButtonCloseClick(Sender: TObject);
begin
  System.Close(Output);
  ButtonWrite.Enabled := False;
  ButtonWriteLn.Enabled := False;
  ButtonOpen.Enabled := True;
  ButtonClose.Enabled := False;
end;

procedure TForm1.ButtonClsClick(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

end.

Ich möchte jetzt keine Diskussion, dass ich mein Programm "mal eben" neu schreiben soll. Ich hätte "mal eben" 5 MB Quelltext zu überarbeiten. Geschweige testen und was sonst noch anfällt.

Ich möchte nur einen Weg veröffentlichen, wie man die Ausgabe über Write(Ln) abfangen kann - auch ohne eine Konsole zu haben.


Stefan