FireMonkey vs VCL , TPaintBox не пашет

[Cfon]

Пытаюсь перевести VCL код на FMX, застрял на отрисовке Паинтбоксов, в VCL прежний код выводил линии в 8 пайнтбоксов одновремено, а вот FMX версия не пашет, выводится в один пайнтбокс
Кто уже прогет на FMX?
Ниже привел мои эксперименты с пайнтбоксами, изучите плз эту портянку где то я накосячил

unit Unit1;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  System.SyncObjs, System.Threading;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox4: TPaintBox;
    PaintBox5: TPaintBox;
    PaintBox6: TPaintBox;
    PaintBox7: TPaintBox;
    PaintBox8: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FNumRunning: int64;
    FStop: boolean;    
  public
  
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
{$IFDEF MSWINDOWS}
uses Winapi.Windows;
{$ENDIF}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  pb: TArray<TPaintBox>;
begin
  pb := [PaintBox1, PaintBox2, PaintBox3, PaintBox4,
         PaintBox5, PaintBox6, PaintBox7, PaintBox8];
 
  for i := 0 to High(pb) do
    TThread.CreateAnonymousThread((function (i: integer): TProc
      begin
        Result:= procedure
        var
          p1, p2: TPointF;
          d1, d2: TPointF;
          color: TAlphaColor;
 
          procedure CalcPoints(var point, delta: TPointF);
          begin            
            if (point.X < 0) or (point.X >= pb[i].Width) then          
              delta.X:= - delta.X;
            
            if (point.Y < 0) or (point.Y >= pb[i].Height) then        
              delta.Y:= - delta.Y;
            
            point:= point + delta;
          end;
        begin
          TInterlocked.Increment(FNumRunning);
          p1 := PointF(50.0, 10.0); d1 := PointF(2.0, 3.0);
          p2 := PointF(10.0, 50.0); d2 := PointF(3.0, 2.0);
          color := $FF000000;
 
          while not FStop do
          begin
            color:= color + $F0F8FF;
            if color > $FFFFFFFF then color:= $FF000000;
            // рисуем линии
            pb[i].Canvas.BeginScene;
            try
              pb[i].Canvas.Stroke.Color:= color;
              pb[i].Canvas.DrawLine(p1, p2, 1);
            finally
              pb[i].Canvas.EndScene;
            end;
 
            CalcPoints(p1, d1);
            CalcPoints(p2, d2);
            Sleep(10);
          end;
          TInterlocked.Decrement(FNumRunning);
        end;
      end)(i)).Start;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FStop := true;
  // ждем завершения все потоков
  while TInterlocked.Read(FNumRunning) > 0 do
     Application.ProcessMessages;
end;
 
end.

Сообщение отредактировано: Cfon - 20.03.19, 12:24

[Cfon]

Сам все порешал
Как оказалось канва пайнтбокса это канва формы, т.е вот этот код

// рисуем линии
pb[i].Canvas.BeginScene;
try
  pb[i].Canvas.Stroke.Color:= color;
  pb[i].Canvas.DrawLine(p1, p2, 1);
finally
  pb[i].Canvas.EndScene;
end;

на самом деле означает

// рисуем линии
Form1.Canvas.BeginScene;
try
  Form1.Canvas.Stroke.Color:= color;
  Form1.Canvas.DrawLine(p1, p2, 1);
finally
  Form1.Canvas.EndScene;
end;

поэтому вся отрисовка шла начиная с координат (0,0)
Короче добавил где надо смещение на расположение пайнтбоксов и...
ВСЕ ЗАРАБОТАЛО!

Как варик моно было закинуть каждый пейнтбокс в панельку и тогда не заморачиваться вапще с кодом смещения Гениально!

Сообщение отредактировано: Cfon - 20.03.19, 12:30

[Cfon]

Облом на MacOSX этот код не пашет

[Cfon]

Решил через обработку события OnPaint пайнтбокса и таймер

unit Unit1;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  System.Threading, System.SyncObjs, FMX.Controls.Presentation, FMX.StdCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox8: TPaintBox;
    PaintBox7: TPaintBox;
    PaintBox6: TPaintBox;
    PaintBox5: TPaintBox;
    PaintBox4: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);  
    procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
    procedure Timer1Timer(Sender: TObject);  
  private
    p0, p1, p2, d1, d2: TPointF;
    color: TAlphaColor;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
{$IFDEF MSWINDOWS}
uses Winapi.Windows;
{$ENDIF}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  p1:= PointF(50.0, 10.0);
  p2:= PointF(10.0, 50.0);
  d1:= PointF(2.0, 3.0);
  d2:= PointF(3.0, 2.0);
  color := $FF000000;
  PaintBox1.OnPaint:= PaintBox1Paint;
  ...
  PaintBox8.OnPaint:= PaintBox1Paint;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
var pb: TPaintBox;
procedure CalcPoints(pb: TPaintBox; var point, delta: TPointF);
begin
  if (point.X < 0) or (point.X >= pb.Width) then
    delta.X:= - delta.X;
  if (point.Y < 0) or (point.Y >= pb.Height) then
    delta.Y:= - delta.Y;
  point:= point + 2 * delta;
end;
begin
  pb:= Sender as TPaintBox;
  color:= color + $F0F8FF;
  if color >= $FFFFFFFF then color:= $FF000000;
  // рисуем линию  
  Canvas.BeginScene;
  try
    Canvas.Stroke.Color:= color;
    Canvas.Stroke.Thickness:= 3;
    Canvas.Stroke.Kind:= TBrushKind.Solid;
    Canvas.DrawLine(p1, p2, 1);
  finally
    Canvas.EndScene;
  end;
  // пересчет координат
  CalcPoints(pb, p1, d1);
  CalcPoints(pb, p2, d2);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Invalidate;
end;
 
end.

Не очень красиво, но пашет на МАКАКЕ
По поводу ошибки предыдущего кода, как я понял, на МакОСХ все более жестко там была ошибка обращения к залоченому монитором объекту с последующим эксепшеном, короче не стал копать дальше

Сообщение отредактировано: Cfon - 22.03.19, 13:08

[Cfon]

Предлагаю вашему вниманию гениальное решение!
Заюзал анонимную фунцию, убраны переменые из определения формы.
Чтобы присвоить анонимку событию юзается одна хитрая структура

unit Unit1;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  System.Threading, System.SyncObjs, FMX.Controls.Presentation, FMX.StdCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox8: TPaintBox;
    PaintBox7: TPaintBox;
    PaintBox6: TPaintBox;
    PaintBox5: TPaintBox;
    PaintBox4: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);    
    procedure Timer1Timer(Sender: TObject);
  private
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
{$IFDEF MSWINDOWS}
uses Winapi.Windows;
{$ENDIF}
 
type
  TProc = TProc<TObject, TCanvas>;
 
  TPaintEventAdapter = class
  strict private
    FProc: TProc;
  public
    constructor Create(AProc: TProc);
    procedure EventHandler(Sender: TObject; Canvas: TCanvas);
  end;
 
constructor TPaintEventAdapter.Create(AProc: TProc);
begin
  FProc:= AProc;
end;
 
procedure TPaintEventAdapter.EventHandler(Sender: TObject; Canvas: TCanvas);
begin
  FProc(Sender, Canvas);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  pbs: TArray<TPaintBox>;
  p1, p2, d1, d2: TPointF;
  color: TAlphaColor;
begin
  pbs := [PaintBox1, PaintBox2, PaintBox3, PaintBox4, PaintBox5,
          PaintBox6, PaintBox7, PaintBox8];
 
  p1:= PointF(50.0, 10.0);
  p2:= PointF(10.0, 50.0);
  d1:= PointF(2.0, 3.0);
  d2:= PointF(3.0, 2.0);
  color := $FF000000;
 
  for I := 0 to High(pbs) do
  begin
    pbs[i].OnPaint := TPaintEventAdapter.Create(
      procedure (Sender: TObject; Canvas: TCanvas)
        procedure CalcPoints(var point, delta: TPointF);
        var pb: TPaintBox;
        begin
          pb:= Sender as TPaintBox;
          if (point.X < 0) or (point.X >= pb.Width) then
            delta.X:= - delta.X;
          if (point.Y < 0) or (point.Y >= pb.Height) then
            delta.Y:= - delta.Y;
          point:= point + 2 * delta;
        end;
      begin
        color:= color + $F0F8FF;
        if color >= $FFFFFFFF then color:= $FF000000;
        // рисуем линию
        Canvas.BeginScene;
        try
          Canvas.Stroke.Color:= color;
          Canvas.Stroke.Thickness:= 3;
          Canvas.Stroke.Kind:= TBrushKind.Solid;
          Canvas.DrawLine(p1, p2, 1);
        finally
          Canvas.EndScene;
        end;
        // пересчет координат
        CalcPoints(p1, d1);
        CalcPoints(p2, d2);
      end).EventHandler;
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Invalidate;
end;
 
end.

Вот теперь красиво, как мне нравится

Сообщение отредактировано: Cfon - 22.03.19, 19:11

[Cfon]

Продолжаю улучшения кода, нет предела красивому
вот список улучшений:
-- добавил овнера в TPaintEventAdapter, чтобы избежать утечки памяти;
-- ввел IIFE (Immediately Invoked Function Expression), чтобы перенести в локальную область видимости переменные p1,p2,d1,d2,color,pbs с тем чтобы каждый обработчик имел свою копию данных.
На данном примере демонстрируется применение замыкания (closure), я там в коде пометил захваченые перемнные.

unit Unit1;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  System.Threading, System.SyncObjs, FMX.Controls.Presentation, FMX.StdCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox8: TPaintBox;
    PaintBox7: TPaintBox;
    PaintBox6: TPaintBox;
    PaintBox5: TPaintBox;
    PaintBox4: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
{$IFDEF MSWINDOWS}
uses Winapi.Windows;
{$ENDIF}
 
type
  TPaintProc = TProc<TObject, TCanvas>;
 
  TPaintEventAdapter = class(TComponent)
  strict private
    FProc: TPaintProc;
  public
    constructor Create(AOwner: TComponent; AProc: TPaintProc);  
    procedure EventHandler(Sender: TObject; Canvas: TCanvas);
  end;
 
constructor TPaintEventAdapter.Create(AOwner: TComponent; AProc: TPaintProc);
begin
  inherited Create(AOwner);
  FProc:= AProc;
end;
 
procedure TPaintEventAdapter.EventHandler(Sender: TObject; Canvas: TCanvas);
begin
  FProc(Sender, Canvas);
end;
(**************************************************************************)
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  pbs: TArray<TPaintBox>;
begin
  pbs := [PaintBox1, PaintBox2, PaintBox3, PaintBox4, PaintBox5,
          PaintBox6, PaintBox7, PaintBox8];
 
  for I := 0 to High(pbs) do
  begin
    pbs[i].OnPaint := (function (i: integer): TPaintEvent //<--- iife
      var
        p1, p2, d1, d2: TPointF;
        color: TAlphaColor;
      begin
        p1:= PointF(50.0, 10.0);
        d1:= PointF(2.0, 3.0);
        p2:= PointF(10.0, 50.0);
        d2:= PointF(3.0, 2.0);
        color := $FF000000;
 
        Result := TPaintEventAdapter.Create(self, //<--- owner
          procedure (Sender: TObject; Canvas: TCanvas)  //<--- anonymous function
            procedure CalcPoints(var point, delta: TPointF);
            begin
              if (point.X < 0) or (point.X >= pbs[i].Width) then  //<--- pbs captured
                delta.X:= - delta.X;
              if (point.Y < 0) or (point.Y >= pbs[i].Height) then //<--- pbs captured
                delta.Y:= - delta.Y;
              point:= point + 2 * delta;
            end;
          begin
            color:= color + $F0F8FF;  //<--- color captured
            if color >= $FFFFFFFF then color:= $FF000000;
            // рисуем линию
            Canvas.BeginScene;
            try
              Canvas.Stroke.Color:= color;
              Canvas.Stroke.Thickness:= 3;
              Canvas.Stroke.Kind:= TBrushKind.Solid;
              Canvas.DrawLine(p1, p2, 1);  //<--- p1, p2 captured
            finally
              Canvas.EndScene;
            end;
            // пересчет координат
            CalcPoints(p1, d1);  //<--- p1, d1 captured
            CalcPoints(p2, d2);  //<--- p2, d2 captured
          end).EventHandler;
      end)(i);
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Invalidate;
end;
 
end.

Все эти навороты пришлись мне по душе еще когда кодил на JS приятно что все это есть и в Delphi

Сообщение отредактировано: Cfon - 24.03.19, 03:25