如何保留一个确定的形状区域不被切割?
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区域后,两个使用过的矩形从矩形列表中出队。因为有两个,所以现在是空的。
使用下面的代码可以使用鼠标绘制矩形。每个矩形存储在一个不能超过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区域后,两个使用过的矩形从矩形列表中出队。因为有两个,所以现在是空的。