{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
osCommerce Product Manager for Windows (oscpmwin).
Copyright ©2003,2004,2005 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
  FreeImage, SysUtils;



CONST
  opmC_BMPFormat = FIF_BMP;
  opmC_JPEGFormat = FIF_JPEG;
  opmC_PNGFormat = FIF_PNG;
  opmC_GIFFormat = FIF_GIF;
  opmC_NAFormat = FIF_UNKNOWN;
  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;*.gif;*.bmp;*.pcx;*.psd;*.xbm;*.xpm';


FUNCTION FNopm_ImageNameIsJPEG (ImageName : STRING) : BOOLEAN;
FUNCTION FNopm_ImageNameIsPNG (ImageName : STRING) : BOOLEAN;
FUNCTION FNopm_ImageNameIsGIF2 (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) : BOOLEAN;
FUNCTION FNopm_ResizeImage2 (ImageName, DestName : STRING; XSize, YSize : LONGINT; KeepAspect, PadImage : LONGINT; PadColor : LONGINT) : BOOLEAN;



IMPLEMENTATION

USES gnugettext, ShellApi, Forms, Windows, Classes, dataman;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
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_ImageNameIsGIF2 (ImageName : STRING) : BOOLEAN;
BEGIN
  IF (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.GIF') THEN
    FNopm_ImageNameIsGIF2 := TRUE
  ELSE
    FNopm_ImageNameIsGIF2 := FALSE;
END;


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
FUNCTION FNopm_ImageNameIsGIF (ImageName : STRING) : BOOLEAN;
VAR
  FileStream : TFileStream;
  ImgHeader : ARRAY [0..3] OF CHAR;
BEGIN
  IF (ImageName <> '') THEN
    TRY
      FileStream := TFileStream.Create (ImageName, fmOpenRead);
      TRY
        FileStream.Read (ImgHeader, SIZEOF (ImgHeader));
      FINALLY
        FileStream.Free;
      END;
    EXCEPT
      ImgHeader := '';
    END;
  IF (ImgHeader = 'GIF8') THEN
    FNopm_ImageNameIsGIF := TRUE
  ELSE
    FNopm_ImageNameIsGIF := 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) : BOOLEAN;
VAR
  DIB1, DIB2 : FIBITMAP;
  ImageFormat : FREE_IMAGE_FORMAT;
BEGIN
  FNopm_ConvertImage2 := FALSE;
  DIB1 := NIL;
  DIB2 := NIL;
  IF ((ImageName <> '') AND (DestName <> '')) THEN
    BEGIN
      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 :
                    FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
                  opmC_GIFFormat :
                    FreeImage_Save (opmC_GIFFormat, DIB1, PCHAR (DestName), 0);
                  opmC_PNGFormat :
                      TRY
                        DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT);  {Convert to 8 bits...}
                        FreeImage_Save (opmC_PNGFormat, DIB2, PCHAR (DestName), 0);
                      FINALLY
                        FreeImage_Unload (DIB2);
                      END;
                  opmC_JPEGFormat :
                    FreeImage_Save (opmC_JPEGFormat, DIB1, PCHAR (DestName), FNopm_SetQuality (JPEGQuality));
                END;
                FNopm_ConvertImage2 := TRUE;
              EXCEPT
                FNopm_ConvertImage2 := 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
      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;
                    {FreeImage_SetBackgroundColor (DIB5, BackColor);}
                    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;



END.