How to draw a selection rectangle between OnMouseDown and OnMouseUp? [closed] - delphi

Question

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 years ago.
Improve this question
I have code that lets the user select a rectangle on an image that will become a hole in the form. But before I create this hole from combined regions, I want to mark this rectangle area with a red color.
So in this picture, an area with the size of the small rectangle should be drawn red during dragging with the mouse:
My code till so far is:
private
{ Private declarations }
Point1, Point2: TPoint;
function ClientToWindow(const p: TPoint): TPoint;
procedure AdjustRegions;
function TForm1.ClientToWindow(const p: TPoint): TPoint;
begin
Result := ClientToScreen(p);
Result.X := Result.X - Left;
Result.Y := Result.Y - Top;
end;
procedure TForm1.AdjustRegions;
var
rForm, rWindow: hrgn;
headerHeight: Integer;
begin
if ((Point2.X - Point1.X) <= 0) or ((Point2.Y - Point1.Y) <= 0) then
SetWindowRgn(Self.Handle, 0, True)
else
begin
rForm := CreateRectRgn(0, 0, Width, Height);
rWindow := CreateRectRgn(
ClientToWindow(Point1).X,
ClientToWindow(Point1).Y,
ClientToWindow(Point2).X,
ClientToWindow(Point2).Y);
CombineRgn(rForm, rForm, rWindow, RGN_DIFF);
SetWindowRgn(Self.Handle, rForm, True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FillChar(Point1, SizeOf(Point1), 0);
FillChar(Point2, SizeOf(Point2), 0);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
AdjustRegions;
end;
procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Point1.X := X;
Point1.Y := Y;
end;
procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if X > Point1.X then
Point2.X := X
else
begin
Point2.X := Point1.X;
Point1.X := X;
end;
if Y > Point1.Y then
Point2.Y := Y
else
begin
Point2.Y := Point1.Y;
Point1.Y := Y;
end;
AdjustRegions;
end;
Any suggestions are welcome.

Answer 1

You can update the canvas in the OnMouseMove event.
This could look like:
unit Unit1;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.ExtCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
procedure FormResize(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox1Paint(Sender: TObject);
private
FSelecting: Boolean;
FSelection: TRect;
procedure AdjustFormRegion;
function ClientToWindow(const P: TPoint): TPoint;
end;
implementation
{$R *.dfm}
procedure TForm1.AdjustFormRegion;
var
FormRegion: HRGN;
HoleRegion: HRGN;
begin
FSelection.NormalizeRect;
if FSelection.IsEmpty then
SetWindowRgn(Handle, 0, True)
else
begin
FormRegion := CreateRectRgn(0, 0, Width, Height);
HoleRegion := CreateRectRgn(
ClientToWindow(FSelection.TopLeft).X,
ClientToWindow(FSelection.TopLeft).Y,
ClientToWindow(FSelection.BottomRight).X,
ClientToWindow(FSelection.BottomRight).Y);
CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
SetWindowRgn(Handle, FormRegion, True);
end;
end;
function TForm1.ClientToWindow(const P: TPoint): TPoint;
begin
Result := PaintBox1.ClientToScreen(P);
Dec(Result.X, Left);
Dec(Result.Y, Top);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
AdjustFormRegion;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FSelection.Left := X;
FSelection.Top := Y;
FSelecting := True;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FSelecting then
begin
FSelection.Right := X;
FSelection.Bottom := Y;
PaintBox1.Invalidate;
end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FSelecting := False;
FSelection.Right := X;
FSelection.Bottom := Y;
PaintBox1.Invalidate;
AdjustFormRegion;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Color := clRed;
PaintBox1.Canvas.Rectangle(FSelection);
end;
end.
Some general remarks:
You do not have to initialize a TPoint to zero, this will be done automatically. See the documentation:
Because a constructor always clears the storage it allocates for a new object, all fields start with a value of zero (ordinal types), nil (pointer and class types), empty (string types), or Unassigned (variants). Hence there is no need to initialize fields in a constructor's implementation except to nonzero or nonempty values.
Although an Image component can be used for custom drawing, it is designed for showing pictures. I suggest you change it into a PaintBox (or the Form itself).
Since you use Delphi XE5, make use of its TRect members like NormalizeRect, IsEmpty, etc...