On 21 March 2015 at 11:35, Sven Barth <pascaldra...@googlemail.com> wrote:
> On 21.03.2015 11:13, vfclists . wrote: > >> >> >> On 20 March 2015 at 20:54, Sven Barth <pascaldra...@googlemail.com >> <mailto:pascaldra...@googlemail.com>> wrote: >> >> On 20.03.2015 21:18, vfclists . wrote: >> >> >> >> On 20 March 2015 at 19:34, Sven Barth >> <pascaldra...@googlemail.com <mailto:pascaldra...@googlemail.com> >> <mailto:pascaldragon@__googlemail.com >> <mailto:pascaldra...@googlemail.com>>> wrote: >> >> Am 20.03.2015 19:19 schrieb "vfclists ." >> <vfcli...@gmail.com <mailto:vfcli...@gmail.com> >> <mailto:vfcli...@gmail.com <mailto:vfcli...@gmail.com>>>: >> >> >> >> snip >> >> How do you ensure own implementation overrides the system's >> implementation, does the compiler take care of that >> automatically, or >> will you have to name your function differently? >> >> >> There is no need to ensure that. Here is an example: >> >> === code begin === >> >> var >> f, oldout: TextFile; >> begin >> Writeln('Hello Output as StdOut'); >> >> oldout := Output; >> >> Assign(Output, 'test.txt'); >> Rewrite(Output); >> >> Writeln('Hello Output as file'); >> >> Close(f); >> >> Output := oldout; >> >> Writeln('Hello Output as StdOut again'); >> end. >> >> === code end === >> >> To see how such a TextFile is implemented you can take a look at >> unit StreamIO which is part of FPC's units. >> >> (Though I wonder why "Assign(f, 'test.txt'); Output := f; >> Writeln('Hello Output as file');" does not work :/ ) >> >> Regards, >> Sven >> >> _________________________________________________ >> fpc-pascal maillist - fpc-pascal@lists.freepascal.__org >> <mailto:fpc-pascal@lists.freepascal.org> >> http://lists.freepascal.org/__cgi-bin/mailman/listinfo/fpc-__pascal >> <http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal> >> >> >> I need to get the output of a program which uses a lot of Write and >> Writeln commands into the GUI in realtime, by that I not having to >> output it to a text file and reading it afterwards, but by capturing the >> output of each Write command into a variable and displaying it in the >> GUI immediately. >> >> If each Write or Writeln could trigger an event, I could use the event >> to capture the output. My other option is to replace the calls to write >> with my own function, but Write has different number of call parameters >> and it may require as many variants of the function as are used in the >> program, assuming that the call syntax is regular, not something like >> this one - write(JSValToDouble(cx,pom^)):1:scale). >> > > The usage of a text file was merely an example. As I said there already is > the possibility to use a TStream provided by FPC. But since I'm nice here > you also have an example for a TMemo, I'm sure you can adjust that for your > needs: > > === code begin === > > resourcestring > SErrNilMemo = 'Memo is nil'; > > type > PMemo = ^TMemo; > > function GetMemo(var F: TTextRec): TMemo; > begin > Result:=PMemo(@F.Userdata)^; > end; > > function MemoWrite(var F: TTextRec): LongInt; > var > s: String; > begin > Result := 0; > with F do > if BufPos > 0 then > try > SetLength(s, BufPos); > Move(BufPtr^, s[1], BufPos); > GetMemo(F).SelText := s; > BufPos:=0; > except > Result:=101; > end; > end; > > > function MemoClose(var F: TTextRec): LongInt; > begin > Result := 0; > end; > > function MemoOpen(var F: TTextRec): LongInt; > begin > Result := 0; > with F do begin > BufPos:=0; > Bufend:=0; > case Mode of > fmInput: begin > Result := 104; > end; > fmOutput, fmAppend: begin > InOutFunc := @MemoWrite; > FlushFunc := @MemoWrite; > if Mode = fmAppend then > Try > with GetMemo(F) do begin > SelStart := Length(Text); > end; > except > Result := 156; > end; > end else begin > GetMemo(F).Clear; > end; > end; > end; > end; > > procedure AssignMemo(var F: Text; aMemo: TMemo); > var > e: EInoutError; > begin > if not Assigned(aMemo) then begin > E:=EInOutError.Create(SErrNilMemo); > E.ErrorCode:=6; > Raise E; > end; > with TTextRec(F) do begin > OpenFunc := @MemoOpen; > CloseFunc := @MemoClose; > case DefaultTextLineBreakStyle Of > tlbsLF: > TextRec(f).LineEnd := #10; > tlbsCRLF: > TextRec(f).LineEnd := #13#10; > tlbsCR: > TextRec(f).LineEnd := #13; > end; > PMemo(@UserData)^ := aMemo; > Mode := fmClosed; > BufSize := SizeOf(Buffer); > BufPtr := @Buffer; > Name[0] := #0; > end; > end; > > === code end === > > To use it you should use the following code (for example in FormCreate): > > === code begin === > > fOldOutput := Output; // store the old Output somewhere > AssignMemo(Output, Memo1); > Rewrite(Output); > > === code end === > > Then in FormDestroy you cleanup: > > === code begin === > > CloseFile(Output); > Output := fOldOutput; // restore old Output > > === code end === > > And to illustrate that it works I've used a TTimer and added the following > to its OnTimer event: > > === code begin === > > Writeln('Hello World ', fIndex); > Inc(fIndex); // fIndex is a LongInt field of the form > > === code end === > > And with that TMemo gets spammed with 'Hello World N' messages ;) > > You could of course also implement it in a way that you assign a event > handler to a text file instead of a memo. As I said the Pascal I/O > mechanism is very flexible here. > > And just in case: by using this mechanism you don't need to adjust any of > the Write(Ln)s, the full spectrum of variants of how Write(Ln) can be > called is supported. > > > Regards, > Sven > _______________________________________________ > fpc-pascal maillist - fpc-pascal@lists.freepascal.org > http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal > Much obliged. Is the Text object the Write is using global for the whole program or thread, ie all Writes will go to that Text object until it is reverted back to the default? In case of wanting to use different Text objects is it possible to prefix the Write command with the Text e.g Write(TextObject, 'outputtext')? Do Write and WriteLn support something like that? -- Frank Church ======================= http://devblog.brahmancreations.com
_______________________________________________ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
