Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
|
Re: Text von Writeln -> Speicherblock
23. Okt 2003, 19:05
Delphi-Quellcode:
procedure AssignHook(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:
begin
// ouput F.BufPtr^ here
F.BufPtr^ := #0;
F.BufEnd := 1;
F.BufPos := 0;
end;
fmOutput:
begin
// ouput F.BufPtr^ here
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: // output F.Buffer here
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 Test;
begin
AssignHook(Output);
WriteLn( 'Test ');
end;
Gruß Hagen
|
|
Zitat
|