在Image1中画一个固定大小的矩形，矩形可随意拖动，矩形线条的粗细及颜色最好能由我自己来定义

Question

Image1中已显示了一幅bmp图像。我想在Image1中画一个固定大小的矩形，矩形可随意拖动，矩形线条的粗细及颜色最好能由我自己来定义。然后双击矩形区域内任何地方，自动将bmp图像的矩形区域截取下来显示到Image2中。
目的就是将一张数码相机或摄像头拍下来的照片的人像头部截取下来。
望各位不吝赐教啊。。

Answer 1

矩形可拖动可以用google搜索一下“delphi 矢量图 源码“，可以找到一些源码参考，
第二个可以用Canvas.CopyRect方法。

Answer 2

我记得在上次有一个贴中提到同样的问题，你为什么不搜一下呢？
我再贴一次代码！！！unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,pngimage,
  Dialogs, ExtCtrls;type
  TForm1 = class(TForm)
    shp1: TShape;
    img1: TImage;
    img2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure shp1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure shp1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    FDown : Boolean;
    FPoint : TPoint;
    FCopyRect : TRect;
  public
   procedure MyMessage(var Msg: TMsg; var Handled: Boolean); { Public declarations }
   procedure CopyBmpByRect(sDc,dDc : HDC);
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MyMessage;
  FDown := False;
  DoubleBuffered := True;
end;procedure TForm1.MyMessage(var Msg: TMsg; var Handled: Boolean);
  var FRect :TRect;
begin
  case Msg.message of
    WM_LBUTTONDBLCLK  :
    begin
      FRect := Rect(Left + shp1.Left,top  + shp1.Top,Left + shp1.Left + shp1.Width,top + shp1.Top + shp1.Height);
      if PtInRect(FRect,Msg.pt) then
        CopyBmpByRect(img1.Canvas.Handle,img2.Canvas.Handle);
    end;
  end;
end;procedure TForm1.shp1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button <> mbleft then exit;
  FDown := true;
  FPoint.x := X;
  FPoint.Y := Y;
end;procedure TForm1.shp1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button <> mbleft then Exit;
  FDown := False;
end;procedure TForm1.shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not FDown then Exit;
  TControl(Sender).Left := TControl(Sender).Left + X - FPoint.X;
  TControl(Sender).Top := TControl(Sender).Top + Y - FPoint.Y;
  FCopyRect := Rect(TControl(Sender).Left - img1.Left,TControl(Sender).Top - img1.Top,TControl(Sender).Width,TControl(Sender).Height);
end;procedure TForm1.CopyBmpByRect(sDc, dDc: HDC);
begin
  StretchBlt(dDc,0,0,FCopyRect.Right,FCopyRect.Bottom,sDc,FCopyRect.Left,FCopyRect.Top,FCopyRect.Right,
             FCopyRect.Bottom,SRCCOPY );
  img2.Repaint;
end;end.至于矩形的线条，你可以改一下，将tshape替换掉，在画布上画矩形很简单的，
随便也给你一个过程参考一下吧
procedure DrawFrameBorder(Canvas: TCanvas; const LienColor: TColor; const LienWidth: Integer; R: TRect);
var
  OldPenColor: TColor;
  OldPenWidth: Integer;
  nSpace: Integer;
begin
  OldPenColor := Canvas.Pen.Color;
  OldPenWidth := Canvas.Pen.Width;
  try
    Canvas.Pen.Color := LienColor;
    Canvas.Pen.Width := LienWidth;
    if LienWidth > 1 then
    begin
      nSpace := LienWidth div 2;
      with Canvas do
      begin
        MoveTo(R.Left, R.Top + nSpace);
        LineTo(R.Right, R.Top + nSpace);
        MoveTo(R.Right - nSpace, R.Top + nSpace);
        LineTo(R.Right - nSpace, R.Bottom);
        LineTo(R.Left, R.Bottom - nSpace);        MoveTo(R.Left + nSpace, R.Bottom);
        LineTo(R.Left + nSpace, R.Top);
      end;
    end
    else
    begin
      with Canvas do
      begin
        MoveTo(R.Left, R.Top);
        LineTo(R.Right, R.Top);
        MoveTo(R.Right - 1, R.Top);
        LineTo(R.Right - 1, R.Bottom);
        MoveTo(R.Right - 1, R.Bottom - 1);
        LineTo(R.Left, R.Bottom - 1);
        MoveTo(R.Left, R.Bottom - 1);
        LineTo(R.Left, R.Top);
      end;
    end;
  finally
    Canvas.Pen.Color := OldPenColor;
    Canvas.Pen.Width := OldPenWidth;
  end;
end;
这个过程，就不用解释了

Answer 3

我现在已经可以在image1上显示一个可以任意调整大小的shape矩形了。。透明的。。最后，能不能给一段 copy image1的矩形区域到image2的代码？

Answer 4

稻草人,你这个代码，在shap1上双击，image2上显示的是shap1，而不是shap1区域的image1啊。。