RTTI и другие трюки с информацией о классах, модулях и т.п.

Code:

function hasprop(comp: TComponent; const prop: String): Boolean;

var

proplist: PPropList;

numprops, i: Integer;

begin

result := false;

getmem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));

try

   NumProps := getproplist(comp.classInfo, tkProperties, proplist);

   for i := 0to pred (NumProps) do

   begin

     if comparetext(proplist[i]^.Name, prop) = 0then

     begin

       result := true;

       break;

     end;

   end;

finally

   freemem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));

end;

end;

procedure setcomppropstring(comp: TComponent; const prop, s: String);

var

proplist: PPropList;

numprops, i: Integer;

begin

getmem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));

try

   NumProps := getproplist(comp.classInfo, tkProperties, proplist);

   for i := 0to pred (NumProps) do

   begin

     if (comparetext(proplist[i]^.Name, prop) = 0) and

        (comparetext(proplist[i]^.proptype^.name, 'string') = 0then

     begin

       setStrProp(comp, proplist[i], s);

       break;

     end;

   end;

finally

   freemem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));

end;

end;

Code:

function HasProperty(Obj: TObject; Prop: string): PPropInfo;

begin

Result := GetPropInfo(Obj.ClassInfo, Prop);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

p: pointer;

begin

p := HasProperty(Button1, 'Color');

if p <> nilthen

   SetOrdProp(Button1, p, clRed)

else

   ShowMessage('Button has no color property');

p := HasProperty(Label1, 'Color');

if p <> nilthen

   SetOrdProp(Label1, p, clRed)

else

   ShowMessage('Label has no color property');

p := HasProperty(Label1.Font, 'Color');

if p <> nilthen

   SetOrdProp(Label1.Font.Color, p, clBlue)

else

   ShowMessage('Label.Font has no color property');

end;

Code:

TypInfo.GetPropInfo (My_Component.ClassInfo, 'Hint') <> nil