Delphi 压缩图片代码
添加引用:uses JPEG; //=====================图片处理函数,将覆盖原图片文件 =========================== //=====filename:图片完整路径 PressQuality:
压缩质量 Width:宽 Height: 高 function CompressMainFun(filename: String; PressQuality,Width,Height:integer): Boolean; var bmp: TBitmap; jpg: TJpegImage; i: Integer; sTemp:string string; string begin Result := False; //bmp if pos(UpperCase('.bmp'), UpperCase(filename)) <> 0 then 格式 begin bmp.LoadFromFile(filename); jpg.Assign(bmp); jpg.CompressionQuality := PressQuality; jpg.Compress; bmp.height := Height; bmp.Width := Width; bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg); jpg.Assign(bmp); sTemp := filename + '.jpg'; jpg.SaveToFile(sTemp); DeleteFile(filename); CopyFile(PChar(sTemp), PChar(filename), True); DeleteFile(sTemp); end //其它格 else 式 begin jpg.LoadFromFile(filename); bmp.height := Height; bmp.Width := Width; bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg); jpg.Assign(bmp); jpg.CompressionQuality := PressQuality; jpg.Compress;
sTemp := filename + '.jpg'; jpg.SaveToFile(sTemp); DeleteFile(filename); CopyFile(PChar(sTemp), PChar(filename), True); DeleteFile(sTemp); end; end Result := True; end; end
压缩图像文件并转换成 BMP 格式 function GraphicToBmp(P: TPicture; Quality: Integer = 80): TBitmap; var Jpg: TJpegImage; begin Result := TBitmap.Create; with Result do begin Width := P.Width; Height := P.Height; Canvas.Draw(0, 0, P.Graphic); end; if Assigned(Result) then begin Jpg := TJpegImage.Create; Jpg.Assign(Result); Jpg.CompressionQuality := Quality; Jpg.JPEGNeeded; Jpg.Compress; if Assigned(Jpg) then begin Jpg.DIBNeeded; Result.Assign(Jpg); end; end; end;
delphi 显示 jpg、png、gif 图片及 gif 动画
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: procedure Button2Click(Sender: procedure Button3Click(Sender: procedure Button4Click(Sender: end; var Form1: TForm1; implementation {$R *.dfm} uses jpeg, GIFImg, pngimage; {显示 jpg 图片} procedure TForm1.Button1Click(Sender: TObject); var jpg: TJPEGImage; begin jpg := TJPEGImage.Create; jpg.LoadFromFile('C:\Temp\Test.jpg'); Canvas.Draw(0, 0, jpg); jpg.Free; end; {显示 png 图片} procedure TForm1.Button2Click(Sender: TObject); var png: TPngImage; begin png := TPngImage.Create;
TObject); TObject); TObject); TObject);
png.LoadFromFile('C:\Temp\Test.png'); Canvas.Draw(0, 0, png); png.Free; end; {显示 gif 图片} procedure TForm1.Button3Click(Sender: TObject); var gif: TGIFImage; begin gif := TGIFImage.Create; gif.LoadFromFile('C:\Temp\Test.gif'); Canvas.Draw(0, 0, gif); gif.Free; end; {显示 gif 动画} procedure TForm1.Button4Click(Sender: TObject); var gif: TGIFImage; begin gif := TGIFImage.Create; gif.LoadFromFile('C:\Temp\Test.gif'); gif.A
nimate := True; with TImage.Create(Self) do begin Parent := Self; Left := 0; Top := 0; Picture.Assign(gif); end; gif.Free; end; end.
用 delphi2010 可以将图片的格式在
Bmp, Png,
Jpeg,
Gif,
Tiff
WMPhoto
等格式之间互相转换 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphic