高分200：裁剪图片的问题？
我想实在如下功能：
打开一个JPG图片，点击裁图按钮的时候，会在图片上显示一个 宽：200 高：300 的虚拟线框，可以随意移动位置，双击后把虚拟线框选中的图片取出重新生成一个JPG文件。
我没有做过图，所以请高手们写得详细些，附原码者定有高分相赠，THS！！！
[解决办法]
这是在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
截图部分可以参考上面的网址内容
[解决办法]
只有移动虚框的代码,没有裁剪的
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.
[解决办法]
存为Unit.pas
unit 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.