• 欢迎访问搞代码网站,推荐使用最新版火狐浏览器和Chrome浏览器访问本网站!
  • 如果您觉得本站非常有看点,那么赶紧使用Ctrl+D 收藏搞代码吧

Delphi5的控件升级到Delphi6_Delphi

Delphi 搞代码 3年前 (2018-08-09) 204次浏览 已收录 0个评论

其实把属性编辑器等引用DesignEditors的部分,如属性编辑器的声明、实现以及属性编辑器的注册另写一个单元就行了。
下面是一个简单的例子

unit NWDictTreeViewReg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Db, DbTables, DesignIntf, DesignEditors;

http://www.gaodaima.com/65647.htmlDelphi5的控件升级到Delphi6_Delphi

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[i]);
    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[i]);
    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[i]);
    end;
  finally
    TempTable.Free;
    NameStrings.Free;
  end;
end;

end.
当然,也有一些没这么容易,如 TCollectionEditor, TDesignWindow 等,原来的虚拟方法都变了。你可以试试升级 EhLib。

欢迎大家阅读《Delphi5的控件升级到Delphi6_Delphi》,跪求各位点评,若觉得好的话请收藏本文,by 搞代码


喜欢 (0)
[搞代码]
分享 (0)
发表我的评论
取消评论

表情 贴图 加粗 删除线 居中 斜体 签到

Hi,您需要填写昵称和邮箱!

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址