Firemonkey中TImage绘制图形后短暂消失的问题排查

在Firemonkey窗体上放置多个已绑定位图的TImage，显示正常。新增空TImage后，通过Canvas绘制图形，仅能短暂看到图形，很快就被窗体背景覆盖消失。代码可运行，但图形仅显示约十分之一秒，在FormShow事件中调用DrawBaseModel过程，相关代码如下：

Procedure NDrawCircles(var IMGTarget: TImage; xc, yc, Radius: Integer; MyPen: MyPenType);
var
   MyRect: TRectF;
   CustPattern: Array [0 .. 7] of Single;
   i: Integer;
   MyDash, bsc : Integer;
   x1, y1, x2, y2 : Extended;
   V: Single;
Begin
   bsc := IMGTarget.Canvas.BeginSceneCount;
   if bsc = 0 then
      IMGTarget.Canvas.BeginScene;
   IMGTarget.Canvas.Stroke.Kind := TBrushKind.Solid;
   IMGTarget.Canvas.Stroke.Color := MyPen.Color;
   IMGTarget.Canvas.Stroke.Thickness := MyPen.Thickness;
   IMGTarget.Canvas.Stroke.Dash := MyPen.Dash;

   x1 := xc - Radius;
   y1 := yc - Radius;
   x2 := xc + Radius;
   y2 := yc + Radius;
   MyRect := TRectF.Create(x1, y1, x2, y2);
   bsc := IMGTarget.Canvas.BeginSceneCount;
   IMGTarget.Canvas.DrawEllipse(MyRect, MyPen.Opacita);
   bsc := IMGTarget.Canvas.BeginSceneCount;
   if bsc > 0 then
      IMGTarget.Canvas.EndScene;
end;

Procedure TConfiguraDignita.DrawBaseModel;
Type
   TCircleso = Record
        XC,YC : Single;
        R : Integer;
       MyPen : MyPenType;
   end;
Var i : Integer;
    Circles : Array[1..7] of TCircleso;
Begin
   for i := 1 to 7 do
   begin
      Circles[i].XC := TargetIMG.Width / 2;
      Circles[i].YC := TargetIMG.Height / 2;
      Circles[i].MyPen.Kind := TBrushKind.Solid;
      Circles[i].MyPen.Color := claBisque;
      Circles[i].MyPen.Dash := 1;
      Circles[i].MyPen.Opacita := 1.0;
   end;
   Circles[1].MyPen.Thickness := 4.0;
   Circles[2].MyPen.Thickness := 4.0;
   Circles[3].MyPen.Thickness := 4.0;
   Circles[4].MyPen.Thickness := 2.0;
   Circles[5].MyPen.Thickness := 2.0;
   Circles[6].MyPen.Thickness := 2.0;
   Circles[7].MyPen.Thickness := 2.0;

   Circles[1].R := 600;
   Circles[2].R := 550;
   Circles[3].R := 500;
   Circles[4].R := 450;
   Circles[5].R := 400;
   Circles[6].R := 350;

   For i := 1 to 7 do
      NDrawCircles(TargetIMG, Trunc(Circles[i].XC), Trunc(Circles[i].YC), Circles[i].R, Circles[i].MyPen);

   TargetIMG.Repaint;

End;

问题根源 #

• BeginScene/EndScene管理混乱：NDrawCircles中每次调用都独立处理BeginScene和EndScene，循环调用7次时，第一次开启BeginScene后，后续调用不会再开启，但每次都会执行EndScene，导致第一次EndScene就结束了绘制上下文，后续绘制无效，最终内容未正确保留。
• 未持久化绘制内容：空TImage未绑定Bitmap，Canvas绘制的内容是临时的，窗体重绘时会被清除，因为Firemonkey默认不会自动保存临时Canvas的绘制结果。
• Repaint调用错误：DrawBaseModel末尾的TargetIMG.Repaint会触发控件重绘，此时临时绘制已结束，反而导致TImage清空显示空白。

修复方案 #

1. 为TImage绑定Bitmap并统一管理绘制上下文 #

确保绘制内容持久化到Bitmap中，且由外部统一控制BeginScene和EndScene：

Procedure TConfiguraDignita.DrawBaseModel;
Type
   TCircleso = Record
        XC,YC : Single;
        R : Integer;
       MyPen : MyPenType;
   end;
Var i : Integer;
    Circles : Array[1..7] of TCircleso;
Begin
   // 初始化Bitmap，确保尺寸与TImage一致
   if TargetIMG.Bitmap = nil then
      TargetIMG.Bitmap := TBitmap.Create;
   TargetIMG.Bitmap.SetSize(TargetIMG.Width, TargetIMG.Height);

   // 初始化Circles的原有代码保留
   for i := 1 to 7 do
   begin
      Circles[i].XC := TargetIMG.Width / 2;
      Circles[i].YC := TargetIMG.Height / 2;
      Circles[i].MyPen.Kind := TBrushKind.Solid;
      Circles[i].MyPen.Color := claBisque;
      Circles[i].MyPen.Dash := 1;
      Circles[i].MyPen.Opacita := 1.0;
   end;
   Circles[1].MyPen.Thickness := 4.0;
   Circles[2].MyPen.Thickness := 4.0;
   Circles[3].MyPen.Thickness := 4.0;
   Circles[4].MyPen.Thickness := 2.0;
   Circles[5].MyPen.Thickness := 2.0;
   Circles[6].MyPen.Thickness := 2.0;
   Circles[7].MyPen.Thickness := 2.0;

   Circles[1].R := 600;
   Circles[2].R := 550;
   Circles[3].R := 500;
   Circles[4].R := 450;
   Circles[5].R := 400;
   Circles[6].R := 350;

   // 统一开启和结束绘制上下文
   TargetIMG.Bitmap.Canvas.BeginScene;
   try
      For i := 1 to 7 do
         NDrawCircles(TargetIMG, Trunc(Circles[i].XC), Trunc(Circles[i].YC), Circles[i].R, Circles[i].MyPen);
   finally
      TargetIMG.Bitmap.Canvas.EndScene;
   end;

   // 无需调用Repaint，Bitmap更新后会自动触发重绘
End;

2. 修改NDrawCircles方法，直接操作Bitmap的Canvas #

去掉方法内的BeginScene/EndScene逻辑，避免嵌套错误：

Procedure NDrawCircles(var IMGTarget: TImage; xc, yc, Radius: Integer; MyPen: MyPenType);
var
   MyRect: TRectF;
   x1, y1, x2, y2 : Extended;
Begin
   with IMGTarget.Bitmap.Canvas do
   begin
      Stroke.Kind := TBrushKind.Solid;
      Stroke.Color := MyPen.Color;
      Stroke.Thickness := MyPen.Thickness;
      Stroke.Dash := MyPen.Dash;

      x1 := xc - Radius;
      y1 := yc - Radius;
      x2 := xc + Radius;
      y2 := yc + Radius;
      MyRect := TRectF.Create(x1, y1, x2, y2);
      DrawEllipse(MyRect, MyPen.Opacita);
   end;
end;

3. 调整绘制时机 #

建议在FormCreate或TargetIMG.OnResize事件中调用DrawBaseModel，确保TImage尺寸已确定。若必须在FormShow调用，需等待窗体完成布局后执行（比如加个短延迟或在FormActivate中调用）。

内容的提问来源于stack exchange，提问作者Sergio Bonfiglio