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

  

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
OnMouseDown = RoundRect1MouseDown
OnMouseMove = 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

Comments are closed.