0

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

在此处输入图像描述

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

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;
4

1 回答 1

2

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

下面的示例是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）。

设置窗口区域后，从矩形列表中取出两个使用的矩形。由于有两个，它现在是空的。

于 2019-10-11T00:11:20.580 回答