lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / lcl / extgraphics.pas

{  $Id: extgraphics.pas 20712 2009-06-22 09:30:42Z vincents $  }
{
 /***************************************************************************
                              extgraphics.pas
                              ---------------

 ***************************************************************************/

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.LCL, included in this distribution,                 *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
unit extgraphics;

{$mode objfpc}{$H+}

interface

uses Types, Classes, LCLProc, Graphics, Math, GraphMath;

type
  TShapeDirection = (atUp, atDown, atLeft, atRight);
  TInitShapeProc = procedure(var P: array of TPoint;const R: TRect;
    var NumPts: Integer);


procedure Paint2HeadArrow(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintBarbadosTrident(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintBigI(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintBoldArrow(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintCanadianMaple(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintChevronArrow(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintFivePointStar(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintHexagon(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintNotchedArrow(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintOctogon(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintPentagon(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintPlus(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintQuadrangle(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintRightTriangle(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintSwastika(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintTriangle(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0);
procedure PaintTriangular(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0; RightLeftFactor:extended=0.5);
procedure PaintValve(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle: Extended = 0.0);
procedure PaintVArrow(Canvas: TCanvas; const PaintRect : TRect;
  RadAngle :Extended=0.0);



procedure PaintCross(Canvas: TCanvas; XLeft,YUp,XRight,YLow,
          CrossX1,CrossX2,CrossY1,CrossY2:integer);
procedure PaintHalfEllipse(Canvas: TCanvas; Const PaintRect: TRect;
  AHalfEllipseDirection: TShapeDirection);
procedure PaintFivePointLineStar(Canvas: TCanvas; const PaintRect: TRect);
procedure PaintStarN(Canvas: TCanvas;cx,cy,r,n,a:Integer);


procedure InitPolygon(Canvas: TCanvas;PaintRect: TRect;RadAngle: Extended;
  InitShapeProc: TInitShapeProc);

procedure CalculatePentagonPoints
  (const PentagonRect:TRect; var P1,P2,P3,P4,P5:TPoint);
function LinesPointOfIntersection
  (const Line1a,Line1b,Line2a,line2b:TPoint):TPoint;


implementation

procedure CalculatePentagonPoints(const PentagonRect:TRect;
  var P1,P2,P3,P4,P5:TPoint);
var cx,cy,dy,dx:Integer; r:real;
begin
  P1.y:=PentagonRect.Top;
  P2.x:=PentagonRect.Left;
  P3.y:=PentagonRect.Bottom;
  P4.y:=PentagonRect.Bottom;
  P5.x:=PentagonRect.Right;
  P1.x:=(PentagonRect.Right+PentagonRect.Left) div 2;
  dy:=RoundToInt((P1.x-P2.x)*tan(Pi/10));
  r := sqrt(dy*dy+(P1.x-P2.x)*(P1.x-P2.x));
  cx:=P1.x;
  cy:=P1.y+round(r);
  P2.y:=cy-dy;
  P5.y:=P2.y;
  dx:=RoundToInt(r*sin(Pi/5));
  P3.x:=cx-dx;
  P4.x:=cx+dx;
end;


function LinesPointOfIntersection
  (const Line1a,Line1b,Line2a,line2b:TPoint):TPoint;
var k1,k2,b1,b2,x,x1,x2,x3,x4,y,y1,y2,y3,y4:real;
     p:TPoint;
begin
  x1:=Line1a.x;  y1:=Line1a.y;
  x2:=Line1b.x;  y2:=Line1b.y;
  x3:=Line2a.x;  y3:=Line2a.y;
  x4:=Line2b.x;  y4:=Line2b.y;
  k1:=(y2-y1)/(x2-x1);
  k2:=(y4-y3)/(x4-x3);
  b1:=-k1*x1+y1;
  b2:=-k2*x3+y3;
  x:=(b1-b2)/(k2-k1);
  y:=(k2*b1-k1*b2)/(k2-k1);
  p.x:=RoundToInt(x);
  p.y:=RoundToInt(y);
  LinesPointOfIntersection:=p;
end;



procedure PaintCross(Canvas: TCanvas; XLeft,YUp,XRight,YLow,
  CrossX1,CrossX2,CrossY1,CrossY2:integer);
var P:array[0..12] of TPoint;
begin
  P[ 0].x:=XLeft;   P[ 0].y:=CrossY1;
  P[ 1].x:=CrossX1; P[ 1].y:=P[0].y;
  P[ 2].x:=P[ 1].x; P[ 2].y:= YUp;
  P[ 3].x:=CrossX2; P[ 3].y:=P[2].y;
  P[ 4].x:=P[ 3].x; P[ 4].y:=CrossY1;
  P[ 5].x:=XRight;  P[ 5].y:=P[4].y;
  P[ 6].x:=P[ 5].x; P[ 6].y:=CrossY2;
  P[ 7].x:=CrossX2; P[ 7].y:=P[6].y;
  P[ 8].x:=P[ 7].x; P[ 8].y:=YLow;
  P[ 9].x:=CrossX1; P[ 9].y:=P[8].y;
  P[10].x:=P[ 9].x; P[10].y:=CrossY2;
  P[11].x:=XLeft;   P[11].y:=P[10].y;
  P[12].x:=P[11].x; P[12].y:=CrossY1;
  Canvas.Polygon(P);
end;

procedure PolycRotate
  (var Pts:array of TPoint; CountPts:Integer; cntPoint:TPoint; fii:Extended);
var i,dx,dy:Integer;
    x,y:Extended;
begin
  for i:=0 to CountPts-1 do
    begin
      dx:=Pts[i].x-cntPoint.x;
      dy:=Pts[i].y-cntPoint.y;
      x:=dx*cos(fii)+dy*sin(fii);
      y:=dy*cos(fii)-dx*sin(fii);
      Pts[i].x:=cntPoint.x+Round(x);
      Pts[i].y:=cntPoint.y+Round(y);
    end;
end;


procedure PolycMinMax
  (var N:array of TPoint; const P:array of TPoint; CountPts:Integer);
var i,Xmin,Xmax,Ymin,Ymax:Integer;
begin
  Xmin:=P[0].x; Xmax:=P[0].x; Ymin:=P[0].y; Ymax:=P[0].y;
  for i:=0 to CountPts-1 do
    begin
      if P[i].x<Xmin then Xmin:=P[i].x;
      if P[i].x>Xmax then Xmax:=P[i].x;
      if P[i].y<Ymin then Ymin:=P[i].y;
      if P[i].y>Ymax then Ymax:=P[i].y;
    end;
  N[0]:=Point(Xmin,Ymin); N[1]:=Point(Xmin,Ymax);
  N[2]:=Point(Xmax,Ymax); N[3]:=Point(Xmax,Ymin);
end;


procedure PolycNewPaintRect(var PR:TRect; cP:TPoint; wv,hv:Integer);
begin
  with PR do
    begin
      Left:=cP.x-wv;
      Right:=cP.x+wv;
      Top:=cP.y-hv;
      Bottom:=cP.y+hv;
    end;
end;

procedure PolycFixCenterpoint
  (var N:array Of TPoint; cP:TPoint; var P:array Of TPoint; CountPts:Integer);
var i,nx,ny,dx,dy:Integer;
begin
  nx:=(N[0].x+N[2].x) div 2;
  ny:=(N[0].y+N[2].y) div 2;
  dx:=cP.x-nx;
  dy:=cP.y-ny;
  for i:=0 to 3 do
    begin
      N[i].x:=N[i].x+dx;
      N[i].y:=N[i].y+dy;
    end;
  for i:=0 to CountPts-1 do
    begin
      P[i].x:=P[i].x+dx;
      P[i].y:=P[i].y+dy;
    end;
end;

procedure PolycSetHalfWidthAndHeight
  (const PR:TRect;var hv,wv:Integer;fii:Extended);
var h,w:Integer;
begin
  h:=PR.Bottom-PR.Top;
  w:=PR.Right-PR.Left;
  hv:=Round(h*abs(cos(fii))+w*abs(sin(fii))) div 2;
  wv:=Round(h*abs(sin(fii))+w*abs(cos(fii))) div 2;
end;

procedure PolycScale(var P:array of TPoint; CountPts:Integer;
  const PaintRect:TRect; cntPoint:TPoint; N:array of TPoint);
var k,kx,ky:Extended;
    i:Integer;
begin
  kx:=(PaintRect.Right-PaintRect.Left)/(N[2].x-N[0].x);
  ky:=(PaintRect.Bottom-PaintRect.Top)/(N[2].y-N[0].y);
  k:=min(kx,ky);
  for i:=0 to CountPts-1 do
    begin
      P[i].x:=cntPoint.x+Round(k*(P[i].x-cntPoint.x));
      P[i].y:=cntPoint.y+Round(k*(P[i].y-cntPoint.y));
    end;
end;




procedure PaintPolycon(Canvas: TCanvas;PR : TRect; fii :Extended;
  P:array of TPoint; CountPts:Integer;cntPoint:TPoint);
var     N:array[0..3] of TPoint;

begin
  PolycRotate(P,CountPts,cntPoint,fii);
  PolycMinMax(N,P,CountPts);
  PolycFixCenterpoint(N,cntPoint,P,CountPts);
  PolycScale(P,CountPts,PR,cntPoint,N);
  Case CountPts of
    3: Canvas.Polygon([P[0],P[1],P[2]]);
    4: Canvas.Polygon([P[0],P[1],P[2],P[3]]);
    5: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4]]);
    6: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5]]);
    7: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6]]);
    8: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7]]);
    9: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8]]);
    10: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9]]);
    11: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9],
               P[10]]);
    12: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9],
               P[10],P[11]]);
    13: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9],
               P[10],P[11],P[12]]);

    20: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9],
               P[10],P[11],P[12],P[13],P[14],P[15],P[16],P[17],P[18],P[19]]);
    33: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9],
               P[10],P[11],P[12],P[13],P[14],P[15],P[16],P[17],P[18],P[19],
               P[20],P[21],P[22],P[23],P[24],P[25],P[26],P[27],P[28],P[29],
               P[30],P[31],P[32]]);
    35: Canvas.Polygon([P[0],P[1],P[2],P[3],P[4],P[5],P[6],P[7],P[8],P[9],
               P[10],P[11],P[12],P[13],P[14],P[15],P[16],P[17],P[18],P[19],
               P[20],P[21],P[22],P[23],P[24],P[25],P[26],P[27],P[28],P[29],
               P[30],P[31],P[32],P[33],P[34]]);

  end;
end;


procedure InitPolygon(Canvas: TCanvas;PaintRect: TRect;RadAngle: Extended;
  InitShapeProc: TInitShapeProc);
var
  PR, vPR: TRect;
  P: array[0..35] of TPoint;
  CountPts, hv, wv: Integer;
  cntPoint: TPoint;
begin
  PR := PaintRect;
  cntPoint := CenterPoint(PR);
  PolycSetHalfWidthAndHeight(PR, hv, wv, RadAngle);
  PolycNewPaintRect(vPR, cntPoint, wv, hv);
  InitShapeProc(P, vPR, CountPts);
  PaintPolycon(Canvas, PR, RadAngle, P, CountPts, cntPoint);
end;

procedure Init2HeadArrow
  (var P:array of TPoint;const R:TRect;var NumPts:Integer);
var dx,dy:Integer;
begin
  with R do
    begin
      dx:=(Right-Left)div 4;
      dy:=(Bottom-Top)div 4;
      P[0].x:=Left;    P[0].y:=Top+(Bottom-Top) div 2;
      P[1].x:=Left+dx; P[1].y:=Top;
      P[2].x:=P[1].x;  P[2].y:=Top+dy;
      P[3].x:=Right-dx;P[3].y:=P[2].y;
      P[4].x:=P[3].x;  P[4].y:= Top;
      P[5].x:=Right;   P[5].y:=P[0].y;
      P[6].x:=P[3].x;  P[6].y:=Bottom;
      P[7].x:=P[3].x;  P[7].y:=Bottom-dy;
      P[8].x:=P[1].x;  P[8].y:=P[7].y;
      P[9].x:=P[1].x;  P[9].y:=Bottom;
    end;
  NumPts:=10;
end;

procedure InitBarbadosTrident
  (var P:array of TPoint; const R: TRect; var NumPts:Integer);
var RmLpW,BmTpH:extended;cntPoint:TPoint;
begin
  cntPoint:=CenterPoint(R);
  with R do begin
    RmLpW:=(Right-Left)/140;
    BmTpH:=(Bottom-Top)/160;
    P[0].x:=cntPoint.x-round(RmLpW*10); P[0].y:=Bottom;
    P[34].x:=cntPoint.x+round(RmLpW*10);P[34].y:=P[0].y;
    P[1].x:=P[0].x;   P[1].y:=Bottom-round(BmTpH*50);
    P[33].x:=P[34].x; P[33].y:=P[1].y;
    P[2].x:=cntPoint.x-round(RmLpW*35); P[2].y:=P[1].y;
    P[32].x:=cntPoint.x+round(RmLpW*35);P[32].y:=P[2].y;
    P[3].x:=cntPoint.x-round(RmLpW*48); P[3].y:=Bottom-round(BmTpH*98);
    P[31].x:=cntPoint.x+round(RmLpW*48);P[31].y:=P[3].y;
    P[4].x:=left;     P[4].y:=top;
    P[30].x:=Right;   P[30].y:=P[4].y;
    P[5].x:=cntPoint.x-round(RmLpW*42); P[5].y:=Top+round(BmTpH*4);
    P[29].x:=cntPoint.x+round(RmLpW*42);P[29].y:=P[5].y;
    P[6].x:=cntPoint.x-round(RmLpW*40); P[6].y:=Top+round(BmTpH*6);
    P[28].x:=cntPoint.x+round(RmLpW*40);P[28].y:=P[6].y;
    P[7].x:=cntPoint.x-round(RmLpW*39); P[7].y:=Top+round(BmTpH*11);
    P[27].x:=cntPoint.x+round(RmLpW*39);P[27].y:=P[7].y;
    P[8].x:=cntPoint.x-round(RmLpW*45); P[8].y:=Top+round(BmTpH*16);
    P[26].x:=cntPoint.x+round(RmLpW*45);P[26].y:=P[8].y;
    P[9].x:=cntPoint.x-round(RmLpW*45); P[9].y:=Top+round(BmTpH*21);
    P[25].x:=cntPoint.x+round(RmLpW*45);P[25].y:=P[9].y;
    P[10].x:=cntPoint.x-round(RmLpW*32);P[10].y:=Top+round(BmTpH*47);
    P[24].x:=cntPoint.x+round(RmLpW*32);P[24].y:=P[10].y;
    P[11].x:=cntPoint.x-round(RmLpW*28);P[11].y:=Top+round(BmTpH*70);
    P[23].x:=cntPoint.x+round(RmLpW*28);P[23].y:=P[11].y;
    P[12].x:=cntPoint.x-round(RmLpW*22);P[12].y:=Top+round(BmTpH*92);
    P[22].x:=cntPoint.x+round(RmLpW*22);P[22].y:=P[12].y;
    P[13].x:=P[0].x;  P[13].y:=P[12].y;
    P[21].x:=P[34].x; P[21].y:=P[13].y;
    P[14].x:=P[0].x;  P[14].y:=Top+round(BmTpH*30);
    P[20].x:=P[34].x; P[20].y:=P[14].y;
    P[15].x:=cntPoint.x-round(RmLpW*22);P[15].y:=Top+round(BmTpH*22);
    P[19].x:=cntPoint.x+round(RmLpW*22);P[19].y:=P[15].y;
    P[16].x:=cntPoint.x-round(RmLpW*9); P[16].y:=Top+round(BmTpH*12);
    P[18].x:=cntPoint.x+round(RmLpW*9); P[18].y:=P[16].y;
    P[17].x:=cntPoint.x;   P[17].y:=Top;

  end;
  NumPts:=35;
end;

procedure InitBigI(var P:array of TPoint; const R: TRect; var NumPts:Integer);
var dx,dy:Integer;
begin
  with R do begin
    dx:=(Right-Left) div 4;
    dy:=(Bottom-Top) div 18;
    P[0].x:=Left; P[0].y:=Top;
    P[1].x:=Right; P[1].y:=TOP;
    P[2].x:=Right-dx; P[2].y:=Top+dy;
    P[3].x:=P[2].x; P[3].y:=Bottom-dy;
    P[4].x:=Right;  P[4].y:=Bottom;
    P[5].x:=Left;   P[5].y:=Bottom;
    P[6].x:=Left+dx;P[6].y:=P[3].y;
    P[7].x:=P[6].x;P[7].y:=P[2].y;
  end;
  NumPts:=8;
end;

procedure InitBoldArrow(var P:array of TPoint;const R:TRect;var NumPts:Integer);
var dy:Integer;cntPoint:TPoint;
begin
  cntPoint:=CenterPoint(R);
  with R do
    begin
      dy:=(Bottom - Top) div 4;
      P[0].x:=Left;
      P[0].y:=Top+dy;
      P[1].x:=cntPoint.x;
      P[1].y:=P[0].y;
      P[2].x:=cntPoint.x;
      P[2].y:=Top;
      P[3].x:=Right;
      P[3].y:=cntPoint.y;
      P[4].x:=cntPoint.x;
      P[4].y:= Bottom;
      P[5].x:= cntPoint.x;
      P[5].y:=Bottom-dy;
      P[6].x:= Left;
      P[6].y:=P[5].y;
    end;
  NumPts:=7;
end;

procedure InitCanadianMaple
  (var P:array of TPoint;const R:TRect; var NumPts:Integer);
const leafheight=54;      leafwidth=50;
var xcenter,x2:integer;
  RmLpLW, //  (Right - Left)/LeafWidth;
  BmTpLH //(Bottom-Top)/ LeafHeight
  :extended;
begin
  with R do begin
    xcenter:=Left+(Right - Left) div 2;
    p[0].y:=Top;
    p[0].x:=xcenter;
    RmLpLW:=(Right - Left)/LeafWidth;
    BmTpLH:=(Bottom-Top)/ LeafHeight;
    x2:=RoundToInt(RmLpLW*5);
    P[1].x:=xcenter-x2; P[1].y:=RoundToInt(BmTpLH*9+Top);
    P[32].x:=xcenter+x2; P[32].y:=P[1].y;
    x2:=RoundToInt(RmLpLW*10);
    P[2].x:=xcenter-x2; P[2].y:=RoundToInt(BmTpLH *7+Top);
    P[31].x:=xcenter+x2; P[31].y:=P[2].y;
    x2:=RoundToInt(RmLpLW*7);
    P[3].x:=xcenter-x2; P[3].y:=RoundToInt(BmTpLH*21+Top);
    P[30].x:=xcenter+x2; P[30].y:=P[3].y;
    x2:=RoundToInt(RmLpLW*9);
    P[4].x:=xcenter-x2; P[4].y:=P[3].y;
    P[29].x:=xcenter+x2; P[29].y:=P[3].y;
    x2:=RoundtoInt(RmLpLW*15);
    P[5].x:=xcenter-x2; P[5].y:=RoundtoInt(BmTpLH*15+Top);
    P[28].x:=xcenter+x2; P[28].y:=P[5].y;
    x2:=RoundtoInt(RmLpLW*17);
    P[6].x:=xcenter-x2; P[6].y:=RoundtoInt(BmTpLH*19+Top);
    P[27].x:=xcenter+x2; P[27].y:=P[6].y;
    x2:=RoundtoInt(RmLpLW*24);
    P[7].x:=xcenter-x2; P[7].y:=RoundtoInt(BmTpLH*17+Top);
    P[26].x:=xcenter+x2; P[26].y:=P[7].y;
    x2:=RoundtoInt(RmLpLW*22);
    P[8].x:=xcenter-x2; P[8].y:=RoundtoInt(BmTpLH*26+Top);
    P[25].x:=xcenter+x2; P[25].y:=P[8].y;
    x2:=RoundtoInt(RmLpLW*25);
    P[9].x:=xcenter-x2; P[9].y:=RoundtoInt(BmTpLH*28+Top);
    P[24].x:=xcenter+x2; P[24].y:=P[9].y;
    x2:=RoundtoInt(RmLpLW*14);
    P[10].x:=xcenter-x2; P[10].y:=RoundtoInt(BmTpLH*38+Top);
    P[23].x:=xcenter+x2; P[23].y:=P[10].y;
    x2:=RoundtoInt(RmLpLW*15);
    P[11].x:=xcenter-x2; P[11].y:=RoundtoInt(BmTpLH*43+Top);
    P[22].x:=xcenter+x2; P[22].y:=P[11].y;
    x2:=RoundtoInt(RmLpLW);
    P[12].x:=xcenter-x2; P[12].y:=RoundtoInt(BmTpLH*41+Top);
    P[21].x:=xcenter+x2; P[21].y:=P[12].y;
    x2:=RoundtoInt(RmLpLW/2);
    P[13].x:=xcenter-x2; P[13].y:=RoundtoInt(BmTpLH*42+Top);
    P[20].x:=xcenter+x2; P[20].y:=P[13].y;
    P[14].x:=P[13].x; P[14].y:=RoundtoInt(BmTpLH*47+Top);
    P[19].x:=P[20].x; P[19].y:=P[14].y;
    x2:=RoundtoInt(RmLpLW);
    P[15].x:=xcenter-x2; P[15].y:=P[14].y;
    P[18].x:=xcenter+x2; P[18].y:=P[14].y;
    P[16].x:=P[15].x; P[16].y:=bottom;
    P[17].x:=P[18].x; P[17].y:=bottom;
  end;
  NumPts:=33;
end;

procedure InitChevronArrow
  (var P:array of TPoint;const R:TRect; var NumPts:Integer);
var dx:Integer;
begin
  with R do
    begin
      dx:=(Right - Left) div 3;
      P[0].x:=Left;
      P[0].y:=Top;
      P[1].x:= Right-dx;
      P[1].y:=Top;
      P[2].x:=Right;
      P[2].y:=(Top+Bottom) div 2;
      P[3].x:=P[1].x;
      P[3].y:=Bottom;
      P[4].x:=Left;
      P[4].y:= Bottom;
      P[5].x:= Left+dx;
      P[5].y:=P[2].y;
    end;
  NumPts:=6;
end;


procedure InitFivePointStar
  ( var P:array of TPoint;const R: TRect;var NumPts:Integer);
begin
  CalculatePentagonPoints(R,P[0],P[2],P[4],P[6],P[8]);
  P[1]:=LinesPointOfIntersection(P[0],P[4],P[2],P[8]);
  P[3]:=LinesPointOfIntersection(P[0],P[4],P[2],P[6]);
  P[5]:=LinesPointOfIntersection(P[8],P[4],P[2],P[6]);
  P[7]:=LinesPointOfIntersection(P[8],P[4],P[0],P[6]);
  P[9]:=LinesPointOfIntersection(P[8],P[2],P[0],P[6]);
  NumPts:=10;
end;


procedure InitHexagon(var P:array of TPoint;const R: TRect;var NumPts:Integer);
var dx:Integer;
begin
  with R do begin
    dx:=round(((Right - Left) /2*cos(DegToRad(15)))/2);
    P[0].x:=Left+dx; P[0].y:=Top;
    P[1].x:=Left; P[1].y:=(Top+Bottom) div 2;
    P[2].x:=P[0].x; P[2].y:= Bottom;
    P[3].x:=Right-dx; P[3].y:=Bottom;
    P[4].x:=Right; P[4].y:=P[1].y;
    P[5].x:=Right-dx; P[5].y:=Top;
  end;
  NumPts:=6;
end;

procedure InitNotchedArrow
  (var P:array of TPoint;const R:TRect;var NumPts:Integer);
begin
  InitBoldArrow(P,R,NumPts);
  with R do
    begin
      P[7].x:=Left+(Right-Left) div 4;
      P[7].y:=P[3].y; // centerpoint y
    end;
  NumPts:=8;
end;

procedure InitOctogon(var P:array of TPoint;const R: TRect;var NumPts:Integer);
var dx,dy:Integer;
begin
  with R do begin
    dx:=Right - Left;
    dx:=round((dx-dx/(sqrt(2)+1))/2);
    dy:=Bottom - Top;
    dy:=round((dy-dy/(sqrt(2)+1))/2);
    P[0].x:=Left+dx; P[0].y:=Top;
    P[1].x:=Right-dx;P[1].y:=Top;
    P[2].x:=Right;   P[2].y:= Top+dy;
    P[3].x:=Right;   P[3].y:=Bottom-dy;
    P[4].x:=P[1].x;  P[4].y:=Bottom;
    P[5].x:=P[0].x;  P[5].y:=Bottom;
    P[6].x:=Left;    P[6].y:= P[3].y;
    P[7].x:=Left;    P[7].y:= P[2].y;
  end;
  NumPts:=8;
end;

procedure InitPentagon(var P:array of TPoint;const R: TRect;var NumPts:Integer);
begin
  CalculatePentagonPoints(R,P[0],P[1],P[2],P[3],P[4]);
  NumPts:=5;
end;

procedure InitPlus(var P:array of TPoint;const R: TRect;var NumPts:Integer);
var CrossX,Crossy:integer;
begin
  with R do
    begin
      CrossX:=(Right-Left)  div 3 ;
      CrossY:=(Bottom-Top) div 3 ;
      P[ 0].x:=Left;    P[ 0].y:=Top+CrossY;
      P[ 1].x:=Left+CrossX; P[ 1].y:=P[0].y;
      P[ 2].x:=P[ 1].x; P[ 2].y:= Top;
      P[ 3].x:=Right-CrossX; P[ 3].y:=P[2].y;
      P[ 4].x:=P[ 3].x; P[ 4].y:=P[ 0].y;
      P[ 5].x:=Right;   P[ 5].y:=P[4].y;
      P[ 6].x:=P[ 5].x; P[ 6].y:=Bottom-CrossY;
      P[ 7].x:=P[ 3].x; P[ 7].y:=P[6].y;
      P[ 8].x:=P[ 7].x; P[ 8].y:=Bottom;
      P[ 9].x:=P[ 1].x; P[ 9].y:=P[8].y;
      P[10].x:=P[ 9].x; P[10].y:=P[ 6].y;
      P[11].x:=Left;    P[11].y:=P[10].y;
      P[12].x:=P[11].x; P[12].y:=P[ 0].y;
    end;
  NumPts:=13;
end;

procedure InitQuadrangle
  (var P:array of TPoint;const R: TRect;var NumPts:Integer);
begin
  with R do begin
    P[0].x:=Left; P[0].y:=Top;
    P[1].x:=Left; P[1].y:=Bottom;
    P[2].x:=Right; P[2].y:= Bottom;
    P[3].x:=Right; P[3].y:=Top;
  end;
  NumPts:=4;
end;

procedure InitRightTriangle
  (var P:array of TPoint; const R: TRect; var NumPts:Integer);
begin
  with R do begin
       P[0].x:=Left; P[0].y:=Top;
       P[1].x:=Right; P[1].y:=Bottom;
       P[2].x:=P[0].x; P[2].y:= Bottom;
  end;
  NumPts:=3;
end;


procedure InitSwastika(var P:array of TPoint;const R: TRect;var NumPts:Integer);
var x1,x2,y1,y2:Integer;
begin
  with r do begin
    x1:=(Right-Left) div 5;
    y1:=(Bottom-Top) div 5;
    x2:=(Right-Left)*2 div 5;
    y2:=(Bottom-Top)*2 div 5;
    P[0].x:=Left;P[0].y:=Top; P[1].x:=Left+x1;P[1].y:=Top;
    P[2].x:=P[1].x;P[2].y:=Top+y2;P[3].x:=Left+x2;P[3].y:=P[2].y;
    P[4].x:=P[3].x;P[4].y:=Top;P[5].x:=Right;P[5].y:=P[4].y;
    P[6].x:=P[5].x;P[6].y:=Top+y1;P[7].x:=Right-x2;P[7].y:=P[6].y;
    P[8].x:=P[7].x;P[8].y:=p[2].y;P[9].x:=Right;P[9].y:=P[8].y;
    P[10].x:=P[9].x;P[10].y:=Bottom;P[11].x:=Right-x1;P[11].y:=P[10].y;
    P[12].x:=P[11].x;P[12].y:=Bottom-y2;P[13].x:=P[7].x;P[13].y:=P[12].y;
    P[14].x:=P[13].x;P[14].y:=Bottom;P[15].x:=Left;P[15].y:=P[14].y;
    P[16].x:=P[15].x;P[16].y:=Bottom-y1;P[17].x:=Left+x2;P[17].y:=P[16].y;
    P[18].x:=P[17].x;P[18].y:=Bottom-y2;P[19].x:=Left;P[19].y:=P[18].y;
  end;
  NumPts:=20;
end;

procedure InitTriangle(var P:array of TPoint; const R: TRect;
  var NumPts:Integer);
begin
  with R do begin
       P[0].x:=Left; P[0].y:=Top;
       P[1].x:=Right; P[1].y:=Top+(Bottom-Top) div 2;
       P[2].x:=P[0].x; P[2].y:= Bottom;
  end;
  NumPts:=3;
end;

procedure InitValve(var P: array of TPoint; const R: TRect; var NumPts: Integer);
var
  cntPoint: TPoint;
begin
  cntPoint := CenterPoint(R);
  with R do begin
    P[0].x := Left;
    P[0].y := Top;
    P[1].x := cntPoint.x;
    P[1].y := cntPoint.y;
    P[2].x := Right;
    P[2].y := Top;
    P[3].x := Right;
    P[3].y := Bottom;
    P[4].x := cntPoint.x;
    P[4].y := cntPoint.y;
    P[5].x := Left;
    P[5].y := Bottom;
  end;
  NumPts := 6;
end;

procedure InitVArrow(var P:array of TPoint;const R:TRect; var NumPts:Integer);
var  cntPoint:TPoint;
begin
  cntPoint:=CenterPoint(R);
  with R do
    begin
      P[0].x:=Left;
      P[0].y:=Top;
      P[1].x:=Right;
      P[1].y:=cntPoint.y;
      P[2].x:=Left;
      P[2].y:=Bottom;
      P[3].x:=cntPoint.x;
      P[3].y:=cntPoint.y;
    end;
  NumPts:=4;
end;



procedure Paint2HeadArrow(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@Init2HeadArrow);
end;

procedure PaintBarbadosTrident(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitBarbadosTrident);
end;

procedure PaintBigI(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitBigI);
end;

procedure PaintBoldArrow(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitBoldArrow);
end;

procedure PaintCanadianMaple(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitCanadianMaple);
end;

procedure PaintChevronArrow(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitChevronArrow);
end;

procedure PaintFivePointStar(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitFivePointStar);
end;

procedure PaintHexagon(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitHexagon);
end;

procedure PaintNotchedArrow(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitNotchedArrow);
end;

procedure PaintOctogon(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitOctogon);
end;

procedure PaintPentagon(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitPentagon);
end;

procedure PaintPlus(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitPlus);
end;

procedure PaintQuadrangle(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitQuadrangle);
end;

procedure PaintRightTriangle(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitRightTriangle);
end;

procedure PaintSwastika(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitSwastika);
end;

procedure PaintTriangle(Canvas: TCanvas; const PaintRect: TRect;RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitTriangle);
end;

procedure PaintValve(Canvas: TCanvas; const PaintRect: TRect; RadAngle: Extended = 0.0);
begin
  InitPolygon(Canvas, PaintRect, RadAngle, @InitValve);
end;

procedure PaintVArrow(Canvas: TCanvas; const PaintRect : TRect; RadAngle :Extended=0.0);
begin
  InitPolygon(Canvas,PaintRect,RadAngle,@InitVArrow);
end;

procedure PaintTriangular(Canvas: TCanvas; const PaintRect: TRect;
  RadAngle :Extended=0.0; RightLeftFactor:Extended=0.5);
var PR,vPR:TRect;
    P:array[0..35] of TPoint;
    CountPts,hv,wv:Integer;
    cntPoint:TPoint;
begin
  PR:=PaintRect;
  cntPoint:=CenterPoint(PR);
  PolycSetHalfWidthAndHeight(PR,hv,wv,RadAngle);
  PolycNewPaintRect(vPR,cntPoint,wv,hv);

  with vPR do begin
       P[0].x:=Left; P[0].y:=Bottom;
       P[1].x:=Left+round((Right-left)* RightLeftFactor); P[1].y:=Top;
       P[2].x:=Right; P[2].y:= Bottom;
  end;
  CountPts:=3;
  
  PaintPolycon(Canvas,PR,RadAngle,P,CountPts,cntPoint);
end;




procedure PaintHalfEllipse(Canvas: TCanvas;const PaintRect: TRect;
  AHalfEllipseDirection: TShapeDirection);
var Ex1,Ex2,Ey1,Ey2,Sx,Sy,Ex,Ey,i:integer;
begin
  Case AHalfEllipseDirection of
     atUp: with PaintRect do begin
       Ex1:=Left; Ex2:=Right;
       Ex:=Left; Sx:=Right;
       i:=Bottom-Top;
       Ey1:=Top;Ey2:=Bottom+i;
       Sy:=Top+i;Ey:=Top+i;
     end;
     atDown: with PaintRect do begin
       Ex1:=Left; Ex2:=Right;
       Sx:=Left; Ex:=Right;
       i:=Bottom-Top;
       Ey1:=Top-i;Ey2:=Bottom;
       Sy:=Top;Ey:=Top;
     end;
     atRight: with PaintRect do begin
       Ey1:=Top; Ey2:=Bottom;
       Ey:=Top; Sy:=Bottom;
       i:=Right-Left;
       Ex1:=Left-i;Ex2:=Right;
       Sx:=Left;Ex:=Left;
     end;
     atLeft: with PaintRect do begin
       Ey1:=Top; Ey2:=Bottom;
       Sy:=Top; Ey:=Bottom;
       i:=Right-Left;
       Ex1:=Left;Ex2:=Right+i;
       Sx:=Left+i;Ex:=Left+i;
     end;
   end;  ;
   Canvas.Pie(Ex1,Ey1,Ex2,Ey2,Sx,Sy,Ex,Ey);
end;

procedure PaintFivePointLineStar(Canvas: TCanvas; const PaintRect: TRect);
var P: array[0..4] of TPoint;
begin
  CalculatePentagonPoints(PaintRect,P[0],P[1],P[2],P[3],P[4]);
  Canvas.Line(P[0].x,P[0].y,P[2].x,P[2].y);
  Canvas.Line(P[0].x,P[0].y,P[3].x,P[3].y);
  Canvas.Line(P[1].x,P[1].y,P[3].x,P[3].y);
  Canvas.Line(P[1].x,P[1].y,P[4].x,P[4].y);
  Canvas.Line(P[2].x,P[2].y,P[4].x,P[4].y);
end;

procedure PaintStarN(Canvas: TCanvas;cx,cy,r,n,a:Integer);
const MaxStarPoint=36;
var
  r1,r0,alpha:double;
  P:array[0..MaxStarPoint*2-1] of TPoint;
  i,cs:Integer;
begin
  r1:=r/2;
  for i:=0 to 2*n
    do begin
       if (i mod 2)=0 then r0:=r else r0:=r1;
       alpha:=a+(0.5+i/n)*Pi;
       cs:=RoundToInt(r0*cos(alpha));
       P[i].x:=cx+cs;
       P[i].y:=cy-Round(r0*sin(alpha));
    end;
  for i:=2*n to MaxStarPoint*2-1
    do begin
      P[i].x:=P[2*n-1].x;
      P[i].y:=P[2*n-1].y;
    end;
  Canvas.Polygon(P);
end;



 
end.