Hello,

For a game, I need to be able to draw geometric shapes. TShape is perfect except for one missing feature: TShape only draws triangles pointing up, and I need also triangles pointing left, right and down. My first reaction was to create a derived class, and try to somehow add the missing shapes by overriding TShape.Paint and in the overriding method just handle the new shapes. But TShape is designed in such a way that I can't figure out how to do it. Then I thought that I'd create a derived class but that this class Paint method would draw all the possible shapes (including the 3 new ones) and that for that I'd override the Paint method with a modified implementation of TShape.Paint. Much less clean, not really oo-ish, but it should at least work. "Should", because when I tried this, I discovered that it would be much more difficult that I had hoped, so that I decided to stop trying and ask here first.

Does anybody have a good suggestion about how to handle this? Should I forget about deriving TShape and should I directly modify TShape's code?

On 26/12/2013 12:03, Frederic Da Vitoria wrote:
Should I

forget about deriving TShape and should I directly modify TShape's code?

For a project that needed something similar I found that TShape with its fixed TShapeType enumeration was too inflexible (though it is Delphi-compatible, hence its presence).
Trying to stuff too much shape-drawing code variety into one gloriously polymorphic control becomes increasingly complex and difficult to maintain. I ended up writing a simple (isosceles only) triangle control which you are welcome to adapt as suits you, attached here.

unit triangles;
{$mode objfpc}{$H+}
interface
uses
   Classes, Controls, types, Graphics, LCLProc;
type
   {$M+}
   TBaseAlign=(baBottom, baTop, baLeft, baRight);
   {$M+}
   { TTriangle }
   TTriangle=class(TGraphicControl)
   private
     FPen: TPen;
     FBaseAlign: TBaseAlign;
     FBrush: TBrush;
     procedure SetBrush(Value: TBrush);
     procedure SetPen(Value: TPen);
     procedure SetBaseAlign(aValue: TBaseAlign);
   protected
     class function GetControlClassDefaultSize: TSize; override;
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     procedure Paint; override;
     procedure ParamsChanged(Sender: TObject);
   published
     property Align;
     property Anchors;
     property BaseAlign: TBaseAlign read FBaseAlign write SetBaseAlign
default baBottom;
     property BorderSpacing;
     property Brush: TBrush read FBrush write SetBrush;
     property Constraints;
     property DragCursor;
     property DragKind;
     property DragMode;
     property Enabled;
     property ParentShowHint;
     property Pen: TPen read FPen write SetPen;
     property OnChangeBounds;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDock;
     property OnEndDrag;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
     property OnPaint;
     property OnResize;
     property OnStartDock;
     property OnStartDrag;
     property ShowHint;
     property Visible;
   end;
implementation

{ TTriangle }

procedure TTriangle.SetBrush(Value: TBrush);
begin
   if Value  Brush then
     FBrush.Assign(Value);
end;
procedure TTriangle.SetPen(Value: TPen);
begin
    if Value  Pen then
     FPen.Assign(Value);
end;
procedure TTriangle.SetBaseAlign(aValue: TBaseAlign);
begin
   if aValueFBaseAlign then begin
     FBaseAlign:=aValue;
     ParamsChanged(Self);
   end;
end;
class function TTriangle.GetControlClassDefaultSize: TSize;
begin
   Result.cx:=65;
   Result.cy:=65;
end;
constructor TTriangle.Create(TheOwner: TComponent);
begin
   inherited Create(TheOwner);
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, CX, CY);
   ControlStyle := ControlStyle + [csReplicatable];
   FPen := TPen.Create;
   FPen.OnChange := @ParamsChanged;
   FBrush := TBrush.Create;
   FBrush.OnChange := @ParamsChanged;
   FBaseAlign:=baBottom;
end;
destructor TTriangle.Destroy;
begin
   FreeThenNil(FPen);
   FreeThenNil(FBrush);
   inherited Destroy;
end;
procedure TTriangle.Paint;
var
   PaintRect: TRect;
   P: array[1..3] of TPoint;
   PenInc, PenDec: Integer;
   procedure CalcPoints(aBaseAlign: TBaseAlign);
   begin
     case aBaseAlign of
       baBottom: begin P[1].x := (Width - 1) div 2;
         P[1].y := PenInc;
         P[2].x := Width - PenInc - 1;
         P[2].y := Height - PenInc - 1;
         P[3].x := PenInc;
         P[3].y := Height - PenInc - 1;  end;
       baTop: begin P[3].x := (Width - 1) div 2;
         P[1].x := PenInc;
         P[2].x := Width - PenInc - 1;
         P[3].y := Height - PenInc - 1;
         P[1].y := PenInc;
         P[2].y := PenInc;  end;
       baLeft: begin P[1].x := PenInc;
         P[1].y := PenInc;
         P[2].x := Width - PenInc - 1;
         P[2].y := (Height - 1) div 2;
         P[3].x := PenInc;
         P[3].y := Height - PenInc - 1;  end;
       baRight: begin P[1].y := (Height - 1) div 2;
         P[1].x := PenInc;
         P[2].x := Width - PenInc - 1;
         P[2].y := PenInc;
         P[3].x := Width - PenInc - 1;
         P[3].y := Height - PenInc - 1;  end;
     end;
   end;
begin
   Canvas.Pen:=FPen;
   Canvas.Brush:=FBrush;
   PenInc := Pen.Width div 2;
   PenDec := (Pen.Width - 1) div 2;
   PaintRect := Rect(PenInc, PenInc, Self.Width - PenDec, Self.Height -
PenDec);
   if PaintRect.Left = PaintRect.Right then
     PaintRect.Right := PaintRect.Right + 1;
   if PaintRect.Top = PaintRect.Bottom then
     PaintRect.Bottom := PaintRect.Bottom + 1;
   CalcPoints(FBaseAlign);
   Canvas.Polygon(P);
   inherited Paint;
end;
procedure TTriangle.ParamsChanged(Sender: TObject);
begin
   if (Parent  nil) and (Visible or (csDesigning in ComponentState)) and
      Parent.HandleAllocated then
     Invalidate;
end;
end.

2013/12/26 Howard Page-Clark

Isoceles is quite enough for my needs. It should be easy to add squares, rectangles and circles (although of course I'll have the change the class' name)

Thank you, Howard