正在做一个属性编辑器,遇到一个问题,请教大虾。(300分)

  • 主题发起人 主题发起人 realLearning
  • 开始时间 开始时间
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.
 
我看到VCLSkin专门有一个注册得子程序
不知道对你有没有帮助。
unit WinSkinReg;

interface

{$I Compilers.Inc}

uses Dialogs, Forms, Classes, SysUtils,
{$ifdef DELPHI_4}
DsgnIntf,
{$endif DELPHI_4}

{$ifdef DELPHI_5}
DsgnIntf,
{$endif DELPHI_5}

{$ifdef DELPHI_6}
DesignIntf,DesignEditors,
{$endif DELPHI_6}

{$ifdef DELPHI_7}
DesignIntf,DesignEditors,
{$endif DELPHI_7}

{$ifdef CPPB_5}
DsgnIntf,
{$endif CPPB_5}

{$ifdef CPPB_6}
DesignIntf,DesignEditors,
{$endif CPPB_6}

winskindata,skinread,winsubclass,winskinform;

procedure Register;

implementation


type
{ TWinSkinStore}
TWinSkinStore = class(TPropertyEditor)
private
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end;

procedure TWinSkinStore.Edit;
var
OpenDialog: TOpenDialog;
begin
{ Execute editor }
OpenDialog := TOpenDialog.Create(Application);
OpenDialog.Filter := 'Skin files (*.skn)|*.skn';
try
if OpenDialog.Execute then
begin
TSkindata(GetComponent(0)).data.clear;
TSkindata(GetComponent(0)).data.LoadFromFile(OpenDialog.FileName);
TSkindata(GetComponent(0)).SkinFile := '';
end;
Modified;
finally
OpenDialog.Free;
end;
end;

function TWinSkinStore.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;

function TWinSkinStore.GetValue: string;
begin
if TSkindata(GetComponent(0)).data.size > 0 then
// Result := '('+TSeSkinEngine(GetComponent(0)).SkinSource.SkinName+')'
Result := '(SkinData)'
else
Result := '(Emtpy)'
end;

procedure Register;
begin
RegisterComponents('VCLSkin', [TSkinData,TWinSkinForm]);
RegisterPropertyEditor(TypeInfo(String), TSkinData, 'SkinStore',TWinSkinStore);
end;

end.

继续学习中.....
 
接受答案了.
 
后退
顶部