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

核心提示：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;

----------------------------------------------------------------------------------