Fórum Copiar um pedaço da Imagem #351502

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  pInicio.X := X;
  pInicio.Y := Y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  pFim.X := X;
  pFim.Y := Y;
end;

for I := pInicio.X to pFim.X do 
  for J := pInicio.Y to pFim.Y do 
    Image2.Canvas.Pixels[I, J] := Image1.Canvas.Pixels[I, J];

unit upoints;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus, jpeg, Clipbrd, Grids;

type
  TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
  Tfpoints = class(TForm)
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    BitBtn2: TBitBtn;
    StatusBar1: TStatusBar;
    RectangleButton: TSpeedButton;
    image: TImage;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RectangleButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
  points : array [1..4] of integer;
  Origin, MovePt: TPoint;
  Drawing: Boolean;
  DrawingTool: TDrawingTool;
  procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
    { Public declarations }
  end;

var
  fpoints: Tfpoints;

implementation

uses uprincipal;

{$R *.dfm}

procedure Tfpoints.FormCreate(Sender: TObject);
begin
image.picture.loadfromfile(extractfilepath(application.exename)+´image\image.bmp´);
stringgrid1.cells[0,0] := ´Vaga´;
stringgrid1.cells[1,0] := ´Inicial X´;
stringgrid1.cells[2,0] := ´Inicial Y´;
stringgrid1.cells[3,0] := ´Final X´;
stringgrid1.cells[4,0] := ´Final Y´;
drawingtool := dtrectangle;
end;

procedure Tfpoints.BitBtn2Click(Sender: TObject);
begin
close;
end;

procedure Tfpoints.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True;
  Image.Canvas.MoveTo(X, Y);
  Origin := Point(X, Y);
  points[1] := x;
  points[2] := y;
  MovePt := Origin;
  StatusBar1.Panels[0].Text := Format(´Origin: (¬d, ¬d)´, [X, Y]);
end;

procedure Tfpoints.imageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, MovePt, pmNotXor);
    MovePt := Point(X, Y);
    DrawShape(Origin, MovePt, pmNotXor);
  end;
  StatusBar1.Panels[1].Text := Format(´Current: (¬d, ¬d)´, [X, Y]);
end;

procedure Tfpoints.imageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then
  begin
    points[3] := x;
    points[4] := y;
    Drawing := False;
  end;
  stringgrid1.cells[0,(stringgrid1.rowcount-1)] := uppercase(inputbox(´Vagas´,´Nome da Vaga:´,´´));
  stringgrid1.cells[1,(stringgrid1.rowcount-1)] := inttostr(points[1]);
  stringgrid1.cells[2,(stringgrid1.rowcount-1)] := inttostr(points[2]);
  stringgrid1.cells[3,(stringgrid1.rowcount-1)] := inttostr(points[3]);
  stringgrid1.cells[4,(stringgrid1.rowcount-1)] := inttostr(points[4]);
  stringgrid1.rowcount := (stringgrid1.rowcount + 1);
end;

procedure Tfpoints.DrawShape(TopLeft, BottomRight: TPoint;
  AMode: TPenMode);
begin
  with Image.Canvas do
  begin
    Pen.Mode := AMode;
    case DrawingTool of
      dtLine:
        begin
          Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
          Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
        end;
      dtRectangle: Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y);
      dtEllipse: Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y);
      dtRoundRect: Image.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
        (TopLeft.Y - BottomRight.Y) div 2);
    end;
  end;
end;

procedure Tfpoints.RectangleButtonClick(Sender: TObject);
begin
DrawingTool := dtRectangle;
end;

end.