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

[turboPASCAL]

Hi,

schlechte Karten write & writeln sind nun mal nur noch für Dateiausgabe und Console gedacht.

Ich habe das so gelöst das ich write & writeln in _write & _writeln umbenannt habe und
in den entsprechenden Proceduren die Ausgabe in ein Memo lenke.

Delphi-Quellcode:

procedure _writeln(s: string); override;
begin
  MemoX.Lines.Add(s);
end;

procedure _writeln(i: integer); override;
begin
  MemoX.Lines.Add(IntToStr(i));
end;

procedure _write(s: string); override;
begin
  MemoX.Text := MemoX.Text + s;
end;

procedure _writeln(i: integer); override;
begin
  MemoX.Text := MemoX.Text + IntToStr(i);
end;

// ... //

MemoX.Text := MemoX.Text + s; ist zwar eine blöde Lösung aber bei wenig Text ausreichend.

[Assarbad]

PowerGREP kann dir helfen den Code so anzupassen, daß es auch ohne die Änderung von Write und Writeln geht

Habe es schon mehrfach dann für Refactoring benutzt wenn andere Methoden aufwendiger gewesen wären.

[MacGuyver]

Ich habe unterschiedliche Datentypen in einem Write oder WriteLn verwendet.

Ja, DeviceFlush lässt sich viel eleganter programmieren. Vor allem verwende ich dann F.BufPos wo die Menge der Bytes drin steht. Das läuft so super. Ich habe eine CRT-Unit hier gefunden, die erweiter ich noch ein wenig und gut. Ein Array für den Bildschirmspeicher und über Compilerschalter kommen die Ausgaben dann in das Array. Das Kinfenster nimmt dann die Daten und gibt den Consoleninhalt in ein Image aus. Wenn das funzt, schreibe ich alles ausführlich in einem neuen Fred. Die Konvertierung von TP zu Delphi habe ich hier veröffentlicht.

[himitsu]

Du könntest bei allen Write und WriteLn jeweils eine Dateivariable (über AssignFile erstellt) einfügen.

Diese Dateivariable leitest du an eine Pipe weiter.
Die Pipe wird dann ausgelesen und alles was dort ankommt in dein Memo (oder sonswohin) eingefügt.

[littleDave]

Du kannst die Standard-Ausgabe beliebig umbiegen. Dafür gibt es z.B. in der System-Unit die Variablen "Input" und "Output". Diese lassen sich als TTextRec casten (TTestRec(System.Input). {...} ). Da kannst du einiges umbiegen. Was du dafür genau machen musst weiß ich leider nicht. Aber bei Torry.net gibt es eine Open-Source-Komponente TConsole v.2.0, die genau das macht. Vielleicht kannst du dich da mal durcharbeiten.

Gruß
David

[MacGuyver]

Moin

Was ich möchte habe ich doch schon oben geschrieben.

???

Einmal schreibe ich in meiner Anwendung direkt in den Bildschirmspeicher und über Write(Ln). Bei direkt in den Bildschirmspeicher habe ich kein Problem, das ist eine Funktion, die ich ändern muss. Schwerer ist das mit dem Write(Ln).

NEIN, ich möchte keine 800 Stellen umändern und testen.

So wie das oben ist, läuft es super - zumindestens unter Delphi 5. Ich habe eben das Teil mal unter Turbo Delphi laufen lassen, da klappt das nicht. Was ist da für ein Unterschied zu Delphi 5?

[MacGuyver]

N'abend!

Ich habe es gefunden: Es wird unter Turbo Delphi bei Write() eine andere Funktion aufgerufen als bei WriteLn(). Unter Delphi 5 hatte er IMMER "FlushFunc" aufgerufen. Läuft das Programm in der neueren Version, ruft er bei WriteLN() "FlushFunc" und bei Write() "InOutFunc" auf. So kann man das Teil folgend benutzen:

Delphi-Quellcode:

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;

  var
    lSt : ShortString;

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

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

begin
  with TTextRec(F) do
  begin
    FillChar(F, SizeOf(F), 0);
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @DeviceOpen;
    InOutFunc := @DeviceFlush;//@DeviceInOut; So läuft das unter Delphi 5 und Turbo Delphi.
    FlushFunc := @DeviceFlush;
    CloseFunc := @DeviceClose;
  end;
end;

Ich habe einfach die Zuweisung angepasst. Für meinen Programmverlauf macht es hier keinen Unterschied ob InOutFunc oder FlushFunc aufgerufen wird.


Schönen Abend noch
Stefan