eee

    技术2022-05-20  34

    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.

     


    最新回复(0)