Delphi7实现PaintBox弹跳圆盘动画 多盘交叉显示异常及纹理填充问题

故障根源 #

逐圆盘分散式擦除渲染逻辑是显示异常的核心原因：

• 当前代码每处理一个圆盘就立即执行「从纯背景拷贝擦除该圆盘旧位置→绘制圆盘新位置→局部刷新到画布」的流程
• 当两个圆盘的活动区域存在重叠时，后处理的圆盘在擦除自身旧位置时，会直接从纯色背景拷贝像素，覆盖掉上一个已经绘制完成的圆盘新图像，最终就出现生硬的背景矩形块

修复方案 #

重构单帧渲染流程，采用标准双缓冲全帧重绘逻辑，彻底替代分散的逐圆盘擦除操作：

1. 移除TSphere结构中不再需要的ROld、RNew字段
2. 重写Timer1Timer事件代码，严格按照单帧处理顺序执行：

   procedure TForm1.Timer1Timer(Sender: TObject);
   var
     i: integer;
   begin
     if fin then Exit;
     // 1. 先将整个离屏缓冲画布刷为纯背景，完全擦除上一帧所有残留内容
     BmpMoving.Canvas.CopyRect(
       Rect(0, 0, BmpBkg.Width, BmpBkg.Height),
       BmpBkg.Canvas,
       Rect(0, 0, BmpBkg.Width, BmpBkg.Height)
     );
   
     // 2. 统一更新所有圆盘的运动坐标、完成边界碰撞检测
     for i := 0 to High(Spheres) do
     begin
       with Spheres[i] do
       begin
         // 边界反弹逻辑
         if (x < -ImageWidth) or (x > BmpBkg.Width - W + ImageWidth) then
           vx := -vx;
         if (y < 0) or (y > BmpBkg.Height - H) then
           vy := -vy;
         // 坐标累加
         xx := xx + vx;
         yy := yy + vy;
         x := Trunc(xx);
         y := Trunc(yy);
       end;
     end;
   
     // 3. 按绘制顺序将所有圆盘绘制到已经干净的离屏缓冲上
     for i := 0 to High(Spheres) do
     begin
       BmpMoving.Canvas.Draw(Spheres[i].x, Spheres[i].y, Spheres[i].Bitm);
     end;
   
     // 4. 一次性将完整帧内容刷新到PaintBox画布
     PaintBox1.Canvas.CopyRect(
       Rect(0, 0, PaintBox1.Width, PaintBox1.Height),
       BmpMoving.Canvas,
       Rect(0, 0, BmpBkg.Width, BmpBkg.Height)
     );
   end;
   

3. 删除原逻辑中UnionRect、逐圆盘局部刷新到PaintBox的冗余代码

自定义纹理实现 #

当前代码已经为每个圆盘绑定独立的TBitmap对象，无需大幅改动即可加载自定义纹理：

• 直接将目标纹理图片加载到对应圆盘的Bitm实例中，替代原有内置的Sphere1.bmp、Sphere2.bmp
• 优化纹理融合效果：如果需要避免硬边透明效果，可在FormCreate初始化圆盘位图时，将透明模式从「指定纯色透明」改为32位Alpha通道模式：

  // 原有透明代码替换为Alpha模式
  Bitm.PixelFormat := pf32bit;
  Bitm.HandleType := bmDIB;
  

  该模式下圆盘叠加时的透明融合效果更自然，不会出现边缘锯齿

性能优化提示 #

• 保持DoubleBuffered := True的设置，避免窗口绘制闪烁
• 当圆盘数量提升到10个以上时，可将全帧拷贝改为仅拷贝前后两帧的合并无效区域，减少渲染开销
  内容的提问来源于stack exchange，提问作者sherlock