|
function MethodPropToStr: string;
var
Value: TMethod;
Root: TComponent;
begin
Value := GetMethodProp(Instance, PropInfo);
if Value.Code <> nil then
begin
if Instance is TForm then
Root := TComponent(Instance)
else
Root := TComponent(Instance).Owner;
Result := Root.MethodName(Value.Code);
end else begin
Result := '';
end;
end;
begin
begin
PropType := PropInfo^.PropType^;
case PropType^.Kind of
tkInteger, tkChar, tkEnumeration, tkSet:
Result := OrdPropToStr;
tkFloat:
Result := FloatPropToStr;
tkString,tkLString:
Result := StrPropToStr;
tkClass:
Result := ClassPropToStr;
tkMethod:
Result := MethodPropToStr;
else
Result := 'Unknown';
end;
end;
end;
{TObjInfo}
constructor TObjInfo.Create(Instance: TObject);
begin
HaveInstance:= False;
if Assigned(Instance) then
begin
FInstance:= Instance;
FName:= Instance.ClassName;
ListUpProps(Instance);
end;
end;
destructor TObjInfo.Destroy;
begin
if HaveInstance then
FreeMem(FPropList, PropCount * SizeOf(Pointer));
inherited Destroy;
end;
function TObjInfo.GetItems(Index:Integer):TMyPropInfo;
var
PropInfo: PPropInfo;
PropType: PTypeInfo;
PropName, PropValue: string;
begin
PropInfo := FPropList^[Index];
if PropInfo = nil then
begin
Raise Exception.Create('Invalid Index');
Exit;
end;
PropName := PropInfo^.Name;
Result.Name:= PropName;
PropValue := PropValueToStr(TPersistent(FInstance),PropInfo);
Result.Value:= PropValue;
PropType := PropInfo^.PropType^;
Result.Kind:= PropType^.Kind;
end;
function TObjInfo.IndexOfProp(const S:String):Integer;
var
i:integer;
St:TStringList;
begin
St:=TStringList.Create;
for i:= 0 to FCount -1 do
St.Add(Self[i].Name);
Result:= St.IndexOf(S);
St.Free;
end;
procedure TObjInfo.ListUpProps(Instance:TObject);
begin
FCount := GetTypeData(Instance.ClassInfo)^.PropCount;
if FCount > 0 then
begin
GetMem(FPropList, FCount * SizeOf(Pointer));
HaveInstance:= True;
try
GetPropInfos(Instance.ClassInfo, FPropList);
except
end;
end;
end;
end.
unit DsnInfo;
// Runtime Design System Version 2.x June/08/1998
// Copyright(c) 1998 Kazuhiro Sasaki.
interface
uses
Windows, Messages, SysUtils, Classes, Forms, Controls, Dialogs,
TypInfo;
type
TMyPropInfo = record
Name:String;
Value:String;
Kind: TTypeKind;
end;
TObjInfo = class
private
FInstance:TObject;
FName: String;
FCount:Integer;
FPropList: PPropList;
HaveInstance:Boolean;
procedure ListUpProps(Instance:TObject);
function GetItems(Index:Integer):TMyPropInfo;
public
constructor Create(Instance: TObject);
destructor Destroy; override;
function IndexOfProp(const S:String):Integer;
property Name:String read FName;
property Items[Index:Integer]: TMyPropInfo read GetItems; default;
property PropCount: Integer read FCount;
end;
function PropValueToStr(Instance: TPersistent;
PropInfo: PPropInfo):string;
implementation
type
TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
function PropValueToStr(Instance: TPersistent;
PropInfo: PPropInfo):string;
var
PropType: PTypeInfo;
function SetPropToStr(Value: Cardinal):string;
var
I: Integer;
BaseType: PTypeInfo;
begin
BaseType := GetTypeData(PropType)^.CompType^;
Result := '[';
for I := 0 to 15 do
if I in TIntegerSet(Value) then begin
if Result <> '[' then
Result := Result + ',';
Result := Result + GetEnumName(BaseType, I);
end;
Result := Result + ']';
end;
function OrdPropToStr:string;
var
Value: Longint;
begin
Value := GetOrdProp(Instance, PropInfo);
case PropType^.Kind of
tkInteger:
Result := IntToStr(Value);
tkChar:
Result := Chr(Value);
tkSet:
Result := SetPropToStr(Value);
tkEnumeration:
Result := GetEnumName(PropType, Value);
end;
end;
function FloatPropToStr:string;
var
Value: Extended;
begin
Value := GetFloatProp(Instance, PropInfo);
Result := FloatToStr(Value);
end;
function StrPropToStr:string;
begin
Result := GetStrProp(Instance, PropInfo);
end;
function ClassPropToStr:string;
var
Component: TComponent;
begin
if GetTypeData(PropInfo^.PropType^)^.ClassType.InheritsFrom(TComponent)
then begin
Component := TComponent(GetOrdProp(Instance, PropInfo));
if Component = nil then
Result := ''
else
Result := Component.Name;
end else begin
FmtStr(Result, '(%s)', [PropInfo^.PropType^.Name]);
end;
end;
必須引用一個別人寫的物件
只有以下是我寫的
//******************************************************************************
procedure TForm1.Button2Click(Sender: TObject);
//*********************************************
function objins(Sender: TObject):TStringList;
const
KindTYPE : array [0..17] of string =('Unknown','Integer', 'Char', 'Enumeration',
'Float', 'String' , 'Set', 'Class', 'Method', 'WChar', 'LString', 'WString',
'Variant','Array', 'Record', 'Interface', 'Int64', 'DynArray');
var
AObjInfo : TObjInfo;
i :Integer;
S :String;
STR :TStringList;
begin
AObjInfo := TObjInfo.Create(sender);
STR:= TStringList.Create;
//STR.Add('Object'+' '+AObjInfo.Name);
//STR.Add(' '+'begin');
for i := 0 to AObjInfo.PropCount-1 do begin
S:=' ';
if AObjInfo.Items[i].Value <> '' then begin //如果是空資料就不顯示
S:=S+''+ AObjInfo.Items[0].Value;
S:=S+'_'+ KindTYPE[Ord(AObjInfo.Items[i].Kind)];
S:=S+'_'+ AObjInfo.Items[i].Name +' = '+ AObjInfo.Items[i].Value;
S:=S+';';
//+' , '+ IntToStr(Ord(AObjInfo.Items[i].Kind))
STR.Add(S);
end;
end;
//STR.Add(' '+'end');
Result := STR ;
end;
//*********************************************
begin
Memo1.Lines.Text :=objins(Sender).Text;
end;
//******************************************************************************
procedure TForm1.Button1Click(Sender: TObject);
//*********************************************
procedure AddToTreeView(ATreeNode : TTreeNode ; APanel: TPanel);
var
i: integer;
TmpTreeNode: TTreeNode;
begin
for i := 0 to APanel.ControlCount - 1 do
begin
TmpTreeNode := TreeView1.Items.AddChildObject(ATreeNode, APanel.Controls[i].Name,APanel.Controls[i]);
//TmpTreeNode := TreeView1.Items.AddChild(ATreeNode, APanel.Controls[i].Name);
if APanel.Controls[i] is TCustomControl then
AddToTreeView(TmpTreeNode, TPanel(APanel.Controls[i]))
end;
end;
//*********************************************
var
i: integer;
tn, TmpTreeNode: TTreeNode;
begin
tn := TreeView1.Items.Add(nil, Panel1.Caption);
for i := 0 to Panel1.ControlCount - 1 do
begin
TmpTreeNode := TreeView1.Items.AddChildObject(tn, Panel1.Controls[i].Name ,Panel1.Controls[i]);
if Panel1.Controls[i] is TPanel then
begin
AddToTreeView(TmpTreeNode, TPanel(Panel1.Controls[i]))
end;
end;
end;
//******************************************************************************
procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
Button2Click(TObject(TreeView1.Selected.Data));
end; |
|
沒有留言:
張貼留言