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;
begin
Result := False;
if pos(UpperCase('.bmp'), UpperCase(filename)) <> 0 then //bmp格式
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;
Result := True;
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: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
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;
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.Animate := 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, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// JXSF_PIC_Format_Convert
// 图片格式转换
// [in] pic_stream 原图片的数据流
// [in] toPicForMat 要转换的图片格式
// 0 1 2 3 4 5
// Bmp, Png, Jpeg, Gif, Tiff WMPhoto
// [out] targ_stream
// 转换后的数据流
// 返回:
// 转换是否成功
// 0 = 失败
// 1 = 成功
function JXSF_PIC_Format_Convert (
const pic_stream :TMemoryStream;
const toPicForMat : INT32;
const targ_stream : TMemoryStream
) : INT32;
var wi:TWICImage;
var flag : INT32;
begin
if not ( toPicForMat in [0..5] ) then
begin
try
targ_stream.Clear;
except
end;
Result:=0;exit;
end;
wi:=TWICImage.Create;
try
pic_stream.Position:=0;
targ_stream.Clear;
// 下面是格式转换核心代码
wi.LoadFromStream(pic_stream);
wi.ImageFormat := TWICImageFormat( toPicForMat);
wi.SaveToStream( targ_stream);
targ_stream.Position:=0;
flag:=1;
except
flag:=0;
end;
wi.Free;
Result:=flag;
end;
procedure TForm1.Button1Click(Sender: TObject);
var sm1,sm2:TMemoryStream;
var wi:TWICImage;
begin
sm1:= TMemoryStream.Create;
sm2:= TMemoryStream.Create;
sm1.LoadFromFile( 'c:\tt\0002.jpg');
sm1.Position :=0;
JXSF_PIC_Format_Convert( sm1,0,sm2) ;
wi:=TWICImage.Create;
wi.LoadFromStream(sm2);
Image1.Picture.Assign( wi);
wi.Free;
sm1.Free;
sm2.Free;
end;
end.
• Delphi常见图象格式转换技术(二)
作者:lyboy99
e-mail:lyboy99@sina.com
url: http://hnh.126.com
给大家提供几个常用的图象格式转换方法和其转换函数
希望能对你有帮助
1.TxT 转换为 GIF
2.WMF格式转换为BMP格式
3.BMP格式转换为WMF格式
4.TBitmaps to 视窗系统 Regions
-----------------------------------------------------------------------
TxT 转换为 GIF
------------------------------------------------
procedure TxtToGif (txt, FileName: String);
var
temp: TBitmap;
GIF : TGIFImage;
begin
temp:=TBitmap.Create;
try
temp.Height :=400;
temp.Width :=60;
temp.Transparent:=True;
temp.Canvas.Brush.Color:=colFondo.ColorValue;
temp.Canvas.Font.Name:=Fuente.FontName;
temp.Canvas.Font.Color:=colFuente.ColorValue;
temp.Canvas.TextOut (10,10,txt);
Imagen.Picture.Assign(nil);
GIF := TGIFImage.Create;
try
GIF.Assign(Temp);
//保存 GIF
GIF.SaveToFile(FileName);
Imagen.Picture.Assign (GIF);
finally
GIF.Free;
end;
Finally
temp.Destroy;
End;
end;
---------------------------------------------------------------------
2.WMF格式转换为BMP格式
--------------------------------------------------------------------
procedure WmfToBmp(FicheroWmf,FicheroBmp:string);
var
MetaFile:TMetafile;
Bmp:TBitmap;
begin
Metafile:=TMetaFile.create;
{Create a Temporal Bitmap}
Bmp:=TBitmap.create;
{Load the Metafile}
MetaFile.LoadFromFile(FicheroWmf);
{Draw the metafile in Bitmaps canvas}
with Bmp do
begin
Height:=Metafile.Height;
Width:=Metafile.Width;
Canvas.Draw(0,0,MetaFile);
{Save the BMP}
SaveToFile(FicheroBmp);
{Free BMP}
Free;
end;
{Free Metafile}
MetaFile.Free;
end;
---------------------------------------------------------------------
3.BMP格式转换为WMF格式
---------------------------------------------------------------------
procedure BmpToWmf (BmpFile,WmfFile:string);
var
MetaFile : TMetaFile;
MFCanvas : TMetaFileCanvas;
BMP : TBitmap;
begin
{Create temps}
MetaFile := TMetaFile.Create;
BMP := TBitmap.create;
BMP.LoadFromFile(BmpFile);
{Igualemos tama?os}
{Equalizing sizes}
MetaFile.Height := BMP.Height;
MetaFile.Width := BMP.Width;
{Create a canvas for the Metafile}
MFCanvas:=TMetafileCanvas.Create(MetaFile, 0);
with MFCanvas do
begin
{Draw the BMP into canvas}
Draw(0, 0, BMP);
{Free the Canvas}
Free;
end;
{Free the BMP}
BMP.Free;
with MetaFile do
begin
{Save the Metafile}
SaveToFile(WmfFile);
{Free it...}
Free;
end;
end;
---------------------------------------------------------------------
4.TBitmaps to 视窗系统 Regions
---------------------------------------------------------------------
function BitmapToRegion(bmp: TBitmap; TransparentColor: TColor=clBlack;
RedTol: Byte=1; GreenTol: Byte=1; BlueTol: Byte=1): HRGN;
const
AllocUnit = 100;
type
PRectArray = ^TRectArray;
TRectArray = Array[0..(MaxInt div SizeOf(TRect))-1] of TRect;
var
pr: PRectArray;
h: HRGN;
RgnData: PRgnData;
lr, lg, lb, hr, hg, hb: Byte;
x,y, x0: Integer;
b: PByteArray;
ScanLinePtr: Pointer;
ScanLineInc: Integer;
maxRects: Cardinal;
begin
Result := 0;
{ Keep on hand lowest and highest values for the "transparent" pixels }
lr := GetRValue(TransparentColor);
lg := GetGValue(TransparentColor);
lb := GetBValue(TransparentColor);
hr := Min($ff, lr + RedTol);
hg := Min($ff, lg + GreenTol);
hb := Min($ff, lb + BlueTol);
bmp.PixelFormat := pf32bit;
maxRects := AllocUnit;
GetMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
try
with RgnData^.rdh do
begin
dwSize := SizeOf(RGNDATAHEADER);
iType := RDH_RECTANGLES;
nCount := 0;
nRgnSize := 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
end;
ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Integer(bmp.ScanLine[1]) - Integer(ScanLinePtr);
for y := 0 to bmp.Height - 1 do
begin
x := 0;
while x < bmp.Width do
begin
x0 := x;
while x < bmp.Width do
begin
b := @PByteArray(ScanLinePtr)[x*SizeOf(TRGBQuad)];
// BGR-RGB: 视窗系统 32bpp BMPs are made of BGRa quads (not RGBa)
if (b[2] >= lr) and (b[2] <= hr) and
(b[1] >= lg) and (b[1] <= hg) and
(b[0] >= lb) and (b[0] <= hb) then
Break; // pixel is transparent
Inc(x);
end;
{ test to see if we have a non-transparent area in the image }
if x > x0 then
begin
{ increase RgnData by AllocUnit rects if we exceeds maxRects }
if RgnData^.rdh.nCount >= maxRects then
begin
Inc(maxRects,AllocUnit);
ReallocMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
end;
{ Add the rect (x0, y)-(x, y+1) as a new visible area in the region }
pr := @RgnData^.Buffer; // Buffer is an array of rects
with RgnData^.rdh do
begin
SetRect(pr[nCount], x0, y, x, y+1);
{ adjust the bound rectangle of the region if we are "out-of-bounds" }
if x0 < rcBound.Left then rcBound.Left := x0;
if y < rcBound.Top then rcBound.Top := y;
if x > rcBound.Right then rcBound.Right := x;
if y+1 > rcBound.Bottom then rcBound.Bottom := y+1;
Inc(nCount);
end;
end; // if x > x0
if RgnData^.rdh.nCount = 2000 then
begin
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
if Result > 0 then
begin // Expand the current region
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
end
else // First region, assign it to Result
Result := h;
RgnData^.rdh.nCount := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
end;
Inc(x);
end; // scan every sample byte of the image
Inc(Integer(ScanLinePtr), ScanLineInc);
end;
{ need to call ExCreateRegion one more time because we could have left }
{ a RgnData with less than 2000 rects, so it wasnt yet created/combined }
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
if Result > 0 then
begin
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
end
else
Result := h;
finally
FreeMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
end;
----------------------------------------------------------------------------------
常见图象格式转换技术
作者:lyboy99
e-mail:lyboy99@sina.com
url: http://hnh.126.com/
给大家提供几个常用的图象格式转换方法和其转换函数
希望可以对你有帮助
1. ICO图标转换BMP格式
2. 32x32 BMP格式图象转换为 ICO格式
3.转换BMP->JPEG文件格式
4.JPEG 转换为BMP函数
5.Bmp转换为JPEG文件格式函数
-------------------------------------------------------------------------------------------------------------------------
1.Chinese : ICO图标转换BMP格式
English :(Conversion from ICO to BMP)
--------------------------------------------------------
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
===================================
2.Chinese: 32x32 BMP格式图象转换为 ICO格式
English :32x32 bit Bitmaps to ICO's
-----------------------------------
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms,Dialogs,ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;
oldBitmap : HBitmap;
iinfo : TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon.Handle, iinfo);
WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);
BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DeleteDC(destDC);
DeleteDC(srcDC);
DeleteDC(WinDC);
image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
image1.picture.icon.loadfromfile('c:\myicon.ico');
end;
end.
==================================================================
3. Chinese:转换BMP->JPEG文件格式
Englsh:convert the bitmap into a JPEG file format
------------------------------------------------------------------
var
MyJpeg: TJpegImage;
Image1: TImage;
begin
Image1:= TImage.Create;
MyJpeg:= TJpegImage.Create;
Image1.LoadFromFile('TestImage.BMP'); // 读取Bitmap文件
MyJpeg.Assign(Image1.Picture.Bitmap);
object
MyJpeg.SaveToFile('MyJPEGImage.JPG'); //保存JPEG
end;
--------------------------------------------------------------------
4.JPEG 转换为BMP函数
procedure Jpg2Bmp(const source,dest:string);
var
MyJpeg: TJpegImage;
bmp: Tbitmap;
begin
bmp:=tbitmap.Create;
MyJpeg:= TJpegImage.Create;
try
myjpeg.LoadFromFile(source);
bmp.Assign(myjpeg);
bmp.SaveToFile(dest);
finally
bmp.free;
myjpeg.Free;
end;
end;
----------------------------------------------------------
5.Bmp转换为JPEG文件格式函数
----------------------------------------------------------
procedure Bmp2Jpg(const source,dest:string;const scale:byte);
var
MyJpeg: TJpegImage;
Image1: TImage;
begin
Image1:= TImage.Create(application);
MyJpeg:= TJpegImage.Create;
try
Image1.Picture.Bitmap.LoadFromFile(source);
MyJpeg.Assign(Image1.Picture.Bitmap);
MyJpeg.CompressionQuality:=scale;
MyJpeg.Compress;
MyJpeg.SaveToFile(dest);
finally
image1.free;
myjpeg.Free;
end;
end;
-----------------------------------------------------------------------
delphi中我用了了第三方提供的BMP2GIF控件后，出现的问题， 12-14
我用了了第三方提供的BMP2GIF控件后，
代码如下
gif:=TGIFImage.Create;
mmm:=extractfilepath(Application.exename) 'temp\';
Screen.Cursor:=crhourglass;
form1.CoolBar2.Visible:=True;
form1.Gauge2.MaxValue:=Form1.ScrollBar2.Max;
for i:=1 to Form1.ScrollBar2.Max do
Begin
Form1.ScrollBar2.Position:=i;
form1.Gauge2.Progress:=i-10;
form1.POLARDraw1.Write(mmm inttostr(i-1) '.bmp',3);
End;
bitmap :=TBitmap.Create;
for i:=0 to form1.ScrollBar2.Max-1 do
Begin
try
bitmap.LoadFromFile(mmm inttostr(i) '.bmp');
Index :=Gif.Add(bitmap);
If Index=0 Then
Begin
LoopExt := TGIFAppExtNSLoop.Create(GIF.Images[Index]);
LoopExt.Loops := 0; // Forever
LoopExt.BufferSize:=32768;
GIF.Images[I].Extensions.Add(LoopExt);
End;
Ext := TGIFGraphicControlExtension.Create(GIF.Images[Index]);
If Flag =1 Then
Ext.Delay := 10
Else
If Flag=2 Then
Ext.Delay:=30
Else
Ext.Delay:=60;
GIF.Images[Index].Extensions.Add(Ext);
finally
LoopExt.Free;
LoopExt:=Nil;
Ext.Free;
Ext:=Nil;
End; //.//try ...finally;
End; //for scrollbar 2;
bitmap.FreeImage;
bitmap.Dormant;
bitmap.ReleaseHandle;
bitmap.Free;
bitmap:=Nil;
Gif.SaveToFile(FileName);
Finally
Gif.Free;
但是当BMP数量很多， GIF在ADD的时候内存一直增加，很快就内存益处了，高手们如何解决
1：强烈关注，我也碰到这样的问题，不知道该如何解决，不知道可不可以边写到硬盘，边增加图片，这样就不要老增加内存，直到死[:(]
2：建议使用Windows 的GDI Plus,支持BMP、GIF、PNG、WMF、WMF格式
我在转换BMP到GIF时，发现转换后的GIF图象严重缺色失真，各位知道怎样解决吗？
我把真彩位图图象在PS中转换为256的位图或索引格式时，在程序中转换就不会出现失真的现象。
我在转换BMP到GIF时，发现转换后的GIF图象严重缺色失真，各位知道怎样解决吗？各位，帮帮我。分不够就告诉我。先谢谢了。不知道下面的代码对你有没有用 jpg.Assign(bitmap). //file://将图象转成JPG格式 jpg.CompressionQuality:=10.//文件压缩大小设置 jpg.Compress. jpg.SaveToStream(result). //file://将JPG图象写入流中Gif用的是LZW算法。。。不知道用LZW算法来压缩BMP是否可生成GIF。。。 我用的控件不支持从JPG格式转换GIF啊我把真彩位图图象在PS中转换为256的位图或索引格式时，在程序中转换就不会出现失真的现象。。
调色板的问题，自己做色彩量化生成调色板，而不是用系统调色板。
误差扩散可修正颜色过渡效果
遇到过此问题，但对我工作不是特别的重要；所以没去钻研；
我先打开一个BMP图片用ASSIGNFILE转换一下后，保存为GIF图片就出现失真现象；
我使用 GIFImage 的，但是运行以下代码从 BMP 文件转换成 GIF 文件后，GIF 的图像变差，我已经搜索了很多资料也没有提及，请帮个忙。
procedure TForm1.Button1Click(Sender: TObject);
var
Bitmap: TBitmap;
GIFImage: TGIFImage;
begin
Bitmap := TBitmap.Create;
GIFImage := TGIFImage.Create;
Bitmap.LoadFromFile( '1.bmp ');
try
GIFImage.Assign(Bitmap);
GIFImage.Palette := WebPalette;
GIFImage.Compression := gcLZW;
GIFImage.SaveToFile( '1.gif ');
finally
end;
GIFImage.Free;
Bitmap.Free;
end;
GIFImage.ColorReduction := rmQuantize;
delphi GDI+ 获取GIF图片的每一帧 转为bmp图片 收藏
声明：代码修改自万一的blog
=================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
OpenDialog1: TOpenDialog;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses GDIPOBJ, GDIPAPI,GDIPUTIL;
var
img: TGPImage;
GifFrame, GifFrameCount: Word;
procedure TForm1.FormCreate(Sender: TObject);
begin
OpenDialog1.Filter := 'GIF 文件|*.gif';
img := TGPImage.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
img.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
DimensionsCount: Integer;
DimensionsIDs: PGUID;
i: Integer;
type
ArrDimensions = array of TGUID;
begin
if not OpenDialog1.Execute then Exit;
img.Free;
img := TGPImage.Create(OpenDialog1.FileName);
{获取 Gif 总帧数}
DimensionsCount := img.GetFrameDimensionsCount;
GetMem(DimensionsIDs, DimensionsCount * SizeOf(TGUID));
img.GetFrameDimensionsList(DimensionsIDs, DimensionsCount);
GifFrameCount := img.GetFrameCount(ArrDimensions(DimensionsIDs)[0]);
FreeMem(DimensionsIDs);
Text := Format('共有 %d 帧', [GifFrameCount]);
{显示帧列表}
ListBox1.Clear;
for i := 1 to GifFrameCount do
ListBox1.Items.Add(Format('第 %d 帧', [i]));
Repaint;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
g: TGPGraphics;
begin
g := TGPGraphics.Create(Canvas.Handle);
g.DrawImage(img, ListBox1.Width + 10, 10, img.GetWidth, img.GetHeight);
g.Free;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
i:integer;
ImgGUID: TGUID;
begin
//你可以在这里对Listbox1进行循环 获取每一帧的图片
for i:=0 to ListBox1.Items.Count-1 do
begin
//GifFrame := ListBox1.ItemIndex;
//img.SelectActiveFrame(FrameDimensionTime, GifFrame);
img.SelectActiveFrame(FrameDimensionTime, i);
GetEncoderClsid('image/bmp', ImgGUID);
img.Save('c:\test'+inttostr(i)+'.bmp',ImgGUID);
//Repaint;
end;
end;
end.
扫一扫
834
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
