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