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駉s}
{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
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
