paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 05:40:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Initial implementation

Browse Source
This commit is contained in:
michael 2001-09-01 19:00:14 +00:00
parent 236598c235
commit 181529df97
20 changed files with 1380 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
docs/typinfex/Makefile Normal file
View File

@ -0,0 +1,56 @@
#######################################################################
#
# Makefile to compile all examples and convert them to LaTeX
#
#######################################################################
# Compiler
PP=ppc386
# Unit directory
# UNITDIR=/usr/lib/ppc/0.99.0/linuxunits
# Any options you wish to pass.
PPOPTS=
# Script to convert the programs to LaTeX examples which can be included.
PP2TEX=../pp2tex
# Script to collect all examples in 1 file.
MAKETEX=make1tex
#######################################################################
# No need to edit after this line.
#######################################################################
ifdef UNITDIR
PPOPTS:=$(PPOPTS) -Up$(UNITDIR);
endif
.SUFFIXES: .pp .tex
.PHONY: all tex clean
OBJECTS=rttiobj trtti1 trtti2 trtti3 ex1 ex2 ex3 ex4 ex5 ex6 ex7 ex8 ex9 \
ex10 ex11 ex12 ex13
# ex14
# ex15 ex16
TEXOBJECTS=$(addsuffix .tex, $(OBJECTS))
all : $(OBJECTS)
tex : $(TEXOBJECTS)
onetex : tex
$(MAKETEX) $(TEXOBJECTS)
clean :
rm -f *.o *.s $(OBJECTS) $(TEXOBJECTS) rttiobj.ppu
$(OBJECTS): %: %.pp
$(PP) $(PPOPTS) $*
$(TEXOBJECTS): %.tex: %.pp head.tex foot.tex
$(PP2TEX) $*

24
docs/typinfex/ex1.pp Normal file
View File

@ -0,0 +1,24 @@
program example1;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
begin
O:=TMyTestObject.Create;
Writeln('Boolean property : ');
Writeln('Value : ',O.BooleanField);
Writeln('Ord(Value) : ',Ord(O.BooleanField));
Writeln('Get (name) : ',GetOrdProp(O,'BooleanField'));
PI:=GetPropInfo(O,'BooleanField');
Writeln('Get (propinfo) : ',GetOrdProp(O,PI));
SetOrdProp(O,'BooleanField',Ord(False));
Writeln('Set (name,false) : ',O.BooleanField);
SetOrdProp(O,PI,Ord(True));
Writeln('Set (propinfo,true) : ',O.BooleanField);
O.Free;
end.

23
docs/typinfex/ex10.pp Normal file
View File

@ -0,0 +1,23 @@
program example11;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
begin
O:=TMyTestObject.Create;
Writeln('Property tests : ');
Write('IsPublishedProp(O,BooleanField) : ');
Writeln(IsPublishedProp(O,'BooleanField'));
Write('IsPublishedProp(Class,BooleanField) : ');
Writeln(IsPublishedProp(O.ClassType,'BooleanField'));
Write('IsPublishedProp(O,SomeField) : ');
Writeln(IsPublishedProp(O,'SomeField'));
Write('IsPublishedProp(Class,SomeField) : ');
Writeln(IsPublishedProp(O.ClassType,'SomeField'));
O.Free;
end.

23
docs/typinfex/ex11.pp Normal file
View File

@ -0,0 +1,23 @@
program example11;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
begin
O:=TMyTestObject.Create;
Writeln('Stored tests : ');
Write('IsStoredProp(O,StoredIntegerConstFalse) : ');
Writeln(IsStoredProp(O,'StoredIntegerConstFalse'));
Write('IsStoredProp(O,StoredIntegerConstTrue) : ');
Writeln(IsStoredProp(O,'StoredIntegerConstTrue'));
Write('IsStoredProp(O,StoredIntegerMethod) : ');
Writeln(IsStoredProp(O,'StoredIntegerMethod'));
Write('IsStoredProp(O,StoredIntegerVirtualMethod) : ');
Writeln(IsStoredProp(O,'StoredIntegerVirtualMethod'));
O.Free;
end.

34
docs/typinfex/ex12.pp Normal file
View File

@ -0,0 +1,34 @@
Program example13;
uses
rttiobj,typinfo;
Var
O : TMyTestObject;
PT : PTypeData;
PI : PTypeInfo;
I,J : Longint;
PP : PPropList;
prI : PPropInfo;
begin
O:=TMyTestObject.Create;
PI:=O.ClassInfo;
PT:=GetTypeData(PI);
Writeln('Property Count : ',PT^.PropCount);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
begin
With PP^[i]^ do
begin
Write('Property ',i+1:3,': ',name:30);
writeln(' Type: ',TypeNames[typinfo.PropType(O,Name)]);
end;
end;
FreeMem(PP);
O.Free;
end.

35
docs/typinfex/ex13.pp Normal file
View File

@ -0,0 +1,35 @@
Program example13;
uses
rttiobj,typinfo;
Var
O : TMyTestObject;
PT : PTypeData;
PI : PTypeInfo;
I,J : Longint;
PP : PPropList;
prI : PPropInfo;
begin
O:=TMyTestObject.Create;
PI:=O.ClassInfo;
PT:=GetTypeData(PI);
Writeln('Total property Count : ',PT^.PropCount);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
J:=GetPropList(PI,OrdinalTypes,PP);
Writeln('Ordinal property Count : ',J);
For I:=0 to J-1 do
begin
With PP^[i]^ do
begin
Write('Property ',i+1:3,': ',name:30);
writeln(' Type: ',TypeNames[typinfo.PropType(O,Name)]);
end;
end;
FreeMem(PP);
O.Free;
end.

25
docs/typinfex/ex2.pp Normal file
View File

@ -0,0 +1,25 @@
program example2;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
TI : PTypeInfo;
begin
O:=TMyTestObject.Create;
PI:=GetPropInfo(O,'MyEnumField');
TI:=PI^.PropType;
Writeln('Enum property : ');
Writeln('Value : ',GetEnumName(TI,Ord(O.MyEnumField)));
Writeln('Get (name) : ',GetEnumProp(O,'MyEnumField'));
Writeln('Get (propinfo) : ',GetEnumProp(O,PI));
SetEnumProp(O,'MyEnumField','meFirst');
Writeln('Set (name,meFirst) : ',GetEnumName(TI,Ord(O.MyEnumField)));
SetEnumProp(O,PI,'meSecond');
Writeln('Set (propinfo,meSecond) : ',GetEnumName(TI,Ord(O.MyEnumField)));
O.Free;
end.

23
docs/typinfex/ex3.pp Normal file
View File

@ -0,0 +1,23 @@
program example3;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
begin
O:=TMyTestObject.Create;
PI:=GetPropInfo(O,'AnsiStringField');
Writeln('String property : ');
Writeln('Value : ',O.AnsiStringField);
Writeln('Get (name) : ',GetStrProp(O,'AnsiStringField'));
Writeln('Get (propinfo) : ',GetStrProp(O,PI));
SetStrProp(O,'AnsiStringField','First');
Writeln('Set (name,''First'') : ',O.AnsiStringField);
SetStrProp(O,PI,'Second');
Writeln('Set (propinfo,''Second'') : ',O.AnsiStringField);
O.Free;
end.

32
docs/typinfex/ex4.pp Normal file
View File

@ -0,0 +1,32 @@
program example3;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
begin
O:=TMyTestObject.Create;
Writeln('Real property : ');
PI:=GetPropInfo(O,'RealField');
Writeln('Value : ',O.RealField);
Writeln('Get (name) : ',GetFloatProp(O,'RealField'));
Writeln('Get (propinfo) : ',GetFloatProp(O,PI));
SetFloatProp(O,'RealField',system.Pi);
Writeln('Set (name,pi) : ',O.RealField);
SetFloatProp(O,PI,exp(1));
Writeln('Set (propinfo,e) : ',O.RealField);
Writeln('Extended property : ');
PI:=GetPropInfo(O,'ExtendedField');
Writeln('Value : ',O.ExtendedField);
Writeln('Get (name) : ',GetFloatProp(O,'ExtendedField'));
Writeln('Get (propinfo) : ',GetFloatProp(O,PI));
SetFloatProp(O,'ExtendedField',system.Pi);
Writeln('Set (name,pi) : ',O.ExtendedField);
SetFloatProp(O,PI,exp(1));
Writeln('Set (propinfo,e) : ',O.ExtendedField);
O.Free;
end.

36
docs/typinfex/ex5.pp Normal file
View File

@ -0,0 +1,36 @@
program example3;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
NO1,NO2 : TNamedObject;
begin
O:=TMyTestObject.Create;
NO1:=TNamedObject.Create;
NO1.ObjectName:='First named object';
NO2:=TNamedObject.Create;
NO2.ObjectName:='Second named object';
O.ObjField:=NO1;
Writeln('Object property : ');
PI:=GetPropInfo(O,'ObjField');
Write('Property class : ');
Writeln(GetObjectPropClass(O,'ObjField').ClassName);
Write('Value : ');
Writeln((O.ObjField as TNamedObject).ObjectName);
Write('Get (name) : ');
Writeln((GetObjectProp(O,'ObjField') As TNamedObject).ObjectName);
Write('Get (propinfo) : ');
Writeln((GetObjectProp(O,PI,TObject) as TNamedObject).ObjectName);
SetObjectProp(O,'ObjField',NO2);
Write('Set (name,NO2) : ');
Writeln((O.ObjField as TNamedObject).ObjectName);
SetObjectProp(O,PI,NO1);
Write('Set (propinfo,NO1) : ');
Writeln((O.ObjField as TNamedObject).ObjectName);
O.Free;
end.

83
docs/typinfex/ex6.pp Normal file
View File

@ -0,0 +1,83 @@
program example3;
{$mode objfpc}
uses rttiobj,typinfo,sysutils;
Type
TNotifyObject = Class(TObject)
Procedure Notification1(Sender : TObject);
Procedure Notification2(Sender : TObject);
end;
Procedure TNotifyObject.Notification1(Sender : TObject);
begin
Write('Received notification 1 of object with class: ');
Writeln(Sender.ClassName);
end;
Procedure TNotifyObject.Notification2(Sender : TObject);
begin
Write('Received notification 2 of object with class: ');
Writeln(Sender.ClassName);
end;
Var
O : TMyTestObject;
PI : PPropInfo;
NO : TNotifyObject;
M : TMethod;
Procedure PrintMethod (Const M : TMethod);
begin
If (M.Data=Pointer(NO)) Then
If (M.Code=Pointer(@TNotifyObject.Notification1)) then
Writeln('Notification1')
else If (M.Code=Pointer(@TNotifyObject.Notification2)) then
Writeln('Notification2')
else
begin
Write('Unknown method adress (data:');
Write(hexStr(Longint(M.data),8));
Writeln(',code:',hexstr(Longint(M.Code),8),')');
end;
end;
begin
O:=TMyTestObject.Create;
NO:=TNotifyObject.Create;
O.NotifyEvent:=@NO.Notification1;
PI:=GetPropInfo(O,'NotifyEvent');
Writeln('Method property : ');
Write('Notifying : ');
O.Notify;
Write('Get (name) : ');
M:=GetMethodProp(O,'NotifyEvent');
PrintMethod(M);
Write('Notifying : ');
O.Notify;
Write('Get (propinfo) : ');
M:=GetMethodProp(O,PI);
PrintMethod(M);
M.Data:=No;
M.Code:=Pointer(@NO.Notification2);
SetMethodProp(O,'NotifyEvent',M);
Write('Set (name,Notification2) : ');
M:=GetMethodProp(O,PI);
PrintMethod(M);
Write('Notifying : ');
O.Notify;
Write('Set (propinfo,Notification1) : ');
M.Data:=No;
M.Code:=Pointer(@NO.Notification1);
SetMethodProp(O,PI,M);
M:=GetMethodProp(O,PI);
PrintMethod(M);
Write('Notifying : ');
O.Notify;
O.Free;
end.

48
docs/typinfex/ex7.pp Normal file
View File

@ -0,0 +1,48 @@
program example1;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
Function SetAsString (ASet : TMyEnums) : String;
Var
i : TmyEnum;
begin
result:='';
For i:=mefirst to methird do
If i in ASet then
begin
If (Result<>'') then
Result:=Result+',';
Result:=Result+MyEnumNames[i];
end;
end;
Var
S : TMyEnums;
begin
O:=TMyTestObject.Create;
O.SetField:=[mefirst,meSecond,meThird];
Writeln('Set property : ');
Writeln('Value : ',SetAsString(O.SetField));
Writeln('Ord(Value) : ',Longint(O.SetField));
Writeln('Get (name) : ',GetSetProp(O,'SetField'));
PI:=GetPropInfo(O,'SetField');
Writeln('Get (propinfo) : ',GetSetProp(O,PI,false));
S:=[meFirst,meThird];
SetOrdProp(O,'SetField',Integer(S));
Write('Set (name,[mefirst,methird]) : ');
Writeln(SetAsString(O.SetField));
S:=[meSecond];
SetOrdProp(O,PI,Integer(S));
Write('Set (propinfo,[meSecond]) : ');
Writeln(SetAsString(O.SetField));
O.Free;
end.

26
docs/typinfex/ex8.pp Normal file
View File

@ -0,0 +1,26 @@
program example1;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
PI : PPropInfo;
Const
ConstSet = 'mefirst,methird';
Var
S : TMyEnums;
begin
O:=TMyTestObject.Create;
O.SetField:=[mefirst,meSecond,meThird];
PI:=GetPropInfo(O,'SetField');
Writeln('SetToString (brackets) : ',SetToString(Pi,Integer(O.SetField),True));
Writeln('SetToString (default) : ',SetToString(Pi,Integer(O.SetField)));
O.SetField:=TMyEnums(StringToSet(PI,ConstSet));
Writeln('Stringtoset : ',SetToString(PI,Integer(O.SetField)));
O.Free;
end.

17
docs/typinfex/ex9.pp Normal file
View File

@ -0,0 +1,17 @@
program example2;
{$mode objfpc}
uses rttiobj,typinfo;
Var
O : TMyTestObject;
TI : PTypeInfo;
begin
O:=TMyTestObject.Create;
TI:=GetPropInfo(O,'MyEnumField')^.PropType;
Writeln('GetEnumName : ',GetEnumName(TI,Ord(O.MyEnumField)));
Writeln('GetEnumValue(mefirst) : ',GetEnumName(TI,GetEnumValue(TI,'mefirst')));
O.Free;
end.

2
docs/typinfex/foot.tex Normal file
View File

@ -0,0 +1,2 @@
\end{verbatim}
\end{FPCList}

3
docs/typinfex/head.tex Normal file
View File

@ -0,0 +1,3 @@
\begin{FPCList}
\item[Example]
\begin{verbatim}

497
docs/typinfex/rttiobj.pp Normal file
View File

@ -0,0 +1,497 @@
Unit rttiobj;
{$Mode Delphi}
{$M+}
Interface
uses TypInfo;
Const TypeNames : Array [TTYpeKind] of string[15] =
('Unknown','Integer','Char','Enumeration',
'Float','Set','Method','ShortString','LongString',
'AnsiString','WideString','Variant','Array','Record',
'Interface','Class','Object','WideChar','Bool','Int64','QWord',
'DynamicArray','RawInterface');
Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
Type
TMyEnum = (meFirst,meSecond,meThird);
TMyEnums = Set of TMyEnum;
TNotifyEvent = Procedure (Sender : TObject) of object;
TMyTestObject = Class(TObject)
Private
FBoolean : Boolean;
FByte : Byte;
FChar : Char;
FWord : Word;
FInteger : Integer;
Flongint : Longint;
FCardinal : Cardinal;
FReal : Real;
FExtended : Extended;
FMyEnum : TMyEnum;
FAnsiString : AnsiSTring;
FObj : TObject;
FNotifyEvent : TNotifyEvent;
FSetField : TMyEnums;
FStored : Boolean;
Function GetBoolean : Boolean;
Function GetByte : Byte;
Function GetChar : Char;
Function GetWord : Word;
Function GetInteger : Integer;
Function GetLongint : Longint;
Function GetCardinal : Cardinal;
Function GetReal : Real;
Function GetExtended : Extended;
Function GetAnsiString : AnsiString;
Function GetMyEnum : TMyEnum;
Procedure SetBoolean ( Value : Boolean);
Procedure SetByte ( Value : Byte );
Procedure SetChar ( Value : Char );
Procedure SetWord ( Value : Word );
Procedure SetInteger ( Value : Integer );
Procedure SetLongint ( Value : Longint );
Procedure SetCardinal ( Value : Cardinal );
Procedure SetReal ( Value : Real );
Procedure SetExtended ( Value : Extended );
Procedure SetAnsiString ( Value : AnsiString );
Procedure SetMyEnum ( Value : TMyEnum );
Function GetVirtualBoolean : Boolean; virtual;
Function GetVirtualByte : Byte; virtual;
Function GetVirtualChar : Char; virtual;
Function GetVirtualWord : Word; virtual;
Function GetVirtualInteger : Integer; virtual;
Function GetVirtualLongint : Longint; virtual;
Function GetVirtualCardinal : Cardinal; virtual;
Function GetVirtualReal : Real; virtual;
Function GetVirtualExtended : Extended; virtual;
Function GetVirtualAnsiString : AnsiString; virtual;
Function GetVirtualMyEnum : TMyEnum; virtual;
Procedure SetVirtualBoolean ( Value : Boolean); virtual;
Procedure SetVirtualByte ( Value : Byte ); virtual;
Procedure SetVirtualChar ( Value : Char ); virtual;
Procedure SetVirtualWord ( Value : Word ); virtual;
Procedure SetVirtualInteger ( Value : Integer ); virtual;
Procedure SetVirtualLongint ( Value : Longint ); virtual;
Procedure SetVirtualCardinal ( Value : Cardinal ); virtual;
Procedure SetVirtualReal ( Value : Real ); virtual;
Procedure SetVirtualExtended ( Value : Extended ); virtual;
Procedure SetVirtualAnsiString ( Value : AnsiString ); virtual;
Procedure SetVirtualMyEnum ( Value : TMyEnum ); virtual;
Function GetStaticStored : Boolean;
Function GetVirtualStored : Boolean;virtual;
Public
Constructor Create;
Destructor Destroy;override;
Procedure Notify;
Published
Property ObjField: TObject read FObj write FObj;
Property SetField : TMyEnums Read FSetField Write FSetField;
Property NotifyEvent : TNotifyEvent Read FNotifyEvent Write FNotifyEvent;
Property BooleanField : Boolean Read FBoolean Write FBoolean;
Property ByteField : Byte Read FByte Write FByte;
Property CharField : Char Read FChar Write FChar;
Property WordField : Word Read FWord Write FWord;
Property IntegerField : Integer Read FInteger Write FInteger;
Property LongintField : Longint Read FLongint Write FLongint;
Property CardinalField : Cardinal Read FCardinal Write FCardinal;
Property RealField : Real Read FReal Write FReal;
Property ExtendedField : Extended Read FExtended Write FExtended;
Property AnsiStringField : AnsiString Read FAnsiString Write FAnsiString;
Property MyEnumField : TMyEnum Read FMyEnum Write FMyEnum;
Property BooleanMethod : Boolean Read GetBoolean Write SetBoolean;
Property ByteMethod : Byte Read GetByte Write SetByte;
Property CharMethod : Char Read GetChar Write SetChar;
Property WordMethod : Word Read GetWord Write SetWord;
Property IntegerMethod : Integer Read GetInteger Write SetInteger;
Property LongintMethod : Longint Read GetLongint Write SetLongint;
Property CardinalMethod : Cardinal Read GetCardinal Write SetCardinal;
Property RealMethod : Real Read GetReal Write SetReal;
Property ExtendedMethod : Extended Read GetExtended Write SetExtended;
Property AnsiStringMethod : AnsiString Read GetAnsiString Write SetAnsiString;
Property MyEnumMethod : TMyEnum Read GetMyEnum Write SetMyEnum;
Property BooleanVirtualMethod : Boolean Read GetVirtualBoolean Write SetVirtualBoolean;
Property ByteVirtualMethod : Byte Read GetVirtualByte Write SetVirtualByte;
Property CharVirtualMethod : Char Read GetVirtualChar Write SetVirtualChar;
Property WordVirtualMethod : Word Read GetVirtualWord Write SetVirtualWord;
Property IntegerVirtualMethod : Integer Read GetVirtualInteger Write SetVirtualInteger;
Property LongintVirtualMethod : Longint Read GetVirtualLongint Write SetVirtualLongint;
Property CardinalVirtualMethod : Cardinal Read GetVirtualCardinal Write SetVirtualCardinal;
Property RealVirtualMethod : Real Read GetVirtualReal Write SetVirtualReal;
Property ExtendedVirtualMethod : Extended Read GetVirtualExtended Write SetVirtualExtended;
Property AnsiStringVirtualMethod : AnsiString Read GetVirtualAnsiString Write SetVirtualAnsiString;
Property MyEnumVirtualMethod : TMyEnum Read GetVirtualMyEnum Write SetVirtualMyEnum;
Property StoredIntegerConstFalse : Longint Read FLongint Stored False;
Property StoredIntegerConstTrue : Longint Read FLongint Stored True;
Property StoredIntegerField : Longint Read FLongint Stored FStored;
Property StoredIntegerMethod : Longint Read Flongint Stored GetStaticStored;
Property StoredIntegerVirtualMethod : Longint Read Flongint Stored GetVirtualStored;
end;
TNamedObject = Class(TObject)
Private
FObjectName : AnsiString;
Public
Property ObjectName : AnsiString Read FObjectName Write FObjectName;
end;
Const
MyEnumNames : Array[TMyEnum] of string = ('meFirst','meSecond','meThird');
Procedure PrintObject ( Obj: TMyTestObject);
Implementation
Constructor TMyTestObject.Create;
begin
FBoolean:=true;
FByte:=1; { : Byte;}
FChar:='B'; { : Char; }
FWord:=3; {: Word; }
FInteger:=4; {: Integer; }
Flongint:=5; { : Longint; }
FCardinal:=6; {: Cardinal; }
FReal:=7.0; { : Real;}
FExtended :=8.0; { Extended;}
FMyEnum:=methird; { TMyEnum;}
FAnsiString:='this is an AnsiString';
end;
Destructor TMyTestObject.Destroy;
begin
Inherited Destroy;
end;
Function TMyTestObject.GetBoolean : boolean;
begin
Result:=FBoolean;
end;
Function TMyTestObject.GetByte : Byte;
begin
Result:=FByte;
end;
Function TMyTestObject.GetChar : Char;
begin
Result:=FChar;
end;
Function TMyTestObject.GetWord : Word;
begin
Result:=FWord;
end;
Function TMyTestObject.GetInteger : Integer;
begin
Result:=FInteger;
end;
Function TMyTestObject.GetLongint : Longint;
begin
Result:=FLongint;
end;
Function TMyTestObject.GetCardinal : Cardinal;
begin
Result:=FCardinal;
end;
Function TMyTestObject.GetReal : Real;
begin
Result:=FReal;
end;
Function TMyTestObject.GetExtended : Extended;
begin
Result:=FExtended;
end;
Function TMyTestObject.GetAnsiString : AnsiString;
begin
Result:=FAnsiString;
end;
Function TMyTestObject.GetMyEnum : TMyEnum;
begin
Result:=FMyEnum;
end;
Procedure TMyTestObject.Setboolean ( Value : boolean );
begin
Fboolean:=Value;
end;
Procedure TMyTestObject.SetByte ( Value : Byte );
begin
FByte:=Value;
end;
Procedure TMyTestObject.SetChar ( Value : Char );
begin
FChar:=Value;
end;
Procedure TMyTestObject.SetWord ( Value : Word );
begin
FWord:=Value;
end;
Procedure TMyTestObject.SetInteger ( Value : Integer );
begin
FInteger:=Value;
end;
Procedure TMyTestObject.SetLongint ( Value : Longint );
begin
FLongint:=Value;
end;
Procedure TMyTestObject.SetCardinal ( Value : Cardinal );
begin
FCardinal:=Value;
end;
Procedure TMyTestObject.SetReal ( Value : Real );
begin
FReal:=Value;
end;
Procedure TMyTestObject.SetExtended ( Value : Extended );
begin
FExtended:=Value;
end;
Procedure TMyTestObject.SetAnsiString ( Value : AnsiString );
begin
FAnsiString:=Value;
end;
Procedure TMyTestObject.SetMyEnum ( Value : TMyEnum );
begin
FMyEnum:=Value;
end;
Function TMyTestObject.GetVirtualBoolean : boolean;
begin
Result:=FBoolean;
end;
Function TMyTestObject.GetVirtualByte : Byte;
begin
Result:=FByte;
end;
Function TMyTestObject.GetVirtualChar : Char;
begin
Result:=FChar;
end;
Function TMyTestObject.GetVirtualWord : Word;
begin
Result:=FWord;
end;
Function TMyTestObject.GetVirtualInteger : Integer;
begin
Result:=FInteger;
end;
Function TMyTestObject.GetVirtualLongint : Longint;
begin
Result:=FLongint;
end;
Function TMyTestObject.GetVirtualCardinal : Cardinal;
begin
Result:=FCardinal;
end;
Function TMyTestObject.GetVirtualReal : Real;
begin
Result:=FReal;
end;
Function TMyTestObject.GetVirtualExtended : Extended;
begin
Result:=FExtended;
end;
Function TMyTestObject.GetVirtualAnsiString : AnsiString;
begin
Result:=FAnsiString;
end;
Function TMyTestObject.GetVirtualMyEnum : TMyEnum;
begin
Result:=FMyEnum;
end;
Procedure TMyTestObject.SetVirtualboolean ( Value : boolean );
begin
Fboolean:=Value;
end;
Procedure TMyTestObject.SetVirtualByte ( Value : Byte );
begin
FByte:=Value;
end;
Procedure TMyTestObject.SetVirtualChar ( Value : Char );
begin
FChar:=Value;
end;
Procedure TMyTestObject.SetVirtualWord ( Value : Word );
begin
FWord:=Value;
end;
Procedure TMyTestObject.SetVirtualInteger ( Value : Integer );
begin
FInteger:=Value;
end;
Procedure TMyTestObject.SetVirtualLongint ( Value : Longint );
begin
FLongint:=Value;
end;
Procedure TMyTestObject.SetVirtualCardinal ( Value : Cardinal );
begin
FCardinal:=Value;
end;
Procedure TMyTestObject.SetVirtualReal ( Value : Real );
begin
FReal:=Value;
end;
Procedure TMyTestObject.SetVirtualExtended ( Value : Extended );
begin
FExtended:=Value;
end;
Procedure TMyTestObject.SetVirtualAnsiString ( Value : AnsiString );
begin
FAnsiString:=Value;
end;
Procedure TMyTestObject.SetVirtualMyEnum ( Value : TMyEnum );
begin
FMyEnum:=Value;
end;
Function TMyTestObject.GetStaticStored : Boolean;
begin
Result:=False;
end;
Function TMyTestObject.GetVirtualStored : Boolean;
begin
Result:=False;
end;
Procedure TMyTestObject.Notify;
begin
If Assigned(FNotifyEvent) then
FNotifyEvent(Self)
else
Writeln('Error : No notifyevent assigned');
end;
Procedure PrintObject ( Obj: TMyTestObject);
begin
With Obj do
begin
Writeln ('Field properties :');
Writeln ('Property booleanField : ',booleanField);
Writeln ('Property ByteField : ',ByteField);
Writeln ('Property CharField : ',CharField);
Writeln ('Property WordField : ',WordField);
Writeln ('Property IntegerField : ',IntegerField);
Writeln ('Property LongintField : ',LongintField);
Writeln ('Property CardinalField : ',CardinalField);
Writeln ('Property RealField : ',RealField);
Writeln ('Property ExtendedField : ',ExtendedFIeld);
Writeln ('Property AnsiStringField : ',AnsiStringField);
Writeln ('Property MyEnumField : ',ord(MyEnumField));
Writeln ('Method properties :');
Writeln ('Property booleanMethod : ',BooleanMethod);
Writeln ('Property ByteMethod : ',ByteMethod);
Writeln ('Property CharMethod : ',CharMethod);
Writeln ('Property WordMethod : ',WordMethod);
Writeln ('Property IntegerMethod : ',IntegerMethod);
Writeln ('Property LongintMethod : ',LongintMethod);
Writeln ('Property CardinalMethod : ',CardinalMethod);
Writeln ('Property RealMethod : ',RealMethod);
Writeln ('Property ExtendedMethod : ',ExtendedMethod);
Writeln ('Property AnsiStringMethod : ',AnsiStringMethod);
Writeln ('Property MyEnumMethod : ',ord(MyEnumMethod));
Writeln ('VirtualMethod properties :');
Writeln ('Property booleanVirtualMethod : ',BooleanVirtualMethod);
Writeln ('Property ByteVirtualMethod : ',ByteVirtualMethod);
Writeln ('Property CharVirtualMethod : ',CharVirtualMethod);
Writeln ('Property WordVirtualMethod : ',WordVirtualMethod);
Writeln ('Property IntegerVirtualMethod : ',IntegerVirtualMethod);
Writeln ('Property LongintVirtualMethod : ',LongintVirtualMethod);
Writeln ('Property CardinalVirtualMethod : ',CardinalVirtualMethod);
Writeln ('Property RealVirtualMethod : ',RealVirtualMethod);
Writeln ('Property ExtendedVirtualMethod : ',ExtendedVirtualMethod);
Writeln ('Property AnsiStringVirtualMethod : ',AnsiStringVirtualMethod);
Writeln ('Property MyEnumVirtualMethod : ',ord(MyEnumVirtualMethod));
end;
end;
Procedure DumpMem ( PL : PByte );
Var I,j : longint;
begin
For I:=1 to 16 do
begin
Write ((I-1)*16:3,' :');
For J:=1 to 10 do
begin
If (PL^>31) and (PL^<129) then
Write(' ',CHar(PL^))
else
Write (PL^:3);
Write (' ');
inc(pl);
end;
writeln;
end;
end;
Function ProcType (PP : Byte) : String;
begin
Case PP and 3 of
ptfield : Result:='from Field';
ptstatic : Result:='with static method';
ptVirtual : Result:='with virtual method';
ptconst : Result:='with Const';
end;
end;
end.

191
docs/typinfex/trtti1.pp Normal file
View File

@ -0,0 +1,191 @@
Program trtti1;
{$Mode Delphi}
{$M+}
Uses
Rttiobj,Typinfo;
Procedure DumpMem ( PL : PByte );
Var I,j : longint;
begin
For I:=1 to 16 do
begin
Write ((I-1)*16:3,' :');
For J:=1 to 10 do
begin
If (PL^>31) and (PL^<129) then
Write(' ',CHar(PL^))
else
Write (PL^:3);
Write (' ');
inc(pl);
end;
writeln;
end;
end;
Function ProcType (PP : Byte) : String;
begin
Case PP and 3 of
ptfield : Result:='from Field';
ptstatic : Result:='with static method';
ptVirtual : Result:='with virtual method';
ptconst : Result:='with Const';
end;
end;
Procedure DumpTypeInfo (O : TMyTestObject);
Var
PT : PTypeData;
PI : PTypeInfo;
I : Longint;
PP : PPropList;
begin
PI:=O.ClassInfo;
Writeln ('Type kind : ',TypeNames[PI^.Kind]);
Writeln ('Type name : ',PI^.Name);
PT:=GetTypeData(PI);
//DumpMem(PByte(PI));
If PT^.ParentInfo=Nil then
Writeln ('Object has no parent info')
else
Writeln ('Object has parent info');
Writeln ('Property Count : ',PT^.PropCount);
Writeln ('Unit name : ',PT^.UnitName);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
If PP^[i]<>Nil then
With PP^[I]^ do
begin
Writeln ('Property name : ',Name);
Writeln (' Type kind: ',TypeNames[PropType^.Kind]);
Writeln (' Type Name: ',PropType^.Name);
If GetProc=Nil then Write ('No');
Writeln (' Getproc available');
If SetProc=Nil then Write ('No');
Writeln (' Setproc available');
If StoredProc=Nil then Write ('No');
Writeln (' Storedproc available');
Writeln (' Get property ',proctype(Propprocs));
Writeln (' Set Property ',proctype(propprocs shr 2));
Writeln (' Stored Property ',proctype(propprocs shr 4));
Writeln (' Default : ',Default,' Index : ',Index);
Writeln (' NameIndex : ',NameIndex);
end;
end;
Procedure PrintObject ( Obj: TMyTestObject);
begin
With Obj do
begin
Writeln ('Field properties :');
Writeln ('Property booleanField : ',booleanField);
Writeln ('Property ByteField : ',ByteField);
Writeln ('Property CharField : ',CharField);
Writeln ('Property WordField : ',WordField);
Writeln ('Property IntegerField : ',IntegerField);
Writeln ('Property LongintField : ',LongintField);
Writeln ('Property CardinalField : ',CardinalField);
Writeln ('Property RealField : ',RealField);
Writeln ('Property ExtendedField : ',ExtendedFIeld);
Writeln ('Property AnsiStringField : ',AnsiStringField);
Writeln ('Property MyEnumField : ',ord(MyEnumField));
Writeln ('Method properties :');
Writeln ('Property booleanMethod : ',BooleanMethod);
Writeln ('Property ByteMethod : ',ByteMethod);
Writeln ('Property CharMethod : ',CharMethod);
Writeln ('Property WordMethod : ',WordMethod);
Writeln ('Property IntegerMethod : ',IntegerMethod);
Writeln ('Property LongintMethod : ',LongintMethod);
Writeln ('Property CardinalMethod : ',CardinalMethod);
Writeln ('Property RealMethod : ',RealMethod);
Writeln ('Property ExtendedMethod : ',ExtendedMethod);
Writeln ('Property AnsiStringMethod : ',AnsiStringMethod);
Writeln ('Property MyEnumMethod : ',ord(MyEnumMethod));
Writeln ('VirtualMethod properties :');
Writeln ('Property booleanVirtualMethod : ',BooleanVirtualMethod);
Writeln ('Property ByteVirtualMethod : ',ByteVirtualMethod);
Writeln ('Property CharVirtualMethod : ',CharVirtualMethod);
Writeln ('Property WordVirtualMethod : ',WordVirtualMethod);
Writeln ('Property IntegerVirtualMethod : ',IntegerVirtualMethod);
Writeln ('Property LongintVirtualMethod : ',LongintVirtualMethod);
Writeln ('Property CardinalVirtualMethod : ',CardinalVirtualMethod);
Writeln ('Property RealVirtualMethod : ',RealVirtualMethod);
Writeln ('Property ExtendedVirtualMethod : ',ExtendedVirtualMethod);
Writeln ('Property AnsiStringVirtualMethod : ',AnsiStringVirtualMethod);
Writeln ('Property MyEnumVirtualMethod : ',ord(MyEnumVirtualMethod));
end;
end;
Procedure TestGet (O : TMyTestObject);
Var
PT : PTypeData;
PI : PTypeInfo;
I,J : Longint;
PP : PPropList;
prI : PPropInfo;
begin
PI:=O.ClassInfo;
Writeln ('Type kind : ',TypeNames[PI^.Kind]);
Writeln ('Type name : ',PI^.Name);
PT:=GetTypeData(PI);
If PT^.ParentInfo=Nil then
Writeln ('Object has no parent info')
else
Writeln ('Object has parent info');
Writeln ('Property Count : ',PT^.PropCount);
Writeln ('Unit name : ',PT^.UnitName);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
begin
pri:=PP^[i];
With Pri^ do
begin
Write ('(Examining ',name,' : Type : ',TypeNames[PropType^.Kind],', ');
If (Proptype^.kind in Ordinaltypes) Then
begin
J:=GetOrdProp(O,pri);
Write ('Value : ',j);
If PropType^.Kind=tkenumeration then
Write ('(=',GetEnumName(Proptype,J),')')
end
else
Case pri^.proptype^.kind of
tkfloat : begin
Write ('Value : ');
Flush(output);
Write(GetFloatProp(O,pri))
end;
tkAstring : begin
Write ('value : ');
flush (output);
Write(GetStrProp(O,Pri));
end;
else
Write ('Untested type:',ord(pri^.proptype^.kind));
end;
Writeln (')');
end;
end;
end;
Var O : TMyTestObject;
begin
O:=TMyTestObject.Create;
DumpTypeInfo(O);
PrintObject(O);
testget(o);
end.

110
docs/typinfex/trtti2.pp Normal file
View File

@ -0,0 +1,110 @@
Program trtti1;
{$Mode Delphi}
{$M+}
Uses
Rttiobj,Typinfo;
Procedure TestGetPropInfo (O : TMyTestObject);
Const YesNo : Array[Boolean] of string[5] = (' NO ',' YES');
Var
PT : PTypeData;
PI : PTypeInfo;
I : Longint;
PP : PPropList;
begin
PI:=O.ClassInfo;
Writeln ('Type kind : ',TypeNames[PI^.Kind]);
Writeln ('Type name : ',PI^.Name);
PT:=GetTypeData(PI);
If PT^.ParentInfo=Nil then
Writeln ('Object has no parent info')
else
Writeln ('Object has parent info');
Writeln ('Property Count : ',PT^.PropCount);
Writeln ('Unit name : ',PT^.UnitName);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
If PP^[i]<>Nil then
With PP^[I]^ do
begin
Write('Property: ',Name:26,' (');
Write(YesNo[GetPropInfo(PI,Name)=PP^[i]]);
Write(YesNo[GetPropInfo(O,Name)=PP^[I]]);
Write(YesNo[GetPropInfo(O.ClassType,Name)=PP^[I]]);
Write(YesNo[GetPropInfo(PI,Name,tkProperties)=PP^[i]]);
Write(YesNo[GetPropInfo(O,Name,tkProperties)=PP^[I]]);
Write(YesNo[GetPropInfo(O.ClassType,Name,tkProperties)=PP^[I]]);
Write(YesNo[FindPropInfo(O,Name)=PP^[I]]);
Write(YesNo[FindPropInfo(O.ClassType,Name)=PP^[I]]);
Writeln(')')
end;
end;
Procedure TestGet (O : TMyTestObject);
Var
PT : PTypeData;
PI : PTypeInfo;
I,J : Longint;
PP : PPropList;
prI : PPropInfo;
begin
PI:=O.ClassInfo;
Writeln ('Type kind : ',TypeNames[PI^.Kind]);
Writeln ('Type name : ',PI^.Name);
PT:=GetTypeData(PI);
If PT^.ParentInfo=Nil then
Writeln ('Object has no parent info')
else
Writeln ('Object has parent info');
Writeln ('Property Count : ',PT^.PropCount);
Writeln ('Unit name : ',PT^.UnitName);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
begin
pri:=PP^[i];
With Pri^ do
begin
Write ('(Examining ',name,' : Type : ',TypeNames[PropType^.Kind],', ');
If (Proptype^.kind in Ordinaltypes) Then
begin
J:=GetOrdProp(O,pri);
Write ('Value : ',j);
If PropType^.Kind=tkenumeration then
Write ('(=',GetEnumName(Proptype,J),')')
end
else
Case pri^.proptype^.kind of
tkfloat : begin
Write ('Value : ');
Flush(output);
Write(GetFloatProp(O,pri))
end;
tkAstring : begin
Write ('value : ');
flush (output);
Write(GetStrProp(O,Pri));
end;
else
Write ('Untested type:',ord(pri^.proptype^.kind));
end;
Writeln (')');
end;
end;
end;
Var O : TMyTestObject;
begin
O:=TMyTestObject.Create;
TestGetPropInfo(O);
// testget(o);
end.

92
docs/typinfex/trtti3.pp Normal file
View File

@ -0,0 +1,92 @@
Program trtti1;
{$Mode Delphi}
{$M+}
Uses
Rttiobj,Typinfo;
Procedure TestGet (O : TMyTestObject);
begin
// PI:=O.ClassInfo;
With O do
begin
Writeln ('Field properties :');
Write ('Property booleanField : ',BooleanField,' : ');
Writeln(Ord(booleanField)=GetOrdProp(O,'booleanfield'));
Write ('Property ByteField : ',ByteField,' : ');
Writeln(ByteField=GetOrdProp(O,'bytefield'));
Write ('Property CharField : ',CharField,' : ');
Writeln(Ord(CharField)=GetOrdProp(O,'charfield'));
Write ('Property WordField : ',WordField,' : ');
Writeln(WordField=GetOrdProp(O,'wordfield'));
Write ('Property IntegerField : ',IntegerField,' : ');
Writeln(IntegerField=GetOrdProp(O,'integerfield'));
Write ('Property LongintField : ',LongintField,' : ');
Writeln(LongIntField=GetOrdProp(O,'longintfield'));
Write ('Property CardinalField : ',CardinalField,' : ');
Writeln(CardinalField=GetOrdProp(O,'Cardinalfield'));
Write ('Property RealField : ',RealField,' : ');
Writeln(RealField=GetFloatProp(O,'RealField'));
Write ('Property ExtendedField : ',ExtendedFIeld,' : ');
Writeln(ExtendedField=GetFloatProp(O,'ExtendedField'));
Write ('Property AnsiStringField : ',AnsiStringField,' : ');
Writeln(AnsiStringField=GetStrProp(O,'AnsiStringField'));
Write ('Property MyEnumField : ',ord(MyEnumField),' : ');
Writeln (GetEnumProp(O,'myEnumField'));
Writeln ('Method properties :');
Write ('Property booleanMethod : ',BooleanMethod,' : ');
Writeln(Ord(booleanMethod)=GetOrdProp(O,'booleanMethod'));
Write ('Property ByteMethod : ',ByteMethod,' : ');
Writeln(ByteMethod=GetOrdProp(O,'byteMethod'));
Write ('Property CharMethod : ',CharMethod,' : ');
Writeln(Ord(CharMethod)=GetOrdProp(O,'charMethod'));
Write ('Property WordMethod : ',WordMethod,' : ');
Writeln(WordMethod=GetOrdProp(O,'wordMethod'));
Write ('Property IntegerMethod : ',IntegerMethod,' : ');
Writeln(IntegerMethod=GetOrdProp(O,'integerMethod'));
Write ('Property LongintMethod : ',LongintMethod,' : ');
Writeln(LongIntMethod=GetOrdProp(O,'longintMethod'));
Write ('Property CardinalMethod : ',CardinalMethod,' : ');
Writeln(CardinalMethod=GetOrdProp(O,'CardinalMethod'));
Write ('Property RealMethod : ',RealMethod,' : ');
Writeln(RealMethod=GetFloatProp(O,'RealMethod'));
Write ('Property ExtendedMethod : ',ExtendedMethod,' : ');
Writeln(ExtendedMethod=GetFloatProp(O,'ExtendedMethod'));
Write ('Property AnsiStringMethod : ',AnsiStringMethod,' : ');
Writeln(AnsiStringMethod=GetStrProp(O,'AnsiStringMethod'));
Write ('Property MyEnumMethod : ',ord(MyEnumMethod),' : ');
Writeln (GetEnumProp(O,'myEnumMethod'));
Writeln ('VirtualMethod properties :');
Write ('Property booleanVirtualMethod : ',BooleanVirtualMethod,' : ');
Writeln(Ord(booleanVirtualMethod)=GetOrdProp(O,'booleanVirtualMethod'));
Write ('Property ByteVirtualMethod : ',ByteVirtualMethod,' : ');
Writeln(ByteVirtualMethod=GetOrdProp(O,'byteVirtualMethod'));
Write ('Property CharVirtualMethod : ',CharVirtualMethod,' : ');
Writeln(Ord(CharVirtualMethod)=GetOrdProp(O,'charVirtualMethod'));
Write ('Property WordVirtualMethod : ',WordVirtualMethod,' : ');
Writeln(WordVirtualMethod=GetOrdProp(O,'wordVirtualMethod'));
Write ('Property IntegerVirtualMethod : ',IntegerVirtualMethod,' : ');
Writeln(IntegerVirtualMethod=GetOrdProp(O,'integerVirtualMethod'));
Write ('Property LongintVirtualMethod : ',LongintVirtualMethod,' : ');
Writeln(LongIntVirtualMethod=GetOrdProp(O,'longintVirtualMethod'));
Write ('Property CardinalVirtualMethod : ',CardinalVirtualMethod,' : ');
Writeln(CardinalVirtualMethod=GetOrdProp(O,'CardinalVirtualMethod'));
Write ('Property RealVirtualMethod : ',RealVirtualMethod,' : ');
Writeln(RealVirtualMethod=GetFloatProp(O,'RealVirtualMethod'));
Write ('Property ExtendedVirtualMethod : ',ExtendedVirtualMethod,' : ');
Writeln(ExtendedVirtualMethod=GetFloatProp(O,'ExtendedVirtualMethod'));
Write ('Property AnsiStringVirtualMethod : ',AnsiStringVirtualMethod,' : ');
Writeln(AnsiStringVirtualMethod=GetStrProp(O,'AnsiStringVirtualMethod'));
Write ('Property MyEnumVirtualMethod : ',ord(MyEnumVirtualMethod),' : ');
Writeln (GetEnumProp(O,'myEnumVirtualMethod'));
end;
end;
Var O : TMyTestObject;
begin
O:=TMyTestObject.Create;
testget(o);
end.