unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;
type
TForm1 =
class(TForm)
Image1: TImage;
Image2: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private-Deklarationen }
CopyFrame: TRect;
CopyMouseDown: Boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CopyFrame.Left := X;
CopyFrame.Top := Y;
CopyMouseDown := True;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if PtInRect(Image1.ClientRect, Point(X, Y))
then
begin
CopyFrame.Right := X;
CopyFrame.Bottom := Y;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32Bit;
Bmp.Width := CopyFrame.Right - CopyFrame.Left;
Bmp.Height := CopyFrame.Bottom - CopyFrame.Top;
Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), Image1.Picture.Bitmap.Canvas, CopyFrame);
Image2.Picture.Bitmap.Assign(Bmp);
finally
Bmp.Free;
end;
end;
end.