• 图形格式转换


    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;

     
  • 相关阅读:
    Java面试之对象拷贝
    Java面试之反射
    Java面试之多线程
    Java面试之容器
    Java面试之基础一
    Java面试之Hibernate
    Mysql进阶
    高并发,不怕不怕「限流算法第一把法器:计数器法」
    SpringBoot加载速度慢
    idea VM options参数优化
  • 原文地址:https://www.cnblogs.com/hnxxcxg/p/2941046.html
Copyright © 2020-2023  润新知