Создание компонента сложной формы (аккуратной контурной стрелки).

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, math;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TArrow = array [0..6] of TPoint;

type
  TestPanel = class (TPanel)
  private
     Image:TImage;
     Numb:integer;
     procedure MovePanelMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
  public
     property Index:Integer read Numb write Numb;
  end;

TFA = class
 private
    TextLabel:array [1..5] of TLabel;
    Arrow:TestPanel;
    Hex:TestPanel;
    X,Y:Real;
    RDes:Integer;
    Numb:integer;
    Parent :  TWinControl;
    function BodyArrow(X1,Y1,X2,Y2: Integer; LW: Extended):TArrow;
 public
    DeltX,DelTY:Real;
    property PosX:real write X;
    property PosY:real write Y;
    procedure DrawArrow (DeltX,DeltY:Real; Wdt:integer);
 Published
    constructor  Create(AOwner: TWinControl; PosX, PosY : real; RadDes, Index  : Integer);
 end;

TRPoint = record
x,y:real;
end;

var
  Form1: TForm1;
  RPoint: array [1..163] of TRPoint;
  FA:array [1..163] of TFA;
  
implementation

{$R *.dfm}

constructor TFA.Create(AOwner: TWinControl; PosX, PosY : real; RadDes, Index : Integer); //ñîçäàþ ìíîãîóãîëüíèê ñ òåêòîì
var
  i       :integer;
  CirRgn  :HRGN;
  pt      :array[0..5]  of TPoint;
const
  NPoint=6;
begin
  X:=PosX;  Y:=PosY;
  RDes:=RadDes;
  Parent:=AOwner;
  Numb:=Index;

  Hex:=TestPanel.Create(AOwner);
  Hex.Index:=Numb;
  Hex.Parent:=AOwner;
  Hex.SendToBack;

 with  Hex do
   begin
      BevelInner:=bvNone;  BevelOuter:=bvNone;  BorderStyle:=bsNone; //ïàðàìåíòðû ïàíåëè
      Height:=RDes*2;    Width:=RDes*2;
      Top:=Round(Y);     Left:=Round(X);

      Image:=TImage.Create(Hex);
      Image.Parent:=Hex;
      Image.Align:=alClient;
      Image.OnMouseDown:=Hex.MovePanelMouseDown;

      for i:=1 to 5 do     //òåêñò
       begin
        TextLabel[i]:=Tlabel.Create(Hex);
        TextLabel[i].Parent:=Hex;
        TextLabel[i].Caption:=inttostr(i);
        TextLabel[i].Left:=RDes-Round(TextLabel[i].width/2);
        TextLabel[i].Top:=Round(i*(2*RDes-12)/(5)-6);
        TextLabel[i].Transparent:=True;
       end;

      for i:=0 to NPoint-1 do  //ôîðìà ìíîãîóãîëüíèêà
        begin
          pt[i].Y:=Round((Sin(2*i*pi/NPoint+pi/NPoint)+1)*RDes);
          pt[i].X:=Round((Cos(2*i*pi/NPoint+pi/NPoint)+1)*RDes);
        end;
      CirRgn:= CreatePolygonRgn (pt,NPoint,1);
      SetWindowRgn(Handle,CirRgn,true);
      Image.Canvas.Pen.Width:=4;

      Image.Canvas.Brush.Color:=RGB(random(255), random(255), random(255));
      Image.Canvas.Brush.Style:=bsSolid;
      Image.Canvas.Pen.Color:=clBlack;
      Image.Canvas.Polygon(pt);
   end;
end;


function TFA.BodyArrow(X1,Y1,X2,Y2: Integer; LW: Extended):TArrow; //ðèñóþ ñòðåëêó
  var
    Angle: Extended;
    A1,A2: Extended;
    Body:  TArrow;
    SinA,CosA,AbsA:Extended;
  const
    WidthLen=2.2;
    LineLen=4.74;
    ArrAngl=0.28322;
    HeadLenght=4.5;
begin
  Angle:=ArcTan2(Y1-Y2,X2-X1);
  AbsA:=Sqrt(Sqr(Y2-Y1)+Sqr(X2-X1));
  SinA:=(Y2-Y1)/AbsA;
  CosA:=(X2-X1)/AbsA;

  Angle:=Pi+Angle;
  A1:=Angle-ArrAngl; A2:=Angle+ArrAngl;
  Body[0]:=Point(Round(X1+WidthLen*SinA),Round(Y1-WidthLen*CosA));
  Body[1]:=Point(Round(X1-WidthLen*SinA),Round(Y1+WidthLen*CosA));
  Body[2]:=Point(Round(X2-WidthLen*SinA -LW*HeadLenght*CosA),Round(Y2+WidthLen*CosA-LW*HeadLenght*SinA));
  Body[3]:=Point(X2+Round(LineLen*LW*Cos(A2)),Y2-Round(LineLen*LW*Sin(A2)));
  Body[4]:=Point(X2,Y2);
  Body[5]:=Point(X2+Round(LineLen*LW*Cos(A1)),Y2-Round(LineLen*LW*Sin(A1)));
  Body[6]:=Point(Round(X2+WidthLen*SinA -LW*HeadLenght*CosA),Round(Y2-WidthLen*CosA-LW*HeadLenght*SinA));

  BodyArrow:=Body;
end;

procedure TFA.DrawArrow (DeltX,DeltY:Real; Wdt:integer);
var
  CirRgn:HRGN;
  RecPoint:TArrow;
  Line: array [1..2] of TPoint;
  i:Integer;
  SinA,CosA,AbsA,dX,dY:Real;
  TempInteger:Integer;
begin
 AbsA:=Sqrt(Sqr(DeltX)+Sqr(DeltY));
 SinA:=(DeltY)/AbsA;
 CosA:=(DeltX)/AbsA;
 dX:=(SinA*Wdt)/2;
 dY:=(CosA*Wdt)/2;

 Arrow:=TestPanel.Create(Parent);
 Arrow.Parent:=Parent;
 Arrow.Index:=0;

with  Arrow do
  begin
   BevelInner:=bvNone; BevelOuter:=bvNone;  BorderStyle:=bsNone;   //óáèðàåì ãðàíèöû

   if DeltX>=0 then  Left:=Round(X+RDes-abs(dX))  else  Left:=Round(X+RDes+DeltX-abs(dX)); //ðàçåìðû ïàíåëè
   if DeltY>=0 then  Top:= Round(Y+RDes-abs(dY))  else  Top:= Round(Y+RDes+DeltY-abs(dY));
   Width:=Round(Abs(DeltX)+2*abs(dX));       Height:=Round(Abs(DeltY)+2*abs(dY));

   Image:=TImage.Create(Arrow);      //ñîçäàåì ïàíåëü
   Image.Parent:=Arrow;
   Image.Align:=alClient;
   Image.Canvas.Brush.Color:=clRed;
   Image.Canvas.Pen.Width:=2;

   if (DeltX>=0) then begin  Line[1].X:=Round(DeltX+abs(dX)); Line[2].X:=Round(0+abs(dX) )      end
                else  begin  Line[1].X:=Round(0+abs(dX));     Line[2].X:=Round(-DeltX+abs(dX) ) end;

   if (DeltY>=0) then begin  Line[1].Y:=Round(DeltY+abs(dY)); Line[2].Y:=Round(0+abs(dY))   end
                 else begin  Line[1].Y:=Round(0+abs(dY));     Line[2].Y:=Round(-DeltY+abs(dY)) end;

   RecPoint:=    BodyArrow(Line[1].X,Line[1].Y,Line[2].X,Line[2].Y,3);

   CirRgn:= CreatePolygonRgn (RecPoint,7,1);
   Image.Canvas.Polygon(RecPoint);
   SetWindowRgn(Handle,CirRgn,true);

   Image.OnMouseDown:=Arrow.MovePanelMouseDown;
  end;
end;

procedure TestPanel.MovePanelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  (Sender as TImage).Parent.Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure LoadData;
 var
  sl,dmsl:TStringList;
  i:integer;
begin
  sl:=TStringList.Create;
  sl.LoadFromFile('fa_locations.c1');
  dmsl:=TStringList.Create;
  dmsl.Delimiter:=' ';
  for i:=0 to 162 do
  begin
   dmsl.DelimitedText:=sl[i];
   RPoint[i+1].x:=StrToFloat (dmsl[1]);
   RPoint[i+1].y:=StrToFloat (dmsl[2]);
  end;
  dmsl.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i:Integer;
begin
Panel1.Visible:=false;
 if FileExists('fa_locations.c1') then LoadData
    else for i:=1 to 163 do begin RPoint[i].x:=Random(3000)/1000-1.5; RPoint[i].y:=Random(3000)/1000-1.5; end;


 for i:=1 to 163 do if FA[i]=nil then  FA[i]:=TFA.Create(Panel1,RPoint[i].x*220+400,RPoint[i].y*220+350,30,i);
Panel1.Visible:=True;
Button2.Enabled:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i:Integer;
begin
Panel1.Visible:=false;
 for i:=1 to 163 do   FA[i].DrawArrow(Random(50)+50,Random(50)+50,10);
Panel1.Visible:=True;
end;

End.