Delphi XE2 Firemonkey の Align プロパティを alScale に設定すると、座標系にどのような影響がありますか?
Firemonkey のキャンバス描画機能を調べているところ、コンポーネントの Align プロパティが alScale に設定されている場合に座標系に問題が発生しました。次のデモ プログラム (FM HD アプリケーション) は、この問題を示しています。サンプル コードをコンパイルして実行し、数行を描画してから、奇妙なことにフォームのサイズを変更します。ラインが予期した位置に表示されません。
どんな提案や説明も大歓迎です! 前もって感謝します。
メイン フォーム (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.
FMX ファイル (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