Копирование свойств компонентов -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [18.191.218.130]

Модераторы: jack128, Rouse_, Krid

Копирование свойств компонентов

s-mike

Сообщ. #1 , 12.02.05, 07:41

Unregistered

uses TypInfo, StrUtils;

procedure CopyComponentProp(Source: TObject; Receiver: TObject; aExcept: array of string);

// Копирование всех одинаковых по названию свойств/методов одного компонента в

// другой за исключение "Name", "Left", "Top" и тех которые заданы в aExcept

var

I: Integer;

Props: PPropList;

TypeData: PTypeData;

begin

if (Source = nil) or (Source.ClassInfo = nil) then Exit;

TypeData := GetTypeData(Source.ClassInfo);

if (TypeData = nil) or (TypeData^.PropCount = 0) then Exit;

GetMem(Props, TypeData^.PropCount * sizeof(Pointer));

try

GetPropInfos(Source.ClassInfo, Props);

for I := 0 to TypeData^.PropCount-1 do begin

with Props^[I]^ do begin

if Assigned(GetProc) and Assigned(SetProc) and

(AnsiIndexText(Name, ['Name', 'Left', 'Top']) = -1 ) and

(AnsiIndexText(Name, aExcept ) = -1 ) and

(GetPropInfo (Receiver.ClassInfo, Name ) <> nil) then try

case PropType^^.Kind of

tkInteger, tkChar,

tkEnumeration, tkFloat,

tkString, tkSet, tkWChar,

tkLString, tkWString,

tkVariant, tkArray,

tkRecord, tkInterface,

tkInt64, tkDynArray: SetPropValue (Receiver, Name, GetPropValue (Source, Name));

tkMethod: SetMethodProp(Receiver, Name, GetMethodProp(Source, Name));

tkClass: SetOrdProp (Receiver, Name, GetOrdProp (Source, Name));

end;

except

raise Exception.CreateFmt(

'Произошла ошибка при копировании свойства/метода "%s" тип "%d".',

[Name, Integer(PropType^^.Kind)]);

end;

finally

FreeMem(Props);

end;

Автор: Alex-Co

1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,2871 ] [ 15 queries used ] [ Generated: 17.05.24, 06:39 GMT ]