var
AncX, AncY, CurX, CurY:
Integer
;
Select:
Boolean
=
False
;
SRect:TRect;
procedure
TForm1
.
Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
begin
if
not
Select
then
begin
AncX := X;
CurX := X;
AncY := Y;
CurY := Y;
SRect
.
Left:=X;
SRect
.
Top:=Y;
Select :=
True
;
end
;
end
;
procedure
TForm1
.
Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y:
Integer
);
begin
if
Select
then
begin
Image1
.
Canvas
.
Pen
.
Mode := pmNotXor;
Image1
.
Canvas
.
Pen
.
Style:= psDot;
Image1
.
Canvas
.
Pen
.
Width :=
1
;
Image1
.
Canvas
.
Brush
.
Style := bsClear;
Image1
.
Canvas
.
Rectangle(AncX, AncY, CurX, CurY);
CurX := X;
CurY := Y;
Image1
.
Canvas
.
Rectangle(AncX, AncY, CurX, CurY);
Image1
.
Canvas
.
Pen
.
Style:= psSolid;
end
;
end
;
procedure
TForm1
.
Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
begin
if
Select
then
if
(AncX <> CurX)
and
(AncY <> CurY)
then
begin
Select :=
False
;
Image1
.
Canvas
.
Pen
.
Mode := pmXor;
Image1
.
Canvas
.
Brush
.
Style := bsClear;
Image1
.
Canvas
.
Rectangle(AncX, AncY, CurX, CurY);
SRect
.
Right:=X;
SRect
.
Bottom:=Y;
Close;
end
;
end
;