快来领分拉-组件开发中的一个问题，UP有奖！

Question

我在定制一个组件时，其中一个属性需要用到下拉框，也就是类似于TEDIT中的选择对齐方式，颜色等属性等的那种选择框，应该很常见！问题是，这些属性类型定义一般都是枚举类型的--也就是说事先定义好的，但我需要动态载入列表，就象DBTEXT等中的DATAFIELD字段那样！请问这样的属性该如何设计？指定为何种类型？谢谢了！

Answer 1

第二名啊我
up up up up

Answer 2

声明枚举类型
  TEnuValue = (a, b, c, d)
声明变量
  FValue: TEnuValue;
公开属性
  property Value: TEnuValue read FValue write FValue; 

Answer 3

delphi6以上版本有这样的组件，好象叫valuelist还是keylist什么的记不太清楚了，反正你可以用它为编辑框动态加载你预先定义的键值，而且还可使输入与显示的值不一样。

Answer 4

需要编写属性编辑器Property Editor，高级编程教材会有提级，Delphi中的例子也很多，参考VCL源码的Property Editor。

Answer 5

如何写Property Editor，给点思路好吗？谢谢

Answer 6

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}unit DBReg;interfaceuses SysUtils, Classes, DesignIntf, DesignEditors,
{$IFDEF MSWINDOWS}DSDesign{$ENDIF}{$IFDEF LINUX}DSDesignLin{$ENDIF};type
  TDBStringProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
  end;  TDataFieldProperty = class(TDBStringProperty)
  public
    function GetDataSourcePropName: string; virtual;
    procedure GetValueList(List: TStrings); override;
  end;  TDataFieldAggProperty = class(TDBStringProperty)
  public
    function GetDataSourcePropName: string; virtual;
    procedure GetValueList(List: TStrings); override;
  end;  TDataSetEditor = class(TComponentEditor{$IFDEF LINUX}, IDesignerThreadAffinity{$ENDIF})
  protected
    function GetDSDesignerClass: TDSDesignerClass; virtual;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
{$IFDEF LINUX}
    procedure Edit; override;
    {IDesignerThreadAffinity}
    function GetThreadAffinity: TThreadAffinity;
{$ENDIF}
  end;  TIndexFieldNamesProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;  TIndexNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;{ TListFieldProperty }type
  TListFieldProperty = class(TDataFieldProperty)
  public
    function GetDataSourcePropName: string; override;
  end;procedure Register;implementationuses
  Windows, Controls, Forms, Mask, TypInfo, DsnDBCst, DB, 
  ColnEdit, ActnList, DBActRes, DBColnEd;{ TDataSetEditor }function TDataSetEditor.GetDSDesignerClass: TDSDesignerClass;
begin
  Result := TDSDesigner;
end;procedure TDataSetEditor.ExecuteVerb(Index: Integer);
begin
  if Index = 0 then
    ShowFieldsEditor(Designer, TDataSet(Component), GetDSDesignerClass);
end;function TDataSetEditor.GetVerb(Index: Integer): string;
begin
  Result := SDatasetDesigner;
end;function TDataSetEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;{$IFDEF LINUX}
function TDataSetEditor.GetThreadAffinity: TThreadAffinity;
begin
  Result  := taQT;
end;procedure TDataSetEditor.Edit; 
begin
  ShowFieldsEditor(Designer, TDataSet(Component), GetDSDesignerClass);
end;{$ENDIF}{ TDataSetProperty }type
  TDataSetProperty = class(TComponentProperty)
  private
    FCheckProc: TGetStrProc;
    procedure CheckComponent(const Value: string);
  public
    procedure GetValues(Proc: TGetStrProc); override;
  end;procedure TDataSetProperty.CheckComponent(const Value: string);
var
  J: Integer;
  Dataset: TDataset;
begin
  Dataset := TDataset(Designer.GetComponent(Value));
  for J := 0 to PropCount - 1 do
    if TDataSource(GetComponent(J)).IsLinkedTo(Dataset) then
      Exit;
  FCheckProc(Value);
end;procedure TDataSetProperty.GetValues(Proc: TGetStrProc);
begin
  FCheckProc := Proc;
  inherited GetValues(CheckComponent);
end;

Answer 7

{ TDataSourceProperty }type
  TDataSourceProperty = class(TComponentProperty)
  private
    FCheckProc: TGetStrProc;
    procedure CheckComponent(const Value: string);
  public
    procedure GetValues(Proc: TGetStrProc); override;
  end;procedure TDataSourceProperty.CheckComponent(const Value: string);
var
  J: Integer;
  DataSource: TDataSource;
begin
  DataSource := TDataSource(Designer.GetComponent(Value));
  for J := 0 to PropCount - 1 do
    if TDataSet(GetComponent(J)).IsLinkedTo(DataSource) then
      Exit;
  FCheckProc(Value);
end;procedure TDataSourceProperty.GetValues(Proc: TGetStrProc);
begin
  FCheckProc := Proc;
  inherited GetValues(CheckComponent);
end;{ TNestedDataSetProperty }type
  TNestedDataSetProperty = class(TComponentProperty)
  private
    FCheckProc: TGetStrProc;
    procedure CheckComponent(const Value: string);
  public
    procedure GetValues(Proc: TGetStrProc); override;
  end;procedure TNestedDataSetProperty.CheckComponent(const Value: string);
var
  DataSet: TDataset;
begin
  DataSet := (GetComponent(0) as TDataSetField).DataSet;
  if TDataset(Designer.GetComponent(Value)) <> DataSet then
    FCheckProc(Value);
end;procedure TNestedDataSetProperty.GetValues(Proc: TGetStrProc);
begin
  FCheckProc := Proc;
  inherited GetValues(CheckComponent);
end;{ TDBStringProperty }function TDBStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;procedure TDBStringProperty.GetValueList(List: TStrings);
begin
end;procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do Proc(Values[I]);
  finally
    Values.Free;
  end;
end;function GetIndexDefs(Component: TPersistent): TIndexDefs;
var
  DataSet: TDataSet;
begin
  DataSet := Component as TDataSet;
  Result := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs;
  if Assigned(Result) then
  begin
    Result.Updated := False;
    Result.Update;
  end;
end;{ TIndexNameProperty }procedure TIndexNameProperty.GetValueList(List: TStrings);
begin
  GetIndexDefs(GetComponent(0)).GetItemNames(List);
end;{ TIndexFieldNamesProperty }procedure TIndexFieldNamesProperty.GetValueList(List: TStrings);
var
  I: Integer;
  IndexDefs: TIndexDefs;
begin
  IndexDefs := GetIndexDefs(GetComponent(0));
  for I := 0 to IndexDefs.Count - 1 do
    with IndexDefs[I] do
      if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
        List.Add(Fields);
end;{ TDataFieldProperty }function TDataFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'DataSource';
end;procedure TDataFieldProperty.GetValueList(List: TStrings);
var
  DataSource: TDataSource;
begin
  DataSource := GetObjectProp(GetComponent(0), GetDataSourcePropName) as TDataSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(List);
end;{ TDataFieldAggProperty }function TDataFieldAggProperty.GetDataSourcePropName: string;
begin
  Result := 'DataSource';
end;procedure TDataFieldAggProperty.GetValueList(List: TStrings);
var
  DataSource: TDataSource;
  AggList: TStringList;
begin
  DataSource := GetObjectProp(GetComponent(0), GetDataSourcePropName) as TDataSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  begin
    DataSource.DataSet.GetFieldNames(List);
    if DataSource.DataSet.AggFields.Count > 0 then
    begin
      AggList := TStringList.Create;
      try
        DataSource.DataSet.AggFields.GetFieldNames(AggList);
        List.AddStrings(AggList);
      finally
        AggList.Free;
      end;
    end;
  end;
end;{ TLookupSourceProperty }type
  TLookupSourceProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;procedure TLookupSourceProperty.GetValueList(List: TStrings);
begin
  with GetComponent(0) as TField do
    if DataSet <> nil then DataSet.GetFieldNames(List);
end;{ TLookupDestProperty }type
  TLookupDestProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;procedure TLookupDestProperty.GetValueList(List: TStrings);
begin
  with GetComponent(0) as TField do
    if LookupDataSet <> nil then LookupDataSet.GetFieldNames(List);
end;function TListFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'ListSource';
end;{ TLookupFieldProperty }type
  TLookupFieldProperty = class(TDataFieldProperty)
  public
    function GetDataSourcePropName: string; override;
  end;function TLookupFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'LookupSource';
end;{ TLookupIndexProperty }type
  TLookupIndexProperty = class(TLookupFieldProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;procedure TLookupIndexProperty.GetValueList(List: TStrings);
var
  DataSource: TDataSource;
begin
  DataSource := GetObjectProp(GetComponent(0), GetDataSourcePropName) as TDataSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(List);
end;{ Registration }procedure Register;
begin
  { Database Components are excluded from the STD SKU }
  if GDAL <> LongWord(-16) then
  begin
    RegisterComponents(srDAccess, [TDataSource]);    RegisterNoIcon([TField]);    RegisterFields([TStringField, TIntegerField, TSmallintField, TWordField,
      TFloatField, TCurrencyField, TBCDField, TFMTBcdField, TBooleanField, TDateField,
      TVarBytesField, TBytesField, TTimeField, TDateTimeField, TSQLTimeStampField,
      TBlobField, TMemoField, TGraphicField, TAutoIncField, TLargeIntField,
      TADTField, TArrayField, TDataSetField, TReferenceField, TAggregateField,
      TWideStringField, TVariantField, TGuidField, TInterfaceField, TIDispatchField]);    RegisterPropertyEditor(TypeInfo(TDataSet), TDataSource, 'DataSet', TDataSetProperty);
    RegisterPropertyEditor(TypeInfo(TDataSet), TDataSetField, 'NestedDataSet', TNestedDataSetProperty);
    RegisterPropertyEditor(TypeInfo(TDataSource), TDataSet, 'MasterSource', TDataSourceProperty);
    RegisterPropertyEditor(TypeInfo(TDataSource), TDataSet, 'DataSource', TDataSourceProperty);
    RegisterPropertyEditor(TypeInfo(string), TField, 'KeyFields', TLookupSourceProperty);
    RegisterPropertyEditor(TypeInfo(string), TField, 'LookupKeyFields', TLookupDestProperty);
    RegisterPropertyEditor(TypeInfo(string), TField, 'LookupResultField', TLookupDestProperty);
    RegisterPropertyEditor(TypeInfo(string), TComponent, 'DataField', TDataFieldProperty);
    RegisterPropertyEditor(TypeInfo(string), TWinControl, 'LookupField', TLookupIndexProperty);
    RegisterPropertyEditor(TypeInfo(string), TWinControl, 'LookupDisplay', TLookupFieldProperty);    RegisterComponentEditor(TDataset, TDataSetEditor);
    { Property Category registration }
    RegisterPropertiesInCategory(sDatabaseCategoryName, TDataSet,
      ['*Field', '*Fields', 'Index*', 'Lookup*', '*Defs', 'ObjectView', 'Table*',
       'Param*', 'Cache*', 'Lock*', 'Cursor*']);
    RegisterPropertiesInCategory(sDatabaseCategoryName, TField,
      ['*Field', '*Fields']);
    RegisterPropertyInCategory(sDatabaseCategoryName, TComponent, 'DataField');  end;
end;end.