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.