// Способ первый
// Второй параметр - класс, на котором следует прервать построение списка.
// Если он навен nil, список строится вплоть до TObject.
function InheritsFromEx(AObject: TObject; AClass: TClass;
  List: TStrings): Pointer;
var
  ClassPtr: Pointer;
  P: Pointer;
begin
  Result := nil;
  List.Clear;
 
  ClassPtr := PPointer(AObject)^;
  while True do
  begin
    if Assigned(List) then
      List.Insert(0, PShortString(PPointer(NativeInt(ClassPtr) + vmtClassName)^)^);
 
    if Assigned(AClass) and (ClassPtr = Pointer(AClass)) then
      Break;
    P := PPointer(NativeInt(ClassPtr) + vmtParent)^;
    if P = nil then
      Break;
    ClassPtr := PPointer(P)^;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStrings;
begin
  List := TStringList.Create;
  InheritsFromEx(Form1, nil, List);
  ShowMessage(List.Text);
  List.Free;
end;

// Способ второй
uses
  RTTI;

procedure TForm1.Button1Click(Sender: TObject);
var
  c: TRttiContext;
  t: TRttiType;
  List: TStrings;
begin
  List := TStringList.Create;
  c := TRttiContext.Create;
  try
    t := c.GetType(TForm1);
    List.Add(t.Name);
    while Assigned(t.BaseType) do
    begin
      t := t.BaseType;
      List.Insert(0, t.Name);
    end;
    ShowMessage(List.Text);
  finally
    c.Free;
    List.Free;
  end;
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
  ClassRef: TClass;
begin
  s := '';
  ClassRef := Sender.ClassType;
  while ClassRef <> nil do
  begin
    s := s + ClassRef.ClassName + #13;
    ClassRef := ClassRef.ClassParent;
  end;
  ShowMessage(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  m: TMethod;
begin
  m := GetMethodProp(Sender, 'OnClick');
  ShowMessage(TObject(m.Data).MethodName(m.Code));
end;

uses
  System.TypInfo;

procedure CheckAllEvents(Comp: TComponent; ssEvents: TStringList);

  procedure CheckEvent(Comp: TComponent);
  var
    i: Integer;
    FList: PPropList;
    FCount: Integer;
    FSize: Integer;
    EventName: string;
  begin
    FCount := GetPropList(Comp.ClassInfo, [tkMethod], nil);
    FSize := FCount * SizeOf(Pointer);
    GetMem(FList, FSize);
    try
      GetPropList(Comp.ClassInfo, [tkMethod], FList);
      for i := 0 to FCount-1 do
        if GetMethodProp(Comp as TObject, FList^[i]).Code <> nil then
        begin
          if Comp is TCustomForm then
            EventName := FList^[i]^.Name
          else
            EventName := Comp.Name + '.' + FList^[i]^.Name;

          ssEvents.Add(EventName);
          //if (Comp.name <> '') and (ssEvents.IndexOf(EventName) = -1) then
          //   raise Exception.Create('Сначала уберите обработчики событий (' + EventName + ')');
        end;
    finally
      FreeMem(FList, FSize);
    end;
  end;

var
  i: Integer;
begin
  CheckEvent(Comp);
  if Comp is TWinControl then
    for i := 0 to (Comp as TWinControl).ControlCount-1 do
      CheckAllEvents((Comp as TWinControl).Controls[i], ssEvents);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    CheckAllEvents(CheckBox1, sl);
    ShowMessage(sl.Text);
  finally
    sl.Free;
  end;
end;

// Можно сделать это используя программу convert.exe, идущую
// в составе RAD Studio, или приведенным ниже способом.

function IsDFMFileBinary(FileDfm: string): Boolean;
var
  Header: TBytes;
  fs: TFileStream;
begin
  if not FileExists(FileDfm) then
    Exit(False);

  fs := TFileStream.Create(FileDfm, fmOpenRead);
  try
    SetLength(Header, 3);
    fs.Read(Header, 3);
    Result := (Header[0] = $FF) and (Header[1] = $A) and (Header[2] = 0);
  finally
    fs.Free;
  end;
end;

function BinaryDFM2String(const FileDfm: string): string;
var
  fs: TFileStream;
  ss: TStringStream;
begin
  if not FileExists(FileDfm) then
    Exit('');

  fs := TFileStream.Create(FileDfm, fmOpenRead);
  ss := TStringStream.Create;

  try
    ObjectResourceToText(fs, ss);
    Result := ss.DataString;
  finally
    ss.Free;
    fs.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FileExists('c:\Unit1.dfm') then
    if IsDFMFileBinary('c:\Unit1.dfm') then
      ShowMessage(BinaryDFM2String('c:\Unit1.dfm'));
end;