如何保持确定的形状区域不被切割？

Posted 2023-02-27

【中文标题】如何保持确定的形状区域不被切割？

【英文标题】：How preserve a determined area of form to not be cut?

【发布时间】：2020-02-08 10:33:05

【问题描述】：

通过下面的代码，可以使用鼠标绘制矩形。每个矩形存储在一个不能超过 2 个元素的 TQueue（列表）中（这个值可以自定义）。我绘制这两个区域的目标是第一个可以切割，第二个不能，最终结果如下所示：

我怎样才能做到这一点？切割过程必须在两个区域都被绘制之后进行。到目前为止，我所做的只是逆过程（我认为）。按照代码：

uses
  Generics.Collections;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
     Private declarations 
    FSelecting: Boolean;
    FSelection: TRect;
    Region, Region2: hrgn;
    pos1, pos2, pos3, pos4: Integer;
    FRectangles: TQueue<TRect>;
  public
     Public declarations 
  end;

var
  Form1: TForm1;

implementation

$R *.dfm

const
  MAXRECTANGLECOUNT = 2;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FRectangles := TQueue<TRect>.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FRectangles.Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSelection.Left := X;
  FSelection.Top := Y;
  FSelecting := true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if FSelecting then
  begin
    FSelection.Right := X;
    FSelection.Bottom := Y;
    Invalidate;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  FSelecting := false;
  FSelection.Right := X;
  FSelection.Bottom := Y;
  Invalidate;

  FSelection.NormalizeRect;

  if not FSelection.IsEmpty then
  begin

    pos1 := FSelection.Left;
    pos2 := FSelection.Top;
    pos3 := X;
    pos4 := Y;

    FRectangles.Enqueue(FSelection);
    if FRectangles.Count > MAXRECTANGLECOUNT then
      FRectangles.Dequeue;

    for I := 0 to FRectangles.Count - 1 do
    begin
      if I = 1 then
      begin
        Region := CreaterectRgn(0, 0, Width, Height);
        Region2 := CreaterectRgn(pos1, pos2, pos3, pos4);
        CombineRgn(Region, Region, Region2, RGN_DIFF);
        SetWindowRgn(Handle, Region, True);
      end;
    end;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;
  Canvas.Rectangle(FSelection);

  for R in FRectangles do
    Canvas.Rectangle(R);
end;

【问题讨论】：

您已经知道该怎么做（制作一个不包括所需剪切区域的HRGN），那么您遇到的实际问题是什么？另一种方法是将表单的 TransparentColorValue 属性设置为唯一颜色，然后在表单上绘制该颜色，无论您想要剪切它的任何位置。

【参考方案1】：

您需要做的就是将第三个区域与您的组合区域组合在一起，以产生您需要的结果。可能的模式在函数的documentation中进行了解释。

以下示例是OnMouseUp 事件处理程序的相应修改版本。它假定首先绘制较大的矩形。修改包括为绘制的矩形考虑标题和边框（因为鼠标向上处理程序提供客户端坐标，但SetWindowRegion 需要具有窗口坐标的区域）以及在不再需要区域时删除它们。

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Pt: TPoint;
  I: Integer;
begin
  FSelecting := false;
  FSelection.Right := X;
  FSelection.Bottom := Y;
  Invalidate;

  FSelection.NormalizeRect;
  if not FSelection.IsEmpty then
  begin
    FRectangles.Enqueue(FSelection);
    if FRectangles.Count = MAXRECTANGLECOUNT then
    begin
      Region := CreateRectRgn(0, 0, Width, Height);

      Region2 := CreateRectRgnIndirect(FRectangles.Dequeue);
      // offset region to account for caption and borders
      Pt := ClientOrigin;
      OffsetRgn(Region2, Pt.X - Left, Pt.Y - Top);

      CombineRgn(Region, Region, Region2, RGN_DIFF);
      DeleteObject(Region2);    


      Region2 := CreateRectRgnIndirect(FRectangles.Dequeue);
      // offset region to account for caption and borders
      OffsetRgn(Region2, Pt.X - Left, Pt.Y - Top);

      CombineRgn(Region, Region, Region2, RGN_OR);
      DeleteObject(Region2);

      SetWindowRgn(Handle, Region, True);
      DeleteObject(Region);
    end;
  end;
end;

.. 并摆脱未使用的整数变量 (pos1 .. pos4)。

设置窗口区域后，从矩形列表中取出两个使用的矩形。因为有两个，所以现在是空的。