Как сохранить определенную область формы, чтобы не вырезать? - PullRequest
Новая
       42

Как сохранить определенную область формы, чтобы не вырезать?

1 голос
/ 11 октября 2019

С кодом ниже можно рисовать прямоугольники с помощью мыши. Каждый прямоугольник хранится в TQueue (списке), который не может превышать 2 элемента (это значение можно настроить). Моя цель с этими двумя нарисованными областями состоит в том, что первая может быть вырезана, а вторая - нет, где конечный результат выглядит следующим образом:

enter image description here

Какмогу ли я достичь этого? Процедура резки должна выполняться после того, как обе области нарисованы. Все, что я делал до сих пор, было обратной процедурой (я думаю). Следуйте коду: 

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;

1 Ответ

3 голосов
/ 11 октября 2019

Все, что вам нужно сделать, - это объединить третий регион с вашим объединенным регионом в режиме, который даст желаемый результат. Возможные режимы описаны в документации функции .

. Ниже приведен пример измененной версии обработчика событий 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).

После того, как задана область окна, из списка прямоугольников исключаются два используемых прямоугольника. Так как их было два, теперь пусто.

...