为什么这个程序运行后,只有表单出现,但表单上的控件没有出现?(10分)

  • 主题发起人 主题发起人 awfigsk
  • 开始时间 开始时间
A

awfigsk

Unregistered / Unconfirmed
GUEST, unregistred user!
visible属性没有动。
unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,StdCtrls,TypInfo,QActnList,QStdCtrls;

type
Tfm_Main = class(TForm)
lbClasses: TListBox;
btnGetClasses: TButton;
Label1: TLabel;
Label2: TLabel;
lbClassInfo: TListBox;
Label3: TLabel;
lbProperty: TListBox;
procedure btnGetClassesClick(Sender: TObject);
procedure lbClassesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function CreateClass(const AClassName:string):TObject;
procedure GetClassInfo(AClass:TObject;AStrings:TStrings);
procedure GetClassAncestor(AClass:TObject;AStrings:TStrings);
procedure GetClassProperty(AClass:TObject;Astrings:TStrings);
end;

var
fm_Main: Tfm_Main;

implementation

{$R *.dfm}

procedure Tfm_Main.btnGetClassesClick(Sender: TObject);
begin
with lbClasses.Items do
begin
clear;
Add('TApplication');
Add('TForm');
Add('TButton');
Add('TComponent');
Add('TGraphicControl');
Add('TListBox');
Add('TComboBox');
Add('TLabel');
Add('TActionList');
end;
RegisterClasses([TApplication,TForm,TButton,TComponent,TGraphicControl,
TListBox,TComboBox,TLabel,TActionList]);
end;

function Tfm_Main.CreateClass(const AClassName:string):TObject;
var
C:TFormClass;
Obj:TObject;
begin
C:=TFormClass(FindClass(AClassName));
Obj:=C.Create(nil);
Result:=Obj;
end;

procedure Tfm_Main.GetClassAncestor(AClass:TObject;Astrings:TStrings);
var
AC:TClass;
begin
AC:=AClass.ClassParent;
AStrings.add('Class Ancestry');
while AC<>nil do
begin
AStrings.Add(Format(' %s',[AC.ClassName]));
AC:=AC.ClassParent;
end;
end;

procedure Tfm_Main.GetClassInfo(AClass:TObject;AStrings:TStrings);
var
TI:PTypeInfo;
TD:PTypeData;
EnumName:string;
begin
TI:=AClass.ClassInfo;
TD:=GetTypeData(TI);
with AStrings do
begin
Add(Format('Class Name: %s',[TI.Name]));
EnumName:=GetEnumName(TypeInfo(TTypeKind),Integer(TI.Kind));
Add(Format('Kind: %s',[EnumName]));
Add(Format('Size: %d',[AClass.InstanceSize]));
Add(Format('Defined in: %s.pas',[TD.UnitName]));
Add(Format('Num Propertieds: %d',[TD.PropCount]));
end;
end;

procedure Tfm_Main.GetClassProperty(AClass:TObject;AStrings:TStrings);
var
PropList:PPropList;
TI:PTypeInfo;
TD:PTypeData;
i:integer;
NumProps:integer;
begin
TI:=AClass.ClassInfo;
TD:=GetTypeData(TI);
if TD.PropCount<>0 then
begin
GetMem(PropList,SizeOf(PPropInfo)*TD.PropCount);
try
GetPropInfos(AClass.ClassInfo,PropList);
for i:=0 to TD.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;
for i:=0 to NumProps-1 do
AStrings.Add(Format('%s:%s',[PropList^.Name,
PropList^.PropType^.Name]));
finally
FreeMem(PropList,SizeOf(PPropInfo)*TD.PropCount);
end;
end;
end;

procedure Tfm_Main.lbClassesClick(Sender: TObject);
var
Cls:TObject;
ClassName:string;
begin
lbClassInfo.Items.Clear;
lbProperty.Items.Clear;
try
ClassName:=lbClasses.Items[lbClasses.ItemIndex];
Cls:=CreateClass(ClassName);
try
GetClassInfo(Cls,lbClassInfo.Items);
GetClassAncestor(Cls,lbClassInfo.Items);
GetClassProperty(Cls,lbProperty.Items);
finally
Cls.Free;
end;
except
on E:EClassNotFound do
Showmessage('Class not Found');
end;
end;

end.
 
有没有指定控件的Parent?
 
我的控件是设计时放的,它应该会自动设置的吧。我只是敲进了代码。这是怎么回事?
 
接受答案了.
 
后退
顶部