unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, SUIImagePanel, jpeg;
type
RMRect=record
A:TRect;
B:TRect;
C:TRect;
D:TRect;
AB:TRect;
AC:TRect;
BD:TRect;
CD:TRect;
X,Y,W,H:Integer;
end;
TForm1 = class(TForm)
btn4: TButton;
Main3: TImage;
Main1: TImage;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btn4Click(Sender: TObject);
procedure Main1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Main1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Main1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
MLeftDown,MUp:boolean;
MPoint:TPoint;
MyRect: TRect;
procedure CanvasRec(x, y, w, h: Integer;CCanvas:Tcanvas);
{ Private declarations }
public
Cmr:RMRect;
Cbmp:TBitmap;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
Cursor:=crSizeAll;
MLeftDown:=true;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MLeftDown:=false;
Cursor:=crDefault;
end;
procedure TForm1.CanvasRec(x:integer;y:Integer;w:Integer;h:Integer;CCanvas:Tcanvas);
var
R: TRect;
begin
with CCanvas do
begin
Pen.Color := clRed;
Brush.Color := clRed;
R := Rect(x,y, x+w,y+h);
Cmr.X:=x;
Cmr.Y:=y;
Cmr.W:=x+ w;
Cmr.H:=y+h;
FrameRect(R);
Rectangle(x-3,y-3, X+1,Y+1);
Cmr.A:=Rect(x-3,y-3, X+1,Y+1);
Rectangle(x-3,y+h-1, x+1,y+h+3);
Cmr.C:=Rect(x-3,y+h-1, x+1,y+h+3);
Rectangle(x+w-1,y-3, x+w+3,Y+1);
Cmr.B:=Rect(x+w-1,y-3, x+w+3,Y+1);
Rectangle(x+w-1,y+h-1, x+w+3,y+h+3);
Cmr.D:=Rect(x+w-1,y+h-1, x+w+3,y+h+3);
Rectangle(x-3,y+(h div 2)-2, x+1,y+(h div 2)+2);
Cmr.AC:=Rect(x-3,y+(h div 2)-2, x+1,y+(h div 2)+2);
Rectangle(x+w-1,y+(h div 2)-1, x+w+3,y+(h div 2)+3);
Cmr.BD:=Rect(x+w-1,y+(h div 2)-1, x+w+3,y+(h div 2)+3);
Rectangle(x+(w div 2)-2,y-3, x+(w div 2)+2,Y+1);
Cmr.AB:=Rect(x+(w div 2)-2,y-3, x+(w div 2)+2,Y+1);
Rectangle(x+(w div 2)-2,y+h-1, x+(w div 2)+2,y+h+3);
Cmr.CD:=Rect(x+(w div 2)-2,y+h-1, x+(w div 2)+2,y+h+3);
end;
end;
procedure TForm1.btn4Click(Sender: TObject);
begin
Main3.Top:=Main1.Top;
Main3.Left:=Main1.Left;
Main3.Width:=Main1.Width;
Main3.Height:=Main1.Height;
Cbmp:=TBitmap.Create;
Cbmp.Width:=Main1.Width;
Cbmp.Height:=Main1.Height;
Cbmp.Transparent:=true;
CanvasRec(10,20,200,150, Cbmp.Canvas);
Main3.Picture.Graphic:=Cbmp;
Cbmp.Free;
end;
procedure TForm1.Main1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MLeftDown:=true;
MPoint:=Point(x,y);
if (PtInRect(Cmr.A,Point(x,Y))) or (PtInRect(Cmr.AB,Point(x,Y))) or (PtInRect(Cmr.B,Point(x,Y)))
or (PtInRect(Cmr.AC,Point(x,Y))) then
MUp:=true
else
MUp:=false
end;
procedure TForm1.Main1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Spoint:TPoint;
cx,cy:integer;
begin
if MLeftDown then
begin
if Main1.Cursor=crSizeAll then
MyRect := Rect(x-MPoint.x+Cmr.X,Y-(MPoint.Y-Cmr.Y),x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y));
if Main1.Cursor=crSizeNWSE then
if MUp then
MyRect := Rect(x-MPoint.x+Cmr.X,Y-(MPoint.Y-Cmr.Y),Cmr.w,Cmr.h)
else
MyRect := Rect(Cmr.X,Cmr.Y,x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y)) ;
if Main1.Cursor=crSizeNESW then
if MUp then
MyRect := Rect(Cmr.X,Y-(MPoint.Y-Cmr.Y),x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Cmr.h)
else
MyRect := Rect(x-MPoint.x+Cmr.X,Cmr.Y,Cmr.w,Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y)) ;
if Main1.Cursor=crSizeNS then
if MUp then
MyRect := Rect(Cmr.X,Y-(MPoint.Y-Cmr.Y),Cmr.w,Cmr.h)
else
MyRect := Rect(Cmr.X,Cmr.Y,Cmr.w,Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y)) ;
if Main1.Cursor=crSizeWE then
if MUp then
MyRect := Rect(x-MPoint.x+Cmr.X,Cmr.Y,Cmr.W,Cmr.h)
else
MyRect := Rect(Cmr.X,Cmr.Y,x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Cmr.h) ;
if MyRect.Left<0 then MyRect.Left:=3;
if MyRect.Top<0 then MyRect.Top:=3;
if MyRect.Right>Main1.Width then MyRect.Right:=Main1.Width-3;
if MyRect.Bottom>Main1.Height then MyRect.Bottom:=Main1.Height-3;
if MyRect.Right-MyRect.Left<15 then
if MyRect.Left-3=0 then
MyRect.Right:=MyRect.Left+15
else
if Mup or (Main1.Cursor=crSizeAll) then
if Main1.Cursor=crSizeNESW then
MyRect.Right:=MyRect.Left+15
else
MyRect.Left:=MyRect.Right-15
else
if Main1.Cursor=crSizeNESW then
MyRect.Left:=MyRect.Right-15
else
MyRect.Right:=MyRect.Left+15;
if MyRect.Bottom-MyRect.Top<15 then
if MyRect.Top-3=0 then
MyRect.Bottom:=MyRect.Top+15
else
if Mup or (Main1.Cursor=crSizeAll) then
MyRect.Top:=MyRect.Bottom-15
else
MyRect.Bottom:=MyRect.Top+15;
Main1.canvas.FillRect(Rect(0, 0, Main1.Width, Main1.Height));
DrawFocusRect(Main1.Canvas.Handle, MyRect);
end
else
begin
Main1.Cursor:=crDefault;
if PtInRect(Rect(Cmr.X,Cmr.Y,Cmr.W,Cmr.H),Point(x,Y)) then
Main1.Cursor:=crSizeAll;
if (PtInRect(Cmr.A,Point(x,Y))) or (PtInRect(Cmr.D,Point(x,Y))) then
Main1.Cursor:=crSizeNWSE;
if (PtInRect(Cmr.B,Point(x,Y))) or (PtInRect(Cmr.C,Point(x,Y))) then
Main1.Cursor:=crSizeNESW;
if (PtInRect(Cmr.AC,Point(x,Y))) or (PtInRect(Cmr.BD,Point(x,Y))) then
Main1.Cursor:=crSizeWE;
if (PtInRect(Cmr.AB,Point(x,Y))) or (PtInRect(Cmr.CD,Point(x,Y))) then
Main1.Cursor:=crSizeNS;
end;
end;
procedure TForm1.Main1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edit1.Text:=IntToStr(MyRect.Left);
edit2.Text:=IntToStr(MyRect.Top);
edit3.Text:=IntToStr(MyRect.Right-MyRect.Left);
edit4.Text:=IntToStr(MyRect.Bottom-MyRect.Top);
MLeftDown:=False;
Main1.canvas.FillRect(Rect(0, 0, Main1.Width, Main1.Height));
Cbmp:=TBitmap.Create;
Cbmp.Width:=Main1.Width;
Cbmp.Height:=Main1.Height;
Cbmp.Transparent:=true;
CanvasRec(MyRect.Left,MyRect.Top,MyRect.Right-MyRect.Left,MyRect.Bottom-MyRect.Top, Cbmp.Canvas);
Main3.Picture.Graphic:=Cbmp;
Cbmp.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=true;
end;
end.