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

[FCU]

我想实在如下功能：
打开一个JPG图片，点击裁图按钮的时候，会在图片上显示一个 宽：200 高：300 的虚拟线框，可以随意移动位置，双击后把虚拟线框选中的图片取出重新生成一个JPG文件。
我没有做过图，所以请高手们写得详细些，附原码者定有高分相赠，THS！！！

[mantisblue]

have a study!

[tian1215225lu]

学习了

[lyhoo163]

up

[FCU]

回楼上的 （ESC）的 退兄：

谢谢你这么热心，你问我要给你多少分？ 全部给你是不可能的了，哈哈，因为如果不是大家一直在帮我UP我也不会这么坚定的去追求结果。
希望你能帮我实现一下，哪怕不要BMP，只要JPG也OK啊，肯定会多给你分（阿波发等等也要多给，名字我也就不一一说了），呵呵

[FCU]

TO:（ESC）退兄：

你的代码我试了一下，有问题啊， SHAPE拖动做得很好，只是有个问题，我点保存的时候报错：

错误位置在：
procedure TForm1.button1Click(Sender: TObject);
var
bmp:Tbitmap;
R:TRect;
begin
bmp:=Tbitmap.Create;
bmp.PixelFormat:=image1.Picture.Bitmap.PixelFormat; {//代码在这里执行出错 错误信息是：Invalid pixel format}

bmp.Width:=200;
bmp.Height:=300;
R:=Shape1.ClientRect;
OffsetRect(R,Shape1.Left,Shape1.Top);
bmp.Canvas.CopyRect(bmp.Canvas.ClipRect,image1.Picture.Bitmap.Canvas,R);
bmp.SaveToFile('D:\mwy.bmp');
bmp.Free;
end;

错误信息是：Invalid pixel format


这是咋搞的

[FCU]

To:(稻草人)

我不是高手，我也没有做过绘图，我不想学是因为我只是想实现一个功能而已，我有分，所以我出分让高手们帮我解决，如果大家一心想帮我，或想要分自然会帮我出主意，和解决办法。
你说我懒，可我是做JAVA的现在，我实在没有太多精力再去钻研DELPHI

向你道歉，下面的话我可能说得有些过：

如果你一看到这种贴子不明白情况就说楼主懒，那我可以说你是一个DELPHI高手，但你永远也就是一个代码高手了，不懂得解决办法，其实这样也是一种解决问题的很好途径啊！

[QQ5555044]

致： 阿发伯

从您的代码中可以看得出你功力不浅。有一个细节您未注意到：两个控件被程序员放的顺序问题。所以应该下：
procedure TForm1.FormCreate(Sender: TObject);
begin
MaskBox.SetBounds(Image1.Left, Image1.Top, Image1.Width, Image1.Height);
MaskBox.BringToFront;//添加此句，保证它在image上面，否则您的代码新手就试不出效果。
end;


致16楼的 hjkto的话“tak kwan的代码如果可以加载ｊｐｇ图片就好了。”

答：在原有代码基础上用gdi+实现，可以支持tif／png/jpg/bmp/ico等众多格式！


致所有人：

其实这个问题有一个极简单的方法，就是借用Shape，那么关键代码只用Canvas.CopyRect一行就可以搞定楼主的问题！


致 楼主：

大家的代码都不错，不过框是用鼠标画的，而不是固定的宽：200 高：300，因此对于图像处理方面比较弱的你，搞不定，对不对？我来帮你写一个新的吧：

在窗体上放一个image，一个button，一个Shape（在Additional面板上）。Unit1.pas代码如下



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Shape1: TShape;
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
mousep:TPoint;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.Picture.LoadFromFile('C:\A.bmp');//必须是bmp图片，如果是jpg或其它格式，需要另加代码，不过不知道你能给我多少分啊？
image1.AutoSize:=true;
image1.Left:=0;
image1.Top:=0;
shape1.Left:=10;
shape1.Top:=10;
shape1.Width:=200;
shape1.Height:=300;
shape1.Brush.Style:=bsClear;
shape1.BringToFront;
button1.Caption:='保存';
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
mousep:=Point(x,y);
end;

procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if GetKeyState(1)>=0 then exit;
(Sender as TShape).Left:=(Sender as TShape).Left+X-mousep.X;
(Sender as TShape).Top:=(Sender as TShape).Top+y-mousep.Y;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp:Tbitmap;
R:TRect;
begin
bmp:=Tbitmap.Create;
bmp.PixelFormat:=image1.Picture.Bitmap.PixelFormat;
bmp.Width:=200;
bmp.Height:=300;
R:=Shape1.ClientRect;
OffsetRect(R,Shape1.Left,Shape1.Top);
bmp.Canvas.CopyRect(bmp.Canvas.ClipRect,image1.Picture.Bitmap.Canvas,R);
bmp.SaveToFile('D:\mwy.bmp');
bmp.Free;
end;

end.



窗体代码如下：

object Form1: TForm1
Left = 192
Top = 114
Width = 814
Height = 585
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 Shape1: TShape
Left = 536
Top = 144
Width = 65
Height = 65
OnMouseDown = Shape1MouseDown
OnMouseMove = Shape1MouseMove
end
object Image1: TImage
Left = 144
Top = 72
Width = 321
Height = 257
end
object Button1: TButton
Left = 192
Top = 456
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end

[hjkto]

我这里并没有报错
不过，不能改变选择框的大小和提示宽和高？

[FCU]

如果想要改变宽和高你可以用阿波发的代码直接画，我现在要把他们两个的代码整合到一起。。。

[FCU]

TO: (◥◣ESC◢◤)

把你的代码写完整吧

[无条件为你]

楼主的贴子快一个月了，还不结贴啊，想必问题早解决了。
唉，又见到一个解决问题后消失的人。。。

[无条件为你]

你把bmp.PixelFormat:=image1.Picture.Bitmap.PixelFormat; 这句去掉。
或者改为：bmp.PixelFormat:=pf24bit;

代码在我这里测试不报错。

[流梓]

顶下~~~ 楼主只能这样！！ 如果打开的jpg图像太大，如你的image控件Stretch属性设为True了，问题有点马烦了！！！

继续研究吧。。

[hjkto]

[Quote=引用 160 楼 napsoft 的回复:]
顶下~~~ 楼主只能这样！！  如果打开的jpg图像太大，如你的image控件Stretch属性设为True了，问题有点马烦了！！！

继续研究吧。。
[/Quote]
esc的代码只能打开ｂｍｐ的图片，打开ｊｐｇ的代码，我怎么没看到贴出来呢？

[fa_ge]

进来学习下，收藏

[ffwin]

mark,最近delphi版好像比前两年火了?

[FCU]

谢谢

[枫间一叶]

UP!我是来观摩的..顺便向阿发伯学习图像方面的技术

[ZZQTM]

新手！好好学习下！顶个先！

[zhijializhangcao]

很不错
收藏下