TBitmap.Canvas 上繪製的內容被自動縮放的問題

項目	內容
調試	Delphi Seattle
運行	Win7 & iOS 9.2

問題描述

當需要在Bitmap.Canvas上人工繪製內容（包括圖像和形狀）時，遇到如下問題。

procedure TForm1.FDrawMethod1(Sender: TObject);
begin
  with Image1.Bitmap do
  begin
    SetSize(Round(Image1.Width * Self.FScreenScaleRate),
      Round(Image1.Height * Self.FScreenScaleRate));
    Clear(TAlphaColorRec.Null);
    Canvas.BeginScene();
    try
      Canvas.Fill.Kind := TBrushKind.Solid;
      Canvas.Fill.Color := TAlphaColorRec.White;
      Canvas.FillEllipse(TRectF.Create(5, 5, Canvas.Width-5, Canvas.Height-5), 1);
    finally
      Canvas.EndScene;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ScreenService : IFMXScreenService;
begin
{$IFDEF MSWINDOWS}
  REPORTMEMORYLEAKSONSHUTDOWN := True;
{$ENDIF}
  Self.FScreenScaleRate := 1;
  if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService,
    IInterface(ScreenService)) then
  begin
    Self.FScreenScaleRate := ScreenService.GetScreenScale;
  end;
  Text1.Text:= 'ScreenScaleRate: '+FormatFloat('0.00',Self.FScreenScaleRate);
end;

執行結果：
Win7上運行截圖

而該代碼在iPhone 5S設備(包括模擬器）上運行結果如下：

很顯然，顯示的內容僅爲繪製內容的1/4。應該是與ScreenScaleRate有直接關係。
但即使設置Image.WrapMode爲Stretch或Fit，結果一樣。
甚至將
SetSize(Round(Image1.Width * Self.FScreenScaleRate),
Round(Image1.Height * Self.FScreenScaleRate));
改爲
SetSize(Round(Image1.Width),
Round(Image1.Height));
運行結果同樣顯示1/4內容，應該是與TBitmap.Canvas的Scale始終爲1有關。

解決方法(1)

不直接繪製Image，而使用一個TBitmap對象進行繪製操作，繪製完成後再給TImage控件賦值。

procedure TForm1.FDrawMethod2(Sender: TObject);
var
  lbmp:TBitmap;
begin
  lbmp:= TBitmap.Create;
  try
    with lbmp do
    begin
      SetSize(Round(Image1.Width * Self.FScreenScaleRate),
        Round(Image1.Height * Self.FScreenScaleRate));
      Clear(TAlphaColorRec.Null);
      Canvas.BeginScene();
      try
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := TAlphaColorRec.Yellowgreen;
        Canvas.FillEllipse(TRectF.Create(5, 5, Canvas.Width-5, Canvas.Height-5), 1);
      finally
        Canvas.EndScene;
      end;
    end;
    Image1.Bitmap:= lbmp;
  finally
    lbmp.Free;
  end;
end;

運行截圖：

解決方法（2）

根據調試信息獲得，Method1中獲得的TBitmap對象與Method2生成的TBitmap在Canvas.Scale上存在差異。
Method1
Image1.Bitmap.Canvas.Scale = 2

Method2
lbmp:= TBitmap.Create();
lbmp.Canvas.Scale = 1

依次數值，可得另一種解決方案（修改Method1的處理代碼，加入Scale）

procedure TForm1.FDrawMethod1(Sender: TObject);
begin
  with Image1.Bitmap do
  begin
    SetSize(Round(Image1.Width * Self.FScreenScaleRate),
      Round(Image1.Height * Self.FScreenScaleRate));
    Clear(TAlphaColorRec.Null);
    Canvas.BeginScene();
    try
      Canvas.Fill.Kind := TBrushKind.Solid;
      Canvas.Fill.Color := TAlphaColorRec.White;

      //繪製區域與ScreenScaleRate需關聯
      Canvas.FillEllipse(TRectF.Create(
        5/Self.FScreenScaleRate,
        5/Self.FScreenScaleRate,
        (Canvas.Width-5)/Self.FScreenScaleRate,
        (Canvas.Height-5)/Self.FScreenScaleRate), 1);
    finally
      Canvas.EndScene;
    end;
  end;
end;