Graph format conversion

Uses
Windows, messages, sysutils, classes, graphics, JPEG;

Function BMP tojpeg (SOU: tfilename; des: tfilename): Boolean; // convert BMP to JPG
Function BMP toemf (SOU: tfilename; des: tfilename): Boolean; // convert BMP to EMF
Function BMP towmf (SOU: tfilename; des: tfilename): Boolean; // convert BMP to WMF
Function BMP toicon (SOU: tfilename; des: tilename): Boolean; // convert BMP to icon
Function compute tobmp (SOU: tfilename; des: tfilename): Boolean; // convert JPG to BMP
Function emftobmp (SOU: tfilename; des: tfilename): Boolean; // converts EMF to BMP.
Function wmftobmp (SOU: tfilename; des: tfilename): Boolean; // convert WMF to BMP
Function icontobmp (SOU: tfilename; des: tfilename): Boolean; // icon to convert to BMP

Implementation

{*********** convert BMP to JPG ************}
function BMP tojpeg (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
ajpeg: tjpegimage;
begin
result: = false;
abmp: = tbitmap. create;
ajpeg: = tsf-image. create;
try
abmp. loadfromfile (SOU);
ajpeg. assign (abmp);
ajpeg. compressionquality: = 100;
ajpeg. compress;
ajpeg. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (ajpeg);
end;

{*********** convert JPG to BMP ************}
function compute tobmp (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
ajpeg: tjpegimage;
begin
result: = false;
abmp: = tbitmap. create;
ajpeg: = tsf-image. create;
try
ajpeg. loadfromfile (SOU);
abmp. assign (ajpeg);
abmp. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (ajpeg);
end;

{********** convert BMP to EMF ***********}
function BMP toemf (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
aemf: tmetafile;
begin
result: = false;
abmp: = tbitmap. create;
aemf: = tmetafile. create;
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;
aemf. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (aemf);
end;

{********** convert BMP to WMF ***********}
function BMP towmf (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
AWMF: tmetafile;
begin
result: = false;
abmp: = tbitmap. create;
AWMF: = tmetafile. create;
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;
AWMF. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (AWMF);
end;

{*********** EMF conversion to BMP ***********}
function emftobmp (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
aemf: tmetafile;
begin
result: = false;
abmp: = tbitmap. create;
aemf: = tmetafile. create;
try
aemf. loadfromfile (SOU);
abmp. width: = aemf. width;
abmp. height: = aemf. height;
abmp. canvas. draw (0, 0, aemf);
abmp. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (aemf);
end;

{*********** WMF conversion to BMP ***********}
function wmftobmp (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
AWMF: tmetafile;
begin
result: = false;
abmp: = tbitmap. create;
AWMF: = tmetafile. create;
try
AWMF. loadfromfile (SOU);
abmp. width: = AWMF. width;
abmp. height: = AWMF. height;
abmp. canvas. draw (0, 0, AWMF);
abmp. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (AWMF);
end;

{********** icon to BMP **********}
function icontobmp (SOU: tfilename; des: tfilename): Boolean;
var
abmp: tbitmap;
aicon: ticon;
begin
result: = false;
abmp: = tbitmap. create;
aicon: = ticon. create;
try
aicon. loadfromfile (SOU);
abmp. width: = aicon. width;
abmp. height: = aicon. height;
abmp. canvas. draw (0, 0, aicon);
abmp. savetofile (DES);
result: = true;
else t
result: = false;
end;
finally
freeandnil (abmp);
freeandnil (aicon);
end;

{******** Convert BMP to an icon ********}
Function BMP toicon (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;