Кто родитель компонента?

← →
Alecs (2002-12-03 09:36) [0]

Есть ряд форм родителей (TForm->TForm1->TForm2->TForm3). Как узнать, кому из них пренадлежит какой-либо компонент?

← →
Song (2002-12-03 09:37) [1]

Owner/Parent: смотря что надо.

← →
alecs (2002-12-03 09:53) [2]

Я не идиот. Хотя спасибо за внимание. А вообще я имел ввиду, какая именно из форм является родителем.

← →
Юрий Зотов (2002-12-03 09:59) [3]

Owner/Parent: смотря что надо.

Только не повторяйте, что Вы не идиот, это и так понятно. Лучше объясните толком, что же Вам нужно узнать?

← →
Alecs (2002-12-03 10:08) [4]

Хорошо, начну с другой стороны.
У меня есть компонент лежащий на какой-то форме Form3, а она в свою очередь является наследником формы Form2, а та наследником Form1 и так далее. Как мне узнать, на какой именно форме он был создан изначально, а не перешёл по наследованию?

← →
Song (2002-12-03 10:22) [5]

Par:=Edit1.Parent;
While Assigned(Par) Do Par:=Par.Parent;

Оно ??

← →
Alecs (2002-12-03 10:43) [6]

Хорошо, давай так. На форме Form1 лежит компонент Edit1, на форме Form2 (наследнице Form1) лежит компонент Edit2, на форме Form3 (наследнице Form2) лежит Edit3.
Как работая только с формой Form3, мне узнать какой именно форме принадлежат все Edit-ы : Form1,Form2, а какой Form3???????????
Ты мне показываешь пример про компонент на котором лежит искомый компонент, а не форма на которой он создан.

← →
Skier (2002-12-03 10:44) [7]

>Alecs
А теперь объясни - зачем всё это ?

← →
Alecs (2002-12-03 10:52) [8]

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

← →
Skier (2002-12-03 10:59) [9]

>Alecs

> Есть блок находящийся в одной из родительских форм, который
> делает определённые действия со всеми компонентами на форме
> (переводы,шрифты и т.д.)

Что за блок такой ?
Догадываюсь что это методы чтения и записи в Ини-файл, если
так то объяви в классе TForm1 методы для чтения и записи
(что-то типа LoadParamsFromIni и SaveParamsIntoIni) и помести
его в раздел public и в потомках вызывай на здоровье...

← →
FreeLancer (2002-12-03 11:01) [10]

class function InheritsFrom(AClass: TClass): Boolean;
Determines the relationship of two object types.

← →
Alecs (2002-12-03 11:02) [11]

А при чём тут "вызывай на здоровье". Этот блок и не спрятан. Проблема-та совсем в другом, но всё равно спасибо.

← →
Alecs (2002-12-03 11:08) [12]

InheritFrom, даст мне родителя компонента (т.е. данный компонент будет являться его наследником), а мне надо знать форму владельца ( НА КОТОРОМ ИЗНАЧАЛЬНО НАХОДИЛСЯ КОМПОНЕНТ, А НЕ ПЕРЕШЁЛ ПО НАСЛЕДИЮ)

← →
Кулюкин Олег (2002-12-03 11:10) [13]

2 Alecs © (03.12.02 09:36)
Прислушайтесь к совету Skier © (03.12.02 10:59).
Напишите функции, которые будут читать из ini-файла.
В наследниках перегружайте их, и будет Вам счастье.

← →
Skier (2002-12-03 11:10) [14]

>Alecs

> Проблема-та совсем в другом,

В чём ? Я так понял что тебе нужно сохранить (прочитать) параметры компонентов на форме в Ини-фалй. Так ?

> А мне нужно её отсечь, что-бы она хранилась один раз.

А почему она сохраняется не один раз ?

Можно сделать так

TForm1 = class(...)
protected
procedure LoadParamsFromIni; virtual;
procedure SaveParamsIntoIni; virtual;
end; //TForm1

А в потомках просто в реализации
этих методов пишешь inherited;

← →
Бурундук (2002-12-03 11:15) [15]

>Есть блок находящийся в одной из родительских форм, который >делает определённые действия со всеми компонентами на форме
>(переводы,шрифты и т.д.), все данные он хранит в Ини-файле

Тогда этот блок должен работать со всеми компонентами,
т.е. и с компонентами потомков (если реально форма - потомок
и ты не перебираешь вручную компоненты, а используешь
Components[] или Controls[]).

Тогда потомки не должны ничего делать, всё должно быть
сделано в предке. (Или я не совсем понял???).

PS А решить твою проблему в том виде, в котором ты
сформулировал её первоначально, я боюсь, можно
лишь вручную копаясь в таблицах RTTI.

← →
Alecs (2002-12-03 11:18) [16]

>Skier
Форм1 содержит : Едит1,Едит2,Панел1
Форм2 содержит : Едит3 и Едит4 лежащий на Панел1
Форм3 содержит : ещё кучу всяких компонентов.

Форм3 наследник Форм2, Форм2 наследник Форм1.

В каждом из родителей цикл по Components будет оперировать с одним и тем-же списком, и все его Components[I] будут иметь Owner=Form3.

Поскольку цикл нужно вызывать только один раз (это я думаю понятно и так), то необходимо внутри него отсечь компоненты созданные в родителях от компонентов созданных в конечной форме. Если кто-нибудь ЗНАЕТ как это выяснить, пожалуйста напишите. Все предыдущие советы в данном случае, мне абсолютно не нужны.

← →
Юрий Зотов (2002-12-03 11:19) [17]

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

function FindFirstForm(AClass: TFormClass; AComponent: TComponent): TFormClass;
var
Form: TForm;
begin
Result := AClass;
while Result <> TForm do
begin
Form := TFormClass(Result.ClassParent).Create(nil);
try
if Form.FindComponent(AComponent.Name) = nil
then Exit
else Result := TFormClass(Form.ClassType)
finally
Form.Free
end
end;
if Result = TForm then Result := AClass
end;

Вызов FindFirstForm(TForm3, Edit1) должен вернуть TForm1.
Вызов FindFirstForm(TForm3, Edit3) должен вернуть TForm3.
И т.д.

← →
Skier (2002-12-03 11:20) [18]

>Alecs
Можешь отсечь с помощью флажков
в классе TForm1 добавляешь поля (в private)
FSave : Boolean;
FLoad : Boolean;

и пишешь

procedure TForm1.LoadParamsFromIni;
begin
if FLoad then Exit;
//загрузка параметров...
FLoad := True;
end;

procedure TForm1.SaveParamsIntoIni; virtual;
begin
if FSave then Exit;
//сохранение параметров...
FSave := True;
end;

← →
Alecs (2002-12-03 11:20) [19]

>Бурундук
По мойму ты единственный кто хоть проблему понял.
В RTTI, что ты имеешь ввиду, использовать TypInfo или что-то другое?

← →
Alecs (2002-12-03 11:24) [20]

>Зотов
Спасибо, этот способ и так вполне понятный, но я имел ввиду что-нибудь более профессиональное.

>Skier
Извиняюся за прямоту, но ты не понял проблему. Просьба не засорять "эфир".

← →
icWasya (2002-12-03 11:24) [21]

можно попробовать такой вариант:
в FormCreate каждой формы заводить список компонент, которые присутствуют на форме, и в Save-Restore обрабатывать только эти компоненты.

← →
Alecs (2002-12-03 11:25) [22]

>icWasya
Что ты имеешь ввиду "заводить"?

← →
Бурундук (2002-12-03 11:32) [23]

2Alecs © (03.12.02 11:20)
>В RTTI, что ты имеешь ввиду, использовать TypInfo или что-то другое?

В том-то и дело, что нет. Придётся пользоваться недокументированной информацией - которая может измениться к
следующей версии.

По указателю на VMT (т.е. Pointer(TForm1),
Pointer(TFOrm2)...)
можно найти таблицу полей (vmtFieldTable).
В ней можно искать адрес поля с именем компонента
(или поле, хранящее указатель на Components[i]) -
если нашёл - поле принадлежит этому классу, иначе нет.

PS Но, сразу скажу, ты идёшь не тем путём.

← →
ЮЮ (2002-12-03 11:35) [24]

А я вот не врублюсь
"В каждом из родителей цикл по Components будет оперировать с одним и тем-же списком, и все его Components[I] будут иметь Owner=Form3."

Откуда же возьмутся ещё и родители, если создан экземпляр класса TForm3 ???

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

А почему этот цикл должен работать несколько раз. Если этим занимается метод формы TForm1, а в наследниках он не переопределялся, то что запускает цикл снова?

← →
alecs (2002-12-03 11:38) [25]

>Бурундук
А какой другой путь?

← →
Бурундук (2002-12-03 12:11) [26]

Других путей может быть много.
Один я тебе уже сказал - пусть весь код по сохранению в
ини и по изменению будет в предке - логика (по идее) должна быть
одна и та же.

Но если уж тебе так хочется, привожу пример с RTTI:

function IsControlIntroducedHere(Form: TObject; OnOfParentClasses: TClass; Ctrl: TControl): Boolean;
var p: ^Pointer;
begin
Result := False;
with TPublishedFieldIterator.Create(OnOfParentClasses) do
begin
try
AutoAscend := False; // Не ищет в предках
First;
while (not Finished) do
begin
Cardinal(p) := Cardinal(Form) + Cardinal(CurrentField^.Offset);
if p^ = Pointer(Ctrl) then
begin
Result := True;
Break;
end;
Next;
end;
finally
Free;
end;
end;
end;

{----------- unit rttiD5it -----------------------------}

unit rttiD5it;

interface

uses
Classes, TypInfo;

type

PPropData = ^TPropData;

{---------vmtFieldTable--------------------------------------------------------}

PClass = ^TClass;
PFieldClassTable = ^TFieldClassTable;
TFieldClassTable = packed record
Count: Word;
Classes: packed array[0..MaxListSize] of PClass;
{Classes: packed array[0..Count-1] of PClass;}
end;

PVmtField = ^TVmtField;
TVmtField = packed record
Offset: Cardinal; {Смещение поля в данных класса}
ClassIndex: Word; {Индекс в FieldClassTable}
Name: ShortString;
end;

PVmtFieldTable = ^TVmtFieldTable;
TVmtFieldTable= packed record
Count: Word;
FieldClassTable: PFieldClassTable;
Fields: packed array[0..MaxListSize] of Byte;
{Fields: packed array[0..Count-1] of TVmtField;} // TVmtField имеет переменную длину
end;

{----------vmtMethodTable------------------------------------------------------}

PVmtMethod = ^TVmtMethod;
TVmtMethod = packed record
Size: Word;
Address: Pointer;
Name: ShortString;
end;

PVmtMethodTable = ^TVmtMethodTable;
TVmtMethodTable = packed record
Count: Word;
Methods: array [0..MaxListSize] of Byte;
{ Methods : array [0..Count-1] of TVmtMethod; } // TVmtMethod имеет переменную длину
end;

{------------------------------------------------------------------------------}

PParamData = ^TParamData;
TParamData = record
Flags: TParamFlags;
ParamName: ShortString;
//TypeName: ShortString;
end;

{------------------------------------------------------------------------------}

PVmtDynMethodTable = ^TVmtDynMethodTable;
TVmtDynMethodTable = packed record
Count : Word;
Data : packed array[0..MaxListSize] of Byte;
{Indexes : packed array [1..Count] of SmallInt;
Addresses : packed array[1..Count] of Pointer;}
end;

{------------------------------------------------------------------------------}

TPublishedIterator = class
protected
FVMT: TClass;
FTable: Pointer;
FCurrent: Pointer;
FCurrentIndex: Integer;
FAutoAscend: Boolean;
function GetName: string; virtual; abstract;
function GetCount: Integer; virtual; abstract;
function DegenerateCase(var Res): Boolean; virtual;
procedure ExecuteAutoAscendIfNeed; virtual;
function GetFinished: Boolean;
procedure Init(AClass: TClass); virtual;
public
property VMT: TClass read FVMT;
property Count: Integer read GetCount;
property Current: Pointer read FCurrent;
property CurrentName: string read GetName;
property Finished: Boolean read GetFinished;
property AutoAscend: Boolean read FAutoAscend write FAutoAscend;

constructor Create(AClass: TClass); virtual;
function AscendToAncestor: TClass;
function First: Pointer; virtual; abstract;
function Next: Pointer; virtual; abstract;
end;

{------------------------------------------------------------------------------}

TNonHomogeneousTableIterator = class(TPublishedIterator)
protected
function CurrentSize: Integer; virtual; abstract;
public
function Next: Pointer; override;
end;
{------------------------------------------------------------------------------}

TPublishedMethodIterator = class (TNonHomogeneousTableIterator)
protected
function GetName: string; override;
function GetCurrentMethod: PVmtMethod;
function GetCount: Integer; override;
function CurrentSize: Integer; override;
procedure Init(AClass: TClass); override;
public
property CurrentMethod: PVmtMethod read GetCurrentMethod;

function First: Pointer; override;
//function Next: Pointer; override;
end;

{------------------------------------------------------------------------------}

← →
Бурундук (2002-12-03 12:12) [27]

TPublishedFieldIterator = class (TNonHomogeneousTableIterator)
protected
function GetName: string; override;
function GetCurrentField: PVmtField;
function CurrentSize: Integer; override;
procedure Init(AClass: TClass); override;
function GetCount: Integer; override;
function GetCurrentFieldClass: TClass;
public
property CurrentField: PVmtField read GetCurrentField;
property CurrentFieldClass: TClass read GetCurrentFieldClass;

function First: Pointer; override;
//function Next: Pointer; override;
end;

{------------------------------------------------------------------------------}

TRealOrderPropertyIterator = class (TNonHomogeneousTableIterator)
protected
function GetName: string; override;
function GetCurrentProperty: PPropInfo;
function CurrentSize: Integer; override;
procedure Init(AClass: TClass); override;
function GetCount: Integer; override;
public
property CurrentProperty: PPropInfo read GetCurrentProperty;

function First: Pointer; override;
//function Next: Pointer; override;
end;

{------------------------------------------------------------------------------}

TPublishedPropertyIterator = class (TPublishedIterator)
protected
FPropCount: Integer;
function GetName: string; override;
function GetCurrentProperty: PPropInfo;
procedure Init(AClass: TClass); override;
function GetCount: Integer; override;
procedure ReleasePropList;
procedure ExecuteAutoAscendIfNeed; override;
public
property CurrentProperty: PPropInfo read GetCurrentProperty;

destructor Destroy; override;
function First: Pointer; override;
function Next: Pointer; override;
end;

{------------------------------------------------------------------------------}

TArgumentIterator = class
protected
FTypeData: PTypeData;
FCurrent: PParamData;
FCurrentIndex: Integer;
FTypeName: PShortString;
FResultType: PShortString;
function GetName: string; //virtual;
function GetDefinition: string; //virtual;
function GetResultType: string;
function CurrentSize: Integer; //virtual;
function GetCount: Integer; //virtual;
function GetTypeName: string;
function GetFlags: TParamFlags;
public
property Current: PParamData read FCurrent;
property CurrentName: string read GetName;
property CurrentTypeName: string read GetTypeName;
property CurrentFlags: TParamFlags read GetFlags;
property Count: Integer read GetCount;
property Definition: string read GetDefinition;
property ResultType: string read GetResultType;

constructor Create(Info: PTypeInfo);
function First: Pointer; //virtual;
function Next: Pointer; //virtual;
end;

function OffsetPtr(P: Pointer; Offset: Integer): Pointer;
function ReconstructMethodSignature(Info: PTypeInfo): string;

implementation

uses
SysUtils;

function OffsetPtr(P: Pointer; Offset: Integer): Pointer;
begin
Integer(Result) := Integer(P) + OffSet;
end;

function ReconstructMethodSignature(Info: PTypeInfo): string;
begin
Result := "";
if Info^.Kind <> tkMethod then Exit;

// TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
// mkClassProcedure, mkClassFunction,

with TArgumentIterator.Create(Info) do
begin
try
case FTypeData^.MethodKind of
mkProcedure: Result := Result + "procedure (";
mkFunction: Result := Result + "function (";
mkConstructor: Result := Result + "constructor (";
mkDestructor: Result := Result + "destructor (";
mkClassProcedure: Result := Result + "class procedure (";
mkClassFunction: Result := Result + "class function (";
end;

← →
Бурундук (2002-12-03 12:12) [28]

First;
while (Current <> nil) do
begin
Result := Result + Definition + "; ";
Next;
end;
Result := Copy(Result, 1, Length(Result)-2);

Result := Result + ")";
if FTypeData^.MethodKind = mkFunction then Result := Result + ": " + ResultType;
Result := Result + " of object;";
finally
Free;
end;
end;

end;

{ TPublishedIterator }

constructor TPublishedIterator.Create(AClass: TClass);
begin
Init(AClass);
end;

procedure TPublishedIterator.Init(AClass: TClass);
begin
FVMT := AClass;
FTable := nil;
FCurrent := nil;
FCurrentIndex := -1;
end;

function TPublishedIterator.AscendToAncestor: TClass;
begin
if DegenerateCase(Result) then Exit;
Init(TClass(FVMT).ClassParent);
end;

function TPublishedIterator.DegenerateCase(var Res {variable to nullify if true}): Boolean;
begin
Result := (FTable = nil)or(FVMT = nil){or(Count = 0)};
if Result then
begin
FVMT := nil;
FTable := nil;
Pointer(Res) := nil; // Integer(Res) := 0;
FCurrent := nil;
FCurrentIndex := -1;
end;
end;

function TPublishedIterator.GetFinished: Boolean;
begin
ExecuteAutoAscendIfNeed;
Result := FCurrent = nil;
end;

procedure TPublishedIterator.ExecuteAutoAscendIfNeed;
begin
if (FCurrent = nil)and(FAutoAscend) then
while (FCurrent = nil)and(FVMT <> nil) do
begin
AscendToAncestor;
First;
end;
end;

{ TNonHomogeneousTableIterator }

function TNonHomogeneousTableIterator.Next: Pointer;
begin
if DegenerateCase(Result) then Exit;

if FCurrentIndex < Count-1 then
begin
FCurrent := OffsetPtr(FCurrent, CurrentSize);
Inc(FCurrentIndex);
end
else
FCurrent := nil;

Result := FCurrent;
end;

{ TPublishedMethodIterator }

procedure TPublishedMethodIterator.Init(AClass: TClass);
begin
inherited Init(AClass);
if Assigned(FVMT) then FTable := Pointer( OffsetPtr(FVMT, vmtMethodTable)^ );
end;

function TPublishedMethodIterator.GetCount: Integer;
begin
if DegenerateCase(Result) then Exit;
Result := PVmtMethodTable(FTable)^.Count;
end;

function TPublishedMethodIterator.First: Pointer;
begin
if DegenerateCase(Result) then Exit;
FCurrentIndex := 0;
FCurrent := Pointer(@PVmtMethodTable(FTable)^.Methods[0]);
ExecuteAutoAscendIfNeed;

Result := FCurrent;
end;

function TPublishedMethodIterator.CurrentSize: Integer;
begin
if DegenerateCase(Result) then Exit;
Result := CurrentMethod^.Size; // SizeOf(Word) + SizeOf(Pointer) + Length(Current^.Name) + 1;
end;

function TPublishedMethodIterator.GetCurrentMethod: PVmtMethod;
begin
Result := PVmtMethod(FCurrent);
end;

function TPublishedMethodIterator.GetName: string;
begin
Result := CurrentMethod^.Name;
end;

{ TPublishedFieldIterator }

procedure TPublishedFieldIterator.Init(AClass: TClass);
begin
inherited Init(AClass);
if Assigned(FVMT) then FTable := Pointer( OffsetPtr(FVMT, vmtFieldTable)^ );
end;

function TPublishedFieldIterator.CurrentSize: Integer;
begin
if DegenerateCase(Result) then Exit;
Result := SizeOf(Cardinal) + SizeOf(Word) + Length(CurrentField^.Name) + 1;
end;

function TPublishedFieldIterator.First: Pointer;
begin
if DegenerateCase(Result) then Exit;
FCurrentIndex := 0;
FCurrent := Pointer(@PVmtFieldTable(FTable)^.Fields[0]);
ExecuteAutoAscendIfNeed;

Result := FCurrent;
end;

← →
Бурундук (2002-12-03 12:13) [29]

function TPublishedFieldIterator.GetCount: Integer;
begin
if DegenerateCase(Result) then Exit;
Result := PVmtFieldTable(FTable)^.Count;
end;

function TPublishedFieldIterator.GetCurrentField: PVmtField;
begin
Result := PVmtField(FCurrent);
end;

function TPublishedFieldIterator.GetCurrentFieldClass: TClass;
begin
Result := PVmtFieldTable(FTable)^.FieldClassTable^.Classes[CurrentField^.ClassIndex]^;
end;

function TPublishedFieldIterator.GetName: string;
begin
Result := CurrentField^.Name;
end;

{ TPublishedPropertyIterator }

procedure TPublishedPropertyIterator.Init(AClass: TClass);
begin
inherited Init(AClass);

ReleasePropList;
if not Assigned(FVMT) then Exit;

FPropCount := GetTypeData(FVMT.ClassInfo).PropCount;
GetMem(FTable, FPropCount*SizeOf(Pointer));
GetPropInfos(FVMT.ClassInfo, FTable);
end;

procedure TPublishedPropertyIterator.ReleasePropList;
begin
if Assigned(FTable) then
begin
FPropCount := GetTypeData(FVMT.ClassInfo).PropCount; //
FreeMem(FTable, FPropCount*SizeOf(Pointer));
end;
FTable := nil;
FPropCount := 0;
end;

function TPublishedPropertyIterator.GetCount: Integer;
begin
Result := FPropCount;
end;

function TPublishedPropertyIterator.First: Pointer;
begin
if DegenerateCase(Result) then Exit;
FCurrentIndex := 0;
FCurrent := PPropList(FTable)^[FCurrentIndex];
Result := FCurrent;
end;

function TPublishedPropertyIterator.GetCurrentProperty: PPropInfo;
begin
Result := PPropInfo(FCurrent);
end;

function TPublishedPropertyIterator.Next: Pointer;
begin
if DegenerateCase(Result) then Exit;

if FCurrentIndex < Count-1 then
begin
Inc(FCurrentIndex);
FCurrent := PPropList(FTable)^[FCurrentIndex];
end
else
FCurrent := nil;

Result := FCurrent;
end;

destructor TPublishedPropertyIterator.Destroy;
begin
ReleasePropList;
end;

function TPublishedPropertyIterator.GetName: string;
begin
Result := CurrentProperty^.Name;
end;

procedure TPublishedPropertyIterator.ExecuteAutoAscendIfNeed;
begin
// Nothing
end;

{ TArgumentIterator }

constructor TArgumentIterator.Create(Info: PTypeInfo);
begin
if Info^.Kind <> tkMethod then raise Exception.CreateFmt("%s not a method",[Info^.Name]);
FTypeData := GetTypeData(Info);
FResultType := nil;
end;

function TArgumentIterator.CurrentSize: Integer;
begin
Result := SizeOf(TParamFlags) + 1 + Length(FCurrent^.ParamName) + 1 + Length(FTypeName^);
end;

function TArgumentIterator.First: Pointer;
begin
FCurrentIndex := 0;
FCurrent := OffsetPtr(@FTypeData^.ParamCount, SizeOf(FTypeData^.ParamCount));
FTypeName := OffsetPtr(@FCurrent^.ParamName, 1 + Length(FCurrent^.ParamName));
end;

function TArgumentIterator.Next: Pointer;
begin
if FCurrentIndex < Count-1 then
begin
FCurrent := OffsetPtr(FCurrent, CurrentSize);
FTypeName := OffsetPtr(@FCurrent^.ParamName, 1 + Length(FCurrent^.ParamName));
Inc(FCurrentIndex);
end
else
begin
FResultType := OffsetPtr(FCurrent, CurrentSize);
FCurrent := nil;
end;
Result := FCurrent;
end;

← →
Бурундук (2002-12-03 12:13) [30]

function TArgumentIterator.GetCount: Integer;
begin
Result := FTypeData^.ParamCount;
end;

function TArgumentIterator.GetDefinition: string;
begin
Result := "";

with FCurrent^ do
begin
// pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut

if pfVar in Flags then Result := Result + "var ";
if pfConst in Flags then Result := Result + "const ";
if pfOut in Flags then Result := Result + "out ";

Result := Result + ParamName + ": ";
if pfArray in Flags then Result := Result + " array of ";
Result := Result + FTypeName^;

end;
end;

function TArgumentIterator.GetName: string;
begin
Result := FCurrent^.ParamName;
end;

function TArgumentIterator.GetTypeName: string;
begin
Result := FTypeName^;
end;

function TArgumentIterator.GetFlags: TParamFlags;
begin
Result := FCurrent^.Flags;
end;

function TArgumentIterator.GetResultType: string;
begin
if FResultType = nil then raise Exception.Create("TArgumentIterator.GetResultType can be called only after iterations finished");
Result := FResultType^;
end;

{ TRealOrderPropertyIterator }

procedure TRealOrderPropertyIterator.Init(AClass: TClass);
begin
inherited Init(AClass);
if Assigned(FVMT) then
begin
FTable := Pointer( OffsetPtr(FVMT, vmtTypeInfo)^ ); // TypeInfo
if not Assigned(FTable) then Exit; //

FTable := Pointer( OffsetPtr(@PTypeInfo(FTable)^.Name, // TypeData
Length(PTypeInfo(FTable)^.Name) + 1) );
if not Assigned(FTable) then Exit; // for any case...

FTable := Pointer( OffsetPtr(@PTypeData(FTable)^.UnitName, // PropData
Length(PTypeData(FTable)^.UnitName) + 1) );
end;
end;

function TRealOrderPropertyIterator.GetCount: Integer;
begin
if DegenerateCase(Result) then Exit;
Result := PPropData(FTable)^.PropCount;
end;

function TRealOrderPropertyIterator.CurrentSize: Integer;
const
ConstPart = SizeOf(PPTypeInfo) + 3*SizeOf(Pointer) + SizeOf(Integer)
+ SizeOf(LongInt) + SizeOf(SmallInt) + 1;
begin
if DegenerateCase(Result) then Exit;
Result := ConstPart + Length(CurrentProperty^.Name);
end;

function TRealOrderPropertyIterator.First: Pointer;
begin
if DegenerateCase(Result) then Exit;
FCurrent := @PPropData(FTable)^.PropList;
FCurrentIndex := 0;
if Count = 0 then FCurrent := nil;
ExecuteAutoAscendIfNeed;
Result := FCurrent;
end;

function TRealOrderPropertyIterator.GetCurrentProperty: PPropInfo;
begin
Result := PPropInfo(FCurrent);
end;

function TRealOrderPropertyIterator.GetName: string;
begin
Result := CurrentProperty^.Name;
end;

end.

← →
ЮЮ (2002-12-03 12:16) [31]

to Бурундук
Теперь, думаю, от прислушается к первому совету :-))

← →
Skier (2002-12-03 12:20) [32]

Мда...
А можно всё это ещё и ассемблере написать - ащё проще будет :)))

← →
Бурундук (2002-12-03 12:23) [33]

Кто родитель компонента? Найти похожие ветки