paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 17:10:02 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Small observer demo from Graeme Geldenhuys (bug ID 23329)

Browse Source 
git-svn-id: trunk@23092 -
This commit is contained in:
michael 2012-12-02 11:24:42 +00:00
parent 5419d06a96
commit 053fd43324
2 changed files with 68 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1782,6 +1782,7 @@ packages/fcl-base/examples/crittest.pp svneol=native#text/plain
packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
packages/fcl-base/examples/debugtest.pp svneol=native#text/plain
packages/fcl-base/examples/decodeascii85.pp svneol=native#text/plain
packages/fcl-base/examples/dobserver.pp svneol=native#text/plain
packages/fcl-base/examples/doecho.pp svneol=native#text/plain
packages/fcl-base/examples/dparser.pp svneol=native#text/plain
packages/fcl-base/examples/dsockcli.pp svneol=native#text/plain

67
packages/fcl-base/examples/dobserver.pp Normal file
View File

@ -0,0 +1,67 @@
{ This demo is very basic, but shows the Observer support in the RTL }
program dobserver;
{$mode objfpc}{$h+}
{$ifdef mswindows}{$apptype console}{$endif}
uses
Classes, SysUtils, typinfo;
type
TMyObserver = class(TObject, IFPObserver)
private
procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer);
end;
{ TMyObserver }
procedure TMyObserver.FPOObservedChanged(ASender: TObject;
Operation: TFPObservedOperation; Data: Pointer);
function OperationToString(AOperation: TFPObservedOperation): string;
begin
result := GetEnumName(TypeInfo(TFPObservedOperation),
Ord(AOperation));
end;
var
intf: IFPObserved;
begin
if Operation = ooFree then
begin
writeln('[ooFree] detected so we should detach ourselves');
if Supports(ASender, IFPObserved, intf) then
intf.FPODetachObserver(self);
end
else
begin
writeln(ASender.ClassName + ' has changed ['+
OperationToString(Operation) + ']');
end;
end;
var
sl: TStringList;
observer: TMyObserver;
intf: IFPObserved;
begin
{ This stringlist will be the subject (observed) }
sl := TStringList.Create;
{ this instance will be the observer - notified when StringList changes }
observer := TMyObserver.Create;
{ attach observer }
if Supports(sl, IFPObserved, intf) then
begin
intf.FPOAttachObserver(observer);
end;
{ Do something to the stringlist }
sl.Add('Item one');
sl.Add('Item two');
sl.Delete(0);
{ Clean-up code - also shows ooFree operation }
sl.Free;
observer.Free;
end.