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

Андрей Игоревич
Дата: 28.08.2019 17:20:35
Вопрос несколько шире, чем можно написать в заголовке и требует некоторого пояснения.
В моей программке есть рисовалка, которая показывает результаты расчетов пример на картинке. Но всё что отображается по сути обычный рисунок на канве. Интерактивность обеспечивается перехватом координат по клику, сравнивание с изображенным на рисунке и вызовом соответствующих процедур.

Картинка с другого сайта.

Но в определенный момент мне захотелось большей "интерактивности" (информация при наведении на элемент, информация при клике по тексту или рисунку, т.п.).
Так же когда объемы и форматы выводимой информации стали весьма значительными
+ (рисунки для примера)
Картинка с другого сайта.
Картинка с другого сайта.
Картинка с другого сайта.
Картинка с другого сайта.
добавление любых новых данных стало ну очень сложным (так как всё один рисунок + интерактивность + куча условий + каждый раз данные подгружаются разные, надо всё учитывать, ну и т.п.) решил попробовать сделать свой компонент наследника от панели (из-за удобной возможности "ручного" перетаскивания и широкого выбора событий) с лейблами для вывода текста и прочим подобным.

Сделать это на первый взгляд оказалось не сложно (на картинки каждый шестигранник - компонент)...
+ пример - картинка
Картинка с другого сайта.
,
но только на первый взгляд, одним из очень важных элементов визуального отображения результатов являются стрелки
+ картинка - пример тут всё является одним рисунком
Картинка с другого сайта.

и вот тут возникла сложность, а как рисовать стрелки поверх панелек не перекрывая доступ к ним (яж хочу "интерактивность"). Ну и в общем основной вопрос в этом. Как реализовать такие стрелки?
Наиболее очевидным для меня было сделать контурную стрелку и вырезать панельку по ней, так я и сделал, но результат сильно разочаровал:
+ пример со стрелками вырезанными из панелек
Картинка с другого сайта.

Во первых ужасное "сглаживание" наклонных линий (есть ли способ уменьшить эти лесенки?).
Во вторых я никак не могу понять почему основания стрелок сужаются/расширяются? Что-то с округлением и непопаданием пикселей, вроде тригонометрия правильная? Почему криво обрезаются...
Из решений пока думаю сделать панельку прозрачной(теми или иными способами) и рисовать стрелки старым способом.

Я резонно предполагаю, что способ реализации выбранный мной ну очень спорный, потому открыт для любых адекватных предложений.
Отдельные вопросы:
1. Создания сотен панелей потенциально не опасно для работы программы? Что-нибудь может поломаться? В принципе что по памяти, что по отклику проблем никаких не замечено.
2. Имеет ли смысл включать канвас на панели вместо создания на ней Image, это даст какие-то ресурсные преимущества, ну или, возможно, это правильнее?
3. Как можно ускорить создание панелек, несколько сотен панелек создается несколько секунд, что не много, но не мгновенно.
4. Можно ли рисовать прям поверх всех панелей при этом не ограничивая взаимодействия.
5. Почему
CreatePolygonRgn (pt,NPoint,1); 
SetWindowRgn(Handle,CirRgn,true);
при использовании динамического массива просто уничтожает работу системы. Винда зависает почти в ноль даже на многоядерном процессоре, данные на входе проверял - правильны.
То есть такой код работает нормально:
    Var
  pt      :array[0..5]  of TPoint;
  ...
 begin
  CirRgn:= CreatePolygonRgn (pt,6,1);
  SetWindowRgn(Handle,CirRgn,true);
 end
А вот такой убивает винду (по крайней мере на Delphi7), почему?
    Var
  pt      :array  of TPoint;
  ...
 begin
  Setlength (pt,6)
  CirRgn:= CreatePolygonRgn (pt,6,1);
  SetWindowRgn(Handle,CirRgn,true);
 end


Если интересен код, вот, сильно не бейте, писалось просто что в голову придет и я пока просто учусь:
+ код
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.


Ну а теперь отдельно.
Если мои вопросы слишком глупы для данного форума, то, вроде, есть более лояльные к новичкам форумы, просто это мне показался наиболее живым из существующих, если считаете что не стоит тут задавать, то более не буду.
Если же мои вопрос слишком сложны и надо писать их в разделе "работа", то поясню, всё что я делаю, по сути делаю для "научного интереса", то есть мне за это никто не платит, я за это ничего не получу (кроме, возможно, благодарности). Можно сказать что я просто учусь и заодно что-то делаю облегчая жизнь себе и коллегам. Банально мне это интересно и нравится.
П.С. Мне на форуме советовали книгу по типам данных Delphi, теперь никак не могу найти где именно мне её посоветовали. Скачал несколько по алгоритмам, хорошие книги, но пока не совсем то, что мне надо. Чтож за книгу там мне посоветовали...
Андрей Игоревич
Дата: 28.08.2019 17:22:39
Сомневаюсь, что кому-то нужно, но прицепил программку. Зато можно стрелочки порисовать :).
s62
Дата: 28.08.2019 18:12:58
Андрей Игоревич
П.С. Мне на форуме советовали книгу по типам данных Delphi, теперь никак не могу найти где именно мне её посоветовали. Скачал несколько по алгоритмам, хорошие книги, но пока не совсем то, что мне надо. Чтож за книгу там мне посоветовали...

Я вам писал о вот этой книжке:
https://royallib.com/book/baknell_dgulian/fundamentalnie_algoritmi_i_strukturi_dannih_v_Delphi.html
Но может быть вы что-то другое имеете в виду.
Андрей Игоревич
Дата: 28.08.2019 18:24:01
s62
Андрей Игоревич
П.С. Мне на форуме советовали книгу по типам данных Delphi, теперь никак не могу найти где именно мне её посоветовали. Скачал несколько по алгоритмам, хорошие книги, но пока не совсем то, что мне надо. Чтож за книгу там мне посоветовали...

Я вам писал о вот этой книжке:
https://royallib.com/book/baknell_dgulian/fundamentalnie_algoritmi_i_strukturi_dannih_v_Delphi.html
Но может быть вы что-то другое имеете в виду.

А, эту книгу я уже скачал. Хорошая, но некоторая сложность в том, что алгоритмы из книги я нигде пока не использую (ну из начала кнаги по крайней мере), а что не использовал, то почти сразу забываю (треклятая дырявая память), сейчас добью "Библию Делфи" (ничего нового особо не узнал, но некоторое систематизировал) и попробую эту ещё раз уже пытаясь куда-нибудь применив.
Док
Дата: 28.08.2019 18:54:29
Андрей Игоревич
Сделать это на первый взгляд оказалось не сложно (на картинки каждый шестигранник - компонент)...

Ну ты, брат, силен. Основную работу работать-то успеваешь? :)

зы. если честно, ЯНХНП. Но, если суть вопроса в корректной и оптимальной отрисовке, дождись, пока ответит Соколинский Борис , он в этом вопросе продвинут, КМК.
Василий 2
Дата: 28.08.2019 19:28:16
Попробуй вместо панелек отрисовку в Tshape с перекрытым Draw и Brush.Style=bsClear. Да, регионы очень тормознутые, тем более когда их сотни.
Андрей Игоревич
Дата: 28.08.2019 19:40:37
Док
Андрей Игоревич
Сделать это на первый взгляд оказалось не сложно (на картинки каждый шестигранник - компонент)...

Ну ты, брат, силен. Основную работу работать-то успеваешь? :)

зы. если честно, ЯНХНП. Но, если суть вопроса в корректной и оптимальной отрисовке, дождись, пока ответит Соколинский Борис , он в этом вопросе продвинут, КМК.

Лето, пара отпусков, всё начальство отдыхает, вот и ковыряюсь пока время есть. По факту я уже раза 3-4 почти всё переделывал, на это (и на поиск ошибок от выхода за пределы массива) уходить куда больше времени, чем на создание чего-то нового :).

Суть вопроса достаточно проста:
как нарисовать красивую стрелочку поверх всего(панелек, имеджей, ...) на форме при том чтоб стрелка не перекрывала доступ к компонентам под ней.

Остальное уже так, заранее ответил на возможные вопросы :) (по опыту). Нашел несколько готовых решений, но там везде идет перекрытие (стрелка на прозрачном фоне). Наверняка в сети "тыщу" раз это обсуждалось, но я не всегда умею грамотно спросить у гугла (обычно знаешь что спрашивать уже зная ответ).
Ну и просто может кто по опыту скажет, что я вообще не правильно всё делаю и надо делать не так (ну там не панельки использовать, не так компоненты рисловать, и т.п.).
X-Cite
Дата: 28.08.2019 20:36:53
и на поиск ошибок от выхода за пределы массива


Программа сама найдет

Range checking
Андрей Игоревич
Дата: 28.08.2019 21:03:35
X-Cite
и на поиск ошибок от выхода за пределы массива

Программа сама найдет
Range checking

Спасибо, попробую, нужная вещь. Вроде и знал о данной возможности, а вроде и ленился найти как включить. Ведь каждый раз думаешь "ну в чем же ошибка, ну в этот раз точно не динамический массив", а по факту постоянно из-за него :), как я не люблю динамические массивы, будь они неладны...

Василий 2
Попробуй вместо панелек отрисовку в Tshape с перекрытым Draw и Brush.Style=bsClear. Да, регионы очень тормознутые, тем более когда их сотни.

Попробую, пока что-то не разобрался как её на передний план вывести и будет ли прямоугольник компонента перекрывать доступ, но поковыряюсь.
DimaBr
Дата: 28.08.2019 22:20:21
Почему в пользу "интеракивности" был выбран TWinControl + SetWindowRgn, а не просто TGraphicsControl ?