Text von Writeln -> Speicherblock

[neolithos]

Ich habe mich mal daran gemacht ein kleines Test-Programm zu schreiben...

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(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;
    F.BufPtr^ := #0;
    F.BufEnd := 1;
    F.BufPos := 0;
  end;

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

  function DeviceInOut(var F: TTextRec): Integer; register;
  begin 
    Result := 0;
    case F.Mode of
      fmInput:; // read F.Buffer here in
      fmOutput:
        begin
          with Form1.Memo1 do
            Text := Text + F.Buffer; // output F.Buffer here
          Flush(Text(F));
        end;
    end;
  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.FormCreate(Sender: TObject);
begin
  AssignMemo(Output);
end;

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

end.

Dummerweise geht er nie DeviceInOut. Und beim Beenden tritt der RunTimeError 216 auf.