delphi处理图片(剪切，压缩)

原作者: [db:作者] 来自: [db:来源] 收藏邀请

剪切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;