问如何用GridPanel创建类似RowSpan、ColSpan Delphi组件属性

EN

unit UPropertyFakeVerticalAlignment;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Dialogs, DesignIntf,
  DesignEditors, DesignMenus, TypInfo, Winapi.Messages,
  Winapi.Windows, Vcl.StdCtrls, Vcl.Forms, System.Types;

type
  TBaseComponentPropertyEditor = class(TBasePropertyEditor)
  private
    FComponent: TComponent;
    FDesigner: IDesigner;
  protected

  public
    constructor Create(const ADesigner: IDesigner; APropCount: Integer); override;
    property Component: TComponent read FComponent write FComponent;
    property Designer: IDesigner read FDesigner;
  end;

  TPropertyVerticalAlignment = class(TBaseComponentPropertyEditor, IProperty,
      IPropertyKind)
  private
    function GetControl: TControl;
    procedure SetControl(const Value: TControl);
    procedure Activate;
    function AllEqual: Boolean;
    function AutoFill: Boolean;
    procedure Edit; overload;
    function HasInstance(Instance: TPersistent): Boolean;
    function GetEditLimit: Integer;
    procedure GetProperties(Proc: TGetPropProc);
    function GetPropInfo: PPropInfo; virtual;
    function GetPropType: PTypeInfo; virtual;
    procedure Revert;
    function ValueAvailable: Boolean;

  protected
    function GetEditValue(out Value: String): Boolean;
    function GetKind: TTypeKind;
    function GetName: string; reintroduce;
    function GetValue: string; reintroduce;
    procedure SetValue(const Value: String); reintroduce;
    function GetAttributes: TPropertyAttributes;
    procedure GetValues(Proc: TGetStrProc);
  public
    property Control: TControl read GetControl write SetControl;
  end;

  type
    TAddPropertyFakeVerticalAlignment = class(TSelectionEditor, ISelectionPropertyFilter)
      procedure FilterProperties(const ASelection: IDesignerSelections; const
        ASelectionProperties: IInterfaceList);
  end;


implementation

uses NGridPanel;

procedure TAddPropertyFakeVerticalAlignment.FilterProperties(const ASelection:
    IDesignerSelections; const ASelectionProperties: IInterfaceList);
var
  ParentProperty: TPropertyVerticalAlignment;
begin
  if aSelection.Count <> 1 then
   Exit;
  if (aSelection[0] is TControl) then
  begin
    if TControl(ASelection[0]).GetParentComponent is TNGridPanel then
    begin
      ParentProperty := TPropertyVerticalAlignment.Create(inherited Designer, 1);
      ParentProperty.Control := TControl(ASelection[0]);
      ASelectionProperties.Add(ParentProperty as IProperty);
    end;
  end;
end;

constructor TBaseComponentPropertyEditor.Create(const ADesigner: IDesigner;
  APropCount: Integer);
begin
  inherited Create(ADesigner, APropCount);
  FDesigner := ADesigner;
end;

{ TPropertyVerticalAlignment }

procedure TPropertyVerticalAlignment.Activate;
begin

end;

function TPropertyVerticalAlignment.AllEqual: Boolean;
begin
  Result := True;
end;

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

procedure TPropertyVerticalAlignment.Edit;
begin
  inherited;
end;

function TPropertyVerticalAlignment.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paAutoUpdate, paRevertable, paValueEditable];
end;

function TPropertyVerticalAlignment.GetControl: TControl;
begin
  Result := TControl(Component);
end;

function TPropertyVerticalAlignment.GetEditLimit: Integer;
begin
  Result := -1;
end;

function TPropertyVerticalAlignment.GetEditValue(out Value: string): Boolean;
begin
  if Value = EmptyStr then
   Value := GetValue();
  Result := True;
end;

function TPropertyVerticalAlignment.GetKind: TTypeKind;
begin
  Result := tkClass;
end;

function TPropertyVerticalAlignment.GetName: string;
begin
  Result := 'VerticalAlignment';
end;

procedure TPropertyVerticalAlignment.GetProperties(Proc: TGetPropProc);
begin
  inherited;

end;

function TPropertyVerticalAlignment.GetPropInfo: PPropInfo;
begin
  Result := nil;
end;

function TPropertyVerticalAlignment.GetPropType: PTypeInfo;
begin
  Result := nil;
end;

function TPropertyVerticalAlignment.GetValue: string;
var
  AGridPanel: TNGridPanel;
  AControlItem: TControlItemFreedom;
  AIndex: Integer;
begin
  if Assigned(Control) and Assigned(Control.Parent) then
  begin
    if Control.GetParentComponent is TNGridPanel then
    begin
      AGridPanel := TNGridPanel(Control.Parent);

      if AGridPanel <> nil then
      begin
        AIndex := AGridPanel.ControlCollectionFreedom.IndexOf(Control);
        if AIndex > -1 then
        begin
          AControlItem := AGridPanel.ControlCollectionFreedom.Items[AIndex];
          Result := GetEnumName(TypeInfo(TVerticalAlignment), Integer(AControlItem.VerticalAlignment));
        end;
      end;
    end;
  end
  else
    Result := 'taAlignTop';
end;


procedure TPropertyVerticalAlignment.GetValues(Proc: TGetStrProc);
begin
  Designer.GetComponentNames(GetTypeData(TypeInfo(TVerticalAlignment)), Proc);
  if Assigned(Control) and Assigned(Control) then
  begin
    Proc(GetEnumName(TypeInfo(TVerticalAlignment), 0));
    Proc(GetEnumName(TypeInfo(TVerticalAlignment), 1));
    Proc(GetEnumName(TypeInfo(TVerticalAlignment), 2));
  end;
end;

function TPropertyVerticalAlignment.HasInstance(Instance: TPersistent): Boolean;
begin
  Result := True;
end;

procedure TPropertyVerticalAlignment.Revert;
begin

end;

procedure TPropertyVerticalAlignment.SetControl(const Value: TControl);
begin
  Component := Value;
end;

procedure TPropertyVerticalAlignment.SetValue(const Value: String);
var
  P: TWinControl;
  AGridPanel: TNGridPanel;
  AControlItem: TControlItemFreedom;
  AIndex: Integer;
  AVerticalAlignment: TVerticalAlignment;
begin
 inherited;
  if Assigned(Control) and Assigned(Control.Owner) then
  begin
    if Control.GetParentComponent is TNGridPanel then
    begin
      AGridPanel := TNGridPanel(Control.Parent);

      if AGridPanel <> nil then
      begin
        AIndex := AGridPanel.ControlCollectionFreedom.IndexOf(Control);
        if AIndex > -1 then
        begin
          AControlItem := AGridPanel.ControlCollectionFreedom.Items[AIndex];

          AIndex := GetEnumValue(TypeInfo(TVerticalAlignment), Value);

          AVerticalAlignment := TVerticalAlignment(AIndex);

          AControlItem.VerticalAlignment := AVerticalAlignment;
          Designer.Modified;
        end;
      end;
    end;
  end;
end;

function TPropertyVerticalAlignment.ValueAvailable: Boolean;
begin
  Result := True;
end;

end.

unit NGridPanelReg;

interface

uses
  System.Classes, Vcl.Controls, DesignIntf, DesignEditors, TypInfo,
  Winapi.Messages,
  Winapi.Windows, Vcl.StdCtrls, Vcl.Forms, System.Types;

  procedure Register;

implementation

uses NGridPanel, UPropertyFakeVerticalAlignment;


procedure Register;
begin
  RegisterComponents('EMSI', [TNGridPanel]);
  RegisterSelectionEditor(TControl, TAddPropertyFakeVerticalAlignment);
  UnlistPublishedProperty(TNGridPanel, 'ControlCollectionFreedom');
end;

unit NGridPanel;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Dialogs, Variants,
  TypInfo, Winapi.Messages, Winapi.Windows, Vcl.StdCtrls, Vcl.Forms, System.Types;

type

  TControlItemFreedom = class(TCollectionItem)
  private
    FControl: TControl;
    FVerticalAlignment: TVerticalAlignment;
    procedure SetControl(Value: TControl);
    function GetGridPanel: TCustomGridPanel;
    procedure SetVerticalAlignment(const Value: TVerticalAlignment);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    property GridPanel: TCustomGridPanel read GetGridPanel;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property VerticalAlignment: TVerticalAlignment read FVerticalAlignment write SetVerticalAlignment;
    property Control: TControl read FControl write SetControl;
  end;

  TControlCollectionFreedom = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TControlItemFreedom;
    procedure SetItem(Index: Integer; const Value: TControlItemFreedom);
  protected

  public
    function IndexOf(AControl: TControl): Integer;
    constructor Create(AOwner: TPersistent);
    function Add: TControlItemFreedom;
    procedure AddControl(AControl: TControl; AVerticalAlignment: TVerticalAlignment);
    procedure RemoveControl(AControl: TControl);
    property Items[Index: Integer]: TControlItemFreedom read GetItem write SetItem; default;
  end;

  TNGridPanel = class(TGridPanel)
  private
    FControlCollectionFreedom: TControlCollectionFreedom;
    procedure SetControlCollectionVertical(const Value: TControlCollectionFreedom);
    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ControlCollectionFreedom: TControlCollectionFreedom read FControlCollectionFreedom write SetControlCollectionVertical;
  end;

implementation


procedure TNGridPanel.CMControlChange(var Message: TCMControlChange);
begin
  inherited;
  if not (csLoading in ComponentState) then
    if Message.Inserting and (Message.Control.Parent = Self) then
    begin
      DisableAlign;
      try
        Message.Control.Anchors := [];
        FControlCollectionFreedom.AddControl(Message.Control, 'taCenter', taAlignTop, True);
      finally
        EnableAlign;
      end;
    end else
      FControlCollectionFreedom.RemoveControl(Message.Control);
end;

constructor TNGridPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FControlCollectionFreedom := TControlCollectionFreedom.Create(Self);
end;


destructor TNGridPanel.Destroy;
begin
  inherited;
  FreeAndNil(FControlCollectionFreedom);
end;

procedure TNGridPanel.Loaded;
begin
  inherited;
end;

procedure TNGridPanel.SetControlCollectionVertical(const Value: TControlCollectionFreedom);
begin
  FControlCollectionFreedom := Value;
end;

{ TControlItemVertical }

procedure TControlItemFreedom.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TControlItemFreedom then
  begin
    with TControlItem(Dest) do
    begin
      FControl := Self.Control;
      FVerticalAlignment := Self.VerticalAlignment;
      Changed(False);
    end;
  end;
end;

constructor TControlItemFreedom.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FVerticalAlignment := taAlignTop;
end;

destructor TControlItemFreedom.Destroy;
begin

  inherited;
end;

function TControlItemFreedom.GetGridPanel: TCustomGridPanel;
var
  Owner: TControlCollection;
begin
  Owner := TControlCollection(GetOwner);
  if Owner <> nil then
    Result := Owner.Owner
  else
    Result := nil;
end;

procedure TControlItemFreedom.SetControl(Value: TControl);
begin
  if FControl <> Value then
  begin
{$IF DEFINED(CLR)}
    if Assigned(Value) and Value.Equals(GridPanel) then
{$ELSE}
    if Value = GridPanel then
{$IFEND}
      raise EGridPanelException.Create('Controle Inválido');
    FControl := Value;
    Changed(False);
  end;
end;

procedure TControlItemFreedom.SetVerticalAlignment(
  const Value: TVerticalAlignment);
begin
  FVerticalAlignment := Value;
end;

{ TControlCollectionVertical }

function TControlCollectionFreedom.Add: TControlItemFreedom;
begin
  Result := TControlItemFreedom(inherited Add);
end;

procedure TControlCollectionFreedom.AddControl(AControl: TControl; AVerticalAlignment: TVerticalAlignment);
  procedure PlaceInCell(ControlItem: TControlItemFreedom;  AVerticalAlignment: TVerticalAlignment);
  var
    I, J: Integer;
  begin
    with ControlItem do
    try
      Control := AControl;
      VerticalAlignment := AVerticalAlignment;
    except
      Control := nil;
      Free;
      raise;
    end;
  end;
begin
   if IndexOf(AControl) < 0 then
   begin
     PlaceInCell(Add, AVerticalAlignment);
   end;
end;

function TControlCollectionFreedom.IndexOf(AControl: TControl): Integer;
begin
  for Result := 0 to Count - 1 do
    if TControlItemFreedom(Items[Result]).Control = AControl then
      Exit;
  Result := -1;
end;

procedure TControlCollectionFreedom.RemoveControl(AControl: TControl);
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    if Items[I].Control = AControl then
    begin
      Items[I].Control := nil;
      Delete(I);
      Exit;
    end;
end;

procedure TControlCollectionFreedom.SetItem(Index: Integer;
  const Value: TControlItemFreedom);
begin
  inherited SetItem(Index, Value);
end;

constructor TControlCollectionFreedom.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TControlItemFreedom);
end;

function TControlCollectionFreedom.GetItem(Index: Integer): TControlItemFreedom;
begin
  Result := TControlItemFreedom(inherited GetItem(Index));
end;

end.