Delphi line component - delphi

Question

I am looking for a line component.
I have seen a couple examples, however they dont enable
the line to be drawn at any angle, or
with different line paterns - dot/dash
etc.
I would like to be able to do something similar to the INSERT/SHAPES/LINE in MS word, that i can grab the anchor at an end and drag at any angle...
This is one i found: TLine v.1.0
but it only lets me draw horizontal or vertical lines, not a line at say 17 degrees..
This link is the type of thing i want to do, have anchor points at the end of the line, so i can click on them at runtime and drag the line
Does anyone know of a component (freeware) that
can do what i want or
help to convert the above to do what i want, or
any suggests that might help..
thanks in advance...

Answer 1

I understand you have found a component, but it is missing some properties you wish for. Well, I took a look at how TShape is made and came up with the following try out:
Update:
Properties AutoAngle and Backwards added.
unit Line;
interface
uses
Windows, Classes, Controls, Graphics, StdCtrls, Math;
type
TLine = class(TGraphicControl)
private
FAlignment: TAlignment;
FAngle: Integer;
FAutoAngle: Boolean;
FLayout: TTextLayout;
FPen: TPen;
function DiagonalAngle: Integer;
function GetBackwards: Boolean;
function GetExtends(LimitWidth, LimitHeight: Integer): TRect;
procedure PenChanged(Sender: TObject);
procedure SetAlignment(Value: TAlignment);
procedure SetAngle(Value: Integer);
procedure SetAutoAngle(Value: Boolean);
procedure SetBackwards(Value: Boolean);
procedure SetLayout(Value: TTextLayout);
procedure SetPen(Value: TPen);
protected
procedure AdjustSize; override;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
procedure Paint; override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Alignment: TAlignment read FAlignment write SetAlignment
default taCenter;
property Anchors;
property Angle: Integer read FAngle write SetAngle;
property AutoAngle: Boolean read FAutoAngle write SetAutoAngle
default True;
property AutoSize;
property Backwards: Boolean read GetBackwards write SetBackwards
stored False;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property ParentShowHint;
property Pen: TPen read FPen write SetPen;
property ShowHint;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TLine]);
end;
{ TLine }
procedure TLine.AdjustSize;
begin
if AutoSize then
FAutoAngle := False;
inherited AdjustSize;
end;
function TLine.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
with GetExtends(NewWidth, NewHeight) do
begin
NewWidth := Right;
NewHeight := Bottom;
end;
Result := True;
end;
constructor TLine.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 65;
Height := 65;
FPen := TPen.Create;
FPen.OnChange := PenChanged;
FAlignment := taCenter;
FLayout := tlCenter;
FAutoAngle := True;
end;
destructor TLine.Destroy;
begin
FPen.Free;
inherited Destroy;
end;
function TLine.DiagonalAngle: Integer;
begin
if Width = FPen.Width then
Result := 90
else if Height = FPen.Width then
Result := 0
else
if Backwards then
Result := 180 - Round(RadToDeg(ArcTan(Height / Width)))
else
Result := Round(RadToDeg(ArcTan(Height / Width)));
end;
function TLine.GetBackwards: Boolean;
begin
Result := FAngle > 90;
end;
function TLine.GetExtends(LimitWidth, LimitHeight: Integer): TRect;
begin
Result.Left := 0;
Result.Top := 0;
if FAngle = 0 then
begin
Result.Right := LimitWidth;
Result.Bottom := FPen.Width;
end
else if FAngle = 90 then
begin
Result.Right := FPen.Width;
Result.Bottom := LimitHeight;
end
else
begin
Result.Right := Min(LimitWidth,
Round(LimitHeight / Abs(Tan(DegToRad(FAngle)))));
Result.Bottom := Min(LimitHeight,
Round(LimitWidth * Abs(Tan(DegToRad(FAngle)))));
end;
end;
procedure TLine.Paint;
var
R: TRect;
begin
Canvas.Pen.Assign(FPen);
Canvas.Brush.Style := bsClear;
R := GetExtends(Width, Height);
case FAlignment of
taCenter:
OffsetRect(R, (Width - R.Right) div 2, 0);
taRightJustify:
OffsetRect(R, Width - R.Right, 0);
end;
case FLayout of
tlCenter:
OffsetRect(R, 0, (Height - R.Bottom) div 2);
tlBottom:
OffsetRect(R, 0, Height - R.Bottom);
end;
if FAngle = 0 then
begin
Canvas.MoveTo(R.Left, R.Top + FPen.Width div 2);
Canvas.LineTo(R.Right, R.Top + FPen.Width div 2);
end
else if FAngle = 90 then
begin
Canvas.MoveTo(R.Left + FPen.Width div 2, R.Top);
Canvas.LineTo(R.Left + FPen.Width div 2, R.Bottom);
end
else if FAngle < 90 then
begin
Canvas.MoveTo(R.Left, R.Bottom);
Canvas.LineTo(R.Right, R.Top);
end
else
begin
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Right, R.Bottom);
end;
end;
procedure TLine.PenChanged(Sender: TObject);
begin
AdjustSize;
Invalidate;
end;
procedure TLine.Resize;
begin
if FAutoAngle then
Angle := DiagonalAngle;
inherited Resize;
end;
procedure TLine.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TLine.SetAngle(Value: Integer);
begin
while Value < 0 do
Inc(Value, 180);
while Value >= 180 do
Dec(Value, 180);
if FAngle <> Value then
begin
FAngle := Value;
if FAngle <> DiagonalAngle then
FAutoAngle := False;
if AutoSize then
AdjustSize;
Invalidate;
end;
end;
procedure TLine.SetAutoAngle(Value: Boolean);
begin
if FAutoAngle <> Value then
begin
FAutoAngle := Value;
if FAutoAngle then
begin
AutoSize := False;
Angle := DiagonalAngle;
end;
end;
end;
procedure TLine.SetBackwards(Value: Boolean);
begin
if Backwards <> Value then
Angle := 180 - FAngle;
end;
procedure TLine.SetLayout(Value: TTextLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
Invalidate;
end;
end;
procedure TLine.SetPen(Value: TPen);
begin
FPen.Assign(Value);
end;
end.

Answer 2

EFG's Computer Lab Graphic Line Stretch comes close to what you are looking for.
Look and feel:
(source: efg2.com)