如何实现类似IDE的透明框多选TRzPanel中的TAdvShape图标？

以下是针对TRzPanel面板内TAdvShape图标实现透明拖选框的可行步骤，完全基于Delphi原生API和控件特性实现：

一、核心变量定义 #

在窗体类中声明用于跟踪选框状态和选中图标的变量：

private
  FSelecting: Boolean;          // 是否处于拖选状态
  FStartPoint, FCurrentPoint: TPoint; // 选框起点和当前鼠标点
  FSelectedShapes: TList<TAdvShape>;  // 存储选中的图标列表
  function GetSelectionRect: TRect;   // 计算选框的实际矩形
  procedure UpdateSelectedShapes;     // 更新选中的图标集合

二、实现选框矩形计算 #

编写GetSelectionRect函数，确保选框矩形始终正确，无论鼠标从哪个方向拖拽：

function TYourForm.GetSelectionRect: TRect;
begin
  Result.Left := Min(FStartPoint.X, FCurrentPoint.X);
  Result.Top := Min(FStartPoint.Y, FCurrentPoint.Y);
  Result.Right := Max(FStartPoint.X, FCurrentPoint.X);
  Result.Bottom := Max(FStartPoint.Y, FCurrentPoint.Y);
end;

三、绑定TRzPanel的鼠标事件 #

1. 鼠标按下事件（OnMouseDown） #

判断点击位置是否在图标上，决定是开始拖选还是选中单个图标：

procedure TYourForm.RzPanel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Shape: TAdvShape;
  HitShape: TAdvShape;
begin
  if Button <> mbLeft then Exit;

  HitShape := nil;
  // 检查点击位置是否命中某个TAdvShape
  for Shape in RzPanel1.Controls do
  begin
    if Shape is TAdvShape and PtInRect(Shape.BoundsRect, Point(X, Y)) then
    begin
      HitShape := TAdvShape(Shape);
      Break;
    end;
  end;

  if not Assigned(HitShape) then
  begin
    // 空白处点击，启动拖选框
    FSelecting := True;
    FStartPoint := Point(X, Y);
    FCurrentPoint := FStartPoint;
    // 未按住Shift时清空原有选中
    if ssShift not in Shift then
    begin
      for Shape in FSelectedShapes do Shape.FillColor := clBtnFace;
      FSelectedShapes.Clear;
    end;
  end
  else
  begin
    // 点击图标，处理单选/追加/切换选中状态
    if ssCtrl in Shift then
    begin
      if FSelectedShapes.Contains(HitShape) then
      begin
        HitShape.FillColor := clBtnFace;
        FSelectedShapes.Remove(HitShape);
      end
      else
      begin
        HitShape.FillColor := clSkyBlue;
        FSelectedShapes.Add(HitShape);
      end;
    end
    else if ssShift not in Shift then
    begin
      for Shape in FSelectedShapes do Shape.FillColor := clBtnFace;
      FSelectedShapes.Clear;
      HitShape.FillColor := clSkyBlue;
      FSelectedShapes.Add(HitShape);
    end;
  end;
end;

2. 鼠标移动事件（OnMouseMove） #

更新当前鼠标位置并触发面板重绘，实时刷新选框：

procedure TYourForm.RzPanel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FSelecting then
  begin
    FCurrentPoint := Point(X, Y);
    RzPanel1.Invalidate;
  end;
end;

3. 鼠标释放事件（OnMouseUp） #

结束拖选状态，更新选中图标集合并清除选框：

procedure TYourForm.RzPanel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft and FSelecting then
  begin
    FSelecting := False;
    UpdateSelectedShapes;
    RzPanel1.Invalidate;
  end;
end;

四、绘制透明选框（OnPaint事件） #

使用XOR模式绘制选框，实现无残影的透明效果：

procedure TYourForm.RzPanel1Paint(Sender: TObject);
var
  SelRect: TRect;
begin
  if not FSelecting then Exit;

  SelRect := GetSelectionRect;
  with RzPanel1.Canvas do
  begin
    Pen.Mode := pmXor;    // XOR模式实现透明叠加，重绘时自动清除残影
    Pen.Color := clBlack;
    Pen.Width := 1;
    Brush.Style := bsClear; // 选框内部透明
    Rectangle(SelRect.Left, SelRect.Top, SelRect.Right, SelRect.Bottom);
  end;
end;

五、更新选中图标集合 #

编写UpdateSelectedShapes函数，根据选框矩形筛选并更新选中的TAdvShape：

procedure TYourForm.UpdateSelectedShapes;
var
  Shape: TAdvShape;
  SelRect: TRect;
  IsInSelRect: Boolean;
begin
  SelRect := GetSelectionRect;
  // 过滤极小选框，避免误操作
  if (Abs(SelRect.Right - SelRect.Left) < 5) and (Abs(SelRect.Bottom - SelRect.Top) < 5) then
    Exit;

  for Shape in RzPanel1.Controls do
  begin
    if not (Shape is TAdvShape) then Continue;

    IsInSelRect := RectIntersectsRect(Shape.BoundsRect, SelRect);
    if IsInSelRect then
    begin
      if not FSelectedShapes.Contains(Shape) then
      begin
        Shape.FillColor := clSkyBlue;
        FSelectedShapes.Add(Shape);
      end;
    end
    else if ssShift not in Shift then
    begin
      // 未按住Shift时，取消不在选框内的选中状态
      if FSelectedShapes.Contains(Shape) then
      begin
        Shape.FillColor := clBtnFace;
        FSelectedShapes.Remove(Shape);
      end;
    end;
  end;
end;

六、初始化与清理 #

在窗体创建和销毁时管理选中列表：

procedure TYourForm.FormCreate(Sender: TObject);
begin
  FSelectedShapes := TList<TAdvShape>.Create;
end;

procedure TYourForm.FormDestroy(Sender: TObject);
begin
  FSelectedShapes.Free;
end;

七、补充说明 #

• 选中样式自定义：示例中用FillColor区分选中状态，你也可以修改BorderColor或BorderWidth来实现更明显的选中标识。
• 选框规则调整：如果需要图标完全包含在选框内才被选中，将RectIntersectsRect替换为自定义的包含判断逻辑，例如：

  IsInSelRect := (Shape.Left >= SelRect.Left) and (Shape.Top >= SelRect.Top) and
                 (Shape.Left + Shape.Width <= SelRect.Right) and (Shape.Top + Shape.Height <= SelRect.Bottom);
  

• 批量移动集成：将现有批量移动逻辑绑定到FSelectedShapes列表，遍历列表中的图标调整其Top和Left属性即可。

内容的提问来源于stack exchange，提问作者Seti Net