On 23.10.2013 21:01, ListMember wrote:
type
TMyWriteLnCallback = procedure(AText: String);
var
GMyWriteLnCallback: TMyCallback = nil;
and then, wherever the 'compiler magic' for WriteLn is, use something
like
if Assigned(GMyWriteLnCallback) then GMyWriteLnCallback(TextStuff)
else {do the usual console output}
So, could someone tell me where I have to inject these lines.
I've already written you how you can do it. Write a text driver which
uses your callback function.
This is much easier than trying to understand how the compiler handles
Writeln plus you don't need to manipulate the compiler or the RTL for
that.
Frankly, I agree that I should not have to modify the compiler or the
RTL; especially for something like redirecting the WriteLn output from
console to my own application.
But, doing it through text drivers etc. is --how can I put it-- almost
inhuman.
What is inhuman in using something that the language/runtime provides?
I don't want to do it through
Procedure AssignStream(var F: Textfile; Stream: TStream);
as it exists in StreamIO unit because I don't want to fiddle around with
streams as it doesn't have an OnChange event. It means I need to wait
for the whole app to finish, or I need to keep polling for what has
changed in the stream. Totally useless in my case.
I could use the sample code you posted a link to (and, thank you also
for that), and I adapted it to use TMemo for my use.
I've attached my own version of EditText which I just adjusted. It works
very similar to the original version I linked, but allows to use any
TCustomEdit descendant (TMemo is one of them).
But, why would I have to write 100+ lines of code just to capture the
output of WriteLn.
Plus, I keep getting segfaults when I close the application --something
is calling InOutFunc when the app closes and still tries to write to a
destroyed TMemo.
You'll need to store the old value of "Output" and restore that before
your form is destroyed.
I think I'll go with Leledumbo's solution --and yes, will alter the
globals.pas in the compiler's source.
Adding a callback to globals.pas will be the completely wrong way...
Regards,
Sven
unit EditText;
{
Written by Kiriakos Vlahos (kvlah...@lbs.lon.ac.uk)
Freeware - Please send comments of improvements.
}
interface
{$mode objfpc}
uses
StdCtrls;
procedure AssignEdit(var T: Text; NewEditComponent: TCustomEdit);
implementation
uses
SysUtils, Math;
type
EditData = record
Edit: TCustomEdit;
Filler: Array [1..12] of Char;
end;
PEditData = ^EditData;
TEditHelper = class helper for TCustomEdit
procedure SetSelTextBuf(aBuf: PChar); inline;
function GetSelTextStr: String; inline;
end;
procedure TEditHelper.SetSelTextBuf(aBuf: PChar);
begin
SetSelText(aBuf);
end;
function TEditHelper.GetSelTextStr: String;
begin
Result := GetSelText;
end;
function EditWrite(var F: TTextRec): Integer; far;
begin
with F do
begin
BufPtr^[BufPos] := #0;
PEditData(@F.UserData)^.Edit.SetSelTextBuf(PChar(BufPtr));
BufPos := 0;
end;
EditWrite := 0;
end;
function EditRead(var F: TTextRec): Integer; far;
Var
CurPos : Integer;
s: String;
begin
with F do
with PEditData(@UserData)^ do begin
BufPos := 0;
Edit.SelLength := BufSize;
s := Edit.GetSelTextStr;
BufEnd := Min(Length(s), BufSize);
Move(s[1], BufPtr^, BufEnd);
Edit.SelStart := Edit.SelStart + BufEnd;
end;
EditRead := 0;
end;
function EditFlush(var F: TTextRec): Integer; far;
begin
F.BufPos := 0;
F.BufEnd := 0;
EditFlush := 0;
end;
function EditOpen(var F: TTextRec): Integer; far;
begin
with F do
begin
if Mode = fmInput then
begin
InOutFunc := @EditRead;
FlushFunc := nil;
PEditData(@F.UserData)^.Edit.SelStart := 0;
end
else
begin
Mode := fmOutput;
InOutFunc := @EditWrite;
FlushFunc := @EditWrite;
end;
EditOpen := 0;
end;
end;
function EditIgnore(var F: TTextRec): Integer; far;
begin
EditIgnore := 0;
end;
procedure AssignEdit(var T: Text; NewEditComponent: TCustomEdit);
begin
with TTextRec(T) do
begin
Handle := $FFFF;
Mode := fmClosed;
BufSize := SizeOf(Buffer)-1;
BufPtr := @Buffer;
OpenFunc := @EditOpen;
CloseFunc := @EditIgnore;
Name[0] := #0;
PEditData(@UserData)^.Edit:= NewEditComponent;
end;
end;
end.
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
