How does Delphi XE2 Firemonkey's Align property set to alScale affect the coordinate system?
I am looking at Firemonkey's canvas drawing capabilities and came across problems with the coordinates system when a component's Align property is set to alScale. The following demonstration program (a FM HD application) illustrates the problem. Compile and run the sample code, draw a couple of lines, then change the form's size for the weirdness to begin. The lines do not appear at the expected locations.
Any suggestions and explanations would be greatly appreciated! Thanks in advance.
The main form (LineDrawFormUnit.pas):
unit LineDrawFormUnit;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;
type
TLineDrawForm = class(TForm)
Image1: TImageControl;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
lX: TLabel;
lY: TLabel;
{ These event handlers are set in the IDE's object inspector }
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
{ This event handler is set/unset with the MouseDown and MouseUp events to capture mouse moves when drawing }
procedure ImageControl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
procedure FormCreate(Sender: TObject);
private
FSaveBitmap: TBitmap;
p1, p2: TPointF; { Start and end points of lines to draw }
end;
var
LineDrawForm: TLineDrawForm;
implementation
{$R *.fmx}
procedure TLineDrawForm.FormCreate(Sender: TObject);
begin
Image1.Bitmap.Create(Round(Image1.Width), Round(Image1.Height));
end;
procedure TLineDrawForm.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
Y: Single);
begin
p1.X := X;
p1.Y := Y;
lX.Text := FloatToStr(X);
lY.Text := FloatToStr(Y);
FSaveBitmap := TBitmap.Create(Image1.Bitmap.Width, Image1.Bitmap.Height);
FSaveBitmap.Assign(Image1.Bitmap); { Save the current canvas as bitmap }
Image1.OnMouseMove := ImageControl1MouseMove; { Activate the MouseMove event handler}
end;
procedure TLineDrawForm.ImageControl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
p2.X := X;
p2.Y := Y;
lX.Text := FloatToStr(X);
lY.Text := FloatToStr(Y);
Image1.Bitmap.Assign(FSaveBitmap);
Image1.Bitmap.Canvas.BeginScene;
try
Image1.Bitmap.Canvas.Stroke.Color := claGray;
Image1.Bitmap.Canvas.StrokeThickness := 0.5;
Image1.Bitmap.Canvas.DrawLine(p1, p2, 1.0);
finally
Image1.Bitmap.Canvas.EndScene;
Image1.Bitmap.BitmapChanged;
end;
end;
procedure TLineDrawForm.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
Y: Single);
begin
p2.X := X;
p2.Y := Y;
lX.Text := FloatToStr(X);
lY.Text := FloatToStr(Y);
Image1.Bitmap.Canvas.BeginScene;
try
Image1.Bitmap.Canvas.Stroke.Color := claBlack;
Image1.Bitmap.Canvas.StrokeThickness := 2;
Image1.Bitmap.Canvas.DrawLine(P1, P2, 1.0);
finally
Image1.Bitmap.Canvas.EndScene;
Image1.Bitmap.BitmapChanged;
end;
(Sender as TControl).OnMouseMove := nil;
if FSaveBitmap <> nil then
FSaveBitmap.Free;
end;
end.
The FMX file (LineDrawFormUnit.fmx):
object LineDrawForm: TLineDrawForm
Left = 0
Top = 0
Caption = 'Polygon Form'
ClientHeight = 513
ClientWidth = 650
Visible = False
OnCreate = FormCreate
StyleLookup = 'backgroundstyle'
object Image1: TImageControl
Align = alScale
Position.Point = '(18,21)'
Width = 620.000000000000000000
Height = 452.000000000000000000
OnMouseDown = Image1MouseDown
OnMouseUp = Image1MouseUp
TabOrder = 0
end
object Panel1: TPanel
Align = alBottom
Position.Point = '(0,480)'
Width = 650.000000000000000000
Height = 33.000000000000000000
TabOrder = 2
object Label1: TLabel
Position.Point = '(16,8)'
Width = 25.000000000000000000
Height = 15.000000000000000000
TabOrder = 1
Text = 'X:'
end
object Label2: TLabel
Position.Point = '(384,8)'
Width = 25.000000000000000000
Height = 15.000000000000000000
TabOrder = 2
Text = 'Y:'
end
object lX: TLabel
Position.Point = '(32,8)'
Width = 313.000000000000000000
Height = 15.000000000000000000
TabOrder = 3
Text = '0'
end
object lY: TLabel
Position.Point = '(424,8)'
Width = 209.000000000000000000
Height = 15.000000000000000000
TabOrder = 4
Text = '0'
end
end
end
Align
property (it's also reproducible withalClient
, by the way). The problem is caused by the fact that the image control is resized but its bitmap is not, therefore it scales. When creating FSaveBitmap you should create it with the size of the image control, not its internal bitmap (otherwise you're not reflecting the changed size of the control and cause scaling). – Ondrej Kelle