Форум: "Потрепаться";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Вниз

задачка   Найти похожие ветки 

← →
Vuk ©   (2004-04-20 15:38) [80]

to Игорь Шевченко ©   (20.04.04 15:31) [78]:
>А параметры ? :))))
Если мне мой склероз не изменяет, нету их тама. :o)
Параметры методов, как они объявлены, можно вытащить только для RTTI-enabled интерфейсов начиная с D6.

---

← →
Игорь Шевченко ©   (2004-04-20 15:38) [81]

MBo ©   (20.04.04 15:33)

Подобный код я тоже вчера вечером написал, а вот сопоставление TypeData от свойств с конкретными именами/адресами методов у меня не вышло без одного из тех двух способов в [76] :)

---

← →
Игорь Шевченко ©   (2004-04-20 15:42) [82]

Vuk ©   (20.04.04 15:38)


> Параметры методов, как они объявлены


Можно вытащить из TypeInfo/TypeData свойства, как это делает DeDe

---

← →
Vuk ©   (2004-04-20 15:47) [83]

Ну это только по факту привязки метод-свойство выявляется, за счет предположения, что заголовок метода совпадает с заголовком типа для свойства. У интерфейсов можно вытащить вообще все. Я, помнится, чуть ли не исходный текст интерфейса восстанавливал.
:o)

---

← →
Игорь Шевченко ©   (2004-04-20 15:49) [84]

Vuk ©   (20.04.04 15:47)

С интерфейсами я не пробовал, ничего не могу сказать, а вот синтаксис свойства-метода с незапамятных времен в RTTI живет, и даже в TypInfo описан :)

---

← →
Vuk ©   (2004-04-20 15:51) [85]

И я про то, что описаны параметры свойства-метода, но не параметры published метода.

---

← →
Igorek ©   (2004-04-20 16:11) [86]

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
   procedure FormShow1(Sender: TObject);
 private
   procedure FormShow2(Sender: TObject);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}
procedure ListMethods(Cls: TClass; Strings: TStrings);
var
PVMT: Pointer;
i, Num, len: Integer;
MName: string;
begin
if Cls = nil then Exit;
PVMT := Pointer(Cls);
Inc(PByte(PVMT), vmtMethodtable);
PVMT := Pointer(PVMT^);
if PVMT = nil then Exit;
Num := PWord(PVMT)^;
Strings.Add(Format("класс %s, методов: %d ", [Cls.ClassName, Num]));
Inc(PWord(PVMT));
for i := 0 to Num - 1 do begin
  len := PWord(PVMT)^;
  Inc(PByte(PVMT),7);
  SetLength(MName, len - 7);
  Move(PVMT^, MName[1], len - 7);
  Strings.Add(Format("%d: %d %s", [i, len, MName]));
  Inc(PByte(PVMT), len - 7);
end;
ListMethods(Cls.ClassParent, Strings);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 OnShow := FormShow2;
end;

procedure TForm1.FormShow1(Sender: TObject);
begin
//  dummy
end;

procedure TForm1.FormShow2(Sender: TObject);
begin
 ListMethods(TForm1, Memo1.Lines);
end;

end.

Кто что думает насчет этого кода?

---

← →
Igorek ©   (2004-04-20 16:32) [87]

А насчет этого:
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;

type
 TDummy = class(TComponent)
   procedure FormShow1(Sender: TObject);
 end;

 TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
 private
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}
procedure ListMethods(Cls: TClass; Strings: TStrings);
var
PVMT: Pointer;
i, Num, len: Integer;
MName: string;
begin
if Cls = nil then Exit;
PVMT := Pointer(Cls);
Inc(PByte(PVMT), vmtMethodtable);
PVMT := Pointer(PVMT^);
if PVMT = nil then Exit;
Num := PWord(PVMT)^;
Strings.Add(Format("класс %s, методов: %d ", [Cls.ClassName, Num]));
Inc(PWord(PVMT));
for i := 0 to Num - 1 do begin
  len := PWord(PVMT)^;
  Inc(PByte(PVMT),7);
  SetLength(MName, len - 7);
  Move(PVMT^, MName[1], len - 7);
  Strings.Add(Format("%d: %d %s", [i, len, MName]));
  Inc(PByte(PVMT), len - 7);
end;
ListMethods(Cls.ClassParent, Strings);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 with TDummy.Create(Self) do
   OnShow := FormShow1;
end;

{ TDummy }

procedure TDummy.FormShow1(Sender: TObject);
begin
 ListMethods(TForm1, Form1.Memo1.Lines);
end;

end.

---

← →
Игорь Шевченко ©   (2004-04-20 18:18) [88]

Для экземпляра класса что-то получилось - не судите строго:
unit main;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, TypInfo;

type
 TfMain = class(TForm)
   ListBox1: TListBox;
   Button3: TButton;
   procedure Button3Click(Sender: TObject);
 private
   procedure SpyMethods(AClass: TClass; Strings: TStrings);
   procedure SpyRootComponentMethods(AClass: TObject; Strings: TStrings);
   procedure SpyComponentMethods(AClass: TObject; Strings, Methods: TStrings);
   procedure SpyInstanceMethods(AClass: TObject; Strings, Methods: TStrings);
   function ParseMethodProp(AProp: PPropInfo;
     const MethodName: string): string; overload;
   function ParseMethodProp(AProp: PPropInfo): string; overload;
 end;

var
 fMain: TfMain;

implementation
uses
 ChildForm;

{$R *.dfm}

{ TfMain }

type
 TMethodDesc = packed record
   MethodDescSize: Word;
   MethodAddress: Pointer;
   MethodName: ShortString;
 end;
 PMethodDesc = ^TMethodDesc;

 TMethodTable = packed record
   MethodCount: Word;
   Data: TMethodDesc;
 end;
 PMethodTable = ^TMethodTable;
 PPMethodTable = ^PMethodTable;

procedure TfMain.SpyMethods(AClass: TClass; Strings: TStrings);
var
 Methods: PMethodTable;
 MethodDesc: PMethodDesc;
 I: Integer;
begin
 Methods := PPMethodTable(PChar(AClass) + vmtMethodTable)^;
 if Assigned(Methods) then begin
   MethodDesc := @Methods^.Data;
   for I:=0 to Pred(Methods^.MethodCount) do begin
     Strings.AddObject(
       Format("%s.%s", [AClass.ClassName, MethodDesc^.MethodName]),
         TObject(MethodDesc^.MethodAddress));
     MethodDesc := PMethodDesc(PChar(MethodDesc) + MethodDesc^.MethodDescSize);
   end;
 end;
 if AClass.ClassParent <> nil then
   SpyMethods(AClass.ClassParent, Strings);
end;

function MethodKindToString (const Value: TMethodKind): string;
const
 MethodKindNames: array[TMethodKind] of string = ("procedure", "function",
   "constructor", "destructor", "class procedure", "class function",
   "procedure", "function");
begin
 Result := MethodKindNames[Value];
end;

type
 TParamDesc = packed record
   Flags: TParamFlags;
   ParamName: ShortString;
   TypeName: ShortString;
 end;
 PParamDesc = ^TParamDesc;

function TfMain.ParseMethodProp(AProp: PPropInfo;
 const MethodName: string): string;
var
 MethodTypeData: PTypeData;
 ParamCount: Integer;
 ParamDesc: PParamDesc;
 Param, Params: string;
 ResultType: PShortString;
 I: Integer;
 TypeName: PShortString;
begin
 MethodTypeData := GetTypeData(AProp^.PropType^);
 ParamCount := MethodTypeData^.ParamCount;
 ParamDesc := @MethodTypeData^.ParamList;
 ResultType := PShortString(ParamDesc);
 for I:=0 to Pred(ParamCount) do begin
   if pfVar in ParamDesc^.Flags then
     Param := "var "
   else if pfConst in ParamDesc^.Flags then
     Param := "const "
   else
     Param := "";
   TypeName := PShortString(PChar(ParamDesc) + SizeOf(TParamFlags) +
     Length(ParamDesc^.ParamName) + SizeOf(Char));
   if pfArray in ParamDesc^.Flags then
     Param := Param + Format("%s: array of %s", [ParamDesc^.ParamName,
       TypeName^])
   else
     Param := Param + Format("%s: %s", [ParamDesc^.ParamName,
       TypeName^]);
   if I <> 0 then
     Params := Params + "; ";
   Params := Params + Param;
   ParamDesc := PParamDesc(PChar(ParamDesc) + SizeOf(TParamFlags) +
     Length(ParamDesc^.ParamName) + Length(TypeName^) +
     SizeOf(Char) * 2);
   ResultType := PShortString(ParamDesc);
 end;
 if Length(Params) <> 0 then
   Params := "(" + Params + ")";
 if MethodTypeData^.MethodKind in
     [mkFunction, mkClassFunction, mkSafeFunction] then
   Params := Format("%s: %s;", [Params, ResultType^])
 else
   Params := Params + ";";
 if MethodTypeData^.MethodKind in [mkSafeProcedure, mkSafeFunction] then
   Params := Params + "safecall;";
 Result := Format("%s %s: %s", [
   MethodKindToString(MethodTypeData^.MethodKind), MethodName, Params]);
end;

function TfMain.ParseMethodProp(AProp: PPropInfo): string;
begin
 Result := ParseMethodProp(AProp, AProp^.Name);
end;

procedure TfMain.SpyInstanceMethods(AClass: TObject;
 Strings, Methods: TStrings);

 function GetFullMethodName(const Methods: TStrings; Address: Pointer): string;
 var
   I: Integer;
 begin
   for I:=0 to Pred(Methods.Count) do
     if Pointer(Methods.Objects[I]) = Address then begin
       Result := Methods[I];
       Break;
     end;
 end;

var
 Props: TPropList;
 I: Integer;
 NumMethods: Integer;
 Method: TMethod;
 FullMethodName: string;
begin
 NumMethods := GetPropList(AClass.ClassInfo, tkMethods, @Props);
 for I:=0 to Pred(NumMethods) do begin
   Method := GetMethodProp(AClass, Props[I]);
   if Assigned(Method.Code) then begin
     FullMethodName := GetFullMethodName(Methods, Method.Code);
     if Length(FullMethodName) <> 0 then
       Strings.Add (ParseMethodProp(Props[I], FullMethodName));
   end;
 end;
end;

procedure TfMain.Button3Click(Sender: TObject);
var
 Strings: TStrings;
begin
 Strings := TStringList.Create;
 try
   SpyRootComponentMethods(fChild, Strings);
   ListBox1.Items.Assign(Strings);
 finally
   Strings.Free;
 end;
end;

procedure TfMain.SpyComponentMethods(AClass: TObject;
 Strings, Methods: TStrings);
var
 I: Integer;
begin
 SpyInstanceMethods(AClass, Strings, Methods);
 if AClass is TComponent then
   for I:=0 to Pred(TComponent(AClass).ComponentCount) do
     SpyComponentMethods(TComponent(AClass).Components[I], Strings, Methods);
end;

procedure TfMain.SpyRootComponentMethods(AClass: TObject;
 Strings: TStrings);
var
 MethodStrings: TStrings;
begin
 MethodStrings := TStringList.Create;
 try
   SpyMethods(AClass.ClassType, MethodStrings);
   SpyComponentMethods(AClass, Strings, MethodStrings);
 finally
   MethodStrings.Free;
 end;
end;

end.


---

← →
Игорь Шевченко ©   (2004-04-20 18:20) [89]

В проекте созданы три формы: главная (текст в студии),
и две формы для иерархии
unit ChildForm;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, ParentForm, ExtCtrls;

type
 TfChild = class(TfParent)
   Timer: TTimer;
   procedure TimerTimer(Sender: TObject);
 end;

var
 fChild: TfChild;

implementation

{$R *.dfm}

procedure TfChild.TimerTimer(Sender: TObject);
begin
 Beep;
end;

end.


и ее родитель:
unit ParentForm;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TfParent = class(TForm)
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormActivate(Sender: TObject);
 end;

var
 fParent: TfParent;

implementation

{$R *.dfm}

procedure TfParent.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

procedure TfParent.FormActivate(Sender: TObject);
begin
 ShowMessage("I am activated");
end;

end.


Все формы создаются в AutoCreate

---

← →
Игорь Шевченко ©   (2004-04-20 18:21) [90]

Как тоже самое сделать не для экземпляра класса, а для класса, легко и просто - не знаю :)

---

← →
-SeM-   (2004-04-21 09:50) [91]

[88] Игорь Шевченко ©   (20.04.04 18:18)

А может еще добавить?


>  for I:=0 to Pred(ParamCount) do begin
>    if pfVar in ParamDesc^.Flags then
>      Param := "var "
>    else if pfConst in ParamDesc^.Flags then
>      Param := "const "


    if pfOut in ParamDesc^.Flags then
      Param:="out ";


>    else
>      Param := "";

---

← →
Игорь Шевченко ©   (2004-04-21 10:17) [92]

-SeM-   (21.04.04 09:50)

Да, спасибо, можно добавить. Может, я его просмотрел. А вот как отображаются в исходном виде параметры pfAddress и pfReference я даже не представляю :)

---

← →
Igorek ©   (2004-04-21 10:38) [93]

Я тут подумал, что в принципе какая-то логика (хотя и имхо неправильная) в постановке Ю.З. есть. Скажем "вывести все методы класса, которые могут выступать в качестве обработчиков". Вот если в форме есть 100 методов, по сигнатуре подходящих для события напр. OnFormCreate, то все их вывести. Но вы же понимаете что только один в конкретный момент может выступать обработчиком. Более того, строго говоря, даже то что на метод указывает поле, хранящее обработчик, этот метод еще не есть обработчиком. Он станет таковым в момент вызова. А до того момента значение поля может сто раз поменяться (что и было продемонстрировано в приведенном мною коде). :-)

---

← →
-SeM-   (2004-04-21 10:44) [94]

[92] Игорь Шевченко ©   (21.04.04 10:17)
А это где, в интерфейсах?

---

← →
Игорь Шевченко ©   (2004-04-21 10:45) [95]

-SeM-   (21.04.04 10:44)

В описании TParamFlag :)

---

← →
Игорь Шевченко ©   (2004-04-21 10:45) [96]

> Вот если в форме есть 100 методов, по сигнатуре подходящих
> для события напр. OnFormCreate, то все их вывести.


А сигнатуру как узнать ? :))

---

← →
-SeM-   (2004-04-21 10:55) [97]

> [93] Igorek ©   (21.04.04 10:38)


> Он станет таковым в момент вызова.


Правильно, но задача то "строить список вообще любых published-методов. То есть - всех доступных данному классу, включая и унаследованные", как я понимаю, на момент исследования.

---

← →
-SeM-   (2004-04-21 10:57) [98]

> [95] Игорь Шевченко ©   (21.04.04 10:45)

Не, я в смысле используется :)

---

← →
Igorek ©   (2004-04-21 13:01) [99]

> Игорь Шевченко ©   (21.04.04 10:45) [96]
> А сигнатуру как узнать ? :))

 TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
 private
 public
 published
   procedure FormShow1(Sender: TObject);
   procedure FormShow2(Sender: TObject);
   procedure FormShow3(Sender: TObject);
 end;

А потом RTTI, если не ошибаюсь.

---

← →
Игорь Шевченко ©   (2004-04-21 13:55) [100]

Igorek ©   (21.04.04 13:01)

Дело в том, что по условию задачи сигнатура мне неизвестна. Произвольный обработчик может иметь произвольный процедурный тип.

---

← →
Igorek ©   (2004-04-21 14:25) [101]

> Игорь Шевченко ©   (21.04.04 13:55) [100]
> Igorek ©   (21.04.04 13:01)
>
> Дело в том, что по условию задачи сигнатура мне неизвестна.
> Произвольный обработчик может иметь произвольный процедурный
> тип.

Как? Тип обработчика определяется типом события.
Т.е. или нам надо вывести все публикуемые методы данного класса, которые могут выступать в роли обработчиков для событий обьектов данного класса. Или нам надо вывести сигнатуры (без названий методов) обработчиков которые подходят для всех событий (иными словами типы событий).

---

← →
Игорь Шевченко ©   (2004-04-21 14:28) [102]

Igorek ©   (21.04.04 14:25)

Вроде, я попытался решить задачу, правда, с несколько измененными начальными условиями, используя не класс (VMT), а экземпляр класса (TObject). Я не совсем понимаю, какой смысл в дополнениях к условиям ?

---

← →
Igorek ©   (2004-04-21 14:39) [103]

> Игорь Шевченко ©   (21.04.04 14:28) [102]
Я не совсем понимаю, какой смысл в дополнениях
> к условиям ?

Просто я привык перед решением четко сформулировать задачу. Что и стараюсь после вчерашнего (а то остался неприятный осадок, и думаю не только у меня). Без формулировки у меня лично нету ни малейшего желания даже браться за задачу.

---

← →
Юрий Зотов ©   (2004-04-21 15:15) [104]

Все же исходная постановка задачи в [42] была правильной - без привязки к TypeData можно построить список параметров для методов RTTI-интерфейсов (см. [80]), а для методов произвольных объектов, как сказал Игорь, нужно либо сканировать ресурсы ручками, либо создавать экземпляр - иначе привязаться к TypeData и получить параметры не удается.

Тем не менее, обоими методами можно получить решение именно для класса, а не для объекта. Естественно, параметры будут получены только для тех методов, которые в этом классе являются обработчиками событий (о чем, собственно, сразу и говорилось в [42]).

Привожу свое решение для обоих вариантов (переключаются опцией ParseDfmIndirect). Чтобы не загромождать код непринципиальными деталями, сканируются только события самих форм. Опция AutoRegisterForms указывает, должна ли быть использована автоматическая регистрация форм (можно либо отключить эту опцию, либо взять пример кода авторегистрации в "Кладовке").

================ Код см. в продолжении ================

---

← →
Юрий Зотов ©   (2004-04-21 15:16) [105]

================ Продолжение ================

Проект состоит из стандартного DPR, модуля главной формы и трех модулей форм, входящих в иерархию. Модуль главной формы такой:

unit Main;

interface

uses
 Classes, Controls, Forms, StdCtrls;

type
 TAppMainForm = class(TForm)
   ListBox1: TListBox;
   Button1: TButton;
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
 end;

var
 AppMainForm: TAppMainForm;

implementation

{$R *.dfm}

{$DEFINE ParseDfmIndirect}
// {$DEFINE AutoRegisterForms}

uses
 Windows, SysUtils, TypInfo, First, Third,
{$IFDEF AutoRegisterForms}
 ClassReg;
{$ELSE AutoRegisterForms}
 Second;
{$ENDIF AutoRegisterForms}

var
 FormsModule: Cardinal;

procedure GetAllHandlers(Strings: TStrings; AClass: TClass);

 function GetHandlers(Strings: TStrings; AClass: TClass): Boolean;

   procedure IncPtr(var P: Pointer; Value: integer);
   begin { IncPtr }
     P := Pointer(Integer(P) + Value)
   end; { IncPtr }

   function ExtractShortString(var P: Pointer): string;
   begin { GetShortString }
     Result := ShortString(P^);
     IncPtr(P, Byte(P^) + 1)
   end; { GetShortString }

   function GetMethodParams(MethodName: string; AClass: TClass): string;

{$IFDEF ParseDfmIndirect}
     function GetHandlerName(PropName: string; AClass: TClass): string;
     var
       ResourceStream: TResourceStream;
       StringStream: TStringStream;
       Fmt: TStreamOriginalFormat;
       i: integer;
     begin
       Result := "";
       if (AClass = nil) or (FindResource(FormsModule, PChar(AClass.ClassName + #0), RT_RCDATA) = 0) then
         Exit;
       StringStream := TStringStream.Create("");
       try
         ResourceStream := TResourceStream.Create(FormsModule, AClass.ClassName, RT_RCDATA);
         try
           Fmt := sofText;
           ObjectResourceToText(ResourceStream, StringStream, Fmt)
         finally
           ResourceStream.Free
         end;
         i := Length(PropName) + 2;
         with StringStream do
         begin
           Position := Pos(PropName, DataString) + i;
           if Position > i then
           begin
             i := Position;
             while DataString[i] in ["_", "0".."9", "A".."Z", "a".."z"] do Inc(i);
             Result := Copy(DataString, Position, i - Position)
           end
           else Result := GetHandlerName(PropName, AClass.ClassParent)
         end
       finally
         StringStream.Free
       end
     end;
{$ELSE ParseDfmIndirect}
     function GetHandlerAddress(PropInfo: PPropInfo): Pointer;
     var
       Component: TComponent;
     begin { GetHandlerAddress }
       Component := ReadComponentRes(AClass.ClassName, nil);
       try
         Result := GetMethodProp(Component, PropInfo).Code
       finally
         Component.Free
       end
     end; { GetHandlerAddress }
{$ENDIF ParseDfmIndirect}
   var
     PropList: PPropList;
     PropCount, i, ParamCount, j: integer;
     P: Pointer;
   begin { GetMethodParams }
     Result := "";
     PropCount := GetPropList(AClass.ClassInfo, tkMethods, nil);
     if PropCount = 0 then Exit;
     GetMem(PropList, PropCount * SizeOf(PPropInfo));
     try
       GetPropList(AClass.ClassInfo, tkMethods, PropList);
       for i := 0 to PropCount - 1 do
{$IFDEF ParseDfmIndirect}
         if SameText(MethodName, GetHandlerName(PropList^[i].Name, AClass)) then
{$ELSE ParseDfmIndirect}
         if AClass.MethodAddress(MethodName) = GetHandlerAddress(PropList^[i]) then
{$ENDIF ParseDfmIndirect}
         begin
           P := GetTypeData(PropList^[i]^.PropType^);
           IncPtr(P, SizeOf(TMethodKind));
           ParamCount := Byte(P^);
           IncPtr(P, 1);
           for j := 0 to ParamCount - 1 do
           begin
             if pfVar in TParamFlags(P^) then
               Result := Result + "var "
             else
               if pfConst in TParamFlags(P^) then
                 Result := Result + "const "
               else
                 if pfOut in TParamFlags(P^) then
                   Result := Result + "out ";
             IncPtr(P, SizeOf(TParamFlags));
             Result := Format("%s%s: %s; ", [Result, ExtractShortString(P), ExtractShortString(P)])
           end;
           SetLength(Result, Length(Result) - 2);
           Exit
         end
     finally
       FreeMem(PropList)
     end
   end; { GetMethodParams }

 var
   P: Pointer;
   MethodCount, i: Word;
   MethodName: string;
 begin { GetHandlers }
   Result := False;
   P := AClass;
   IncPtr(P, vmtMethodTable);
   P := Pointer(P^);
   if P = nil then Exit;
   MethodCount := Word(P^);
   if MethodCount = 0 then Exit else Result := True;
   IncPtr(P, SizeOf(Word));
   for i := 0 to MethodCount - 1 do
   begin
     IncPtr(P, SizeOf(Word) + SizeOf(Pointer));
     MethodName := ExtractShortString(P);
     if Pos(MethodName, Strings.Text) = 0 then
       Strings.Add(Format("%s.%s(%s);", [AClass.ClassName, MethodName,
         GetMethodParams(MethodName, AClass)]))
   end
 end; { GetHandlers }

begin { GetAllHandlers }
 Strings.BeginUpdate;
 try
   Strings.Clear;
   while AClass <> nil do
   begin
     GetHandlers(Strings, AClass);
     AClass := AClass.ClassParent
   end
 finally
   Strings.EndUpdate
 end
end; { GetAllHandlers }

{$IFDEF AutoRegisterForms}
function RegisterForms(AClass: TClass; Data: Pointer): Boolean;
begin
 Result := True;
 if AClass.InheritsFrom(TFirstForm) then Classes.RegisterClass(TPersistentClass(AClass))
end;
{$ENDIF AutoRegisterForms}

{ TForm1 }

procedure TAppMainForm.FormCreate(Sender: TObject);
begin
 FormsModule := FindClassHInstance(TFirstForm);
{$IFDEF AutoRegisterForms}
 EnumClasses(FormsModule, RegisterForms, nil)
{$ELSE AutoRegisterForms}
 RegisterClasses([TFirstForm, TSecondForm, TThirdForm])
{$ENDIF AutoRegisterForms}
end;

procedure TAppMainForm.Button1Click(Sender: TObject);
begin
 GetAllHandlers(ListBox1.Items, TThirdForm)
end;

end.


================ Модули с формами иерархии см. в окончании ================

---

← →
Юрий Зотов ©   (2004-04-21 15:18) [106]

================ Окончание ================

unit First;

interface

uses
 Forms;

type
 TFirstForm = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
 end;

implementation

{$R *.dfm}

procedure TFirstForm.FormCreate(Sender: TObject);
begin
 Width := 500
end;

procedure TFirstForm.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
begin
 Resize := True
end;

end.

unit Second;

interface

uses
 Forms, First;

type
 TSecondForm = class(TFirstForm)
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 end;

implementation

{$R *.dfm}

procedure TSecondForm.FormCreate(Sender: TObject);
begin
 Width := 500
end;

procedure TSecondForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree
end;

end.

unit Third;

interface

uses
 Classes, Forms, Second;

type
 TThirdForm = class(TSecondForm)
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 end;

implementation

{$R *.dfm}

procedure TThirdForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree
end;

procedure TThirdForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 Key := 0
end;

end.


---

← →
Игорь Шевченко ©   (2004-04-21 15:33) [107]

Юрий Зотов ©   (21.04.04 15:16)

Respect!

Про ReadComponentRes я не додумал, спасибо за науку :)

---

← →
euru ©   (2004-04-21 15:58) [108]

Вопрос не по теме, а по коду.

Почему для определения собственных условий компиляции используется конструкция


{$DEFINE condition}

{$IFDEF condition}
{$ENDIF}


вместо


const
  condition = True;

{$IF condition}
{$IFEND}


---

← →
Vuk ©   (2004-04-21 16:20) [109]

to euru ©   (21.04.04 15:58) [108]:
>Почему для определения собственных условий компиляции
>используется конструкция
Потому, что то, что определяется через $DEFINE можно компилятору с командной строки передать.

---

← →
euru ©   (2004-04-21 16:55) [110]

>Vuk ©   (21.04.04 16:20) [109]
А как через командную строку можно определить условие типа

{$IF condition > 5}


---

← →
Игорь Шевченко ©   (2004-04-21 17:05) [111]

euru ©   (21.04.04 16:55)

А у меня компилятор выдает Invalid compiler directive $IF. Отгадайте с трех раз, почему ?

---

← →
Vuk ©   (2004-04-21 17:15) [112]

to euru ©   (21.04.04 16:55) [110]:
>А как через командную строку можно определить условие типа
>{$IF condition > 5}
Для {$IF condition > 5} - никак. Для {$IF Defined(VARIABLE)} и {$IFDEF VARIABLE} - при помощи -D

И вообще, dcc32.exe

---

← →
euru ©   (2004-04-21 17:24) [113]

>Игорь Шевченко ©   (21.04.04 17:05) [111]
Думаю, у вас Delphi v1-v6.

>Игорь Шевченко ©   (21.04.04 17:05) [111]
>Vuk ©   (21.04.04 17:15) [112]
Спасибо за предоставленную информацию.

---

← →
VMcL ©   (2004-04-21 17:32) [114]

>>euru ©  (21.04.04 17:24) [113]

В D6 уже появилась {$IF}.

---

← →
Igorek ©   (2004-04-21 17:45) [115]

2 Юрий Зотов ©   (21.04.04 15:18) [106]

Однако я смотрю этот вопрос для Вас стал принципиальным. :-)
Не умаляя достоинств приведенного кода, позволю себе не согласиться, что это решение задачи в постановке [42]. Там ничего не говорилось про RTTI. Соотв. был и мой пост [53].
Повторю касательно постановки 42. В роли обработчиков могут выступать и не публикуемые методы.
Поймите меня правильно. Я не придираюсь, а просто, отбросив обиды, пытаюсь обьективно найти истину.

---

← →
Игорь Шевченко ©   (2004-04-21 18:00) [116]

> В роли обработчиков могут выступать и не публикуемые методы.


Вот теперь я понял всю глубину задачи:)

Юрий Зотов в задаче и в дополнениях к ней специально сделал акцент на класс, а не на экземпляр. У класса формы в роли обработчиков событий компонент(ов) могут выступать только published-методы.

---

← →
Igorek ©   (2004-04-21 18:30) [117]

> Игорь Шевченко ©   (21.04.04 18:00) [116]
> У класса формы в роли
> обработчиков событий компонент(ов) могут выступать только
> published-методы.

Ты не прав. Не публикуемые методы тоже могут выступать в такой роли. Просто присвоить их событиям можно только динамически.

---

← →
McSimm ©   (2004-04-21 18:34) [118]

> Просто присвоить их событиям можно только динамически.

классу ?

---

← →
Игорь Шевченко ©   (2004-04-21 18:34) [119]

> Просто присвоить их событиям можно только динамически.


Ты сказал (с) Евангелие.

В момент разбора VMT нету экземпляров класса, следовательно о динамическом присвоении речи быть не может :)

---

← →
Игорь Шевченко ©   (2004-04-21 18:37) [120]

Игорь Шевченко ©   (21.04.04 18:34)

Следует читать: При разборе VMT не имеет значения, есть ли экземпляры класса или нет.

---

Страницы: 1 2 3 4 вся ветка

Форум: "Потрепаться";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.73 MB
Время: 0.049 c