高分200：裁剪图片的问题？

这是在form上画框框的代码，你把canvas改为图像的，然后把FillRect区域保存为图像就行了unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    FDraging:Boolean;
    SPoint:TPoint;
    EPoint:TPoint;
    FillRect: TRect;
  public
    { Public declarations }  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDraging := True;
  SPoint.X := X;
  SPoint.Y := Y;
end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDraging := False;end;procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDraging = False then Exit;
  EPoint.X := X;
  EPoint.Y := Y;
  Canvas.Pen.Style := psDot;
  Canvas.Pen.Color := clRed;
  FillRect.Left := SPoint.X;
  FillRect.Top := SPoint.Y;
  FillRect.Right := EPoint.X;
  FillRect.Bottom := EPoint.Y;
  Canvas.Rectangle(FillRect);
end;end.

http://blog.csdn.net/zwk_9/archive/2008/07/18/2669027.aspx
截图部分可以参考上面的网址内容

这是用鼠标拉框的方法
楼主要求的是框固定，可移动的，是吧？
可以考虑把选择框弄成一个固定模块，记录该框的左上角坐标
框的移动重绘可参考楼上的代码，移动大小就是fillrect的长跟宽

只有移动虚框的代码,没有裁剪的
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Image1: TImage;
    btnCut: TButton;    procedure btnCutClick(Sender: TObject);
  private
    IsMouseDown: BOolean;
    oldMPos, oldSPos: TPoint;
    FShape: TShape ;
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsMouseDown := true;
  GetCursorPos(oldmpos);
  oldSPos.X := FShape.Left ;
  oldSPos.Y := FShape.top ;
end;procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  newMPos: TPoint ;
begin
  if IsMouseDown then
  begin
    GetCursorPos(newMPos);
    FShape.Left := newMPos.X - oldMPos.X + oldSPos.X ;
    FShape.Top := newMPos.Y - oldMPos.Y + oldSPos.Y ;
  end;
end;procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsMouseDown := False;
end;procedure TForm1.btnCutClick(Sender: TObject);
begin
  if FShape = nil then
  begin
    FShape := TShape.Create(Self);
    FShape.Width := 200;
    FShape.Height := 300;
    FShape.Brush.Style := bsClear ;
    FShape.Pen.Style := psDot;
    FShape.Pen.Color := clLime;
    FShape.OnMouseDown := Shape1MouseDown;
    FShape.OnMouseMove := Shape1MouseMove;
    FShape.OnMouseUp := Shape1MouseUp;
    FShape.Left := Image1.Left ;
    FShape.Top := Image1.Top ;
    FShape.Parent := Form1;
    FShape.Show ;
  end;
end;end.

贴一个完整代码供参考：可选择图像，并进行移动，双击选择框，保存图像d:\111.jpg(自己修改)。
请注意正确设置Image1和MaskBox事件。unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;type
  TForm1 = class(TForm)
    Image1: TImage;
    MaskBox: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure MaskBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MaskBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MaskBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MaskBoxDblClick(Sender: TObject);
    procedure MaskBoxPaint(Sender: TObject);
  private
    { Private declarations }
    FIsDown: Boolean;
    FDrawIng: Boolean;
    FSelected: Boolean;
    FOrignPoint: TPoint;
    FNextPoint: TPoint;
    FCutRect: TRect;
    procedure DrawCutRect(ReDraw: Boolean = False);
    procedure SetSelected(const Value: Boolean);
  public
    { Public declarations }
    property Selected: Boolean read FSelected write SetSelected;
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.SetSelected(const Value: Boolean);
var
  tmp: Integer;
begin
  if FSelected <> Value then
  begin
    if FDrawing then DrawCutRect;
    FSelected := Value;
    if not Value then Exit;
    if FOrignPoint.X > FNextPoint.X then
    begin
      tmp := FOrignPoint.X;
      FOrignPoint.X := FNextPoint.X;
      FNextPoint.X := tmp;
    end;
    if FOrignPoint.Y > FNextPoint.Y then
    begin
      tmp := FOrignPoint.Y;
      FOrignPoint.Y := FNextPoint.Y;
      FNextPoint.Y := tmp;
    end;
    FCutRect.TopLeft := FOrignPoint;
    FCutRect.BottomRight := FNextPoint;
    DrawCutRect;
  end;
end;procedure TForm1.DrawCutRect(ReDraw: Boolean);
begin
  MaskBox.Canvas.Pen.Mode := pmNotXor;
  MaskBox.Canvas.Brush.Style := bsClear;
  if Selected then
  begin
    MaskBox.Canvas.Pen.Style := psSolid;
    MaskBox.Canvas.Pen.Color := clRed;
    MaskBox.Canvas.Pen.Width := 2;
    MaskBox.Canvas.Rectangle(FCutRect)
  end
  else
  begin
    MaskBox.Canvas.Pen.Style := psDot;
    MaskBox.Canvas.Pen.Color := clBlack;
    MaskBox.Canvas.Pen.Width := 1;
    MaskBox.Canvas.Rectangle(FOrignPoint.X, FOrignPoint.Y, FNextPoint.X, FNextPoint.Y);
  end;
  if not ReDraw then
    FDrawIng := not FDrawIng;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  MaskBox.SetBounds(Image1.Left, Image1.Top, Image1.Width, Image1.Height);
end;procedure TForm1.MaskBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssRight in Shift) and Selected then  // 右键取消选择
    Selected := False;
  if not (ssLeft in Shift) then Exit;
  FOrignPoint.X := X;
  FOrignPoint.Y := Y;
  FIsDown := not Selected or PtinRect(FCutRect, FOrignPoint);
end;procedure TForm1.MaskBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not FIsDown then Exit;
    if FDrawing then
      DrawCutRect;
  if not Selected then
  begin
    if X < 0 then
      X := 0
    else if X > MaskBox.Width then
      X := MaskBox.Width;
    if Y < 0 then
      Y := 0
    else if Y > MaskBox.Height then
      Y := MaskBox.Height;
    FNextPoint.X := X;
    FNextPoint.Y := Y;
  end
  else
  begin
    OffsetRect(FCutRect, X - FOrignPoint.X, Y - FOrignPoint.Y);
    FOrignPoint.X := X;
    FOrignPoint.Y := Y;
    X := 0;
    Y := 0;
    if FCutRect.Left < 0 then
      X := -FCutRect.Left
    else if FCutRect.Right > MaskBox.Width then
      X := MaskBox.Width - FCutRect.Right;
    if FCutRect.Top < 0 then
      Y := -FCutRect.Top
    else if FCutRect.Bottom > MaskBox.Height then
      Y :=  MaskBox.Height - FCutRect.Bottom;
    if (X <> 0) or (Y <> 0) then
      OffsetRect(FCutRect, X, Y);
  end;
  DrawCutRect;
end;procedure TForm1.MaskBoxMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not FIsDown then Exit;
  FNextPoint.X := X;
  FNextPoint.Y := Y;
  FIsDown := False;
  if not Selected then
    Selected := True;
end;procedure TForm1.MaskBoxDblClick(Sender: TObject);
var
  bmp, tmp: TBitmap;
  jpg: TJPEGImage;
  dstRect, srcRect: TRect;
  ScaleX, ScaleY: Single;
begin
  if Selected and PtinRect(FCutRect, FNextPoint) then
  begin
    bmp := TBitmap.Create;
    bmp.Assign(Image1.Picture.Graphic);
    // 如果Image显示的与实际Bitmap不一致，请使用下面代码，同时删除srcRect := FCutRect;
  {
    // 因为Image显示的与实际Bitmap不见得一致，所以必须对选择矩形进行缩放
    ScaleX := tmp.Width / Image1.Width;
    ScaleY := tmp.Height / Image1.Height;
    srcRect := Rect(Trunc(ScaleX * FCutRect.Left),
                    Trunc(ScaleY * FCutRect.Top),
                    Round(ScaleX * FCutRect.Right),
                    Round(ScaleY * FCutRect.Bottom));
  }
    srcRect := FCutRect;
    dstRect := srcRect;
    OffsetRect(dstRect, -dstRect.Left, -dstRect.Top);
    tmp := TBitmap.Create;
    tmp.PixelFormat := pf24Bit;
    tmp.Width := dstRect.Right;
    tmp.Height := dstRect.Bottom;
    tmp.Canvas.CopyRect(dstRect, bmp.Canvas, srcRect);
    jpg := TJPEGImage.Create;
    jpg.Assign(tmp);
    jpg.CompressionQuality := 90;
    jpg.SaveToFile('d:\111.jpg');
    jpg.Free;
    tmp.Free;
    bmp.Free;
  end;
end;procedure TForm1.MaskBoxPaint(Sender: TObject);
begin
  if Selected then
   DrawCutRect(True);
end;end.

如果使用注释掉的语句，里面的tmp.Width和tmp.Height应改为bmp.Width和bmp.Height

呵呵，有可能，仓促之间写的。可能是DrawCutRect多（或者少）调用了一下

记得 mdejtod 有一个这样的DEMO

存为Unit.pasunit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;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;{
mdejtod
(CSDN 稻草人)
}
implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MyMessage;
  FDown := False;
  DoubleBuffered := True;
  Img1.Picture.LoadFromFile('1.bmp');
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.
存为Unit1.dfmobject Form1: TForm1
  Left = 286
  Top = 114
  Width = 514
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Img1: TImage
    Left = 0
    Top = 0
    Width = 506
    Height = 373
    Align = alClient
  end
  object Img2: TImage
    Left = 0
    Top = 373
    Width = 506
    Height = 73
    Align = alBottom
  end
  object Shp1: TShape
    Left = 248
    Top = 192
    Width = 169
    Height = 73
    Brush.Style = bsClear
    Pen.Style = psDot
    OnMouseDown = Shp1MouseDown
    OnMouseMove = Shp1MouseMove
    OnMouseUp = Shp1MouseUp
  end
end

tak kwan的代码如果可以加载ｊｐｇ图片就好了。

致： (阿发伯) 你的代码我测试了下，我发现双击后生成的图片和框框选择的有差异啊，而且很大，为什么？
还有，我不想画框，我想在图片上一点左键就出现一个 width:300,height:200的框框，或者是在画框的时候同时显示框框的大小状态。

1、我的代码已经说明了，如果显示的图像与原图像大小不一致，可用被注释的那句代码。
2、既然你只要一点左键就出现一个 width:300,height:200的框框，就直接在MouseDown事件中画一个框不就完事了。那么上面各位，包括我自己写的代码对你也就没有太大的作用了，你就当我没回帖。

我也在学习， hjkto最近升级速度很快啊！强!

致：阿发伯我得先谢谢你，呵呵！~我把你的注释去掉了好像也不行，保存好的JPG要比框选的图片部分下移

这段代码也很简单，没什么可学的，就是把一个PaintBox当作Image1的遮罩层，避免直接处理Image1（会破坏原图像，速度也较慢）而已。而且这段代码也写的不是很好。
不过，可供借鉴的是“思维”，即处理同样的事情，不要太受传统局限，可以采用多种方法处理，即使你的方法不见得比别人的好多少，但经常这样作，可逐渐养成比较开阔的“思路”（编代码有时和学数学差不多，数学成绩好的同学，往往也只是比别人多几条思路罢了）。

怪事了，我又做了几次测试，没有你说的情况啊。
你用注视里面的代码后，把srcRect := FCutRect;语句去掉了吗？

致：(阿发伯) 谢谢你提供的代码，你的代码没有问题，可以运行，呵呵！！
现在我还有个要补充的，就是我想在画框的时候，同时显示框的状态（WIDTH，HEIGHT），因为这样才能知道裁剪下来的图片有多大。加到阿发伯发的代码里面，或者阿发伯帮忙加一下，先谢谢了！！！我以前是做DELPHI的，现在转JAVA了，图型处理这块我也接触不多，所以麻烦大家了。分不够，我再加啊

[报价=引用33楼风机盘管的回复：]
致：（阿发伯）谢谢你提供的代码，你的代码没有问题，可以运行，呵呵！
现在我还有个要补充的，就是我想在画框的时候，同时显示框的状态（宽，高），因为这样才能知道裁剪下来的图片有多大。加到阿发伯发的代码里面，或者阿发伯帮忙加一下，先谢谢了！我以前是做德尔福的，现在转JAVA的的了，图型处理这块我也接触不多，所以麻烦大家了。分不够，我再加啊
[/报价]画框时实时显示框的状态吗？
在鼠标移动操作里添加就行了，当然要判断下是鼠标按下状态的移动

谢谢你帮忙发出来哈只可惜很多同学觉得仍是不能用，真是不明白为什么就是调不出来呢？我发的代码都是经常测试才敢贴上来的。至于存为JPG，定义一个 Tjpegobject 再将bmp转换一下就可以了

unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;type
  TForm1 = class(TForm)
    Image1: TImage;
    MaskBox: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure MaskBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MaskBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MaskBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MaskBoxDblClick(Sender: TObject);
    procedure MaskBoxPaint(Sender: TObject);
  private
    { Private declarations }
    FIsDown: Boolean;
    FDrawIng: Boolean;
    FSelected: Boolean;
    FOrignPoint: TPoint;
    FNextPoint: TPoint;
    FCutRect: TRect;
    procedure DrawCutRect(ReDraw: Boolean = False);
    procedure SetSelected(const Value: Boolean);
  public
    { Public declarations }
    property Selected: Boolean read FSelected write SetSelected;
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.SetSelected(const Value: Boolean);
var
  tmp: Integer;
begin
  if FSelected <> Value then
  begin
    if FDrawing then DrawCutRect;
    FSelected := Value;
    if not Value then Exit;
    if FOrignPoint.X > FNextPoint.X then
    begin
      tmp := FOrignPoint.X;
      FOrignPoint.X := FNextPoint.X;
      FNextPoint.X := tmp;
    end;
    if FOrignPoint.Y > FNextPoint.Y then
    begin
      tmp := FOrignPoint.Y;
      FOrignPoint.Y := FNextPoint.Y;
      FNextPoint.Y := tmp;
    end;
    FCutRect.TopLeft := FOrignPoint;
    FCutRect.BottomRight := FNextPoint;
    DrawCutRect;
  end;
end;procedure TForm1.DrawCutRect(ReDraw: Boolean);
begin
  MaskBox.Canvas.Pen.Mode := pmNotXor;
  MaskBox.Canvas.Brush.Style := bsClear;
  if Selected then
  begin
    MaskBox.Canvas.Pen.Style := psSolid;
    MaskBox.Canvas.Pen.Color := clRed;
    MaskBox.Canvas.Pen.Width := 2;
    MaskBox.Canvas.Rectangle(FCutRect)
  end
  else
  begin
    MaskBox.Canvas.Pen.Style := psDot;
    MaskBox.Canvas.Pen.Color := clBlack;
    MaskBox.Canvas.Pen.Width := 1;
    MaskBox.Canvas.Rectangle(FOrignPoint.X, FOrignPoint.Y, FNextPoint.X, FNextPoint.Y);
  end;
  if not ReDraw then
    FDrawIng := not FDrawIng;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  MaskBox.SetBounds(Image1.Left, Image1.Top, Image1.Width, Image1.Height);
end;procedure TForm1.MaskBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssRight in Shift) and Selected then  // 右键取消选择
    Selected := False;
  if not (ssLeft in Shift) then Exit;
  FOrignPoint.X := X;
  FOrignPoint.Y := Y;
  FIsDown := not Selected or PtinRect(FCutRect, FOrignPoint);
end;procedure TForm1.MaskBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not FIsDown then Exit;
    if FDrawing then
      DrawCutRect;
  if not Selected then
  begin
    if X < 0 then
      X := 0
    else if X > MaskBox.Width then
      X := MaskBox.Width;
    if Y < 0 then
      Y := 0
    else if Y > MaskBox.Height then
      Y := MaskBox.Height;
    FNextPoint.X := X;
    FNextPoint.Y := Y;
  end
  else
  begin
    OffsetRect(FCutRect, X - FOrignPoint.X, Y - FOrignPoint.Y);
    FOrignPoint.X := X;
    FOrignPoint.Y := Y;
    X := 0;
    Y := 0;
    if FCutRect.Left < 0 then
      X := -FCutRect.Left
    else if FCutRect.Right > MaskBox.Width then
      X := MaskBox.Width - FCutRect.Right;
    if FCutRect.Top < 0 then
      Y := -FCutRect.Top
    else if FCutRect.Bottom > MaskBox.Height then
      Y :=  MaskBox.Height - FCutRect.Bottom;
    if (X <> 0) or (Y <> 0) then
      OffsetRect(FCutRect, X, Y);
  end;
  DrawCutRect;
end;procedure TForm1.MaskBoxMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not FIsDown then Exit;
  FNextPoint.X := X;
  FNextPoint.Y := Y;
  FIsDown := False;
  if not Selected then
    Selected := True;
end;procedure TForm1.MaskBoxDblClick(Sender: TObject);
var
  bmp, tmp: TBitmap;
  jpg: TJPEGImage;
  dstRect, srcRect: TRect;
  ScaleX, ScaleY: Single;
begin
  if Selected and PtinRect(FCutRect, FNextPoint) then
  begin
    bmp := TBitmap.Create;
    bmp.Assign(Image1.Picture.Graphic);
    // 如果Image显示的与实际Bitmap不一致，请使用下面代码，同时删除srcRect := FCutRect;
  {
    // 因为Image显示的与实际Bitmap不见得一致，所以必须对选择矩形进行缩放
    ScaleX := tmp.Width / Image1.Width;
    ScaleY := tmp.Height / Image1.Height;
    srcRect := Rect(Trunc(ScaleX * FCutRect.Left),
                    Trunc(ScaleY * FCutRect.Top),
                    Round(ScaleX * FCutRect.Right),
                    Round(ScaleY * FCutRect.Bottom));
  }
    srcRect := FCutRect;
    dstRect := srcRect;
    OffsetRect(dstRect, -dstRect.Left, -dstRect.Top);
    tmp := TBitmap.Create;
    tmp.PixelFormat := pf24Bit;
    tmp.Width := dstRect.Right;
    tmp.Height := dstRect.Bottom;
    tmp.Canvas.CopyRect(dstRect, bmp.Canvas, srcRect);
    jpg := TJPEGImage.Create;
    jpg.Assign(tmp);
    jpg.CompressionQuality := 90;
    jpg.SaveToFile('d:\111.jpg');
    jpg.Free;
    tmp.Free;
    bmp.Free;
  end;
end;procedure TForm1.MaskBoxPaint(Sender: TObject);
begin
  if Selected then
   DrawCutRect(True);
end;end.
---------------------------
上面是（阿波发）的代码，我用了，没有问题，就是我不想画框读取，我想鼠标只要一点就有一个200，300的框框可以移动位置就截图片，哪个高手帮我解决一下，谢谢了！！PS：贴子也有些日子了，如果解决后我马上结贴！！！

代码好多不看了
大概思路就是
1、用 Canvas.CopyRect 截图
2、保存到TMemoryStream中
3、再savetofile，
应该就可以了

如果不想自己画框,就直接在图片上放一个 Raize 控件中的 RzBorder 框
设置一下框的大小
拷贝的时候取框的位置及大小就可以了

imho888:
如果不想自己画框,就直接在图片上放一个 Raize 控件中的 RzBorder 框
设置一下框的大小
拷贝的时候取框的位置及大小就可以了
-----------
小弟不才，没有弄明白您的意思，你是说把RZBORDER的高和宽附给要画的框是吗？这样没必要啊，我的高度和宽度都是固定的这我知道，我现在就是不怎么让鼠标一点就直接出来一个框，（阿伯发）的代码我已经用了，如果有的朋友告诉我我该怎么做，希望可以在（阿伯发）的代码里说明或发出代码，感激不尽啊，希望（阿伯发）大哥快出来，

TO:73 Floor : winnukec++代码得不得？
----------c++代码不算！呵呵

调试易

高分200：裁剪图片的问题？

解决方案 »