D
delphiwolf
Unregistered / Unconfirmed
GUEST, unregistred user!
其实把属性编辑器等引用DesignEditors的部分,
如属性编辑器的声明、实现以及属性编辑器的注册另写一个单元就行了。
下面是一个简单的例子
unit NWDictTreeViewReg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Db, DbTables, DesignIntf, DesignEditors;
type
TNamePropertyEditor = class(TPropertyEditor)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
end;
TDatabaseNameProperty = class(TNamePropertyEditor)
public
procedure GetValues(Proc: TGetStrProc); override;
end;
TTableNameProperty = class(TNamePropertyEditor)
public
procedure GetValues(Proc: TGetStrProc); override;
end;
TFieldNameProperty = class(TNamePropertyEditor)
public
procedure GetValues(Proc: TGetStrProc); override;
end;
procedure Register;
implementation
uses NWDictTreeView;
procedure Register;
begin
RegisterComponents('NoctWolf DB', [TNWDictTreeView]);
RegisterPropertyEditor(TypeInfo(string), TNWDictTreeView, 'DatabaseName', TDatabaseNameProperty);
RegisterPropertyEditor(TypeInfo(TFileName), TNWDictTreeView, '', TTableNameProperty);
RegisterPropertyEditor(TypeInfo(TFieldName), TNWDictTreeView, '', TFieldNameProperty);
end;
function TNamePropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paValueList, paSortList, paAutoUpdate];
end;
function TNamePropertyEditor.GetValue: string;
begin
Result := GetStrValue;
end;
procedure TDatabaseNameProperty.GetValues(Proc: TGetStrProc);
var
NameStrings: TStrings;
i: Integer;
begin
NameStrings := TStringList.Create;
try
Session.GetDatabaseNames(NameStrings);
for i := 0 to NameStrings.Count - 1 do
begin
Proc(NameStrings);
end;
finally
NameStrings.Free;
end;
end;
procedure TNamePropertyEditor.SetValue(const Value: string);
begin
if GetStrValue <> Value then SetStrValue(Value);
end;
procedure TTableNameProperty.GetValues(Proc: TGetStrProc);
var
NameStrings: TStrings;
i: Integer;
begin
NameStrings := TStringList.Create;
try
Session.GetTableNames((GetComponent(0) as TNWDictTreeView).DatabaseName, '*.*', False, False, NameStrings);
for i := 0 to NameStrings.Count - 1 do
begin
Proc(NameStrings);
end;
finally
NameStrings.Free;
end;
end;
procedure TFieldNameProperty.GetValues(Proc: TGetStrProc);
var
NameStrings: TStrings;
i: Integer;
TempTable: TTable;
begin
NameStrings := TStringList.Create;
TempTable := TTable.Create(GetComponent(0) as TNWDictTreeView);
try
TempTable.DatabaseName := (GetComponent(0) as TNWDictTreeView).DatabaseName;
if (GetName = 'DictRelationParentCodeFieldName') or
(GetName = 'DictRelationCodeFieldName') then
TempTable.TableName := (GetComponent(0) as TNWDictTreeView).DictRelationTableName
else
TempTable.TableName := (GetComponent(0) as TNWDictTreeView).DictTableName;
TempTable.GetFieldNames(NameStrings);
for i := 0 to NameStrings.Count - 1 do
begin
Proc(NameStrings);
end;
finally
TempTable.Free;
NameStrings.Free;
end;
end;
end.
如属性编辑器的声明、实现以及属性编辑器的注册另写一个单元就行了。
下面是一个简单的例子
unit NWDictTreeViewReg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Db, DbTables, DesignIntf, DesignEditors;
type
TNamePropertyEditor = class(TPropertyEditor)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
end;
TDatabaseNameProperty = class(TNamePropertyEditor)
public
procedure GetValues(Proc: TGetStrProc); override;
end;
TTableNameProperty = class(TNamePropertyEditor)
public
procedure GetValues(Proc: TGetStrProc); override;
end;
TFieldNameProperty = class(TNamePropertyEditor)
public
procedure GetValues(Proc: TGetStrProc); override;
end;
procedure Register;
implementation
uses NWDictTreeView;
procedure Register;
begin
RegisterComponents('NoctWolf DB', [TNWDictTreeView]);
RegisterPropertyEditor(TypeInfo(string), TNWDictTreeView, 'DatabaseName', TDatabaseNameProperty);
RegisterPropertyEditor(TypeInfo(TFileName), TNWDictTreeView, '', TTableNameProperty);
RegisterPropertyEditor(TypeInfo(TFieldName), TNWDictTreeView, '', TFieldNameProperty);
end;
function TNamePropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paValueList, paSortList, paAutoUpdate];
end;
function TNamePropertyEditor.GetValue: string;
begin
Result := GetStrValue;
end;
procedure TDatabaseNameProperty.GetValues(Proc: TGetStrProc);
var
NameStrings: TStrings;
i: Integer;
begin
NameStrings := TStringList.Create;
try
Session.GetDatabaseNames(NameStrings);
for i := 0 to NameStrings.Count - 1 do
begin
Proc(NameStrings);
end;
finally
NameStrings.Free;
end;
end;
procedure TNamePropertyEditor.SetValue(const Value: string);
begin
if GetStrValue <> Value then SetStrValue(Value);
end;
procedure TTableNameProperty.GetValues(Proc: TGetStrProc);
var
NameStrings: TStrings;
i: Integer;
begin
NameStrings := TStringList.Create;
try
Session.GetTableNames((GetComponent(0) as TNWDictTreeView).DatabaseName, '*.*', False, False, NameStrings);
for i := 0 to NameStrings.Count - 1 do
begin
Proc(NameStrings);
end;
finally
NameStrings.Free;
end;
end;
procedure TFieldNameProperty.GetValues(Proc: TGetStrProc);
var
NameStrings: TStrings;
i: Integer;
TempTable: TTable;
begin
NameStrings := TStringList.Create;
TempTable := TTable.Create(GetComponent(0) as TNWDictTreeView);
try
TempTable.DatabaseName := (GetComponent(0) as TNWDictTreeView).DatabaseName;
if (GetName = 'DictRelationParentCodeFieldName') or
(GetName = 'DictRelationCodeFieldName') then
TempTable.TableName := (GetComponent(0) as TNWDictTreeView).DictRelationTableName
else
TempTable.TableName := (GetComponent(0) as TNWDictTreeView).DictTableName;
TempTable.GetFieldNames(NameStrings);
for i := 0 to NameStrings.Count - 1 do
begin
Proc(NameStrings);
end;
finally
TempTable.Free;
NameStrings.Free;
end;
end;
end.