задачка

← →
Polevi © (2004-04-19 19:10) [0]

написать ф-ию, возвращающую строку формата ClassName::PublishedProperty по параметру типа TClass

например для TControl должна вернуть
TComponent::Name
TComponent::Tag
TControl::Left
TControl::Top
TControl::Width
TControl::Height
TControl::Cursor
TControl::Hint
TControl::HelpType
TControl::HelpKeyword
TControl::HelpContext

интересено, у кого будет короче код :)

← →
Vuk © (2004-04-19 19:25) [1]

Это... Так функцию, возвращающую строку или функцию, выдающую список строк?

← →
Polevi © (2004-04-19 19:27) [2]

строку с разделителем #13#10

← →
Jack128 © (2004-04-19 19:51) [3]

Примерно так, я думаю:

function GetPropListEx(AClass: TClass): string; var TypeInfo: PTypeInfo; PropList: array[0..100] of PPropInfo; PropCount: Integer; i: Integer; begin Result := ""; TypeInfo := PTypeInfo(AClass.ClassInfo); if not Assigned(TypeInfo) then Exit; PropCount := GetTypeData(TypeInfo)^.PropCount; if PropCount = 0 then Exit; GetPropInfos(TypeInfo, @PropList); Result := ""; for i := 0 to PropCount - 1 do Result := Result + AClass.ClassName + ": " + PropList[i].Name + #13#10; end; function GetAllProps(AClass: TClass): string; var ClassArray: array of TClass; ClassCount: integer; i: Integer; begin SetLength(ClassArray, 10); ClassCount := 0; while Assigned(AClass) do begin if Length(ClassArray) = ClassCount then SetLength(ClassArray, ClassCount + 10); ClassArray[ClassCount] := AClass; AClass := AClass.ClassParent; inc(ClassCount); end; SetLength(ClassArray, ClassCount); Result := ""; for i := Length(ClassArray) - 1 downto 0 do Result := Result + GetPropListEx(ClassArray[i]); end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Lines.Text := GetAllProps(TWinControl); end;

← →
Polevi © (2004-04-19 19:54) [4]

это очень длинно :)

← →
Jack128 © (2004-04-19 19:56) [5]

> [4] Polevi © (19.04.04 19:54)
К тому же не правельно :-(

> это очень длинно :)
А в чем длину оцениваем?? Или это предложение откопать в TypInfo стандартную функцию?

← →
Polevi © (2004-04-19 20:02) [6]

длину оцениваем в строках кода
у меня 13, кто меньше ?
:)

кстати стандартной такой ф-ии я не знаю

← →
Jack128 © (2004-04-19 20:05) [7]

> у меня 13, кто меньше ?
может поспорим, что я смогу ужать этот код до 13 строк???

По 250 символов каждая :-))

← →
VMcL © (2004-04-19 20:06) [8]

>>Polevi © (19.04.04 20:02) [6]

Перепиши все свои 13 строк в одну - будет ваще обалдеть :)

← →
Polevi © (2004-04-19 20:07) [9]

на строке допускается только не более одного знака ";"
:)

← →
VMcL © (2004-04-19 20:09) [10]

>>Polevi © (19.04.04 20:07) [9]

Все равно многие составные операторы можно ужать :)

if a then
b;

меняем на

if a then b;

и т. п.

← →
VMcL © (2004-04-19 20:10) [11]

>>Polevi © (19.04.04 20:07) [9]

В общем, колись давай, а то такой flood разведём :))

← →
Polevi © (2004-04-19 20:15) [12]

ладно, наслаждайтесь :)

function GetPublishedProps(AClass:TClass; var Value:string):integer;
var
Props: PPropList;
i:integer;
begin
if AClass=TObject then exit;
Result:=GetTypeData(AClass.ClassInfo)^.PropCount;
GetMem(Props, Result * sizeof(Pointer));
GetPropInfos(AClass.ClassInfo, Props);
for i := GetPublishedProps(AClass.ClassParent,Value) to Result-1 do
Value:=Value+Format("%s::%s",[AClass.ClassName,PPropInfo(Props^[I]).Name])+#13#10;
FreeMem(Props);
end;

← →
Jack128 © (2004-04-19 20:15) [13]

> VMcL © (19.04.04 20:10)
абсолютно согласен

Polevi - код на бочку!!! :-))

← →
uny (2004-04-19 20:17) [14]

Удалено модератором
Примечание: flood

← →
VMcL © (2004-04-19 20:17) [15]

>>Polevi © (19.04.04 20:15) [12]

try..finally на GetMem/FreeMem
?

← →
ламер © (2004-04-19 20:19) [16]

очень некрасиво. да и нет некоторых рекомендуемых проверок. но пока что работает.

function GetPublishedProperties(AClass: TClass): String; var AParent: TClass; PropList: TPropList; I, PropCount: Integer; begin Result := ""; PropCount := GetPropList(AClass.ClassInfo, tkProperties, @PropList); for I := 0 to PropCount - 1 do begin AParent := AClass; while (AParent.ClassParent <> nil) and (AParent.ClassParent.ClassInfo <> nil) and IsPublishedProp(AParent.ClassParent, PropList[I]^.Name) do AParent := AParent.ClassParent; Result := Result + #13#10 + AParent.ClassName + "::" + PropList[I]^.Name; end; end;

← →
Polevi © (2004-04-19 20:19) [17]

>VMcL © (19.04.04 20:17) [15]
убрал в целях экономии :))

← →
Jack128 © (2004-04-19 20:19) [18]

Ты это где GetPublishedProps откопал?? В Delphi5.TypInfo нету такого. Подлог!!! ;-))

← →
Polevi © (2004-04-19 20:21) [19]

>Jack128 © (19.04.04 20:19) [18]
слово рекурсия видимо тебе не знакомо ?

← →
VMcL © (2004-04-19 20:21) [20]

>>Polevi © (19.04.04 19:27) [2]

Кстати, твоя функция противоречит [2]. Она возвращает Integer, а не String. Ха!

← →
Polevi © (2004-04-19 20:22) [21]

>ламер © (19.04.04 20:19) [16]
круто, только лист забыл освободить

← →
VMcL © (2004-04-19 20:22) [22]

Sorry.
[20] = Re: [12]

← →
Jack128 © (2004-04-19 20:23) [23]

> слово рекурсия видимо тебе не знакомо ?
сорри, не заметил..

← →
Polevi © (2004-04-19 20:23) [24]

>VMcL © (19.04.04 20:21) [20]
не придирайся, и вообще, ты когда нибудь видел настолько красивый код, как у меня ? :)))))

← →
VMcL © (2004-04-19 20:23) [25]

>>uny (19.04.04 20:17) [14]

http://www.translate.ru/text.asp -> flood = наводнение

← →
VMcL © (2004-04-19 20:24) [26]

>>Polevi © (19.04.04 20:23) [24]

Код на Delphi с GetMem/FreeMem и без try...finally я красивым не считаю :)))

← →
uny (2004-04-19 20:25) [27]

Удалено модератором
Примечание: Offtopic

← →
VMcL © (2004-04-19 20:26) [28]

>>Polevi © (19.04.04 20:23) [24]

Да, у тебя еще и Warning. Фи! :)

← →
Polevi © (2004-04-19 20:28) [29]

>VMcL © (19.04.04 20:26) [28]
новая версия, с учетом ранее неизвестных мне ф-ий от ламер © (19.04.04 20:19) [16]

function GetPublishedProps2(AClass:TClass; var Value:string):integer;
var
Props: TPropList;
i:integer;
begin
Result:=GetPropList(AClass.ClassInfo, tkProperties, @Props);
for i := GetPublishedProps2(AClass.ClassParent,Value) to Result-1 do
Value:=Value+Format("%s::%s",[AClass.ClassName,PPropInfo(Props[I]).Name])+#13#10;
end;

← →
Polevi © (2004-04-19 20:28) [30]

кул :)))

← →
VMcL © (2004-04-19 20:34) [31]

>>Polevi © (19.04.04 20:28) [29]
>>Polevi © (19.04.04 20:28) [30]

Канешно, кул, дарагой.
AV, однако.

← →
VMcL © (2004-04-19 20:35) [32]

>>Polevi © (19.04.04 20:28) [29]

Да и память кто будет очищать, дядя kernel?

← →
VMcL © (2004-04-19 20:36) [33]

>>VMcL © (19.04.04 20:35) [32]

Sorry. С памятью поторопился. У тебя ж уже TPropList.

← →
VMcL © (2004-04-19 20:37) [34]

>>Polevi © (19.04.04 20:28) [29]

Но всё равно: выделять по ~64 КБ на каждый из вызовов GetPublishedProps2 - это жирно. Гы.

← →
Polevi © (2004-04-19 20:38) [35]

>VMcL © (19.04.04 20:36) [33]
да, проверочку зря убрал :)

function GetPublishedProps2(AClass:TClass; var Value:string):integer;
var
Props: TPropList;
i:integer;
begin
if AClass=TObject then exit;
Result:=GetPropList(AClass.ClassInfo, tkProperties, @Props);
for i := GetPublishedProps2(AClass.ClassParent,Value) to Result-1 do
Value:=Value+Format("%s::%s",[AClass.ClassName,PPropInfo(Props[I]).Name])+#13#10;
end;

← →
Polevi © (2004-04-19 20:39) [36]

>VMcL © (19.04.04 20:37) [34]
что такое 64 к в наше время... тьфу :)

← →
VMcL © (2004-04-19 20:41) [37]

>>Polevi © (19.04.04 20:38) [35]

Warning. Бу-га-га-га!!!

← →
VMcL © (2004-04-19 20:42) [38]

>>Polevi © (19.04.04 20:39) [36]

Сказал бы ты мне это лет 5-6 назад, когда я на 386SX c 2MB RAM сидел :)

← →
Polevi © (2004-04-19 20:43) [39]

вот пристал :))
function GetPublishedProps2(AClass:TClass; var Value:string):integer;
var
Props: TPropList;
i:integer;
begin
Result:=0;
if AClass=TObject then exit;
Result:=GetPropList(AClass.ClassInfo, tkProperties, @Props);
for i := GetPublishedProps2(AClass.ClassParent,Value) to Result-1 do
Value:=Value+Format("%s::%s",[AClass.ClassName,PPropInfo(Props[I]).Name])+#13#10;
end

← →
Polevi © (2004-04-19 20:45) [40]

>VMcL © (19.04.04 20:42) [38]
ты еще ZX Spectrum вспомни, там вместе с ОЗУ 65к было :-)

← →
VMcL © (2004-04-19 20:50) [41]

>>Polevi © (19.04.04 20:43) [39]

Ну всё. Теперь у тебя суперпупергипермегафункция, куда там AvtoSheme :)

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

Рекурсия с пожиранием 64 Кб стека на каждом уровне?
Из которых реально вряд ли и пара Кб потребуется?
Шалуны...
Stack Overflow на вас нет...
:о)

Ладно, вот задачка похитрее. Дана произвольная иерархия классов форм, отнаследованная от TForm. В каждом классе, возможно, есть произвольные обработчики событий произвольных компонентов. Задан класс TSomeForm, принадлежащий этой иерархии. Задача такая - сформировать список всех его обработчиков, включая и все унаследованные. Список нужно поместить в TStrings, по одному обработчику в строку, в виде:
Имя_класса.Имя_обработчика(Список_параметров)
причем список параметров должен быть синтаксически правильным. Пример:
TSomeFormAncestor.SomeMethod(Sender: TObject; Str: string)

Вот. Это похитрее будет, чем просто функции TypInfo вызывать. Пусть даже и рекурсивно.
:о)

← →
VMcL © (2004-04-19 21:08) [43]

>>Юрий Зотов © (19.04.04 21:07) [42]

Да ну тебя. 8 вечера уже (Киев) :)

← →
Yanis © (2004-04-19 21:12) [44]

<<<---Оффтопик--->>>

Этакий мастерский топик. Одни сливки собрались, ей богу :)

← →
VMcL © (2004-04-19 21:16) [45]

>>Yanis © (19.04.04 21:12) [44]

Чтобы не портить "сливочность", твой пост и некоторые другие "лишние" удалят модераторы :D

← →
Yanis © (2004-04-19 21:18) [46]

To [45]
Мне не привыкать :)
:) :)

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

> VMcL © (19.04.04 21:08) [43]

Нормально. Как раз до утра и выйдет.
:о)

← →
VMcL © (2004-04-19 21:24) [48]

>>Юрий Зотов © (19.04.04 21:18) [47]

>Как раз до утра и выйдет.

Какого тысячелетия? :=D

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

> VMcL © (19.04.04 21:24) [48]

Это уж как получится. Вообще-то, есть шанс стать Маклаудом.
:о)

← →
VMcL © (2004-04-19 21:29) [50]

>>Юрий Зотов © (19.04.04 21:28) [49]

Уже стал. Меня так директор иногда называет.

← →
VideoLord © (2004-04-19 22:24) [51]

Маклаудом... Хм ;-)
Ну если только нашим "бешенным", хотя мало кто может столько выпить.

← →
Игорь Шевченко © (2004-04-19 23:33) [52]

Юрий Зотов © (19.04.04 21:07)

Задан класс или экземпляр класса ?

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

> Юрий Зотов © (19.04.04 21:07) [42]
> Ладно, вот задачка похитрее. Дана произвольная иерархия
> классов форм, отнаследованная от TForm. В каждом классе,
> возможно, есть произвольные обработчики событий произвольных
> компонентов. Задан класс TSomeForm, принадлежащий этой иерархии.
> Задача такая - сформировать список всех его обработчиков,
> включая и все унаследованные. Список нужно поместить в TStrings,
> по одному обработчику в строку, в виде:
> Имя_класса.Имя_обработчика(Список_параметров)
> причем список параметров должен быть синтаксически правильным.
> Пример:
> TSomeFormAncestor.SomeMethod(Sender: TObject; Str: string)

Если дан класс, то невозможно, по определению, определить обработчики, а только события. На этот раз вам уже точно 2 за вопрос.

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

> Если дан класс, то невозможно, по определению, определить
> обработчики, а только события

Если можно, перевод этой фразы дай пожалуйста.

← →
Igorek © (2004-04-20 11:30) [55]

> Игорь Шевченко © (20.04.04 11:28) [54]
>
> > Если дан класс, то невозможно, по определению, определить
>
> > обработчики, а только события
>
>
> Если можно, перевод этой фразы дай пожалуйста.

На какой язык?

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

Igorek © (20.04.04 11:30)

На понятный

← →
Igorek © (2004-04-20 11:37) [57]

> Игорь Шевченко © (20.04.04 11:34) [56]
> Igorek © (20.04.04 11:30)
>
> На понятный

А что конкретно непонятно? Неужели все?

← →
Igorek © (2004-04-20 11:40) [58]

Вообще чем дальше, тем больше меня поражают так называемые "мастера".

← →
pasha_golub © (2004-04-20 11:44) [59]

Igorek © (20.04.04 11:40) [58]
Зря ты так. Зависть плохое чувство.

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

Igorek © (20.04.04 11:37)

Тебе трудно объяснить свою фразу ?

← →
Igorek © (2004-04-20 11:49) [61]

Ок, поясняю попу-лярно.
"Если дан класс" - дано скажем TForm, TObject, TCoolGrid..., а не Form1: TForm...
"то невозможно, по определению, определить обработчики, а только события." - обработчики - это фактически указатели на функции. Эти указатели являются полями класса. А поля, как известно имеют значение только при наличии обьекта, а не класса (за исключением статических полей, которые не знаю есть ли в Паскале).
Таким образом, поскольку мы имеем класс, а не обьект, то мы не можем по-определению узнать значения полей (читай обработчики событий).

← →
Igorek © (2004-04-20 11:50) [62]

> pasha_golub © (20.04.04 11:44) [59]
> Igorek © (20.04.04 11:40) [58]
> Зря ты так. Зависть плохое чувство.

С чего ты взял, что я кому-то завидую?

← →
pasha_golub © (2004-04-20 11:52) [63]

Igorek © (20.04.04 11:50) [62]
Я не сказал, что ты завидуешь :-)

Просто, констатировал факт, что "Зависть - плохое чувство". ;-)

← →
Igorek © (2004-04-20 11:53) [64]

оффтоп, цитата:
"
Мама, мы все тяжело больны...
Мама, я знаю, мы все сошли с ума...
"
В.Цой

← →
Юрий Зотов © (2004-04-20 11:55) [65]

> Игорь Шевченко © (19.04.04 23:33) [52]

Дана иерархия классов и входящий в нее класс. Допустим, иерархия сидит в каком-то BPL, или прямо в EXE - неважно.

Задачу можно упростить (суть останется та же, просто код будет менее громоздким за счет меньшего количества рутины) - будем строить список вообще любых published-методов. То есть - всех доступных данному классу, включая и унаследованные.

> Igorek © (20.04.04 11:11) [53]

Оценки будете выставлять, когда решите задачу (если вообще сможете). А до тех пор - LMD. Сначала разберитесь, чему принадлежит код, а чему - данные.

← →
Igorek © (2004-04-20 11:56) [66]

> pasha_golub © (20.04.04 11:52) [63]
> Igorek © (20.04.04 11:50) [62]
> Я не сказал, что ты завидуешь :-)
>
> Просто, констатировал факт, что "Зависть - плохое чувство".
> ;-)

Ты сказал "зря ты так". Что именно зря? И почему зависть плохое чувство? Я например очень сильно завидую уму и знаниям некоторых программистов с этого форума, и из форумов rsdn.ru. И некоторых из них я искренне уважаю.

← →
Igorek © (2004-04-20 11:57) [67]

> Юрий Зотов © (20.04.04 11:55) [65]
> Оценки будете выставлять, когда решите задачу (если вообще
> сможете). А до тех пор - LMD. Сначала разберитесь, чему
> принадлежит код, а чему - данные.

Да я собственно уже решил в [61]

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

Igorek © (20.04.04 11:49)

Именно это я и хотел услышать.

hint: привязка обработчиков к событиям формы и ее компонентов является общей для всех экземпляров класса формы и располагается в .dfm

← →
Igorek © (2004-04-20 12:12) [69]

> Игорь Шевченко © (20.04.04 12:04) [68]
> Igorek © (20.04.04 11:49)
> Именно это я и хотел услышать.
> hint: привязка обработчиков к событиям формы и ее компонентов
> является общей для всех экземпляров класса формы и располагается
> в .dfm

Что-то я нервный сегодня (из-за вчерашних событий). Еще "мастера" достают.

По сути:
In Delphi, almost all the code you write is executed, directly or indirectly, in response to events. An event is a special kind of property that represents a runtime occurrence, often a user action. The code that responds directly to an event—called an event handler—is an Object Pascal procedure. Все пошел работать.
---
"Кто имеет уши, тот услышит"

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

Юрий Зотов © (20.04.04 11:55)

Тогда уточним задачу:

Есть класс TForm1, у него есть published метод OnCreate. Обработчик его события чаще всего называется TForm1.FormCreate, если его имя не меняется руками.

В задаче требуется для произвольного класса, входящего в иерархию, вывести этот обработчик в виде
procedure TForm1.FormCreate(Sender: TObject);
или в виде
procedure TForm1.OnCreate(Sender: TObject);

?

← →
Юрий Зотов © (2004-04-20 12:54) [71]

> Игорь Шевченко © (20.04.04 12:24) [70]

В виде
procedure TForm1.FormCreate(Sender: TObject);

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

Рассмотрим пример. Пусть есть такая иерархия:

TForm1 = class(TForm)
procedure Proc1(...);
procedure Proc2(...);
end;

TForm2 = class(TForm1)
procedure Proc2(...);
procedure Proc3(...);
end;

TForm3 = class(TForm2)
procedure Proc3(...);
procedure Proc4(...);
end;

Для класса TForm3 должен получиться такой список:

TForm3.Proc3(...);
TForm3.Proc4(...);
TForm2.Proc2(...);
TForm1.Proc1(...);

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

Юрий Зотов © (20.04.04 12:54)

Тогда я наверное чего-то не понимаю. Список методов я могу достать, список свойств-методов с синтаксисом - тоже. Но привязать их одни к другим без dfm я не могу :)

← →
Igorek © (2004-04-20 13:59) [73]

2 Юрий Зотов
Протрите значок мастера и бегом учить азы ObjectPascal.

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

Igorek © (20.04.04 12:12)

> The code that responds directly to an event—called an event
> handler—is an Object Pascal procedure

Точнее, метод объекта.

И эта...завязывай перепалку, плз

← →
Igorek © (2004-04-20 15:08) [75]

> Игорь Шевченко © (20.04.04 14:02) [74]
> И эта...завязывай перепалку, плз

Ок. Но истина тебя интересует? Ответь на вопрос "Задача, заданная в (Юрий Зотов © (19.04.04 21:07) [42]), имеет решение?" Да или нет?

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

Igorek © (20.04.04 15:08)

> Ответь на вопрос

Пока я вижу решение, связанное с разбором .dfm или с созданием экземпляра класса. Но хочу надеятся, что существует более элегантное. То есть, решение имеется в любом случае.

← →
MBo © (2004-04-20 15:28) [77]

> [71]
приспособлено из старых извращений:

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;

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

MBo © (20.04.04 15:28)

А параметры ? :))))

← →
MBo © (2004-04-20 15:33) [79]

>Игорь Шевченко
>А параметры ? :))))
Это еще думать надо, а с обходом VMT уже когда-то копался ;))

← →
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 я не додумал, спасибо за науку :)

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

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

{$DEFINE condition} {$IFDEF condition} {$ENDIF}

вместо

const condition = True; {$IF condition} {$IFEND}

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

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

И вообще, dcc32.exe

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

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

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

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

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

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

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

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

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

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

классу ?

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

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

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

Еще раз давайте разберемся с понятиями. На самом деле тут легко запутаться. Итак:
1) обработчик события - это процедура Паскаля, которая вызывается при наступлении события;
2) событие наступает только тогда, когда есть обьект, и соотв. код обьекта вызывает обработчик, который записан в поле обьекта;
3) с этого вытекает, что процедура становится обработчиком только тогда, когда ссылка на нее содержится в поле обьекта; до этого момента (допустим обьекта еще нет) процедура (если подходит по сигнатуре) может выступать в роли обработчика события конкретного обьекта
4) обработчиком событий данного класса могут выступать процедуры любого класса, подходящие по сигнатуре;

Теперь ответы:

> McSimm © (21.04.04 18:34) [118]
>
> > Просто присвоить их событиям можно только динамически.
>
> классу ?

Исходя из вышесказанного мы присваиваем метод какого-то класса событию какого-то обьекта;

> Игорь Шевченко © (21.04.04 18:34) [119]
> В момент разбора VMT нету экземпляров класса, следовательно
> о динамическом присвоении речи быть не может :)

Какая разница, как мы реализуем задачу? Повторю, что задача была "вывести все обработчики класса". Надо было сказать "вывести все методы класса А, которые есть потенциальные обработчики событий обьектов класса В". А может быть равно В. Но даже в такой постановке задача неразрешима, поскольку возможно в классе А есть приватные методы, которые есть потенциальные обработчики событий обьектов класса В (могут стать таковыми в результате динамического присваивания).

> Igorek © (21.04.04 17:45) [115, 117, 121]

> Однако я смотрю этот вопрос для Вас стал принципиальным.

Почему стал? Он таким и был. Только Вы тут ни при чем - снизьте самооценку, Джо. Дело просто-напросто в том, что, раз уж я в [42] предложил задачу (да еще и с "подковыркой" - вот, мол, попробуйте), то считаю, что должен был дать и свой вариант решения (не сразу, естественно). Оно и раньше всегда было так же, ничего нового.

> Не умаляя достоинств приведенного кода

Браво. Тронут. Плачу. Вы не поверите, насколько для были важна именно ВАША оценка. Сбылось...
"Слеза... стекает... по щеке... на клаву..."
Хотите еще одну задачку - персонально для Вас? В коде, если рассматривать его не как просто пример, а как рабочий код, есть довольно серьезный недостаток. Он был сделан специально, и не просто так, а была на то причина. Надо найти этот недостаток и указать его причину. В идеале - доработать одну из процедур, устранив в ней тот самый недостаток (кстати, объем кода после этого даже уменьшится).

> позволю себе не согласиться, что это решение задачи в
> постановке [42]. Там ничего не говорилось про RTTI.

Там про МЕТОД решения не было сказано вообще НИ-ЧЕ-ГО. Что и естественно. Потому что метод решения задачи оставляется на усмотрение разработчика. Хотите - RTTI юзайте, хотите - выкапывайте Debug Info, хотите - еще как хотите. Дело хозяйское.

> Соотв. был и мой пост [53].

Не будем о грустном.

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

Высоко ценю Ваши знания. Однако же, в [42] речь шла о классах, и ТОЛЬКО о классах - а теперь перечитайте [116] и, как знаток основ Паскаля, устыдитесь за [117].

Таким образом, постановку [42] Вы просто элементарно не поняли. Готов согласиться, что формулировка действительно была слишком скупой, но кто хотел уточнить - тот задал вопросы. И в своем посте [53], как и в последующих, Вам ничто не мешало сделать то же самое, а не устраивать очередную склоку.

Вообще, Игорек, Вы уж извините, но если моя персона так патологически раздражающе на Вас действует - то задумайтесь, наконец, почему это так? Кстати, в затеяной Вами же откровенно склочной ветке Вам об этом сказали практически открытым текстом (причем даже и не один человек) - так что есть что перечитать и о чем подумать.

Что касается [121], то вот Вам наводящая задачка. Пусть мы имеем вот такой DFM:
object Form1: TForm1
OnClose = FormClose
end
и еще не создано ни одного экземпляра TForm1. Теперь ответьте:
1. Является ли этот DFM принадлежностью класса TForm1?
2. Метод FormClose уже существует, или еще нет?
3. Если существует, то чему (кому) он принадлежит?
4. В какой секции он объявлен?
5. Может ли он быть объявлен в другой секции?
6. Назначает ли этот DFM событию OnClose обработчик FormClose?
7. Можно ли назначить событию OnClose другой обработчик, не создавая при этом экземпляра TForm1?

> Pasha Golub & other

Помнится, в ветке про тесты по поводу вопроса 1.1 было написано примерно следующее - вопрос чисто теоретический, потому что в реальных разработках подобный код встретиться не может. На что я тогда ответил что-то вроде того, что вопрос этот теоретический до тех пор, пока он не встретится на практике.

Так вот - выше MBo, Игорем и мною приведены вполне практические примеры использования такого кода (скажем, процедура ExtractShortString). Могу еще добавить, что подобныйй код реально использовался при написании одного редактора свойства (собственно, откуда и родилась сама эта задачка - она ведь не только из головы была придумана). И подобный код можно встретить и в VCL, и в других пакетах - например, посмотрите код в "Кладовке", о котором уже упоминалось.

И дело тут вовсе не в том, что стиль кривой. Просто есть вещи, которые по-другому либо вообще не напишешь, либо резко снизится скорость.

> Хотите еще одну задачку - персонально для Вас? ...

Нет, не хочу. Неинтересная задача. Куда интереснее такая: "сформулировать корректное условие задачи, для которой приведенный код будет решением и в нем не будет ничего лишнего"

> Готов согласиться, что формулировка действительно была слишком
> скупой

Имхо она была некорректной как минимум. А при корректировке к наиболее близкой корректной - неразрешимой.

> Что касается [121], то вот Вам наводящая задачка. Пусть
> мы имеем вот такой DFM: ...

Отвечаю: задача поставлена некорректно и не полно. Кроме того некоторые пункты сами по себе не имеют смысла.

> Отвечаю: задача поставлена некорректно и не полно. Кроме
> того некоторые пункты сами по себе не имеют смысла.

В чем именно некорректность и неполнота ?

Прикольный пример:
1) создаем новое приложение в Дельфи
2) создаем обработчик главной формы на событие OnShow такой:
procedure TForm1.FormShow(Sender: TObject);
begin
with TForm1.CreateNew(Application) do
Show;
end;
3) запускаем...

>
> Игорь Шевченко © (22.04.04 10:48) [125]
> В чем именно некорректность и неполнота ?

Неполнота:
- не приведен код формы, имя модуля, имя файла dfm, проекта
Короче в идеале надо или иметь все исходники или пошаговую инструкцию воспроизведения условия.
- не указан момент, касательно которого вопросы (designtime, точка останова)
Следовательно некорректности:
> 1. Является ли этот DFM принадлежностью класса TForm1?
Какого класса TForm1?
> 2. Метод FormClose уже существует, или еще нет?
Вообще бред.
> 3. Если существует, то чему (кому) он принадлежит?
Бред.
> 4. В какой секции он объявлен?
> 5. Может ли он быть объявлен в другой секции?
Хрен его знает. О каких секциях вообще речь?
> 6. Назначает ли этот DFM событию OnClose обработчик FormClose?
DFM ничего не назначает. Назначает VCL.
> 7. Можно ли назначить событию OnClose другой обработчик,
> не создавая при этом экземпляра TForm1?
Бред.

Не сочтите за грубость - это просто чесно мои мысли.

> Igorek © (22.04.04 11:04) [127]

И Вы еще беретесь о чем-то там спорить?

> Игорь Шевченко, McSimm & other

По-моему, бесполезно. Ламер - он как раз потому и ламер, что считает себя знатоком. Воинствующий ламер - хуже втройне. А воинствующий ламер, не сомневающийся в собственных выводах, да еще и с ярко выраженным талантом флудера... страшнеее, наверное, может быть только пулемет.

Поэтому предлагаю оставить этого Анику-воина в покое. Все равно он даже и не пытается понять того, что ему тут хором пытаются объяснить. Да и не только тут.

P.S.
"Не сочтите за грубость - это просто чесно мои мысли".
(с) Igorek © (22.04.04 11:04) [127]

> Игорь Шевченко © (22.04.04 11:16) [128]
> Sapienti sat

Здесь вроде надо только русском.

> Юрий Зотов © (22.04.04 11:40) [129]

Мне глубоко пофиг, что говорит толпа, когда нет аргументов. Исключение составляют люди, которых я уважаю. К любому мнению таковых я сразу прислушаюсь даже без аргументов. На этом форуме таковыми для себя считаю: MBo и Е-мое Имя.

> Igorek © (22.04.04 11:52) [130]

> Мне глубоко пофиг, что говорит толпа, когда нет аргументов.

А также когда они есть, но некто в упор не желает их видеть. О чем и было сказано выше.

> Исключение составляют люди, которых я уважаю. К любому мнению
> таковых я сразу прислушаюсь даже без аргументов. На этом
> форуме таковыми для себя считаю: MBo и Е-мое Имя.

Это заметно. Уже хотя бы по тому, что у одного Вы заимствовали код, а у другого - ведра.

P.S.
"И это все о нем"
(с) То ли книга, то ли фильм, то ли все вместе.

Надеюсь, я всё правильно понял:

object Form1: TForm1
OnClose = FormClose
end
и еще не создано ни одного экземпляра TForm1. Теперь ответьте:
1. Является ли этот DFM принадлежностью класса TForm1?
- Да, судя по тому, что при создании формы читается её описание из ресурсов (TCustomForm.Create)
2. Метод FormClose уже существует, или еще нет?
- Да, он уже описан в VMT (сама процедура)
3. Если существует, то чему (кому) он принадлежит?
- Он является методом формы (? насколько я знаю)
4. В какой секции он объявлен?
- В Published.
5. Может ли он быть объявлен в другой секции?
- При объявлении его в private или public при создании формы EReadError - "Invalid property value"
6. Назначает ли этот DFM событию OnClose обработчик FormClose?
- При создании.
7. Можно ли назначить событию OnClose другой обработчик, не создавая при этом экземпляра TForm1?
- Нет.

Вот мои ответы с домысленным условием:
> 1. Является ли этот DFM принадлежностью класса TForm1?
В любом случае не является - ВНИМАТЕЛЬНО см. [126]
> 2. Метод FormClose уже существует, или еще нет?
> - Да, он уже описан в VMT (сама процедура)
А в виде текста в designtime метод не существует?
> 3. Если существует, то чему (кому) он принадлежит?
Во первых в моем понятии метод не может принадлежать классу, он может только быть его членом. Вот про обьект я могу сказать, что он пренадлежит классу, ибо есть елементом множества, которое класс описывает
> 4. В какой секции он объявлен?
> - В Published.
При условии, что код компилируется.
> 5. Может ли он быть объявлен в другой секции?
> - При объявлении его в private или public при создании
> формы EReadError - "Invalid property value"
Может, тогда код не будет выполняться.
> 6. Назначает ли этот DFM событию OnClose обработчик FormClose?
> - При создании.
В принципе можно и так выразится, хотя имхо неточно.
> 7. Можно ли назначить событию OnClose другой обработчик,
> не создавая при этом экземпляра TForm1?
Не только нельзя другой, нельзя любой. Нету обьекта - нету обработчика. Есть только методы, которые могут выступать в такой роли. Тоже в принципе буквоедство, но как видим иногда небесполезное.

2 IGOREK © (23.04.04 18:53) [134]
Ну что, обсудим? Предлагаю конструктивный диалог:

>> 1. Является ли этот DFM принадлежностью класса TForm1?
>В любом случае не является - ВНИМАТЕЛЬНО см. [126]
Тогда как ты прокомментируешь тот факт, что форма при создании (см. TCustomForm.Create) читает себя из ресурсов?
имеется в виду именно Тип класса TForm1 (будем считать, что ресурс с описанием класса в ехе-ке менять не будем).

>> 2. Метод FormClose уже существует, или еще нет?
>> - Да, он уже описан в VMT (сама процедура)
>А в виде текста в designtime метод не существует?
Хм, не понял :(

дайте я попробую, что ли...
1. Является ли этот DFM принадлежностью класса TForm1?
имхо - нет. DFM хранится в ресурсах и может быть легко изменена без изменения кода класса.
2. Метод FormClose уже существует, или еще нет?
да.
3. Если существует, то чему (кому) он принадлежит?
классу TForm1.
4. В какой секции он объявлен?
ну там же, где объявлены сами компоненты, в начале класса без ключевого слова private/protected/public/published. поскольку к компонентам формы можно обращаться из вне TForm1 без проблем, значит, это либо public, либо published. хелп данную ситуацию комментирует так:
Members at the beginning of a class declaration that don’t have a specified visibility are by default published, provided the class is compiled in the {$M+} state or is derived from a class compiled in the {$M+} state; otherwise, such members are public.
кроме того, в другом месте написано
A class cannot have published members unless it is compiled in the {$M+} state or descends from a class compiled in the {$M+} state. Most classes with published members derive from TPersistent, which is compiled in the {$M+} state, so it is seldom necessary to use the $M directive.
значит, published. эксперимент показывает, что попытка объявить их как public приводит в ран-тайме к ошибке создания формы. а с published все в порядке. кроме того, если чуть еще подумать и посмотреть, как хранятся ссылки на обработчики событий в откомпилированном DFM, то видно, что они хранятся как имена. значит при загрузке формы используется RTTI и это должна быть published секция.
5. Может ли он быть объявлен в другой секции?
нет.
6. Назначает ли этот DFM событию OnClose обработчик FormClose?
ну не то, чтобы назначает. скорее описывает, что назначить. реальное назначение происходит при загрузке формы, где-то внутрях TReader, наверное.
7. Можно ли назначить событию OnClose другой обработчик, не создавая при этом экземпляра TForm1?
ну если отбросить непосредственное исправление ресурса, то вероятно можно (в том же смысле, в каком DFM "назначает") - для этого надо вклиниться в процесс создания формы, переписав TReader, наверное.

Хорошая получилась ветка.
Могла бы быть еще лучше, если бы, субъекты, препарирующие Delphi, обсуждали только ее внутренности.
Да и число участников было бы больше, если бы градус обсуждения был пониже.

> 1. Является ли этот DFM принадлежностью класса TForm1?
> имхо - нет. DFM хранится в ресурсах и может быть легко изменена
> без изменения кода класса.

Является. Имя ресурса совпадает с именем класса формы. Если изменить имя ресурса извне форма будет являться принадлежностью другого класса.

Игорь Шевченко © (24.04.04 18:33) [138]
> 1. Является ли этот DFM принадлежностью класса TForm1?
> имхо - нет. DFM хранится в ресурсах и может быть легко изменена
> без изменения кода класса.

Не является. Что мешает зачитать ресурс с именем класса формы из потока, созданного в runtime?

> Sha © (24.04.04 19:18) [139]

Ничто не мешает. Но и ничего не меняет. Ресурс класса формы так и останется ресурсом класса формы. Хоть вообще его не читай, хоть читай как угодно и для чего угодно.

Sha © (24.04.04 19:18)

> Не является. Что мешает зачитать ресурс с именем класса
> формы из потока, созданного в runtime?

Глупый вопрос: а зачем ?

Еще можно спросить: "является ли компонент Button1 принадлежностью класса TForm1?". Ясное дело, нет. Компонент с таким именем может быть в любом DFM и даже в том, которого еще нет в design time и который будет создан в run time.
Таким образом, классу TForm1 принадлежат все существующие и будущие DFM, содержащие ресурс с таким именем, а также все созданные в run time потоки, содержащие ресурс с таким именем.
А это значит, что этому классу никакой конкретный DFM не принадлежит, а только может принадлежать, после того, как будет прочитан TReader"ом.

> классу TForm1 принадлежат все существующие и будущие DFM,
> содержащие ресурс с таким именем

Тут такой момент - ресурс может быть только один :)

> Sha © (24.04.04 20:11) [142]

А еще можно говорить, что файл kernel32.dll библиотекой ядра не является, а только МОЖЕТ ею являться.

Но стоит ли?

> Игорь Шевченко © (24.04.04 20:28) [143]
> Тут такой момент - ресурс может быть только один :)

Ничто не мешает хранить ресурсы в отдельных файлах или создавать динамически.

> Юрий Зотов © (24.04.04 20:28) [144]
> А еще можно говорить, что файл kernel32.dll библиотекой ядра не является, а только МОЖЕТ ею являться.
> Но стоит ли?

Спор чисто терминологический: что значит "принадлежит"?
Если это означает совпадение имен и возможность загрузки ресурса, то принадлежит.
Если же это означает собственно загрузку ресурса, то не принадлежит.
Мне больше симпатична вторая точка зрения, потому что окончательный вид формы в run time определяется только после загрузки ресурса. До этого формы просто не существует.

В общем, стоит сначала определиться с терминами. Каждая из этих точек зрения может оказаться верной при соответствующей трактовке терминов.

> Sha © (24.04.04 20:11) [142]

Наверное, нужно пояснить, что я имел в виду в [144]. Конечно, можно понасоздавать 100 потоков, а в них программно нагенерить 100 одноименных ресурсов. Можно сделать еще вообще что угодно, хоть ОС переписать.

Однако же, когда задача ставится, например, так "Найти сумму углов треугольника", то мы понимаем, что речь идет о геометрии Эвклида, а не Лобачевского. Причем на плоскости, а не на сфере или еще на чем-то.

И подобного рода дефолты имеют место всегда. То есть - если явно не оговорено ничего другого, то подразумевается некий стандарт. В нашем случае таким стандартом является единственный ресурс с именем TForm1, находящийся в теле EXE и из него же загружаемый.

Помните анекдот, как программист ходил в магазин? Жена сказала ему: "Купи батон хлеба и если есть яйца, то десяток". Далее произошел такой диалог с продавцом:
- У Вас яйца есть?
- Есть.
- Тогда десяток батонов хлеба.

В словах жены подразумевался тот самый дефолт, но программист поступил, как машина, а не как человек.

Мы будем поступать так же? Будем придираться к словам друг друга, или все же будем понимать, что если что-то не оговорено явно, то имеется и виду стандарт?

Вот что имелось в виду в [144].

Я не придирался, а просто решал задачу в общей постановке.
Теперь понятно, что имелось ввиду :)

> >> 1. Является ли этот DFM принадлежностью класса TForm1?
> >В любом случае не является - ВНИМАТЕЛЬНО см. [126]
> Тогда как ты прокомментируешь тот факт, что форма при создании
> (см. TCustomForm.Create) читает себя из ресурсов?
Да не знаю что и сказать. Читает себе и все.
А как Вы прокомментируете [126]?

> >> 2. Метод FormClose уже существует, или еще нет?
> >> - Да, он уже описан в VMT (сама процедура)
> >А в виде текста в designtime метод не существует?
> Хм, не понял :(
Ну вот я решаю задачу по программированию. Надо написать метод. И вот я уже знаю, как решить задачу - весь метод у меня в голове. Вопрос: этот метод существует?

несомненно

Сначала надо дать определение: "Говорят, что метод существует, если выполнены следующие условия: ...", а после этого начинаем проверять, выполнены ли указанные условия.
Весь сыр-бор в конце концов сводится к тому, чьи определения лучше.

2ЮЗ
Я прошу прощения, но я не нашел куска Вашего кода, который под чистую совпадает с примером 1.1

Лично для меня, пожалуйста, запостите его. Спасибо.

> pasha_golub © (26.04.04 15:35) [151]

Подчистую - конечно, не совпадает. А вот по смыслу (адресная арифметика) и по использованным приемам ("хитрое" получение данных по адресу) - совпадает. См., например, функцию ExtractShortString.

> Sha © (26.04.04 14:37) [150]

Условия очевидны - исходный текст программы содержит данный метод, программа откомпилирована и запущена, но ни один объект класса TForm1 в ней еще не создан.

Юрий Зотов © (26.04.04 18:01) [152]

Ну, тогда метод существует, пока программа работает в ОП, но ни один объект класса TForm1 в ней еще не создан :))

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