R
realLearning
Unregistered / Unconfirmed
GUEST, unregistred user!
请问Delphi如何将属性和其注册的属性编辑器关联起来?
我现在是自己做了两个编辑器,但是如果不用registerClasses注册
这两个类,就无法激活对应的属性编辑器,但是希望能根据需要动态的注册属性编辑器,
不明白Delphi的IDE中是如何处理注册的问题的。程序代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ValEdit,TypInfo, ComCtrls;
type
TObjStru= record
ObjPropName : string;
ObjClass : string;
ObjValue : Integer;
end;
TCustomPropertyEditor = class(TComponent)
private
FComponent : TComponent;
public
procedure Execute;virtual;
end;
TFontPropertyEditor = class(TCustomPropertyEditor)
public
procedure Execute;override;
end;
TStringsPropertyEditor = class(TCustomPropertyEditor)
public
procedure Execute;override;
end;
TfrmPropertyEditor = class(TForm)
vleProp: TValueListEditor;
StatusBar1: TStatusBar;
procedure vlePropValidate(Sender: TObject; ACol, ARow: Integer;
const KeyName, KeyValue: String);
procedure vlePropSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure vlePropEditButtonClick(Sender: TObject);
private
FComponent : TComponent;
FOldValue : string;
FObjValue : array of TObjStru;
public
{ Public declarations }
end;
var
frmPropertyEditor: TfrmPropertyEditor;
procedure ActivePropertyEditor(AComponent : TComponent);
implementation
{$R *.dfm}
procedure ActivePropertyEditor(AComponent : TComponent);
var
PropList : PPropList;
I,J : Integer;
PropCount : Integer;
Value : Variant;
TypeData : PTypeData;
ObjCount : Integer;
begin
with TfrmPropertyEditor.Create(nil) do
try
GetPropList(AComponent,PropList);
if PropList<>nil then
begin
PropCount := GetTypeData(PTypeInfo(AComponent.ClassInfo))^.PropCount;
SortPropList(PropList,PropCount);
ObjCount := 0;
for I := Low(PropList^) to PropCount-1 do
begin
if PropList^.PropType^.Kind in [tkString,tkInteger,tkWString,tkChar,tkWChar,tkFloat,tkEnumeration,tkClass,tkSet,tkVariant] then
begin
Value := GetPropValue(AComponent,PropList^.Name);
vleProp.InsertRow(PropList^.Name,Value,True);
case PropList^.PropType^.Kind of
tkEnumeration :begin
vleProp.ItemProps[PropList^.Name].EditStyle := esPickList;
TypeData := GetTypeData(GetTypeData(PropList^.PropType^)^.BaseType^);
for J := TypeData^.MinValue to TypeData^.MaxValue do
vleProp.ItemProps[PropList^.Name].PickList.Add(GetEnumName(PropList^.PropType^,J));
vleProp.ItemProps[PropList^.Name].ReadOnly := True;
end;
tkClass : begin
vleProp.ItemProps[PropList^.Name].EditStyle := esEllipsis;
vleProp.ItemProps[PropList^.Name].ReadOnly := True;
TypeData := GetTypeData(PropList^.PropType^);
vleProp.Values[PropList^.Name] := '('+TypeData.ClassType.ClassName+')';
SetLength(FObjValue,ObjCount+1);
FObjValue[ObjCount].ObjPropName := PropList^.Name;
FObjValue[ObjCount].ObjValue := Value;
FObjValue[ObjCount].ObjClass := TypeData.ClassType.ClassName;
Inc(ObjCount);
end;
end;
end;
end;
end;
FComponent := AComponent;
ShowModal;
finally
Free;
end;
end;
procedure TfrmPropertyEditor.vlePropValidate(Sender: TObject; ACol,
ARow: Integer; const KeyName, KeyValue: String);
var
vValue : Variant;
begin
vValue := KeyValue;
try
SetPropValue(FComponent,KeyName,vValue);
except
MessageBox(Handle,'无效的属性值!','错误',MB_OK or MB_ICONERROR);
vleProp.Cells[ACol,ARow] := FOldValue;
Abort;
end;
end;
procedure TfrmPropertyEditor.vlePropSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
FOldValue := vleProp.Cells[ACol,ARow];
end;
procedure TfrmPropertyEditor.vlePropEditButtonClick(Sender: TObject);
var
Obj : TComponent;
I : Integer;
PropClass : TClass;
begin
RegisterClasses([TCustomPropertyEditor,TFontPropertyEditor,TStringsPropertyEditor]);//就是这里无法动态的注册属性编辑器。
for I := Low(FObjValue) to High(FObjValue) do
begin
if FObjValue.ObjPropName = vleProp.Keys[vleProp.Row] then
begin
if FObjValue.ObjValue>0 then
begin
Obj := TComponent(FObjValue.ObjValue);
PropClass := GetClass(FObjValue.ObjClass+'PropertyEditor');
if PropClass=nil then
PropClass := GetClass('TCustomPropertyEditor');
with PropClass.Create as TCustomPropertyEditor do
begin
FComponent := Obj;
Execute ;
Free ;
end;
end;
Exit;
end;
end;
end;
{ TCustomPropertyEditor }
procedure TCustomPropertyEditor.Execute;
begin
ActivePropertyEditor(FComponent);
end;
{ TFontPropertyEditor }
procedure TFontPropertyEditor.Execute;
begin
with TFontDialog.Create(Self) do
begin
try
Font.Assign(FComponent);
if Execute then
FComponent.Assign(Font);
finally
Free;
end;
end;
end;
{ TStringsPropertyEditor }
procedure TStringsPropertyEditor.Execute;
begin
with TOpenDialog.Create(Self) do
begin
try
if Execute then
TStringList(FComponent).LoadFromFile(FileName);
finally
Free;
end;
end;
end;
end.
我现在是自己做了两个编辑器,但是如果不用registerClasses注册
这两个类,就无法激活对应的属性编辑器,但是希望能根据需要动态的注册属性编辑器,
不明白Delphi的IDE中是如何处理注册的问题的。程序代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ValEdit,TypInfo, ComCtrls;
type
TObjStru= record
ObjPropName : string;
ObjClass : string;
ObjValue : Integer;
end;
TCustomPropertyEditor = class(TComponent)
private
FComponent : TComponent;
public
procedure Execute;virtual;
end;
TFontPropertyEditor = class(TCustomPropertyEditor)
public
procedure Execute;override;
end;
TStringsPropertyEditor = class(TCustomPropertyEditor)
public
procedure Execute;override;
end;
TfrmPropertyEditor = class(TForm)
vleProp: TValueListEditor;
StatusBar1: TStatusBar;
procedure vlePropValidate(Sender: TObject; ACol, ARow: Integer;
const KeyName, KeyValue: String);
procedure vlePropSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure vlePropEditButtonClick(Sender: TObject);
private
FComponent : TComponent;
FOldValue : string;
FObjValue : array of TObjStru;
public
{ Public declarations }
end;
var
frmPropertyEditor: TfrmPropertyEditor;
procedure ActivePropertyEditor(AComponent : TComponent);
implementation
{$R *.dfm}
procedure ActivePropertyEditor(AComponent : TComponent);
var
PropList : PPropList;
I,J : Integer;
PropCount : Integer;
Value : Variant;
TypeData : PTypeData;
ObjCount : Integer;
begin
with TfrmPropertyEditor.Create(nil) do
try
GetPropList(AComponent,PropList);
if PropList<>nil then
begin
PropCount := GetTypeData(PTypeInfo(AComponent.ClassInfo))^.PropCount;
SortPropList(PropList,PropCount);
ObjCount := 0;
for I := Low(PropList^) to PropCount-1 do
begin
if PropList^.PropType^.Kind in [tkString,tkInteger,tkWString,tkChar,tkWChar,tkFloat,tkEnumeration,tkClass,tkSet,tkVariant] then
begin
Value := GetPropValue(AComponent,PropList^.Name);
vleProp.InsertRow(PropList^.Name,Value,True);
case PropList^.PropType^.Kind of
tkEnumeration :begin
vleProp.ItemProps[PropList^.Name].EditStyle := esPickList;
TypeData := GetTypeData(GetTypeData(PropList^.PropType^)^.BaseType^);
for J := TypeData^.MinValue to TypeData^.MaxValue do
vleProp.ItemProps[PropList^.Name].PickList.Add(GetEnumName(PropList^.PropType^,J));
vleProp.ItemProps[PropList^.Name].ReadOnly := True;
end;
tkClass : begin
vleProp.ItemProps[PropList^.Name].EditStyle := esEllipsis;
vleProp.ItemProps[PropList^.Name].ReadOnly := True;
TypeData := GetTypeData(PropList^.PropType^);
vleProp.Values[PropList^.Name] := '('+TypeData.ClassType.ClassName+')';
SetLength(FObjValue,ObjCount+1);
FObjValue[ObjCount].ObjPropName := PropList^.Name;
FObjValue[ObjCount].ObjValue := Value;
FObjValue[ObjCount].ObjClass := TypeData.ClassType.ClassName;
Inc(ObjCount);
end;
end;
end;
end;
end;
FComponent := AComponent;
ShowModal;
finally
Free;
end;
end;
procedure TfrmPropertyEditor.vlePropValidate(Sender: TObject; ACol,
ARow: Integer; const KeyName, KeyValue: String);
var
vValue : Variant;
begin
vValue := KeyValue;
try
SetPropValue(FComponent,KeyName,vValue);
except
MessageBox(Handle,'无效的属性值!','错误',MB_OK or MB_ICONERROR);
vleProp.Cells[ACol,ARow] := FOldValue;
Abort;
end;
end;
procedure TfrmPropertyEditor.vlePropSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
FOldValue := vleProp.Cells[ACol,ARow];
end;
procedure TfrmPropertyEditor.vlePropEditButtonClick(Sender: TObject);
var
Obj : TComponent;
I : Integer;
PropClass : TClass;
begin
RegisterClasses([TCustomPropertyEditor,TFontPropertyEditor,TStringsPropertyEditor]);//就是这里无法动态的注册属性编辑器。
for I := Low(FObjValue) to High(FObjValue) do
begin
if FObjValue.ObjPropName = vleProp.Keys[vleProp.Row] then
begin
if FObjValue.ObjValue>0 then
begin
Obj := TComponent(FObjValue.ObjValue);
PropClass := GetClass(FObjValue.ObjClass+'PropertyEditor');
if PropClass=nil then
PropClass := GetClass('TCustomPropertyEditor');
with PropClass.Create as TCustomPropertyEditor do
begin
FComponent := Obj;
Execute ;
Free ;
end;
end;
Exit;
end;
end;
end;
{ TCustomPropertyEditor }
procedure TCustomPropertyEditor.Execute;
begin
ActivePropertyEditor(FComponent);
end;
{ TFontPropertyEditor }
procedure TFontPropertyEditor.Execute;
begin
with TFontDialog.Create(Self) do
begin
try
Font.Assign(FComponent);
if Execute then
FComponent.Assign(Font);
finally
Free;
end;
end;
end;
{ TStringsPropertyEditor }
procedure TStringsPropertyEditor.Execute;
begin
with TOpenDialog.Create(Self) do
begin
try
if Execute then
TStringList(FComponent).LoadFromFile(FileName);
finally
Free;
end;
end;
end;
end.