dsgnintf.pas

SQL自动生成

    just by property type.  Additionally property name may include wild card
    symbols.  For example: you can add all properties that match 'Data*' to
    a particular category.  For a full list of what wild card characters
    are available please refer to the TMask class documentation.
  RegisterPropertiesInCategory
    This function will allow you to register a series of property names and/or
    property types filters in a single statement.
  IsPropertyInCategory
    This function comes in two flavors, each taking a slightly different set of
    arguments.  But in either case you can ask if a property of a certain class
    falls under the specified category.  The class can be specified by name or
    by class type.
  PropertyCategoryList
    This function will return, and create if necessary, the global property
    category list.}

function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  const APropertyName: string): TPropertyFilter; overload;
function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  AComponentClass: TClass; const APropertyName: string): TPropertyFilter; overload;
function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  APropertyType: PTypeInfo; const APropertyName: string): TPropertyFilter; overload;
function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  APropertyType: PTypeInfo): TPropertyFilter; overload;

function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  const AFilters: array of const): TPropertyCategory; overload;
function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  AComponentClass: TClass; const AFilters: array of string): TPropertyCategory; overload;
function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  APropertyType: PTypeInfo; const AFilters: array of string): TPropertyCategory; overload;

function IsPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  AComponentClass: TClass; const APropertyName: String): Boolean; overload;
function IsPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  const AClassName: string; const APropertyName: String): Boolean; overload;

function PropertyCategoryList: TPropertyCategoryList;

{ Property Categories
  The following class defines the standard categories used by Delphi.  These are
  general purpose and can be used by component developers for property category
  registration.  Additionally component developers can create new descedents of
  TPropertyCategory to add completly new categories. }

type
  TActionCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TDataCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TDatabaseCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TDragNDropCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  THelpCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TLayoutCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TLegacyCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TLinkageCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TLocaleCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TLocalizableCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TMiscellaneousCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TVisualCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

  TInputCategory = class(TPropertyCategory)
  public
    class function Name: string; override;
    class function Description: string; override;
  end;

var
  BaseRegistryKey: string = '';

implementation

uses Dialogs, Consts, Registry, Math;

type
  PPropertyClassRec = ^TPropertyClassRec;
  TPropertyClassRec = record
    Group: Integer;
    PropertyType: PTypeInfo;
    PropertyName: string;
    ComponentClass: TClass;
    EditorClass: TPropertyEditorClass;
  end;

  PPropertyMapperRec = ^TPropertyMapperRec;
  TPropertyMapperRec = record
    Group: Integer;
    Mapper: TPropertyMapperFunc;
  end;

const
  PropClassMap: array[TypInfo.TTypeKind] of TPropertyEditorClass = (
    nil, TIntegerProperty, TCharProperty, TEnumProperty,
    TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
    TMethodProperty, TPropertyEditor, TStringProperty, TStringProperty,
    TPropertyEditor, nil, nil, nil, TInt64Property, nil);
      (* tkArray, tkRecord, kInterface, tkInt64, tkDynArray *)

var
  PropertyClassList: TList = nil;
  EditorGroupList: TBits = nil;
  PropertyMapperList: TList = nil;
  InternalPropertyCategoryList: TPropertyCategoryList = nil;

const

  { context ids for the Font editor and the Color Editor, etc. }
  hcDFontEditor       = 25000;
  hcDColorEditor      = 25010;
  hcDMediaPlayerOpen  = 25020;

{ TDesignerSelectionList }

constructor TDesignerSelectionList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TDesignerSelectionList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TDesignerSelectionList.Get(Index: Integer): TPersistent;
begin
  Result := FList[Index];
end;

function TDesignerSelectionList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TDesignerSelectionList.Add(Item: TPersistent): Integer;
begin
  Result := FList.Add(Item);
end;

function TDesignerSelectionList.Equals(List: TDesignerSelectionList): Boolean;
var
  I: Integer;
begin
  Result := False;
  if List.Count <> FList.Count then Exit;
  for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  Result := True;
end;

function TDesignerSelectionList.Intf_Add(const Item: IPersistent): Integer;
begin
  Result := Add(ExtractPersistent(Item));
end;

function TDesignerSelectionList.Intf_Equals(const List: IDesignerSelections): Boolean;
var
  I: Integer;
  CompList: IComponentList;
  P1, P2: IPersistent;
begin
  if List.QueryInterface(IComponentList, CompList) = 0 then
    Result := CompList.GetComponentList.Equals(Self)
  else
  begin
    Result := False;
    if List.Count <> FList.Count then Exit;
    for I := 0 to List.Count - 1 do
    begin
      P1 := Intf_Get(I);
      P2 := List[I];
      if ((P1 = nil) and (P2 <> nil)) or
        (P2 = nil) or not P1.Equals(P2) then Exit;
    end;
    Result := True;
  end;
end;

function TDesignerSelectionList.Intf_Get(Index: Integer): IPersistent;
begin
  Result := MakeIPersistent(TPersistent(FList[Index]));
end;

function TDesignerSelectionList.GetComponentList: TDesignerSelectionList;
begin
  Result := Self;
end;

{ TPropertyEditor }

constructor TPropertyEditor.Create(const ADesigner: IFormDesigner;
  APropCount: Integer);
begin
  FDesigner := ADesigner;
  GetMem(FPropList, APropCount * SizeOf(TInstProp));
  FPropCount := APropCount;
end;

destructor TPropertyEditor.Destroy;
begin
  if FPropList <> nil then
    FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
end;

procedure TPropertyEditor.Activate;
begin
end;

function TPropertyEditor.AllEqual: Boolean;
begin
  Result := FPropCount = 1;
end;

procedure TPropertyEditor.Edit;
type
  TGetStrFunc = function(const Value: string): Integer of object;
var
  I: Integer;
  Values: TStringList;
  AddValue: TGetStrFunc;
begin
  if not AutoFill then Exit;
  Values := TStringList.Create;
  Values.Sorted := paSortList in GetAttributes;
  try
    AddValue := Values.Add;
    GetValues(TGetStrProc(AddValue));
    if Values.Count > 0 then
    begin
      I := Values.IndexOf(Value) + 1;
      if I = Values.Count then I := 0;
      Value := Values[I];
    end;
  finally
    Values.Free;
  end;
end;

function TPropertyEditor.AutoFill: Boolean;
begin
  Result := True;
end;

function TPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paRevertable];
end;

function TPropertyEditor.GetComponent(Index: Integer): TPersistent;
begin
  Result := FPropList^[Index].Instance;
end;

function TPropertyEditor.GetFloatValue: Extended;
begin
  Result := GetFloatValueAt(0);
end;

function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
begin
  with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
end;

function TPropertyEd