delphi 处理图片(剪切,压缩)
剪切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;