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;