ограничить перемещения квадрата

← →
mobila (2006-03-24 19:40) [0]

Подскажите пожалуйста как можно ограничить перемещения квадрата (для выделения части изображения) т.е. чтобы квадрат при перемещении мышкой не уходил за граници формы, а врезался в них. Заранее благодарен.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
Capturing : bool;
Captured : bool;
StartPlace : TPoint;
EndPlace : TPoint;
leftX, topY, RectWidth, RectHeight: integer;

public
{ Public declarations }
end;

var
Form1: TForm1;
x0, y0: integer;
{Captured : boolean; }
R, R0: TRect;

implementation

{$R *.dfm}

//рисуем четырёх угольник
function MakeRect(Pt1: TPoint; Pt2: TPoint): TRect;
begin
if pt1.x < pt2.x then
begin
Result.Left := pt1.x;
Result.Right := pt2.x;
end
else
begin
Result.Left := pt2.x;
Result.Right := pt1.x;
end;
if pt1.y < pt2.y then
begin
Result.Top := pt1.y;
Result.Bottom := pt2.y;
end
else
begin
Result.Top := pt2.y;
Result.Bottom := pt1.y;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); //левая кнопка нажата
begin
if button<>mbLeft then Captured:=false
else begin
Captured := true;
x0 := x;
y0 := y;

end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); //находится в движении
begin
if Captured then
begin
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
EndPlace.x := EndPlace.x + x - x0;
EndPlace.y := EndPlace.y + y - y0;

StartPlace.x := StartPlace.x + x - x0;
StartPlace.y := StartPlace.y + y - y0;

x0 := x;
y0 := y;
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); //левая кнопка отпущина
begin

Captured := false;
Capturing := false;
x0 := x;
y0 := y;
end;

//задаём размеры четырёх угольнику
procedure TForm1.Button1Click(Sender: TObject);
begin
DrawFocusRect(Form1.Canvas.Handle, MakeRect(StartPlace, EndPlace));
StartPlace.x := 0;
StartPlace.y := 176;
EndPlace.x := 132;
EndPlace.y := 0;
DrawFocusRect(Form1.Canvas.Handle, MakeRect(StartPlace, EndPlace));
end;

end.

← →
rem2 (2006-03-26 17:29) [1]

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); //ëåâàÿ êíîïêà íàæàòà
var
r:TRect;
begin
if button<>mbLeft then exit;
r:= Rect(
ClientOrigin.x - (StartPlace.x - x),
ClientOrigin.y - (EndPlace.y - y),
ClientOrigin.x + ClientWidth - (EndPlace.x - x) + 1,
ClientOrigin.y + ClientHeight - (StartPlace.y - y) + 1);
ClipCursor(@r);
Captured := true;
x0 := x;
y0 := y;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
ClipCursor(nil);

← →
mobila (2006-03-26 19:03) [2]

Большое спасибо

ограничить перемещения квадрата Найти похожие ветки