Delphi TScrollBox鼠标拖拽画矩形：XOR模式临时预览框擦除实现

原逻辑失效的根本原因 #

你之前设置Canvas.Pen.Mode := pmXor没达到预期，问题出在绘图逻辑和渲染管线完全脱节。
XOR擦除能生效的前提非常简单：在同一个像素位置，用同样的参数连续执行两次XOR绘制，像素值会完全还原到第一次绘制前的状态。但你现在已经用内存位图做栅格背景的双缓冲绘制了，之前在鼠标事件里直接往控件Canvas上画的预览线，根本不在你的内存渲染流程里——只要窗口触发任意一次意外重绘（比如被别的窗口挡住后恢复、拖动滚动条），你画的预览线就会和重绘后的栅格背景像素错位，这时候再用XOR重画一次，根本没法把像素还原回去，自然就擦不干净、留残影。

正确的实现思路 #

完全放弃在鼠标事件里直接操作画布画矩形的老写法，把所有绘制动作全部收归到Paint的统一重绘流程里，借助已经有的FCapturing状态标记控制预览矩形的显示/隐藏，从根源上绕开擦除问题：

• 简化鼠标事件逻辑：只负责更新坐标、修改状态标记，绝对不直接调用Canvas的绘图方法，状态变了就调用Invalidate触发窗口重绘即可。
• 调整Paint流程：把预览矩形的绘制也放到内存位图的绘制环节，等所有元素全部拼完，再一次性把内存位图贴到屏幕上，避免闪屏。

修改后的核心代码参考：
首先是三个鼠标事件：

procedure TXXX.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin 
  if (Button = mbLeft) and MyCondition then begin
    FStartPlace.X := X;
    FStartPlace.Y := Y;
    FEndPlace.X := X;
    FEndPlace.Y := Y;
    FCapturing := True;
    // 按下鼠标就触发一次重绘
    Invalidate;
  end;
end;

procedure TXXX.MouseMove(Shift: TShiftState; X, Y: Integer);
begin   
  if MyCondition and FCapturing then begin
    // 只更新矩形的终点坐标，不直接画图
    FEndPlace.X := X;
    FEndPlace.Y := Y;
    // 触发重绘，刷新预览矩形的位置
    Invalidate;
  end;
end;

procedure TXXX.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and FCapturing then begin
    FCapturing := False;
    // 取消捕获状态后触发重绘，预览矩形自动消失
    Invalidate;
  end;
end;

然后是调整后的Paint函数：

procedure TXXX.Paint();
var
  X, Y: Integer;
  Buffer: TBitmap;
begin
  Buffer := TBitmap.Create;
  try
    Buffer.Width := Width;
    Buffer.Height := Height;   
    // 在内存位图上画点状栅格背景
    X := 0;
    Y := Height;
    while X <= Buffer.Width do begin
      while Y >= 0 do begin
        Buffer.Canvas.Pixels[X, Y]:= clBlack;
        Y := Y - FStep;
      end;
      X := X + FStep;
      Y := Height;
    end;

    // 如果处于拖拽捕获状态，就在内存位图上画预览矩形
    if FCapturing then begin
      // 可以根据需要改成虚线轮廓，效果更贴合绘图工具的习惯
      Buffer.Canvas.Pen.Style := psDash;
      Buffer.Canvas.Rectangle(FStartPlace.X, FStartPlace.Y, FEndPlace.X, FEndPlace.Y);
    end;

    // 把拼好的完整内存位图一次性贴到屏幕上
    Canvas.Draw(0, 0, Buffer);
  finally
    Buffer.Free;
  end;
end;

注意事项和方案优势 #

• 这套逻辑完全不需要依赖XOR擦除：只要FCapturing是False，重绘的时候就根本不会画预览矩形，鼠标抬起后矩形自动消失的效果是天然实现的，不存在擦不干净、留残影的问题。
• 全程走双缓冲绘制，不管是拖拽的时候刷新预览位置，还是重绘栅格背景，都不会出现闪屏、画面撕裂的情况。
• 对TScrollBox场景的适配要注意：计算坐标的时候要叠加HorzScrollBar.Position和VertScrollBar.Position的滚动偏移量，不然滚动条拉动后，预览矩形的位置会和鼠标位置对不上。
• 后续要加圆形、多边形等其他形状的绘制能力，都可以直接在这个Paint流程里统一管理，扩展性很强。

内容的提问来源于stack exchange，提问作者Damien Lachaume