如何保留一个确定的形状区域不被切割?

How preserve a determined area of form to not be cut?

使用下面的代码可以使用鼠标绘制矩形。每个矩形存储在一个不能超过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;

您需要做的就是将第三个区域以能够产生您需要的结果的模式合并到您的合并区域。函数的 documentation.

中解释了可能的模式

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

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)。

设置window区域后,两个使用过的矩形从矩形列表中出队。因为有两个,所以现在是空的。