{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
osCommerce Product Manager for Windows (oscpmwin).
Copyright ©2003-2006 by Mario A. Valdez-Ramirez.

You can contact Mario A. Valdez-Ramirez
by email at mario@mariovaldez.org or paper mail at
Olmos 809, San Nicolas, NL. 66495, Mexico.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
UNIT imageman;

INTERFACE

USES
  Windows, Graphics, FreeImage, SysUtils;



CONST
  opmC_BMPFormat = FIF_BMP;
  opmC_JPEGFormat = FIF_JPEG;
  opmC_PNGFormat = FIF_PNG;
  opmC_GIFFormat = FIF_GIF;
  opmC_NAFormat = FIF_UNKNOWN;
  opmC_TmpLoad_Filename = 'oscpmtmp.tmp';
  opmC_TmpImg_Filename = 'oscpmtmp.img';
  opmC_TmpBMP_Filename = 'oscpmtmp.bmp';
  opmC_TmpJPG_Filename = 'oscpmtmp.jpg';
  opmC_TmpPNG_Filename = 'oscpmtmp.png';
  opmC_TmpGIF_Filename = 'oscpmtmp.gif';
  opmC_Def_UploadExt = 'jpg';
  opmC_Def_UploadFilename = '';
  opmC_Def_UploadFilter = '*.jpg;*.png;*.tif;*.gif;*.bmp;*.pcx;*.psd;*.tga;*.xbm;*.xpm';



TYPE

  opmT_GenericBitmap = CLASS (TBitmap)
    PUBLIC
      PROCEDURE LoadFromFile (CONST GrahicFileName : STRING); OVERRIDE;
    END;


FUNCTION FNopm_ImageNameIsJPEG (ImageName : STRING) : BOOLEAN;
FUNCTION FNopm_ImageNameIsPNG (ImageName : STRING) : BOOLEAN;
FUNCTION FNopm_SetQuality (NumericQuality : LONGINT) : LONGINT;
FUNCTION FNopm_QualityExplain (NumericQuality : INTEGER) : STRING;
FUNCTION FNopm_ConvertImage2 (ImageName, DestName : STRING; TargetFormat : FREE_IMAGE_FORMAT; JPEGQuality : LONGINT; CommentStr : STRING) : BOOLEAN;
FUNCTION FNopm_DirtyConvertImage (ImageName, DestName : STRING) : BOOLEAN;
FUNCTION FNopm_ResizeImage2 (ImageName, DestName : STRING; XSize, YSize : LONGINT; KeepAspect, PadImage : LONGINT; PadColor : LONGINT) : BOOLEAN;
PROCEDURE PRopm_AttachComment (VAR ImageDIB : FIBITMAP; CommentStr : STRING);


VAR
  opmG_ImgTMPPath : STRING;


IMPLEMENTATION

USES gnugettext, ShellApi, Forms, Classes, dataman;




{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
PROCEDURE opmT_GenericBitmap.LoadFromFile (CONST GrahicFileName : STRING);
VAR
  GenDIB : TBITMAP;
BEGIN
  IF (FNopm_DirtyConvertImage (GrahicFileName, opmG_ImgTMPPath + opmC_TmpLoad_Filename) = TRUE) THEN
    BEGIN
      TRY
        GenDIB := TBitmap.Create;
        TRY
          GenDIB.LoadFromFile (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
          Assign (GenDIB);
        FINALLY
          GenDIB.Free;
          SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
        END;
      EXCEPT
      END;
    END
  ELSE
    RAISE EInvalidGraphic.Create ('Invalid image!');
END;




{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_ImageNameIsJPEG (ImageName : STRING) : BOOLEAN;
BEGIN
  IF ((ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.JPG') OR
      (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.JPEG')) THEN
    FNopm_ImageNameIsJPEG := TRUE
  ELSE
    FNopm_ImageNameIsJPEG := FALSE;
END;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_ImageNameIsPNG (ImageName : STRING) : BOOLEAN;
BEGIN
  IF (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.PNG') THEN
    FNopm_ImageNameIsPNG := TRUE
  ELSE
    FNopm_ImageNameIsPNG := FALSE;
END;



{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_SetQuality (NumericQuality : LONGINT) : LONGINT;
BEGIN
  CASE ABS (NumericQuality) OF
    76..100 : FNopm_SetQuality := JPEG_QUALITYSUPERB;
     51..75 : FNopm_SetQuality := JPEG_QUALITYGOOD;
     26..50 : FNopm_SetQuality := JPEG_QUALITYNORMAL;
     11..25 : FNopm_SetQuality := JPEG_QUALITYAVERAGE;
      0..10 : FNopm_SetQuality := JPEG_QUALITYBAD;
  ELSE
    FNopm_SetQuality := JPEG_DEFAULT;
  END;
END;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_QualityExplain (NumericQuality : INTEGER) : STRING;
BEGIN
  CASE ABS (NumericQuality) OF
    76..100 : FNopm_QualityExplain := _('Superb quality');
     51..75 : FNopm_QualityExplain := _('Good quality');
     26..50 : FNopm_QualityExplain := _('Normal quality');
     11..25 : FNopm_QualityExplain := _('Average quality');
      0..10 : FNopm_QualityExplain := _('Bad quality');
  ELSE
    FNopm_QualityExplain := '';
  END;
END;



{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_ConvertImage2 (ImageName, DestName : STRING; TargetFormat : FREE_IMAGE_FORMAT; JPEGQuality : LONGINT; CommentStr : STRING) : BOOLEAN;
VAR
  DIB1, DIB2 : FIBITMAP;
  ImageFormat : FREE_IMAGE_FORMAT;
BEGIN
  FNopm_ConvertImage2 := FALSE;
  DIB1 := NIL;
  DIB2 := NIL;
  IF ((ImageName <> '') AND (DestName <> '')) THEN
    BEGIN
      SysUtils.DELETEFILE (DestName);
      ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
      IF (ImageFormat <> opmC_NAFormat) THEN
        TRY
          DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
          IF (DIB1 <> NIL) THEN
            BEGIN
              TRY
                CASE TargetFormat OF
                  opmC_BMPFormat :
                    IF (JPEGQuality > 0) THEN
                      BEGIN
                        PRopm_AttachComment (DIB1, CommentStr);
                        FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
                      END
                    ELSE
                      IF (FreeImage_GetBPP (DIB1) > 8) THEN
                        TRY
                          IF (JPEGQuality > 50) THEN
                            DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT)
                          ELSE
                            DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_WUQUANT);
                          PRopm_AttachComment (DIB2, CommentStr);
                          FreeImage_Save (opmC_BMPFormat, DIB2, PCHAR (DestName), 0);
                        FINALLY
                          FreeImage_Unload (DIB2);
                        END
                      ELSE
                        BEGIN
                          PRopm_AttachComment (DIB1, CommentStr);
                          FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
                        END;
                  opmC_PNGFormat :
                    IF (JPEGQuality > 0) THEN
                      BEGIN
                        PRopm_AttachComment (DIB1, CommentStr);
                        FreeImage_Save (opmC_PNGFormat, DIB1, PCHAR (DestName), 0);
                      END
                    ELSE
                      TRY
                        IF (JPEGQuality > 50) THEN
                          DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT)
                        ELSE
                          DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_WUQUANT);
                        PRopm_AttachComment (DIB2, CommentStr);
                        FreeImage_Save (opmC_PNGFormat, DIB2, PCHAR (DestName), 0);
                      FINALLY
                        FreeImage_Unload (DIB2);
                      END;
                  opmC_JPEGFormat :
                    BEGIN
                      PRopm_AttachComment (DIB1, CommentStr);
                      FreeImage_Save (opmC_JPEGFormat, DIB1, PCHAR (DestName), FNopm_SetQuality (JPEGQuality));
                    END;
                END;
                FNopm_ConvertImage2 := TRUE;
              EXCEPT
                FNopm_ConvertImage2 := FALSE;
              END;
            END;
        FINALLY
          FreeImage_Unload (DIB1);
        END;
    END;
END;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_DirtyConvertImage (ImageName, DestName : STRING) : BOOLEAN;
VAR
  DIB1 : FIBITMAP;
  ImageFormat : FREE_IMAGE_FORMAT;
BEGIN
  FNopm_DirtyConvertImage := FALSE;
  DIB1 := NIL;
  IF ((ImageName <> '') AND (DestName <> '')) THEN
    BEGIN
      SysUtils.DELETEFILE (DestName);
      ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
      IF (ImageFormat <> opmC_NAFormat) THEN
        TRY
          DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
          IF (DIB1 <> NIL) THEN
            BEGIN
              TRY
                FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
                FNopm_DirtyConvertImage := TRUE;
              EXCEPT
                FNopm_DirtyConvertImage := FALSE;
              END;
            END;
        FINALLY
          FreeImage_Unload (DIB1);
        END;
    END;
END;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_ResizeImage2 (ImageName, DestName : STRING; XSize, YSize : LONGINT;
                             KeepAspect, PadImage : LONGINT; PadColor : LONGINT) : BOOLEAN;
VAR
  DIB1, DIB2, DIB3, DIB4, DIB5, DIB6 : FIBITMAP;
  ImageFormat : FREE_IMAGE_FORMAT;
  XRatio, YRatio : DOUBLE;
  XCurrent, YCurrent : LONGINT;
  NewXSize, NewYSize : LONGINT;
  BackColor : PRGBQUAD;
BEGIN
  FNopm_ResizeImage2 := FALSE;
  DIB1 := NIL;
  DIB2 := NIL;
  DIB3 := NIL;
  DIB4 := NIL;
  DIB5 := NIL;
  DIB6 := NIL;
  BackColor := NIL;
  IF ((ImageName <> '') AND (DestName <> '')) THEN
    BEGIN
      SysUtils.DELETEFILE (DestName);
      ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
      IF (ImageFormat <> opmC_NAFormat) THEN
        TRY
          DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
          IF (DIB1 <> NIL) THEN
            BEGIN
              IF (KeepAspect > 0) THEN
                BEGIN
                  XCurrent := FreeImage_GetWidth (DIB1);
                  YCurrent := FreeImage_GetHeight (DIB1);
                  XRatio := (XCurrent / XSize);
                  YRatio := (YCurrent / YSize);
                  IF (XRatio > YRatio) THEN
                    BEGIN
                      NewXSize := ROUND (XCurrent / XRatio);
                      NewYSize := ROUND (YCurrent / XRatio);
                    END
                  ELSE
                    BEGIN
                      NewXSize := ROUND (XCurrent / YRatio);
                      NewYSize := ROUND (YCurrent / YRatio);
                    END;
                END
              ELSE
                BEGIN
                  NewXSize := XSize;
                  NewYSize := YSize;
                END;
              TRY
                DIB2 := FreeImage_ConvertTo32Bits (DIB1);
                DIB3 := FreeImage_Rescale (DIB2, NewXSize, NewYSize, FILTER_CATMULLROM);
                DIB4 := FreeImage_ConvertTo24Bits (DIB3);
                IF (PadImage > 0) THEN
                  TRY
                    DIB5 := FreeImage_Allocate (XSize, YSize, 24);
                    NEW (BackColor);
                    BackColor^.rgbRed := GetRValue (PadColor);
                    BackColor^.rgbGreen := GetGValue (PadColor);
                    BackColor^.rgbBlue := GetBValue (PadColor);
                    BackColor^.rgbReserved := 0;
                    FOR XCurrent := 0 TO (XSize - 1) DO
                      FOR YCurrent := 0 TO (YSize - 1) DO
                        FreeImage_SetPixelColor (DIB5, XCurrent, YCurrent, BackColor);
                    DIB6 := FreeImage_Copy (DIB4, 0, 0, (NewXSize - 1), (NewYSize - 1));
                    FreeImage_Paste (DIB5, DIB6, ROUND ((XSize - NewXSize) / 2), ROUND ((YSize - NewYSize) / 2), 255);
                    FreeImage_Save (opmC_BMPFormat, DIB5, PCHAR (DestName), 0);
                  FINALLY
                    FreeImage_Unload (DIB5);
                    FreeImage_Unload (DIB6);
                    DISPOSE (BackColor);
                  END
                ELSE FreeImage_Save (opmC_BMPFormat, DIB4, PCHAR (DestName), 0);
                FNopm_ResizeImage2 := TRUE;
              FINALLY
                FreeImage_Unload (DIB2);
                FreeImage_Unload (DIB3);
                FreeImage_Unload (DIB4);
              END;
            END;
        FINALLY
          FreeImage_Unload (DIB1);
        END;
    END;
END;



{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_GetImgTempPath : STRING;
VAR
  TmpDir :  STRING;
  BufSize : DWORD;
BEGIN
  SETLENGTH (TmpDir, MAX_PATH);
  BufSize := GetTempPath (MAX_PATH, PCHAR (TmpDir));
  SETLENGTH (TmpDir, BufSize);
  FNopm_GetImgTempPath := TmpDir;
END;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
PROCEDURE PRopm_AttachComment (VAR ImageDIB : FIBITMAP; CommentStr : STRING);
VAR
  DIBTag : FITAG;
  CommentLen : LONGINT;
  CommentStrU : UTF8STRING;
BEGIN
  DIBTag := NIL;
  CommentStrU := ANSITOUTF8 (CommentStr);
  CommentLen := SIZEOF (CommentStrU) + 1;
  IF (CommentStr <> '') THEN
    TRY
      DIBTag := FreeImage_CreateTag;
      IF (DIBTag <> NIL) THEN
        BEGIN
          FreeImage_SetTagKey (DIBTag, PCHAR ('Comment'));
          FreeImage_SetTagLength (DIBTag, CommentLen);
          FreeImage_SetTagCount (DIBTag, CommentLen);
          FreeImage_SetTagType (DIBTag, FIDT_ASCII);
          FreeImage_SetTagValue (DIBTag, PCHAR (CommentStr));
          FreeImage_SetMetadata (FIMD_COMMENTS, ImageDIB, FreeImage_GetTagKey (DIBTag), DIBTag);
        END;
    FINALLY
      FreeImage_DeleteTag (DIBTag);
    END;
END;


INITIALIZATION

  TPicture.RegisterFileFormat ('jpg', 'JPEG Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('png', 'PNG Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('tif', 'TIFF Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('pcx', 'PCX Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('gif', 'GIF Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('psd', 'Photoshop Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('tga', 'Targa Image', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('xbm', 'X11 Bitmap', opmT_GenericBitmap);
  TPicture.RegisterFileFormat ('xpm', 'X11 Pixmap', opmT_GenericBitmap);

  opmG_ImgTMPPath := FNopm_GetImgTempPath;


FINALIZATION

  SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
  SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpImg_Filename);
  SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpBMP_Filename);
  SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpJPG_Filename);
  SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpPNG_Filename);
  SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpGIF_Filename);

  

END.