unit MethForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, TypInfo, ExtCtrls;
type
TForm1 = class(TForm)
Listbox1: TListBox;
ListBox2: TListBox;
Splitter1: TSplitter;
procedure Listbox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
public
procedure AddType (pti: PTypeInfo);
end;
procedure ShowMethod (pti: PTypeInfo; sList: TStrings);
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Listbox1Click(Sender: TObject);
var
pti: PTypeInfo;
begin
pti := PTypeInfo (ListBox1.Items.Objects [
Listbox1.ItemIndex]);
ListBox2.Items.Clear;
ShowMethod (pti, ListBox2.Items);
end;
type
TParamData = record
Flags: TParamFlags;
ParamName: ShortString;
TypeName: ShortString;
// beware: string length varies!!!
end;
PParamData = ^TParamData;
// show RTTI information for method pointers
procedure ShowMethod (pti: PTypeInfo; sList: TStrings);
var
ptd: PTypeData;
pParam: PParamData;
nParam: Integer;
Line: string;
pTypeString, pReturnString: ^ShortString;
begin
// protect against misuse
if pti^.Kind <> tkMethod then
raise Exception.Create ('Invalid type information');
// get a pointer to the TTypeData structure
ptd := GetTypeData (pti);
// 1: access the TTypeInfo structure
sList.Add ('Type Name: ' + pti^.Name);
sList.Add ('Type Kind: ' + GetEnumName (
TypeInfo (TTypeKind),
Integer (pti^.Kind)));
// 2: access the TTypeData structure
sList.Add ('Method Kind: ' + GetEnumName (
TypeInfo (TMethodKind),
Integer (ptd^.MethodKind)));
sList.Add ('Number of parameters: ' +
IntToStr (ptd^.ParamCount));
// 3: access to the ParamList
// get the initial pointer and
// reset the parameters counter
pParam := PParamData (@(ptd^.ParamList));
nParam := 1;
// loop until all parameters are done
while nParam <= ptd^.ParamCount do
begin
// read the information
Line := 'Param ' + IntToStr (nParam) + ' > ';
// add type of parameter
if pfVar in pParam^.Flags then
Line := Line + 'var ';
if pfConst in pParam^.Flags then
Line := Line + 'const ';
if pfOut in pParam^.Flags then
Line := Line + 'out ';
// get the parameter name
Line := Line + pParam^.ParamName + ': ';
// one more type of parameter
if pfArray in pParam^.Flags then
Line := Line + ' array of ';
// the type name string must be located...
// moving a pointer past the params and
// the string (including its size byte)
pTypeString := Pointer (Integer (pParam) +
sizeof (TParamFlags) +
Length (pParam^.ParamName) + 1);
// add the type name
Line := Line + pTypeString^;
// finally, output the string
sList.Add (Line);
// move the pointer to the next structure,
// past the two strings (including size byte)
pParam := PParamData (Integer (pParam) +
sizeof (TParamFlags) +
Length (pParam^.ParamName) + 1 +
Length (pTypeString^) + 1);
// increase the parameters counter
Inc (nParam);
end;
// show the return type if a function
if ptd^.MethodKind = mkFunction then
begin
// at the end, instead of a param data,
// there is the return string
pReturnString := Pointer (pParam);
sList.Add ('Returns > ' + pReturnString^);
end;
end;
procedure TForm1.AddType (pti: PTypeInfo);
begin
ListBox1.Items.AddObject(pti^.Name, TObject (pti))
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AddType (TypeInfo (TNotifyEvent));
AddType (TypeInfo (TFindMethodEvent));
AddType (TypeInfo (THelpEvent));
AddType (TypeInfo (TSetNameEvent));
AddType (TypeInfo (TDragDropEvent));
AddType (TypeInfo (TDrawItemEvent));
AddType (TypeInfo (TMeasureItemEvent));
AddType (TypeInfo (TScrollEvent));
AddType (TypeInfo (TDragOverEvent));
AddType (TypeInfo (TEndDragEvent));
AddType (TypeInfo (TKeyEvent));
AddType (TypeInfo (TKeyPressEvent));
AddType (TypeInfo (TMouseEvent));
AddType (TypeInfo (TMouseMoveEvent));
AddType (TypeInfo (TStartDragEvent));
AddType (TypeInfo (TCloseEvent));
AddType (TypeInfo (TCloseQueryEvent));
AddType (TypeInfo (TExceptionEvent));
AddType (TypeInfo (TIdleEvent));
AddType (TypeInfo (TMessageEvent));
AddType (TypeInfo (TShowHintEvent));
end;
end.
|
Получить список событий и их описание
