Delphi 10.1 FMX How to copy a RoundRect Bitmap and TPath onto a TImage-CodePudding

I'm using Delphi 10.1 and have a Multi Device application.

I'm loading a image onto a TRoundRect control where the user can draw directly onto it.

My question is how do I copy the RoundRect Image and whats been drawn on it to a TImage?

This is the form:-

object frmMain: TfrmMain
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 528
  ClientWidth = 759
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object tbPhoto: TToolBar
    Align = Bottom
    Position.Y = 432.000000000000000000
    Size.Width = 759.000000000000000000
    Size.Height = 48.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 1
    object btnReset: TButton
      Align = Left
      Margins.Left = 5.000000000000000000
      Margins.Top = 5.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 5.000000000000000000
      Position.X = 5.000000000000000000
      Position.Y = 5.000000000000000000
      Size.Width = 82.000000000000000000
      Size.Height = 38.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
      Text = 'Reset'
      OnClick = btnResetClick
    end
    object btnCopy_File_Image_To_RoundRect: TButton
      Align = Left
      Margins.Left = 5.000000000000000000
      Margins.Top = 5.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 5.000000000000000000
      Position.X = 97.000000000000000000
      Position.Y = 5.000000000000000000
      Size.Width = 176.000000000000000000
      Size.Height = 38.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 2
      Text = 'Copy File Image To RoundRect '
      OnClick = btnCopy_File_Image_To_RoundRectClick
    end
    object btnCopy_Round_Rect_To_Image: TButton
      Align = Left
      Margins.Left = 5.000000000000000000
      Margins.Top = 5.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 5.000000000000000000
      Position.X = 283.000000000000000000
      Position.Y = 5.000000000000000000
      Size.Width = 190.000000000000000000
      Size.Height = 38.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 1
      Text = 'Copy RoundRect to Image'
      OnClick = btnCopy_Round_Rect_To_ImageClick
    end
  end
  object ToolBar2: TToolBar
    Size.Width = 759.000000000000000000
    Size.Height = 41.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 4
    object Label1: TLabel
      Align = Client
      Size.Width = 759.000000000000000000
      Size.Height = 41.000000000000000000
      Size.PlatformDefault = False
      TextSettings.HorzAlign = Center
      Text = 'Image Photo Draw'
    end
  end
  object RoundRect1: TRoundRect
    Align = Left
    Corners = []
    Fill.Kind = None
    Margins.Left = 5.000000000000000000
    Margins.Top = 5.000000000000000000
    Margins.Right = 5.000000000000000000
    Margins.Bottom = 5.000000000000000000
    Position.X = 5.000000000000000000
    Position.Y = 46.000000000000000000
    Size.Width = 372.000000000000000000
    Size.Height = 381.000000000000000000
    Size.PlatformDefault = False
    Stroke.Thickness = 2.000000000000000000
    Stroke.Dash = Dash
    onm ouseDown = RoundRect1MouseDown
    onm ouseMove = RoundRect1MouseMove
    object Path1: TPath
      Align = Client
      Fill.Kind = None
      Locked = True
      HitTest = False
      Size.Width = 372.000000000000000000
      Size.Height = 381.000000000000000000
      Size.PlatformDefault = False
      Stroke.Color = claRed
      Stroke.Thickness = 2.000000000000000000
      WrapMode = Original
    end
  end
  object tbImage: TToolBar
    Align = Bottom
    Position.Y = 480.000000000000000000
    Size.Width = 759.000000000000000000
    Size.Height = 48.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    object btnDraw_Colour: TButton
      Align = Right
      Margins.Left = 5.000000000000000000
      Margins.Top = 5.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 5.000000000000000000
      Position.X = 580.000000000000000000
      Position.Y = 5.000000000000000000
      Size.Width = 82.000000000000000000
      Size.Height = 38.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 1
      Text = 'Black'
      OnClick = btnDraw_ColourClick
    end
    object btnClear_Drawing: TButton
      Tag = 1
      Align = Right
      Margins.Left = 5.000000000000000000
      Margins.Top = 5.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 5.000000000000000000
      Position.X = 672.000000000000000000
      Position.Y = 5.000000000000000000
      Size.Width = 82.000000000000000000
      Size.Height = 38.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
      Text = 'Clear'
      OnClick = btnClear_DrawingClick
    end
  end
  object Image1: TImage
    MultiResBitmap = <
      item
      end>
    Align = Client
    Size.Width = 377.000000000000000000
    Size.Height = 391.000000000000000000
    Size.PlatformDefault = False
    WrapMode = Stretch
  end
end

This is the code I have so far:-

unit uMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.StdCtrls, FMX.Controls.Presentation, FMX.MediaLibrary.Actions,
  System.Actions, FMX.ActnList, FMX.StdActns;

const
  Con_Draw_Colour_Red = 0;
  Con_Draw_Colour_Black = 1;

  Con_Max_Draw_Colours = Con_Draw_Colour_Black;

  Con_Draw_Colours: array[0..Con_Max_Draw_Colours] of String = ('Red', 'Black');

type
  TfrmMain = class(TForm)
    tbPhoto: TToolBar;
    ToolBar2: TToolBar;
    Label1: TLabel;
    btnReset: TButton;
    RoundRect1: TRoundRect;
    Path1: TPath;
    tbImage: TToolBar;
    btnDraw_Colour: TButton;
    btnClear_Drawing: TButton;
    Image1: TImage;
    btnCopy_File_Image_To_RoundRect: TButton;
    btnCopy_Round_Rect_To_Image: TButton;
    procedure btnResetClick(Sender: TObject);
    procedure RoundRect1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure RoundRect1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure btnDraw_ColourClick(Sender: TObject);
    procedure btnClear_DrawingClick(Sender: TObject);
    procedure btnCopy_File_Image_To_RoundRectClick(Sender: TObject);
    procedure btnCopy_Round_Rect_To_ImageClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses
  FMX.Platform,
  FMX.MediaLibrary;

{$R *.fmx}

procedure TfrmMain.btnClear_DrawingClick(Sender: TObject);
begin
  {$REGION 'Clear the Drawing'}
  Path1.Data.Clear;
  {$ENDREGION 'Clear the Drawing'}
end;

procedure TfrmMain.btnDraw_ColourClick(Sender: TObject);
begin
  {$REGION 'Change the Path Stroke Colour'}
  btnDraw_Colour.Text := Con_Draw_Colours[(Sender as TButton).Tag];
  case (Sender as TButton).Tag of
    Con_Draw_Colour_Red   : begin
                              (Sender as TButton).Tag := Con_Draw_Colour_Black;
                              Path1.Stroke.Color := TAlphaColorRec.Black;
                            end;
    Con_Draw_Colour_Black : begin
                              (Sender as TButton).Tag := Con_Draw_Colour_Red;
                              Path1.Stroke.Color := TAlphaColorRec.Red;
                            end;
  end;
  {$ENDREGION 'Change the Path Stroke Colour'}
end;

procedure TfrmMain.btnResetClick(Sender: TObject);
begin
  {$REGION 'Clear the Photo and Drawing'}
  Image1.Bitmap := nil;
  RoundRect1.Fill.Bitmap.Bitmap := nil;
  btnClear_DrawingClick(Sender);
  {$ENDREGION 'Clear the Photo and Drawing'}
end;

procedure TfrmMain.btnCopy_File_Image_To_RoundRectClick(Sender: TObject);
begin
  RoundRect1.Fill.Kind := TbrushKind.Bitmap;
  RoundRect1.Fill.Bitmap.WrapMode := TWrapMode.TileStretch;
  RoundRect1.Fill.Bitmap.Bitmap.LoadFromFile('...\The Image.jpg');
end;

procedure TfrmMain.btnCopy_Round_Rect_To_ImageClick(Sender: TObject);
begin
  {$REGION 'Draw the users lines on the Image'}
  {$REGION 'Set the Bitmap Stroke Colour'}
  case btnDraw_Colour.Tag of
    Con_Draw_Colour_Red   : RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
    Con_Draw_Colour_Black : RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black;
  end;
  {$ENDREGION 'Set the Bitmap Stroke Colour'}

  RoundRect1.Fill.Bitmap.Bitmap.Canvas.BeginScene;
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.DrawPath(Path1.Data, 2);
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.EndScene;
  {$ENDREGION 'Draw the users lines on the Image'}

  Image1.Bitmap.Assign(RoundRect1.Fill.Bitmap.Bitmap);
end;

procedure TfrmMain.RoundRect1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if ssLeft in Shift then
    Path1.Data.MoveTo((TPointF.Create(X, Y)));
end;

procedure TfrmMain.RoundRect1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
  {$REGION 'Draw the line only if we have a Image'}
  if (not RoundRect1.Fill.Bitmap.Bitmap.IsEmpty) then
  begin
    if ssLeft in Shift  then
    begin
      Path1.Data.LineTo((TPointF.Create(X, Y)));
      RoundRect1.Repaint;
    end;
  end;
  {$ENDREGION 'Draw the line only if we have a Image'}
end;

end.

This is where I would like to copy the RoundRect and whats been drawn on it, to a TImage. The loaded image copies but not whats been drawn:-

procedure TfrmMain.btnCopy_Round_Rect_To_ImageClick(Sender: TObject);
begin
  {$REGION 'Draw the users lines on the Image'}
  {$REGION 'Set the Bitmap Stroke Colour'}
  case btnDraw_Colour.Tag of
    Con_Draw_Colour_Red   : RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
    Con_Draw_Colour_Black : RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black;
  end;
  {$ENDREGION 'Set the Bitmap Stroke Colour'}

  RoundRect1.Fill.Bitmap.Bitmap.Canvas.BeginScene;
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.DrawPath(Path1.Data, 2);
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.EndScene;
  {$ENDREGION 'Draw the users lines on the Image'}

  Image1.Bitmap.Assign(RoundRect1.Fill.Bitmap.Bitmap);
end;

The TImage WrapMode is set to Stretch so whats been drawn needs to be proportional.

Any ideas how to copy the RoundRect Bitmap and whats been drawn?

Hope that makes sense. tia

CodePudding user response：

The picture is being stretched, but the path object is not, so when it gets drawn on the TImage it will be stretched with the picture and have the wrong scale. You also hadn't set the stroke thickness for drawing the path. The following is one solution to scale the drawing of the path to match the picture. Math.Vectors is needed in uses. Tested in Delphi 10.4.

procedure TfrmMain.btnCopy_Round_Rect_To_ImageClick(Sender: TObject);
var
  M : TMatrix;
  ScaleX, ScaleY : Single;
begin
  {$REGION 'Draw the users lines on the Image'}
  {$REGION 'Set the Bitmap Stroke Colour'}
  case btnDraw_Colour.Tag of
    Con_Draw_Colour_Red   : RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
    Con_Draw_Colour_Black : RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black;
  end;
  {$ENDREGION 'Set the Bitmap Stroke Colour'}

  RoundRect1.Fill.Bitmap.Bitmap.Canvas.BeginScene;
  ScaleX := RoundRect1.Fill.Bitmap.Bitmap.Width / RoundRect1.Width;
  ScaleY := RoundRect1.Fill.Bitmap.Bitmap.Height / RoundRect1.Height;
  M := TMatrix.CreateScaling(ScaleX, ScaleY);
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.SetMatrix(M);
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.Stroke.Thickness := Path1.Stroke.Thickness;
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.DrawPath(Path1.Data, 1);
  RoundRect1.Fill.Bitmap.Bitmap.Canvas.EndScene;
  {$ENDREGION 'Draw the users lines on the Image'}

  Image1.Bitmap.Assign(RoundRect1.Fill.Bitmap.Bitmap);
end;