400 lines
10 KiB
ObjectPascal
400 lines
10 KiB
ObjectPascal
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
|
{ATShapeLine is a component which paints line (directions: left-right, up-down, diagonals), with or without arrows at both sides. Line width is option. Line color and arrow color are options. It is Lazarus port of Delphi component TLine (renamed since TLine id is busy with TAChart).
|
|
|
|
Original author: Gon Perez-Jimenez (Spain, 2002)
|
|
Ported to Lazarus by: Alexey Torgashin (Russia)
|
|
|
|
- I redone get/set of canvas.pen and canvas.brush: do it only inside Paint, before it was all accross the code, in getters, setters, etc. This gives crashes of IDE on changing props in Linux.
|
|
- I added any linewidth for any direction with arrow1=true and arrow2=true.
|
|
- I converted demo to Laz using ide converter.
|
|
- Icon added to component-pallette to 'Misc'.
|
|
|
|
For BGRAControls by: Lainz
|
|
|
|
- Using BGRABitmap antialiased drawing (2020-09-09)
|
|
|
|
Lazarus: 1.6+}
|
|
|
|
unit atshapelinebgra;
|
|
|
|
interface
|
|
|
|
{$mode delphi}
|
|
|
|
uses
|
|
Graphics, SysUtils, Classes, Controls;
|
|
|
|
type
|
|
TShapeLineDirection = (drLeftRight, drUpDown, drTopLeftBottomRight, drTopRightBottomLeft);
|
|
|
|
{ TShapeLineBGRA }
|
|
|
|
TShapeLineBGRA = class(TGraphicControl)
|
|
private
|
|
{ Private declarations }
|
|
FLineDir: TShapeLineDirection;
|
|
FArrow1: Boolean;
|
|
FArrow2: Boolean;
|
|
FArrowFactor: Integer;
|
|
FLineWidth: integer;
|
|
FLineColor: TColor;
|
|
FArrowColor: TColor;
|
|
|
|
procedure SetArrowColor(AValue: TColor);
|
|
procedure SetLineColor(AValue: TColor);
|
|
procedure SetLineDir(AValue: TShapeLineDirection);
|
|
procedure SetArrow1(Value: Boolean);
|
|
procedure SetArrow2(Value: Boolean);
|
|
procedure SetArrowFactor(Value: integer);
|
|
procedure SetLineWidth(AValue: Integer);
|
|
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 Anchors;
|
|
property BorderSpacing;
|
|
property ParentShowHint;
|
|
property Hint;
|
|
property ShowHint;
|
|
property Visible;
|
|
property PopupMenu;
|
|
property Direction: TShapeLineDirection read FLineDir write SetLineDir default drLeftRight;
|
|
property LineColor: TColor read FLineColor write SetLineColor;
|
|
property ArrowColor: TColor read FArrowColor write SetArrowColor;
|
|
property LineWidth: Integer read FLineWidth 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 8;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEndDock;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses Math, BGRABitmap, BGRABitmapTypes;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Controls', [TShapeLineBGRA]);
|
|
end;
|
|
|
|
{ TShapeLineBGRA }
|
|
|
|
constructor TShapeLineBGRA.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csReplicatable];
|
|
Width:=110;
|
|
Height:=30;
|
|
FArrow1:=false;
|
|
FArrow2:=false;
|
|
FArrowFactor:=8;
|
|
FArrowColor:=clBlack;
|
|
FLineColor:=clBlack;
|
|
FLineWidth:=1;
|
|
FLineDir:=drLeftRight;
|
|
end;
|
|
|
|
destructor TShapeLineBGRA.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetArrowFactor(Value: integer);
|
|
begin
|
|
if Value <> FArrowFactor then begin
|
|
FArrowFactor := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetArrow1(Value: Boolean);
|
|
begin
|
|
if Value <> FArrow1 then begin
|
|
FArrow1 := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetArrow2(Value: Boolean);
|
|
begin
|
|
if Value <> FArrow2 then begin
|
|
FArrow2 := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetLineWidth(AValue: Integer);
|
|
begin
|
|
if AValue <> FLineWidth then
|
|
begin
|
|
FLineWidth := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetLineColor(AValue: TColor);
|
|
begin
|
|
if AValue <> FLineColor then
|
|
begin
|
|
FLineColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetArrowColor(AValue: TColor);
|
|
begin
|
|
if AValue <> FArrowColor then
|
|
begin
|
|
FArrowColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.SetLineDir(AValue: TShapeLineDirection);
|
|
begin
|
|
if AValue <> FLineDir then
|
|
begin
|
|
FLineDir := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TShapeLineBGRA.Paint;
|
|
var
|
|
start: Integer;
|
|
p1,p2,p3: TPoint;
|
|
H0,W0,H,W: Integer;
|
|
Alfa: double;
|
|
bgra: TBGRABitmap;
|
|
begin
|
|
inherited;
|
|
|
|
bgra := TBGRABitmap.Create(Canvas.Width, Canvas.Height, BGRAPixelTransparent);
|
|
bgra.CanvasBGRA.Pen.Color:= FLineColor;
|
|
bgra.CanvasBGRA.Brush.Color:=FArrowColor;
|
|
bgra.CanvasBGRA.Pen.Width:=FLineWidth;
|
|
|
|
case FLineDir of
|
|
drLeftRight:
|
|
begin
|
|
start := (Height - FLineWidth) div 2;
|
|
bgra.CanvasBGRA.Pen.Width:= FLineWidth;
|
|
bgra.CanvasBGRA.MoveTo(IfThen(FArrow1, FArrowFactor), start);
|
|
bgra.CanvasBGRA.LineTo(Width-IfThen(FArrow2, FArrowFactor), Start);
|
|
bgra.CanvasBGRA.Pen.Width:= 1;
|
|
|
|
if FArrow1 then begin
|
|
//Flecha hacia izquierda
|
|
p1:=Point(0,start);
|
|
p2:=Point(FArrowFactor,Start-FArrowFactor);
|
|
p3:=Point(FArrowFactor,Start+FArrowFactor);
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
|
|
if FArrow2 then begin
|
|
//Flecha hacia derecha
|
|
p1:=Point(Width-1, Start);
|
|
p2:=Point(Width-(FArrowFactor+1),Start-FArrowFactor);
|
|
p3:=Point(Width-(FArrowFactor+1),Start+FArrowFactor);
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
end;
|
|
|
|
drUpDown:
|
|
begin
|
|
start := (Width - FLineWidth) div 2;
|
|
bgra.CanvasBGRA.Pen.Width:= FLineWidth;
|
|
bgra.CanvasBGRA.MoveTo(start, IfThen(FArrow1, FArrowFactor));
|
|
bgra.CanvasBGRA.LineTo(start, Height-IfThen(FArrow2, FArrowFactor));
|
|
bgra.CanvasBGRA.Pen.Width:= 1;
|
|
|
|
if FArrow1 then begin
|
|
//Flecha hacia arriba
|
|
p1:=Point(start,0);
|
|
p2:=Point(Start-FArrowFactor,FArrowFactor);
|
|
p3:=Point(Start+FArrowFactor,FArrowFactor);
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
|
|
if FArrow2 then begin
|
|
//Flecha hacia abajo
|
|
p1:=Point(start,Height-1);
|
|
p2:=Point(Start-FArrowFactor,Height-(FArrowFactor+1));
|
|
p3:=Point(Start+FArrowFactor,Height-(FArrowFactor+1));
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
end;
|
|
|
|
drTopLeftBottomRight:
|
|
begin
|
|
Alfa:= arctan2(Height, Width);
|
|
bgra.CanvasBGRA.Pen.Width:= FLineWidth;
|
|
bgra.CanvasBGRA.MoveTo(
|
|
IfThen(FArrow1, Trunc(FArrowFactor*cos(Alfa))),
|
|
IfThen(FArrow1, Trunc(FArrowFactor*sin(Alfa)))
|
|
);
|
|
bgra.CanvasBGRA.LineTo(
|
|
Width-IfThen(FArrow2, Trunc(FArrowFactor*cos(Alfa))),
|
|
Height-IfThen(FArrow2, Trunc(FArrowFactor*sin(Alfa)))
|
|
);
|
|
bgra.CanvasBGRA.Pen.Width:= 1;
|
|
|
|
if FArrow1 and(Width>0)then begin
|
|
//Flecha hacia arriba
|
|
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);
|
|
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
|
|
|
|
if FArrow2 and(Width>0)then begin
|
|
//Flecha hacia abajo
|
|
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);
|
|
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
|
|
end;
|
|
|
|
drTopRightBottomLeft:
|
|
begin
|
|
Alfa:= arctan2(Height, Width);
|
|
bgra.CanvasBGRA.Pen.Width:= FLineWidth;
|
|
bgra.CanvasBGRA.MoveTo(
|
|
Width-IfThen(FArrow1, Trunc(FArrowFactor*cos(Alfa))),
|
|
IfThen(FArrow1, Trunc(FArrowFactor*sin(Alfa)))
|
|
);
|
|
bgra.CanvasBGRA.LineTo(
|
|
IfThen(FArrow2, Trunc(FArrowFactor*cos(Alfa))),
|
|
Height-IfThen(FArrow2, Trunc(FArrowFactor*sin(Alfa)))
|
|
);
|
|
bgra.CanvasBGRA.Pen.Width:= 1;
|
|
|
|
if FArrow1 and(Width>0)then begin
|
|
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);
|
|
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
|
|
if FArrow2 and(Width>0)then begin
|
|
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);
|
|
|
|
bgra.CanvasBGRA.Polygon([p1,p2,p3]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
bgra.Draw(Canvas, 0, 0, False);
|
|
bgra.Free;
|
|
end;
|
|
|
|
end.
|