eee

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.

 

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值