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;

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