задачка

← →
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. Фи! :)

>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 © (19.04.04 20:28) [29]

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

>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;

вот пристал :))
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

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