How to create Component Property similar RowSpan, ColSpan Delphi with GridPanel

Question

I am creating a component inheriting from the gridpanel. When I add a label, edit, or other component on the gridpanel, the edit, label... component appears in the Row, Col, RowSpan, and ColSpan properties. How do I create a new property equal to these Row, Col, RowSpan, and ColSpan properties. Which only enables when to a component on the gridPanel? No If I want to create a new property and this property will appear for the Edit, Label among others that are on the gridpanel.

I'm using Delphi XE2

Answer 1

It seems not possible. Of course you can copy source and modify it, but not directly inheriting.

The problem is that you can inherit from TControlItem class and add the property you want but then you cannot modify TControlCollection ItemClass: TControlCollection constructor replace ancestor (TOwnedCollection) constructor and so you cannot change default ItemClass (TControlItem) with the derived one.

You can try with a class helper for TControlItem but in that case you will have only runtime support (object inspector and RTTI will know nothing about that). Well, with some nasty trick you can do whatever you want, but I think this go beyond our scope here (see Add a property on TWinControl Class accepted answer for details and read original cited Allen Bauer artcicle).

Answer 2

Follow the code with the new fake property in the NGridPanel component.

Class Fake Property

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.

Class Register

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;

Class Component

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.