IDE:  Missing Line Objects in TShape?
lazarus / 10-Designer

----------------------------------------------------------------------
IPguy · 2011-04-11 23:34

I have been unable to find a line object in the IDE.

I've used TShape to make a dividing line between two sections within a
form, but that was more work than it should have been.  I added a
stRectangle and flattened it.  Hard to click on that object in the IDE
and I could not create a "fat" line just using Pen.Width.  To get a
decent heavy line I had to set the Pen.Width to something large (like
4 or more) and then set the Height to ~4. 

And there are no arrow ends.
And I do not see a way to rotate the "line" (rectangle) object.

How do others add lines and arrows to your projects?

----------------------------------------------------------------------
typo · 2011-04-11 23:42

You could add a feature request on BugTracker and even help to write
the component.

Or you could convert a Delphi component or draw the line by yourself.

Here is the Paint procedure of TShape.

Code: [Select]procedure TShape.Paint;
var
  PaintRect: TRect;
  MinSize: Longint;
  P: array[0..3] of TPoint;
  PenInc, PenDec: Integer;
begin
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;

    PenInc := Pen.Width div 2;
    PenDec := (Pen.Width - 1) div 2;

    PaintRect := Rect(PenInc, PenInc, Self.Width - PenDec, Self.Height
- PenDec);
    with PaintRect do
    begin
      MinSize := Min(Right - Left, Bottom - Top);
      if FShape in [stSquare, stRoundSquare, stCircle,
stSquaredDiamond] then
      begin
        Left := Left + ((Right - Left) - MinSize) div 2;
        Top := Top + ((Bottom - Top) - MinSize) div 2;
        Right := Left + MinSize;
        Bottom := Top + MinSize;
      end;
    end;

    case FShape of
      stRectangle, stSquare:
        Rectangle(PaintRect);
      stRoundRect, stRoundSquare:
        RoundRect(PaintRect, MinSize div 4, MinSize div 4);
      stCircle, stEllipse:
        Ellipse(PaintRect);
      stSquaredDiamond, stDiamond:
      begin
        with Self do
        begin
          P[0].x := PenInc;
          P[0].y := (Height - 1) div 2;
          P[1].x := (Width - 1) div 2;
          P[1].y := PenInc;
          P[2].x := Width - PenInc - 1;
          P[2].y := P[0].y;
          P[3].x := P[1].x;
          P[3].y := Height - PenInc - 1;
          Polygon(P);
        end;
      end;
      stTriangle:
      begin
        with Self do
        begin
          P[0].x := (Width - 1) div 2;
          P[0].y := PenInc;
          P[1].x := Width - PenInc - 1;
          P[1].y := Height - PenInc - 1;
          P[2].x := PenInc;
          P[2].y := Height - PenInc - 1;
          P[3].x := P[0].x;
          P[3].y := P[0].y;
          Polygon(P);
        end;
      end;
    end;
  end;
  // to fire OnPaint event
  inherited Paint;
end;   

You could add you code here and commit it on BugTracker.

----------------------------------------------------------------------
IPguy · 2011-04-11 23:55

If no one comes up with a solution, I will add a feature request, but
I want to be sure that I have not overlooked something in the IDE
first.

I used Delphi back in the v2 (?) days and I no longer have the
software or the license key. 

The "do it myself" option is interesting and it would help me learn
the internals, but I have to get my product out the door first before
I can "play".

----------------------------------------------------------------------
IPguy · 2011-04-11 23:58

typo,
Thanks for the code. 

I just submitted a bug report for two of the shapes disappearing with
certain height and pen.width combinatioins.  I'll look into the code
to see if I can figure out why that is happening.

----------------------------------------------------------------------
Blaazen · 2011-04-12 00:11

There are components TDividerBevel (in LazControls) or TBevel (as
bsTopLine or bsBottomLine) for those purposes.

To reported bug: if TShape.Height is 10 and Pen.Width is 11 then it
disappears too. (Always when Pen.Width=Shape.Height+1)

----------------------------------------------------------------------
IPguy · 2011-04-12 00:16

Thanks Blaazen,
I'll add that information to the bug report.

And I will try the T*Bevel objects.

----------------------------------------------------------------------
typo · 2011-04-12 01:53

Here is a free TLine class:

http://www.torry.net/authorsmore.php?id=3649

----------------------------------------------------------------------
typo · 2011-04-12 19:03

This unit implements a TLine component: 

Code: [Select]// Initially developed by Gon Perez-Jimenez. 2002-4th-
April for Delphi
unit ULine;

interface

uses
   SysUtils, Classes, Controls, Graphics;

type
  TLineDirection = (drLeftRight, drUpDown, drTopLeftBottomRight,
drTopRightBottomLeft);

  TLine = class(TGraphicControl)
  private
    { Private declarations }
    FLineDir: TLineDirection;
    FArrow1: Boolean;
    FArrow2: Boolean;
    FArrowFactor: Integer;
    function GetLineWidth: Integer;
    function GetLineColor: TColor;
    function GetLineStyle: TPenStyle;
    procedure SetLineWidth(const NewWidth: Integer);
    procedure SetLineColor(const NewColor: TColor);
    procedure SetLineDir(const NewDir: TLineDirection);
    procedure SetArrow1(Value: Boolean);
    procedure SetArrow2(Value: Boolean);
    procedure SetArrowFactor(Value: integer);
    procedure SetLineStyle(const NewStyle: TPenStyle);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property DragCursor;
    property DragKind;
    property DragMode;
    property Align;
    property ParentShowHint;
    property Hint;
    property ShowHint;
    property Visible;
    property PopupMenu;
    property Direction: TLineDirection read FLineDir write SetLineDir
default drLeftRight;
    property Color: TColor read GetLineColor write SetLineColor;
    property LineStyle :TPenStyle read GetLineStyle write
SetLineStyle;
    property LineWidth: Integer read GetLineWidth write SetLineWidth;
    property Arrow1: Boolean read FArrow1 write SetArrow1 default
False;
    property Arrow2: Boolean read FArrow2 write SetArrow2 default
False;
    property ArrowFactor: Integer read FArrowFactor write
SetArrowFactor default 3;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEndDock;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
    property OnDblClick;
  end;

procedure Register;

implementation

{ TLine }

constructor TLine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 65;
  Height := 4;
  Canvas.Brush.Color:=clBlack;
  FArrowFactor:=3;
end;

destructor TLine.Destroy;
begin
  inherited Destroy;
end;

procedure TLine.SetArrowFactor(Value: Integer);
begin
  if Value <> FArrowFactor then begin
     FArrowFactor := Value;
     Invalidate;
  end;
end;

procedure TLine.SetArrow1(Value: Boolean);
begin
  if Value <> FArrow1 then begin
     FArrow1 := Value;
     if Value then SetLineWidth(1);
     Invalidate;
  end;
end;

procedure TLine.SetArrow2(Value: Boolean);
begin
  if Value <> FArrow2 then begin
     FArrow2 := Value;
     if Value then SetLineWidth(1);
     Invalidate;
  end;
end;

function TLine.GetLineWidth: Integer;
begin
  Result := Canvas.Pen.Width;
end;

function TLine.GetLineColor: TColor;
begin
  Result := Canvas.Pen.Color;
end;

function TLine.GetLineStyle: TPenStyle;
begin
  Result := Canvas.Pen.Style;
end;

procedure TLine.SetLineWidth(const NewWidth: Integer);
begin
  if NewWidth <> Canvas.Pen.Width then
  begin
    if FArrow1 or FArrow2 then begin
       //LineWidth:=1;  // stack overflow
       Canvas.Pen.Width:=1;
    end else Canvas.Pen.Width := NewWidth;
    Invalidate;
  end;
end;

procedure TLine.SetLineColor(const NewColor: TColor);
begin
  if NewColor <> Canvas.Pen.Color then
  begin
    Canvas.Pen.Color := NewColor;
    Invalidate;
  end;
end;

procedure TLine.SetLineStyle(const NewStyle: TPenStyle);
begin
  if NewStyle <> Canvas.Pen.Style then
  begin
    Canvas.Pen.Style := NewStyle;
    Invalidate;
  end;
end;

procedure TLine.SetLineDir(const NewDir: TLineDirection);
begin
  if NewDir <> FLineDir then
  begin
    FLineDir := NewDir;
    Invalidate;
  end;
end;

procedure TLine.Paint;
var
  start: Integer;
  p1,p2,p3:TPoint;
  H0,W0,H,W:Integer;
  Alfa:extended;
begin
  inherited;
  case FLineDir of
    drLeftRight:
      begin
        start := (Height - Canvas.Pen.Width) div 2;
        Canvas.Brush.Style := bsClear;
        Canvas.MoveTo(0, start);
        Canvas.LineTo(Width, Start);
        if FArrow1 then begin
          // Arrow left
          p1:=Point(0,start);
          p2:=Point(FArrowFactor,Start-FArrowFactor);
          p3:=Point(FArrowFactor,Start+FArrowFactor);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;

        if FArrow2 then begin
          // Arrow right
          p1:=Point(Width-1, Start);
          p2:=Point(Width-(FArrowFactor+1),Start-FArrowFactor);
          p3:=Point(Width-(FArrowFactor+1),Start+FArrowFactor);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;
      end;
    drUpDown:
      begin
        start := (Width - Canvas.Pen.Width) div 2;
        Canvas.Brush.Style := bsClear;
        Canvas.MoveTo(start, 0);
        Canvas.LineTo(start, Height);
        if FArrow1 then begin
          // Arrow up
          p1:=Point(start,0);
          p2:=Point(Start-FArrowFactor,FArrowFactor);
          p3:=Point(Start+FArrowFactor,FArrowFactor);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;

        if FArrow2 then begin
          // Arrow down
          p1:=Point(start,Height-1);
          p2:=Point(Start-FArrowFactor,Height-(FArrowFactor+1));
          p3:=Point(Start+FArrowFactor,Height-(FArrowFactor+1));
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;
      end;
    drTopLeftBottomRight:
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.MoveTo(0, 0);
        Canvas.LineTo(Width, Height);
        if FArrow1 and(Width>0)then begin
          // Arrow up
          Alfa:=ArcTan(Height/Width);
          H0:=Round((FArrowFactor+1)*Sin(Alfa));
          W0:=Round((FArrowFactor+1)*Cos(Alfa));
          p1:=Point(0,0);
          W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
          if H<0 then H:=0;
          if W<0 then W:=0;
          p2:=Point(W,H);
          W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
          if H<0 then H:=0;
          if W<0 then W:=0;
          p3:=Point(W,H);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;
        if FArrow2 and(Width>0)then begin
          // Arrou down
          Alfa:=ArcTan(Height/Width);
          H0:=Round((FArrowFactor+1)*Sin(Alfa));
          W0:=Round((FArrowFactor+1)*Cos(Alfa));
          p1:=Point(Width-1, Height-1);
          W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
          W:=Width-W-1;
          H:=Height-H-1;
          if H>=Height then H:=Height-1;
          if W>=Width then W:=Width-1;
          p2:=Point(W,H);
          W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
          W:=Width-W-1;
          H:=Height-H-1;
          if H>=Height then H:=Height-1;
          if W>=Width then W:=Width-1;
          p3:=Point(W,H);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;
      end;
    drTopRightBottomLeft:
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.MoveTo(Width, 0);
        Canvas.LineTo(0, Height);
        if FArrow1 and(Width>0)then begin
          // Arrou up
          Alfa:=ArcTan(Height/Width);
          H0:=Round((FArrowFactor+1)*Sin(Alfa));
          W0:=Round((FArrowFactor+1)*Cos(Alfa));
          p1:=Point(Width-1,0);
          W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
          W:=Width-W-1;
          if H<0 then H:=0;
          if W>=Width then W:=Width-1;
          p2:=Point(W,H);
          W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
          W:=Width-W-1;
          if H<0 then H:=0;
          if W>=Width then W:=Width-1;
          p3:=Point(W,H);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;
        if FArrow2 and(Width>0)then begin
          // Arrow down
          Alfa:=ArcTan(Height/Width);
          H0:=Round((FArrowFactor+1)*Sin(Alfa));
          W0:=Round((FArrowFactor+1)*Cos(Alfa));
          p1:=Point(0, Height-1);
          W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
          H:=Height-H-1;
          if H>=Height then H:=Height-1;
          if W<0 then W:=0;
          p2:=Point(W,H);
          W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
          H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
          H:=Height-H-1;
          if H>=Height then H:=Height-1;
          if W<0 then W:=0;
          p3:=Point(W,H);
          Canvas.Brush.Style := bsSolid;
          Canvas.Brush.Color := Canvas.Pen.Color;
          Canvas.Polygon([p1,p2,p3]);
        end;
      end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Misc', [TLine]);
end;

end.             

Maybe TShape is not the better place to put a line, since TLine should
have properties like Direction or Arrow which are not present on the
other kind of shapes. Maybe a standard horizontal line with right
arrow could be made by TShape object.