Получить информацию о методах

Автор: Xavier Pacheco

unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, DBClient, MidasCon, MConnect;
type
TMainForm = class(TForm)
lbSampMethods: TListBox;
lbMethodInfo: TMemo;
lblBasicMethodInfo: TLabel;
procedure FormCreate(Sender: TObject);
procedure lbSampMethodsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
uses TypInfo, DBTables, Provider;
{$R *.DFM}
type
// It is necessary to redefine this record as it is commented out in
// typinfo.pas.
PParamRecord = ^TParamRecord;
TParamRecord = record
Flags: TParamFlags;
ParamName: ShortString;
TypeName: ShortString;
end;
procedure GetBaseMethodInfo(ATypeInfo: PTypeInfo; AStrings: TStrings);
{ This method obtains some basic RTTI data from the TTypeInfo and adds that
information to the AStrings parameter. }
var
MethodTypeData: PTypeData;
EnumName: string;
begin
MethodTypeData := GetTypeData(ATypeInfo);
with AStrings do
begin
Add(Format('Class Name:     %s', [ATypeInfo^.Name]));
EnumName := GetEnumName(TypeInfo(TTypeKind), Integer(ATypeInfo^.Kind));
Add(Format('Kind:           %s', [EnumName]));
Add(Format('Num Parameters: %d', [MethodTypeData.ParamCount]));
end;
end;
procedure GetMethodDefinition(ATypeInfo: PTypeInfo; AStrings: TStrings);
{ This method retrieves the property info on a method pointer. We use this
information to recunstruct the method definition. }
var
MethodTypeData: PTypeData;
MethodDefine: string;
ParamRecord: PParamRecord;
TypeStr: ^ShortString;
ReturnStr: ^ShortString;
i: integer;
begin
MethodTypeData := GetTypeData(ATypeInfo);
// Determine the type of method
case MethodTypeData.MethodKind of
mkProcedure: MethodDefine := 'procedure ';
mkFunction: MethodDefine := 'function ';
mkConstructor: MethodDefine := 'constructor ';
mkDestructor: MethodDefine := 'destructor ';
mkClassProcedure: MethodDefine := 'class procedure ';
mkClassFunction: MethodDefine := 'class function ';
end;
// point to the first parameter
ParamRecord := @MethodTypeData.ParamList;
i := 1; // first parameter
// loop through the method's parameters and add them to the string list as
// they would be normally defined.
while i <= MethodTypeData.ParamCount do
begin
if i = 1 then
MethodDefine := MethodDefine + '(';
if pfVar in ParamRecord.Flags then
MethodDefine := MethodDefine + ('var ');
if pfconst in ParamRecord.Flags then
MethodDefine := MethodDefine + ('const ');
if pfArray in ParamRecord.Flags then
MethodDefine := MethodDefine + ('array of ');
//  we won't do anything for the pfAddress but know that the Self parameter
//  gets passed with this flag set.
{
if pfAddress in ParamRecord.Flags then
MethodDefine := MethodDefine+('*address* ');
}
if pfout in ParamRecord.Flags then
MethodDefine := MethodDefine + ('out ');
// Use pointer arithmetic to get the type string for the parameter.
TypeStr := Pointer(Integer(@ParamRecord^.ParamName) +
Length(ParamRecord^.ParamName) + 1);
MethodDefine := Format('%s%s: %s', [MethodDefine, ParamRecord^.ParamName,
TypeStr^]);
inc(i); // Increment the counter.
// Go the next parameter. Notice that use of pointer arithmetic to
// get to the appropriate location of the next parameter.
ParamRecord := PParamRecord(Integer(ParamRecord) + SizeOf(TParamFlags) +
(Length(ParamRecord^.ParamName) + 1) + (Length(TypeStr^) + 1));
// if there are still parameters then setup
if i <= MethodTypeData.ParamCount then
begin
MethodDefine := MethodDefine + '; ';
end
else
MethodDefine := MethodDefine + ')';
end;
// If the method type is a function, it has a return value. This is also
// placed in the method definition string. The return value will be at the
// location following the last parameter.
if MethodTypeData.MethodKind = mkFunction then
begin
ReturnStr := Pointer(ParamRecord);
MethodDefine := Format('%s: %s;', [MethodDefine, ReturnStr^])
end
else
MethodDefine := MethodDefine + ';';
// finally, add the string to the listbox.
with AStrings do
begin
Add(MethodDefine)
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
{ Add some method types to the list box. Also, store the pointer to the RTTI
data in listbox's Objects array }
with lbSampMethods.Items do
begin
AddObject('TNotifyEvent', TypeInfo(TNotifyEvent));
AddObject('TMouseEvent', TypeInfo(TMouseEvent));
AddObject('TBDECallBackEvent', TypeInfo(TBDECallBackEvent));
AddObject('TDataRequestEvent', TypeInfo(TDataRequestEvent));
AddObject('TGetModuleProc', TypeInfo(TGetModuleProc));
AddObject('TReaderError', TypeInfo(TReaderError));
end;
end;
procedure TMainForm.lbSampMethodsClick(Sender: TObject);
begin
lbMethodInfo.Lines.Clear;
with lbSampMethods do
begin
GetBaseMethodInfo(PTypeInfo(Items.Objects[ItemIndex]), lbMethodInfo.Lines);
GetMethodDefinition(PTypeInfo(Items.Objects[ItemIndex]),
lbMethodInfo.Lines);
end;
end;
end.

Далее: Получить информацию о перечисляемых типах »»