Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.142.173.166] |
|
Сообщ.
#1
,
|
|
|
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; end; end; finally FreeMem(Props); end; end; Автор: Alex-Co |