图像格式转换

 uses
  Windows, Messages, SysUtils, Classes, Graphics, JPEG;

function BmpToJpeg(Sou:TFileName;Des:TFileName):Boolean;  //bmp转换成jpg
function BmpToEmf(Sou:TFileName;Des:TFileName):Boolean;  //bmp转换成emf
function BmpToWmf(Sou:TFileName;Des:TFileName):Boolean;  //bmp转换成wmf
function BmpToIcon(Sou:TFileName;Des:TileName):Boolean;  //bmp转换成icon
function JpegToBmp(Sou:TFileName;Des:TFileName):Boolean;  //jpg转换成bmp
function EmfToBmp(Sou:TFileName;Des:TFileName):Boolean;  //emf转换成bmp
function WmfToBmp(Sou:TFileName;Des:TFileName):Boolean;  //wmf转换成bmp
function IconToBmp(Sou:TFileName;Des:TFileName):Boolean;  //icon转换成bmp



implementation


{**********bmp转换成jpg***********}
function BmpToJpeg(Sou:TFileName;Des:TFileName):Boolean;  
var
 aBmp:TBitmap;
 aJpeg:TJPEGImage;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aJpeg:=TJPEGImage.Create;
 try
  try
   aBmp.LoadFromFile(Sou);
   aJpeg.Assign(aBmp);
   aJpeg.CompressionQuality:=100;
   aJpeg.Compress;
   aJpeg.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aJpeg);
 end;
end;

{**********jpg转换成bmp***********}
function JpegToBmp(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aJpeg:TJPEGImage;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aJpeg:=TJPEGImage.Create;
 try
  try
   aJpeg.LoadFromFile(Sou);
   aBmp.Assign(aJpeg);
   aBmp.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aJpeg);
 end;
end;

{********bmp转换成emf**********}
function BmpToEmf(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aEmf:TMetaFile;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aEmf:=TMetaFile.Create;
 try
  try
   aBmp.LoadFromFile(Sou);
   aEmf.Width:=aBmp.Width;
   aEmf.Height:=aBmp.Height;
   aEmf.Enhanced:=True;
   with TMetaFileCanvas.CreateWithComment(aEmf,0,'','') do
   begin
    try
     Draw(0,0,aBmp);
    finally
     Free;
    end;
   end;
   aEmf.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aEmf);
 end;
end;

{********bmp转换成wmf**********}
function BmpToWmf(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aWmf:TMetaFile;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aWmf:=TMetaFile.Create;
 try
  try
   aBmp.LoadFromFile(Sou);
   aWmf.Width:=aBmp.Width;
   aWmf.Height:=aBmp.Height;
   aWmf.Enhanced:=False;
   with TMetaFileCanvas.CreateWithComment(aWmf,0,'','') do
   begin
    try
     Draw(0,0,aBmp);
    finally
     Free;
    end;
   end;
   aWmf.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aWmf);
 end;
end;

{*********emf转换成bmp**********}
function EmfToBmp(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aEmf:TMetaFile;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aEmf:=TMetaFile.Create;
 try
  try
   aEmf.LoadFromFile(Sou);
   aBmp.Width:=aEmf.Width;
   aBmp.Height:=aEmf.Height;
   aBmp.Canvas.Draw(0,0,aEmf);
   aBmp.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aEmf);
 end;
end;

{*********wmf转换成bmp**********}
function WmfToBmp(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aWmf:TMetaFile;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aWmf:=TMetaFile.Create;
 try
  try
   aWmf.LoadFromFile(Sou);
   aBmp.Width:=aWmf.Width;
   aBmp.Height:=aWmf.Height;
   aBmp.Canvas.Draw(0,0,aWmf);
   aBmp.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aWmf);
 end;
end;

{*********icon转换成bmp*********}
function IconToBmp(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aIcon:TIcon;
begin
 Result:=False;
 aBmp:=TBitmap.Create;
 aIcon:=TIcon.Create;
 try
  try
   aIcon.LoadFromFile(Sou);
   aBmp.Width:=aIcon.Width;
   aBmp.Height:=aIcon.Height;
   aBmp.Canvas.Draw(0,0,aIcon);
   aBmp.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(aBmp);
  FreeAndNil(aIcon);
 end;
end;

{********bmp转换成icon********}
function BmpToIcon(Sou:TFileName;Des:TFileName):Boolean;
var
 aBmp:TBitmap;
 aIcon:TIcon;
 IconSizeX:integer;
 IconSizeY:integer;
 XOrMask:TBitmap;
 MonoMask:TBitmap;
 BlackMask:TBitmap;
 IconInfo:TIconInfo;
 R:TRect;
 transcolor:Tcolor;
begin
 Result:=False;
 XOrMask:=TBitmap.Create;
 MonoMask:=TBitmap.Create;
 BlackMask:=TBitmap.Create;
 aBmp:=TBitmap.Create;
 aIcon:=TIcon.Create;
 aBmp.LoadFromFile(Sou);

 try
  try
   {Get the icon size}
   IconSizeX:=GetSystemMetrics(SM_CXICON);
   IconSizeY:=GetSystemMetrics(SM_CYICON);
   R:=Rect(0,0,IconSizeX,IconSizeY);

   {Create the "XOr" mask}
   XOrMask.Width:=IconSizeX;
   XOrMask.Height:=IconSizeY;

   {stretchdraw mypaint}
   XorMask.canvas.draw(0,0,aBmp);
   transcolor:=XorMask.Canvas.Pixels[0,IconSizeY-1];

   {Create the Monochrome mask}
   MonoMask.Width:=IconSizeX;
   MonoMask.Height:=IconSizeY;
   MonoMask.Canvas.Brush.Color:=Clwhite;
   MonoMask.Canvas.FillRect(R);

   {Create the Black mask}
   BlackMask.Width:=IconSizeX;
   BlackMask.Height:=IconSizeY;

   {if black is not the transcolor we must replace black
   with a temporary color}
   if transcolor<>clblack then
   begin
    BlackMask.Canvas.Brush.Color := $F8F9FA;
    BlackMask.Canvas.FillRect(R);
    BlackMask.canvas.BrushCopy(R,XorMask,R,clblack);
    XorMask.Assign(BlackMask);
   end;

   {now make the black mask}
   BlackMask.Canvas.Brush.Color:=Clblack;
   BlackMask.Canvas.FillRect(R);

   {draw the XorMask with brushcopy}
   BlackMask.canvas.BrushCopy(R,XorMask,R,transcolor);
   XorMask.Assign(BlackMask);


   {Assign and draw the mono mask}
   XorMask.Transparent:=true;
   //XorMask.TransparentColor:=transcolor;
   XorMask.TransparentColor:=clblack;
   MonoMask.Canvas.draw(0,0,XorMask);
   MonoMask.canvas.copymode:=cmsrcinvert;
   MonoMask.canvas.CopyRect(R,XorMask.canvas,R);
   MonoMask.monochrome:=true;

   {restore the black color in the image}
   BlackMask.Canvas.Brush.Color:=Clblack;
   BlackMask.Canvas.FillRect(R);
   BlackMask.canvas.BrushCopy(R,XorMask,R,$F8F9FA);
   XorMask.Assign (BlackMask);

   {Create a icon}
   IconInfo.fIcon:=true;
   IconInfo.xHotspot:=0;
   IconInfo.yHotspot:=0;
   IconInfo.hbmMask:=MonoMask.Handle;
   IconInfo.hbmColor:=XOrMask.Handle;
   aIcon.Handle:=CreateIconIndirect(IconInfo);
   aIcon.SaveToFile(Des);
   Result:=True;
  except
   Result:=False;
  end;
 finally
  FreeAndNil(XOrMask);
  FreeAndNil(MonoMask);
  FreeAndNil(BlackMask);
  FreeAndNil(aBmp);
  FreeAndNil(aIcon);
 end;
end;

你可能感兴趣的:(图像格式转换)