103 lines
2.4 KiB
ObjectPascal

unit utest17;
{$mode objfpc}{$H+}
interface
uses
Graphics, Classes, SysUtils, utest, BGRABitmap, BGRABitmapTypes;
type
{ TTest17 }
TTest17 = class(TTest)
time: double;
dashstyle: TPenStyle;
constructor Create;
procedure OnPaint(Canvas: TCanvas; Left,Top,Width,Height: Integer); override;
procedure OnTimer(Width,Height: Integer; ElapsedSec: Double); override;
end;
implementation
{ TTest17 }
constructor TTest17.Create;
begin
Name := 'Line primitives';
dashstyle := psSolid;
end;
procedure TTest17.OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer);
var
image: TBGRABitmap;
c : TBGRAPixel;
angleofs: single;
procedure DrawLines(x,y: single; title: string);
var
penwidth: single;
i: Integer;
ca,sa: single;
begin
image.textout(round(x),round(y),title,c);
y += image.TextSize(title).cy+10;
for i := 1 to 2 do
begin
ca := cos(sin(angleofs)/2);
sa := sin(sin(angleofs)/2);
penwidth := i*8+1;
image.PenStyle := dashstyle;
image.DrawPolyLineAntialias([PointF(x+40,y),PointF(x,y),PointF(x+sa*6*penwidth,y+ca*6*penwidth)],ColorToBGRA(clHighlight),penwidth);
if penwidth > 5 then
begin
image.penStyle := psSolid;
image.DrawPolyLineAntialias([PointF(x+40,y),PointF(x,y),PointF(x+sa*6*penwidth,y+ca*6*penwidth)],ColorToBGRA(clHighlightText),1);
end;
y += penwidth*2+6*penwidth+5;
angleofs += Pi*0.6;
end;
end;
begin
angleofs := time;
image := TBGRABitmap.Create(Width,Height,ColorToBGRA(clBtnFace));
c := ColorToBGRA(clWindowText);
image.LineCap := pecFlat;
DrawLines(30,20,'Flat cap');
image.LineCap := pecSquare;
DrawLines(115,Height-200,'Square');
image.LineCap := pecRound;
DrawLines(190,20,'Round cap');
image.LineCap := pecFlat;
image.JoinStyle := pjsBevel;
DrawLines(330,20,'Bevel join');
image.JoinStyle := pjsMiter;
DrawLines(430,Height-200,'Miter join');
image.JoinStyle := pjsRound;
DrawLines(530,20,'Round join');
image.Draw(Canvas,Left,Top,True);
image.free;
end;
procedure TTest17.OnTimer(Width, Height: Integer;
ElapsedSec: Double);
var prev5: integer;
begin
prev5 := trunc(time/5);
time := time+0.1;
if prev5 <> trunc(time/5) then
begin
if dashstyle = psDashDotDot then
dashstyle := psSolid else
dashstyle := succ(dashstyle);
end;
end;
end.