Question

这个问题看起来很简单，VCL这个工作正常（图片是VCL上的TImage）：

procedure TFormMain.btnDrawBackgroundClick(Sender: TObject);
var
  theme: HTHEME;
begin
  theme := OpenThemeData(0, 'TASKDIALOG');
  if theme <> 0 then
  try
    DrawThemeBackground(theme,
                        Image.Canvas.Handle,
                        TDLG_SECONDARYPANEL,
                        0,
                        Image.ClientRect,
                        nil);
  finally
    CloseThemeData(theme);
  end;
end;

问题：我应该更改以获得与FMX相同的效果（在Windows上）

Answer 1

根据this answer，您根本无法做到这一点。

问题是，使用Firemonkey，您只有一台设备表单的上下文，而不是每个组件的上下文。当一个组件需要重新绘制，它会传递窗体画布，但有剪切和坐标映射到组件位置。

但总会有一些解决方法，你可以尝试这样的事情。

procedure TFormMain.btnDrawBackgroundClick(Sender: TObject);
var
  lTheme : HTHEME;
  lStream : TMemoryStream;
  lBitmap : Vcl.Graphics.TBitmap;
begin
  lTheme := OpenThemeData(0, 'TASKDIALOG');
  if lTheme <> 0 then
  try
    lBitmap := Vcl.Graphics.TBitmap.Create;
    try
      lBitmap.Width := Round(Image.Width);
      lBitmap.Height := Round(Image.Height);
      DrawThemeBackground(lTheme, lBitmap.Canvas.Handle, TDLG_SECONDARYPANEL, 0, 
                          Rect(0, 0, lBitmap.Width, lBitmap.Height), nil);
      lStream := TMemoryStream.Create;
      try
        lBitmap.SaveToStream(lStream);
        Image.Bitmap.LoadFromStream(lStream);
      finally
        lStream.Free;
      end;
    finally
      lBitmap.Free;
    end;
  finally
    CloseThemeData(lTheme);
  end;
end;

使用WinApi函数在FMX画布上绘图

1 个答案: