本文整理自网络，侵删。
剪切bmp：效果为指定的rect大小，若图片比rect小，则会放大。
都要uses Vcl.Imaging.jpeg;
需要注意的是FMX里也需要jpeg的支持，虽然没引用编译器不会报错，但用到jpg时会报内存错误。
procedure TForm1.Button1Click(Sender: TObject);
var
Bitmap: TBitmap;
MyRect1, MyOther: TRect;
begin
if self.OpenDialog1.Execute then
begin
MyRect1 := Rect(100, 100, 500, 500);
MyOther := Rect(100, 100, 500, 500);
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile(self.OpenDialog1.FileName); // bmp图片 也可以把jpg图片转换成bmp图片
self.Canvas.CopyRect(MyOther, Bitmap.Canvas, MyRect1); // 显示在窗体上 这个在VCL上可以，在FMX里没有这个属性
Bitmap.Free;
end;
end;
缩小jpg图片，效果： 图片为rect大小，若图片大于rect，则会按比例缩小成rect大小。
procedure TForm1.Button2Click(Sender: TObject);
var
bitCut: TBitmap;
bitEdit: TBitmap;
picOriginal: TPicture;
begin
picOriginal := TPicture.Create;
if self.OpenDialog1.Execute then
begin
picOriginal.LoadFromFile(OpenDialog1.FileName); //fileName为jpg文件路径
bitCut := TBitmap.Create;
bitCut.Width := 200;
bitCut.Height := 200;
bitCut.Canvas.StretchDraw(Rect(0, 0, bitCut.Width, bitCut.Height), picOriginal.Graphic);
bitEdit := TBitmap.Create;
bitEdit.Width := picOriginal.Width;
// FMX里没有这个属性，要么把引用的FMX.Graphics换成VCL的
bitCut.Canvas.CopyRect(Rect(0, 0, bitCut.Width, bitCut.Height), bitEdit.Canvas, Rect(0, 0, 200, 20));
bitcut.SaveToFile('d:/dd.jpg');
Image1.Picture.Bitmap.Assign(bitCut);
// 该释放的对象要释放
bitEdit.Free;
bitCut.Free;
picOriginal.Free;
end;
end;
裁剪图片上一部分的rect：
procedure TForm1.Button3Click(Sender: TObject);
var
bmp: TBitmap;
jpg: TJpegImage;
MyRect, MyOther: TRect;
img: TImage;
begin
jpg := TJpegImage.Create;
bmp := TBitmap.Create;
if OpenDialog1.Execute then
begin
jpg.LoadFromFile(OpenDialog1.FileName);
bmp.Assign(jpg); // 把jpg的图片资源放在bmp内
MyRect := Rect(0, 0, 200, 200);
MyOther:= Rect(0, 0, 200, 200);
SetStretchBltMode(bmp.Canvas.Handle, COLORONCOLOR); // 这个函数 uses Winapi.Windows;
Self.Canvas.CopyRect(MyOther, bmp.Canvas, MyRect); // 将一个图片复制到另一个rect上
end;
FreeAndNil(bmp);
FreeAndNil(jpg);
end;
这些这VCL里都可以实现，在FMX里就需要变引用文件，但是用起来也不是那么方便，
在FMX里这样用，delphi自带的FMX.Graphics中有处理图片的函数，具体查看帮助手册：
这里贴出画图片的功能：
procedure TForm2.Button1Click(Sender: TObject);
var
MyBitmap: TBitmap;
MyRect: TRectF;
begin
if OpenDialog1.Execute then
MyBitmap := TBitmap.CreateFromFile(OpenDialog1.Files[0]);
MyRect := TRectF.Create(10,12,301,203);
Image1.Bitmap.Canvas.BeginScene;
Image1.Bitmap.Canvas.DrawBitmap(MyBitmap, MyRect, MyRect, 20); // 这个DrawBitmap Image中必须有图片，为空画不上去。。。可能是我方法不对
Image1.Bitmap.Canvas.EndScene;
end;
从本地一张图片中复制一个rect再保存到本地：
function CopyImgRect(f0, f1: String; x, y, w, h: Integer): Boolean;
// f0磁盘图片路径名，f1保存的文件名，x,y,w,h表示给定的矩形框范围值
var
b0,b1: TBitmap;
begin
result:=True;
b0:=TBitmap.Create;
b1:=TBitmap.Create;
b0.LoadFromFile(f0);
b1.Width:=w;
b1.Height:=h;
b1.CopyFromBitmap(b0,rect(x,y,w,h),0,0); // 从bitmap中复制bitmap
b1.SaveToFile(f1); // 保存到本地
b0.Free;
b1.Free;
end;
相关阅读 >>
Delphi xe intraweb 程序在iis下的发布详细教程
更多相关阅读请进入《Delphi》频道 >>
