能否动态取得一个控件的所有publish属性(30分)

RT

提问者:
如果你还要继续讨论请定期提前你的帖子，如果不想继续讨论请结束帖子。
请认真阅读大富翁论坛规则说明 http://www.delphibbs.com/delphibbs/rules.htm

运行期间类信息（RTTI），可已获得控件的所有属性及方法，具体的方法有点复杂，
下次写给你

看看下面代码，我在系统中用到的。

procedure ChangeLangA(Control:TWinControl);
var
PKinds : TTypeKinds;
PList,plist1,plist3: PPropList;
I,J,k: Integer;
i1,j1,k1,o1:integer;
v,v1:TPersistentClass;
co:Tcollection;
f:tfont;
ss:tstrings;
i2,j2,k2:integer;
b:tColumn;
begin
PKinds:=[tkString, tkClass, tkLString,tkwstring];
//改变控件本身属性
i:=GetPropList(Control.ClassInfo,PKinds,Nil);
GetMem(PList,i * SizeOf(Pointer));
i:=GetPropList(Control.ClassInfo,PKinds,PList);
for k:=0 to i-1 do
if Plist[k]^.PropType^.Kind<>tkClass then
setstrprop(Control,Plist[k],gbtobig5(getstrprop(control,Plist[k])))
else
begin
v:=getclass(Plist[k]^.PropType^.Name);
if (v<>nil) and (v=TFont) then
begin
f:=TFont(getobjectprop(control,plist[k]));
f.Charset:=136;
f.Name:=gbtobig5('细明体');
end;
end;
freemem(PList,i * SizeOf(Pointer));
//查找各控件属性，将String属性转换为Big5码
with Control do
for j:=componentcount-1 downto 0 do
begin
if (components[j].classname='TMenuItem') and (Tmenuitem(components[j]).action<>nil) then
continue;
if (components[j] is ttoolbutton)and(Tcontrol(components[j]).parent.name='ToolBar2') then
continue;
i:=GetPropList(components[j].ClassInfo,PKinds,Nil);
GetMem(PList,i * SizeOf(Pointer));
i:=GetPropList(components[j].ClassInfo,PKinds,PList);
for k:=0 to i-1 do
if Plist[k]^.PropType^.Kind<>tkClass then
setstrprop(components[j],Plist[k],gbtobig5(getstrprop(components[j],Plist[k])))
else
//如果控件属性是TCollection类
begin
v:=getclass(Plist[k]^.PropType^.Name);
if (v<>nil) and(v.InheritsFrom(TCollection)) then
begin
co:=Tcollection(getobjectprop(components[j],plist[k]));
for j1:=0 to co.Count-1 do
begin
i1:=GetPropList(co.items[j1].ClassInfo,PKinds,Nil);
GetMem(PList1,i1 * SizeOf(Pointer));
i1:=GetPropList(co.items[j1].ClassInfo,PKinds,PList1);
for k1:=0 to i1-1 do
if Plist1[k1]^.PropType^.Kind<>tkClass then
setstrprop(co.items[j1],Plist1[k1],gbtobig5(getstrprop(co.items[j1],Plist1[k1])));
{else
if co is TDBGridColumns then
begin
b:=TColumn(getobjectprop(co.items[j1],Plist1[k1]));
for i2:=0 to b.PickList.Count-1 do
b.PickList.Strings[i2]:=gbtobig5(b.PickList.Strings[i2]);
b.Title.Font.Name:=gbtobig5('细明体');
end;}
freemem(plist1,i1 * SizeOf(Pointer));
end;
end else
//Tfont属性
if (v<>nil) and (v=TFont) then
begin
f:=TFont(getobjectprop(components[j],plist[k]));
f.Charset:=136;
f.Name:=gbtobig5('细明体');
end else
//Tstrings属性
if (V<>nil) and (V=Tstrings) then
begin
ss:=tstrings(getobjectprop(components[j],plist[k]));
for o1:=0 to ss.Count-1 do
ss.Strings[o1]:=gbtobig5(ss.strings[o1]);
end;
end;
freemem(plist,i * SizeOf(Pointer));
end;
end;

下面的代码应该是比较好的；（我从一个例子中找出来的，自己改吧）
Count := GetTypeData(Sender.ClassInfo)^.PropCount;
if Count > 0 then
begin
// 得到属性数
GetMem(PropList, Count * SizeOf(PPropList));
try
// ?得到属性
GetPropInfos(Sender.ClassInfo, PropList);
frmObject.insp.RowCount:=count;
frmObject.event.RowCount:=count;
j:=0;
K:=0;
for I := 0 to Count - 1 do
begin
PropInfo := PropList^;

case PropInfo.PropType^.kind of
tkInteger,
tkEnumeration :
frmObject.insp.cells[1,j]:= inttostr(getordProp(Sender,PropInfo));
tkString,
tkLString,
tkWString :
frmObject.insp.cells[1,j]:= getstrProp(Sender,PropInfo);
tkFloat :
frmObject.insp.cells[1,j]:=FloattoStr(GetFloatProp(Sender,PropInfo));
tkMethod :
frmObject.event.cells[1,k]:='Event';
else
frmObject.insp.cells[1,i]:='TYPE'+inttostr(ord(PropInfo.PropType^.kind));
end;
if PropInfo.PropType^.kind=tkMethod then
begin
frmObject.event.cells[0,k]:=PropInfo.Name;
k:=k+1
end
else
begin
frmObject.insp.cells[0,j]:=PropInfo.Name;
j:=j+1;
end;
end;
frmObject.insp.RowCount:=j;
frmObject.event.RowCount:=k;
finally
FreeMem(PropList, Count * SizeOf(PPropList));
end;
end;

唉，二位给的代码实在是不全

这样行了吧！
那个insp和event是stringgrid;主要的是要uses Typinfo;
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls,typinfo;

type
TForm1 = class(TForm)
Button1: TButton;
insp: TStringGrid;
event: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var count,j,k,i : integer;
proplist: PPropList;//
Propinfo : PPropinfo;
begin
Count := GetTypeData(Sender.ClassInfo)^.PropCount;
if Count > 0 then
begin
// 得到属性数
GetMem(PropList, Count * SizeOf(PPropList));
try
// ?得到属性
GetPropInfos(Sender.ClassInfo, PropList);
insp.RowCount:=count;
event.RowCount:=count;
j:=0;
K:=0;
for I := 0 to Count - 1 do
begin
PropInfo := PropList^;

case PropInfo.PropType^.kind of
tkInteger,
tkEnumeration :
insp.cells[1,j]:= inttostr(getordProp(Sender,PropInfo));
tkString,
tkLString,
tkWString :
insp.cells[1,j]:= getstrProp(Sender,PropInfo);
tkFloat :
insp.cells[1,j]:=FloattoStr(GetFloatProp(Sender,PropInfo));
tkMethod :
event.cells[1,k]:='Event';
else
insp.cells[1,i]:='TYPE'+inttostr(ord(PropInfo.PropType^.kind));
end;
if PropInfo.PropType^.kind=tkMethod then
begin
event.cells[0,k]:=PropInfo.Name;
k:=k+1
end
else
begin
insp.cells[0,j]:=PropInfo.Name;
j:=j+1;
end;
end;
insp.RowCount:=j;
event.RowCount:=k;
finally
FreeMem(PropList, Count * SizeOf(PPropList));
end;
end;
end;

下面为一过程,对的属性全放在AStrings中
procedure GetClassProperties(AClass: TObject; AStrings: TStrings);
{ This method retrieves the property names and types for the given object
and adds that information to the AStrings parameter. }
var
PropList: PPropList;
ClassTypeInfo: PTypeInfo;
ClassTypeData: PTypeData;
i: integer;
NumProps: Integer;
begin
ClassTypeInfo := aClass.ClassType.ClassInfo ;
ClassTypeData := GetTypeData(ClassTypeInfo);
if ClassTypeData.PropCount <> 0 then
begin
GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
try
GetPropInfos(AClass.ClassInfo, PropList);
for i := 0 to ClassTypeData.PropCount - 1 do
if not (PropList^.PropType^.Kind = tkMethod) then
AStrings.Add(Format('%s: %s', [PropList^.Name, PropList^.PropType^.Name]));
NumProps := GetPropList(AClass.ClassInfo, [tkMethod], PropList);
if NumProps <> 0 then begin
AStrings.Add('');
AStrings.Add(' EVENTS ================ ');
AStrings.Add('');
end;
// Fill the AStrings with the events.
for i := 0 to NumProps - 1 do
AStrings.Add(Format('%s: %s', [PropList^.Name, PropList^.PropType^.Name]));

finally
FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;
end;
end;
之前uses单元TypInfo,简单吧