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:=falseend;
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.