Delphi常见图象格式转换技术(二)

　2006-02-04 13:32:58　来源：WEB开发网　　　

核心提示：Delphi常见图象格式转换技术(二)作者:lyboy99 e-mail:lyboy99@sina.com url: http://hnh.126.com给大家提供几个常用的图象格式转换方法和其转换函数希望可以对你有帮助1.TxT 转换为 GIF2.WMF格式转换为BMP格式3.BMP格式转换为WMF格式4.TBitm

Delphi常见图象格式转换技术(二)
作者:lyboy99
e-mail:lyboy99@sina.com　
url: http://hnh.126.com

给大家提供几个常用的图象格式转换方法和其转换函数
希望可以对你有帮助

1.TxT 转换为 GIF
2.WMF格式转换为BMP格式
3.BMP格式转换为WMF格式
4.TBitmaps to Windows 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 Bitmap's 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 Windows 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: Windows 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 wasn't 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;