designeditors.pas

模仿QQ的靠边停靠源码

    if ( (P^.PropertyType = PropType) {or
         ((P^.PropertyType^.Kind = PropType.Kind) and
          (P^.PropertyType^.Name = PropType.Name)
         )}
       ) or  // compatible class type
       ( (PropType^.Kind = tkClass) and
         (P^.PropertyType^.Kind = tkClass) and
         GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType)
       ) or  // compatible interface type
       ( (PropType^.Kind = tkInterface) and
         (P^.PropertyType^.Kind = tkInterface) and
         InterfaceInheritsFrom(GetTypeData(PropType), GetTypeData(P^.PropertyType))
       ) then
      if ((P^.ComponentClass = nil) or (Obj.InheritsFrom(P^.ComponentClass))) and
         ((P^.ClassGroup = nil) or (P^.ClassGroup = ClassGroupOf(Obj))) and
         ((P^.PropertyName = '') or (CompareText(PropInfo^.Name, P^.PropertyName) = 0)) then
        if (C = nil) or   // see if P is better match than C
           ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil)) or
           ((C^.PropertyName = '') and (P^.PropertyName <> ''))
           or  // P's proptype match is exact, but C's isn't
           ((C^.PropertyType <> PropType) and (P^.PropertyType = PropType))
           or  // P's proptype is more specific than C's proptype
           ( (P^.PropertyType <> C^.PropertyType) and
             ( ( // P has a more specific class type than C.
                 (P^.PropertyType^.Kind = tkClass) and
                 (C^.PropertyType^.Kind = tkClass) and
                 GetTypeData(P^.PropertyType)^.ClassType.InheritsFrom(
                   GetTypeData(C^.PropertyType)^.ClassType)
               ) or // P has a more specific interface type than C.
               ( (P^.PropertyType^.Kind = tkInterface) and
                 (C^.PropertyType^.Kind = tkInterface) and
                 InterfaceInheritsFrom(GetTypeData(P^.PropertyType), GetTypeData(C^.PropertyType))
               )
             )
           ) or // P's component class is more specific than C's component class
           ( (P^.ComponentClass <> nil) and (C^.ComponentClass <> nil) and
             (P^.ComponentClass <> C^.ComponentClass) and
             (P^.ComponentClass.InheritsFrom(C^.ComponentClass))
           ) then
          C := P;
    Inc(I);
  end;
  if C <> nil then
    Result := C^.EditorClass else
    Result := PropClassMap[PropType^.Kind];
end;

procedure GetComponentProperties(const Components: IDesignerSelections;
  Filter: TTypeKinds; const Designer: IDesigner; Proc: TGetPropProc;
  EditorFilterFunc: TPropertyEditorFilterFunc);
var
  I, J, CompCount: Integer;
  CompType: TClass;
  Candidates: TPropInfoList;
  PropLists: TList;
  EditorInstance: TBasePropertyEditor;
  Editor: IProperty;
  EdClass: TPropertyEditorClass;
  PropInfo: PPropInfo;
  AddEditor: Boolean;
  Obj: TPersistent;
begin
  if (Components = nil) or (Components.Count = 0) then Exit;
  CompCount := Components.Count;
  Obj := Components[0];
  CompType := Components[0].ClassType;
  // Create a property candidate list
  Candidates := TPropInfoList.Create(Components[0], Filter);
  try
    for I := Candidates.Count - 1 downto 0 do
    begin
      PropInfo := Candidates[I];
      EdClass := GetEditorClass(PropInfo, Obj);
      if EdClass = nil then
        Candidates.Delete(I)
      else
      begin
        EditorInstance := EdClass.Create(Designer, 1);
        Editor := EditorInstance as IProperty;
        TPropertyEditor(EditorInstance).SetPropEntry(0, Components[0], PropInfo);
        TPropertyEditor(EditorInstance).Initialize;
        with PropInfo^ do
          if (GetProc = nil) or
             (not GShowReadOnlyProps and
              ((PropType^.Kind <> tkClass) and
               (SetProc = nil))) or
             ((CompCount > 1) and
              not (paMultiSelect in Editor.GetAttributes)) or
             not Editor.ValueAvailable or
             (Assigned(EditorFilterFunc) and not EditorFilterFunc(Editor)) then
            Candidates.Delete(I);
      end;
    end;
    PropLists := TList.Create;
    try
      PropLists.Capacity := CompCount;
      // Create a property list for each component in the selection
      for I := 0 to CompCount - 1 do
        PropLists.Add(TPropInfoList.Create(Components[I], Filter));
      // Eliminate each property in Candidates that is not in all property list
      for I := 0 to CompCount - 1 do
        Candidates.Intersect(TPropInfoList(PropLists[I]));
      // Eliminate each property in the property list that are not in Candidates
      for I := 0 to CompCount - 1 do
        TPropInfoList(PropLists[I]).Intersect(Candidates);
      // PropList now has a matrix of PropInfo's, create property editors for
      // each property with given each the array of PropInfos
      for I := 0 to Candidates.Count - 1 do
      begin
        EdClass := GetEditorClass(Candidates[I], Obj);
        if EdClass = nil then Continue;
        EditorInstance := EdClass.Create(Designer, CompCount);
        Editor := EditorInstance as IProperty;
        AddEditor := True;
        for J := 0 to CompCount - 1 do
        begin
          if (Components[J].ClassType <> CompType) and
            (GetEditorClass(TPropInfoList(PropLists[J])[I],
              Components[J]) <> EdClass) then
          begin
            AddEditor := False;
            Break;
          end;
          TPropertyEditor(EditorInstance).SetPropEntry(J, Components[J],
            TPropInfoList(PropLists[J])[I]);
        end;
        if AddEditor then
        begin
          TPropertyEditor(EditorInstance).Initialize;
          if Editor.ValueAvailable then Proc(Editor);
        end;
      end;
    finally
      for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
      PropLists.Free;
    end;
  finally
    Candidates.Free;
  end;
end;

procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
var
  P: PPropertyMapperRec;
begin
  if PropertyMapperList = nil then
    PropertyMapperList := TList.Create;
  New(P);
  P^.Group := CurrentGroup;
  P^.Mapper := Mapper;
  PropertyMapperList.Insert(0, P);
end;

{ Component Editors }

{ TComponentEditor }

constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: IDesigner);
begin
  inherited Create(AComponent, ADesigner);
  FComponent := AComponent;
  FDesigner := ADesigner;
end;

procedure TComponentEditor.Edit;
begin
  if GetVerbCount > 0 then ExecuteVerb(0);
end;

function TComponentEditor.GetComponent: TComponent;
begin
  Result := FComponent;
end;

function TComponentEditor.GetDesigner: IDesigner;
begin
  Result := FDesigner;
end;

function TComponentEditor.GetVerbCount: Integer;
begin
  // Intended for descendents to implement
  Result := 0;
end;

function TComponentEditor.GetVerb(Index: Integer): string;
begin
  // Intended for descendents to implement
end;

procedure TComponentEditor.ExecuteVerb(Index: Integer);
begin
  // Intended for descendents to implement
end;

procedure TComponentEditor.Copy;
begin
  // Intended for descendents to implement
end;

function TComponentEditor.IsInInlined: Boolean;
begin
  Result := csInline in Component.Owner.ComponentState;
end;

procedure TComponentEditor.PrepareItem(Index: Integer;
  const AItem: IMenuItem);
begin
  // Intended for descendents to implement
end;

{ TDefaultEditor }

procedure TDefaultEditor.CheckEdit(const Prop: IProperty);
begin
  if FContinue then
    EditProperty(Prop, FContinue);
end;

procedure TDefaultEditor.EditProperty(const Prop: IProperty;
  var Continue: Boolean);
var
  PropName: string;
  BestName: string;
  MethodProperty: IMethodProperty;

  procedure ReplaceBest;
  begin
    FBest := Prop;
    if FFirst = FBest then FFirst := nil;
  end;

begin
  if not Assigned(FFirst) and
    Supports(Prop, IMethodProperty, MethodProperty) then
    FFirst := Prop;
  PropName := Prop.GetName;
  BestName := '';
  if Assigned(FBest) then BestName := FBest.GetName;
  if CompareText(PropName, 'ONCREATE') = 0 then
    ReplaceBest
  else if CompareText(BestName, 'ONCREATE') <> 0 then
    if CompareText(PropName, 'ONCHANGE') = 0 then
      ReplaceBest
    else if CompareText(BestName, 'ONCHANGE') <> 0 then
      if CompareText(PropName, 'ONCLICK') = 0 then
        ReplaceBest;
end;

procedure TDefaultEditor.Edit;
var
  Components: IDesignerSelections;
begin
  Components := TDesignerSelections.Create;
  FContinue := True;
  Components.Add(Component);
  FFirst := nil;
  FBest := nil;
  try
    GetComponentProperties(Components, tkAny, Designer, CheckEdit);
    if FContinue then
      if Assigned(FBest) then
        FBest.Edit
      else if Assigned(FFirst) then
        FFirst.Edit;
  finally
    FFirst := nil;
    FBest := nil;
  end;
end;

{ RegisterComponentEditor }
type
  PComponentClassRec = ^TComponentClassRec;
  TComponentClassRec = record
    Group: Integer;
    ComponentClass: TComponentClass;
    EditorClass: TComponentEditorClass;
  end;

var
  ComponentClassList: TList = nil;

procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);
var
  P: PComponentClassRec;
begin
  if ComponentClassList = nil then
    ComponentClassList := TList.Create;
  New(P);
  P.Group := CurrentGroup;
  P.ComponentClass := ComponentClass;
  P.EditorClass := ComponentEditor;
  ComponentClassList.Insert(0, P);
end;

{ GetComponentEditor }

function GetComponentEditor(Component: TComponent;
  const Designer: IDesigner): IComponentEditor;
var
  P: PComponentClassRec;
  I: Integer;
  ComponentClass: TComponentClass;
  EditorClass: TComponentEditorClass;
begin
  ComponentClass := TComponentClass(TPersistent);
  EditorClass := TDefaultEditor;
  if ComponentClassList <> nil then
    for I := 0 to ComponentClassList.Count-1 do
    begin
      P := ComponentClassList[I];
      if (Component is P^.ComponentClass) and
        (P^.ComponentClass <> ComponentClass) and
        (P^.ComponentClass.InheritsFrom(ComponentClass)) then
      begin
        EditorClass := P^.EditorClass;
        ComponentClass := P^.ComponentClass;
      end;
    end;
  Result := EditorClass.Create(Component, Designer) as IComponentEditor;
end;


{ TSelectionEditor }

constructor TSelectionEditor.Create(const ADesigner: IDesigner);
begin
  inherited Create(ADesigner);
  FDesigner := ADesigner;
end;

procedure TSelectionEditor.ExecuteVerb(Index: Integer; const List: IDesignerSelections);
begin
  // Intended for descendents to implement
end;

function TSelectionEditor.GetVerb(Index: Integer): string;
begin
  // Intended for descendents to implement
  Result := '';
end;

function TSelectionEditor.GetVerbCount: Integer;
begin
  // Intended for descendents to implement
  Result := 0;
end;

procedure TSelectionEditor.RequiresUnits(Proc: TGetStrProc);
begin
  // No implementation needed (see description in DesignIntf)
end;

procedure TSelectionEditor.PrepareItem(Index: Integer;
  const AItem: IMenuItem);
begin
  // Intended for descendents to implement
end;

type
  TSelectionEditorList = class(TInterfacedObject, ISelectionEditorList)
  private
    FList: IInterfaceList;
  protected
    procedure Add(AEditor: ISelectionEditor);
  public
    constructor Create;
    function Get(Index: Integer): ISelectionEditor;
    function GetCount: Integer;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: ISelectionEditor read Get; default;
  end;

{ TSelectionEditorList }

procedure TSelectionEditorList.Add(AEditor: ISelectionEditor);
begin
  FList.Add(AEditor);
end;

constructor TSelectionEditorList.Create;
begin
  inherited;
  FList := TInterfaceList.Create;
end;

function TSelectionEditorList.Get(Index: Integer): ISelectionEditor;
begin
  Result := FList[Index] as ISelectionEditor;
end;

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

type
  TSelectionEditorDefinition = class(TObject)
  private
    FGroup: Integer;
    FClass: TClass;
    FEditor: TSelectionEditorClass;
  public
    constructor Create(AClass: TClass; AEditor: TSelectionEditorClass);
    function Matches(AClass: TClass): Boolean;
    property Editor: TSelectionEditorClass read FEditor;
  end;

  TSelectionEditorDefinitionList = class(TObjectList)
  protected
    function GetItem(Index: Integer): TSelectionEditorDefinition;
    procedure SetItem(Index: Integer; AObject: TSelectionEditorDefinition);
    procedure FreeEditorGroup(AGroup: Integer);
  public
    property Items[Index: Integer]: TSelectionEditorDefinition read GetItem write SetItem; default;
  end;

{ TSelectionEditorDefinition }

constructor TSelectionEditorDefinition.Create(AClass: TClass;
  AEditor: TSelectionEditorClass);
begin
  inherited Create;
  FGroup := CurrentGroup;
  FClass := AClass;
  FEditor := AEditor;
end;

function TSelectionEditorDefinition.Matches(AClass: TClass): Boolean;
begin
  Result := AClass.InheritsFrom(FClass);
end;

{ TSelectionEditorDefinitionList }

procedure TSelectionEditorDefinitionList.FreeEditorGroup(AGroup: Integer);
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    if Items[I].FGroup = AGroup then
      Delete(I);
end;

function TSelectionEditorDefinitionList.GetItem(Index: Integer): TSelectionEditorDefinition;
begin
  Result := TSelectionEditorDefinition(inherited Items[Index]);
end;

procedure TSelectionEditorDefinitionList.SetItem(Index: Integer;
  AObject: TSelectionEditorDefinition);
begin
  inherited Items[Index] := AObject;
end;

var
  SelectionEditorDefinitionList: TSelectionEditorDefinitionList;

procedure RegisterSelectionEditor(AClass: TClass; AEditor: TSelectionEditorClass);
begin
  if not Assigned(SelectionEd