Source code of file oscpmwin_v0.4.1.636/imageman.pas from the
osCommerce Product Manager for Windows.
0000: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001: osCommerce Product Manager for Windows (oscpmwin).
0002: Copyright �2003-2006 by Mario A. Valdez-Ramirez.
0003:
0004: You can contact Mario A. Valdez-Ramirez
0005: by email at mario@mariovaldez.org or paper mail at
0006: Olmos 809, San Nicolas, NL. 66495, Mexico.
0007:
0008: This program is free software; you can redistribute it and/or modify
0009: it under the terms of the GNU General Public License as published by
0010: the Free Software Foundation; either version 2 of the License, or (at
0011: your option) any later version.
0012:
0013: This program is distributed in the hope that it will be useful, but
0014: WITHOUT ANY WARRANTY; without even the implied warranty of
0015: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0016: General Public License for more details.
0017:
0018: You should have received a copy of the GNU General Public License
0019: along with this program; if not, write to the Free Software
0020: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
0021: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0022: UNIT imageman;
0023:
0024: INTERFACE
0025:
0026: USES
0027: Windows, Graphics, FreeImage, SysUtils;
0028:
0029:
0030:
0031: CONST
0032: opmC_BMPFormat = FIF_BMP;
0033: opmC_JPEGFormat = FIF_JPEG;
0034: opmC_PNGFormat = FIF_PNG;
0035: opmC_GIFFormat = FIF_GIF;
0036: opmC_NAFormat = FIF_UNKNOWN;
0037: opmC_TmpLoad_Filename = 'oscpmtmp.tmp';
0038: opmC_TmpImg_Filename = 'oscpmtmp.img';
0039: opmC_TmpBMP_Filename = 'oscpmtmp.bmp';
0040: opmC_TmpJPG_Filename = 'oscpmtmp.jpg';
0041: opmC_TmpPNG_Filename = 'oscpmtmp.png';
0042: opmC_TmpGIF_Filename = 'oscpmtmp.gif';
0043: opmC_Def_UploadExt = 'jpg';
0044: opmC_Def_UploadFilename = '';
0045: opmC_Def_UploadFilter = '*.jpg;*.png;*.tif;*.gif;*.bmp;*.pcx;*.psd;*.tga;*.xbm;*.xpm';
0046:
0047:
0048:
0049: TYPE
0050:
0051: opmT_GenericBitmap = CLASS (TBitmap)
0052: PUBLIC
0053: PROCEDURE LoadFromFile (CONST GrahicFileName : STRING); OVERRIDE;
0054: END;
0055:
0056:
0057: FUNCTION FNopm_ImageNameIsJPEG (ImageName : STRING) : BOOLEAN;
0058: FUNCTION FNopm_ImageNameIsPNG (ImageName : STRING) : BOOLEAN;
0059: FUNCTION FNopm_SetQuality (NumericQuality : LONGINT) : LONGINT;
0060: FUNCTION FNopm_QualityExplain (NumericQuality : INTEGER) : STRING;
0061: FUNCTION FNopm_ConvertImage2 (ImageName, DestName : STRING; TargetFormat : FREE_IMAGE_FORMAT; JPEGQuality : LONGINT; CommentStr : STRING) : BOOLEAN;
0062: FUNCTION FNopm_DirtyConvertImage (ImageName, DestName : STRING) : BOOLEAN;
0063: FUNCTION FNopm_ResizeImage2 (ImageName, DestName : STRING; XSize, YSize : LONGINT; KeepAspect, PadImage : LONGINT; PadColor : LONGINT) : BOOLEAN;
0064: PROCEDURE PRopm_AttachComment (VAR ImageDIB : FIBITMAP; CommentStr : STRING);
0065:
0066:
0067: VAR
0068: opmG_ImgTMPPath : STRING;
0069:
0070:
0071: IMPLEMENTATION
0072:
0073: USES gnugettext, ShellApi, Forms, Classes, dataman;
0074:
0075:
0076:
0077:
0078: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0079: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0080: PROCEDURE opmT_GenericBitmap.LoadFromFile (CONST GrahicFileName : STRING);
0081: VAR
0082: GenDIB : TBITMAP;
0083: BEGIN
0084: IF (FNopm_DirtyConvertImage (GrahicFileName, opmG_ImgTMPPath + opmC_TmpLoad_Filename) = TRUE) THEN
0085: BEGIN
0086: TRY
0087: GenDIB := TBitmap.Create;
0088: TRY
0089: GenDIB.LoadFromFile (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
0090: Assign (GenDIB);
0091: FINALLY
0092: GenDIB.Free;
0093: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
0094: END;
0095: EXCEPT
0096: END;
0097: END
0098: ELSE
0099: RAISE EInvalidGraphic.Create ('Invalid image!');
0100: END;
0101:
0102:
0103:
0104:
0105: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0106: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0107: FUNCTION FNopm_ImageNameIsJPEG (ImageName : STRING) : BOOLEAN;
0108: BEGIN
0109: IF ((ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.JPG') OR
0110: (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.JPEG')) THEN
0111: FNopm_ImageNameIsJPEG := TRUE
0112: ELSE
0113: FNopm_ImageNameIsJPEG := FALSE;
0114: END;
0115:
0116:
0117: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0118: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0119: FUNCTION FNopm_ImageNameIsPNG (ImageName : STRING) : BOOLEAN;
0120: BEGIN
0121: IF (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.PNG') THEN
0122: FNopm_ImageNameIsPNG := TRUE
0123: ELSE
0124: FNopm_ImageNameIsPNG := FALSE;
0125: END;
0126:
0127:
0128:
0129: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0130: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0131: FUNCTION FNopm_SetQuality (NumericQuality : LONGINT) : LONGINT;
0132: BEGIN
0133: CASE ABS (NumericQuality) OF
0134: 76..100 : FNopm_SetQuality := JPEG_QUALITYSUPERB;
0135: 51..75 : FNopm_SetQuality := JPEG_QUALITYGOOD;
0136: 26..50 : FNopm_SetQuality := JPEG_QUALITYNORMAL;
0137: 11..25 : FNopm_SetQuality := JPEG_QUALITYAVERAGE;
0138: 0..10 : FNopm_SetQuality := JPEG_QUALITYBAD;
0139: ELSE
0140: FNopm_SetQuality := JPEG_DEFAULT;
0141: END;
0142: END;
0143:
0144:
0145: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0146: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0147: FUNCTION FNopm_QualityExplain (NumericQuality : INTEGER) : STRING;
0148: BEGIN
0149: CASE ABS (NumericQuality) OF
0150: 76..100 : FNopm_QualityExplain := _('Superb quality');
0151: 51..75 : FNopm_QualityExplain := _('Good quality');
0152: 26..50 : FNopm_QualityExplain := _('Normal quality');
0153: 11..25 : FNopm_QualityExplain := _('Average quality');
0154: 0..10 : FNopm_QualityExplain := _('Bad quality');
0155: ELSE
0156: FNopm_QualityExplain := '';
0157: END;
0158: END;
0159:
0160:
0161:
0162: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0163: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0164: FUNCTION FNopm_ConvertImage2 (ImageName, DestName : STRING; TargetFormat : FREE_IMAGE_FORMAT; JPEGQuality : LONGINT; CommentStr : STRING) : BOOLEAN;
0165: VAR
0166: DIB1, DIB2 : FIBITMAP;
0167: ImageFormat : FREE_IMAGE_FORMAT;
0168: BEGIN
0169: FNopm_ConvertImage2 := FALSE;
0170: DIB1 := NIL;
0171: DIB2 := NIL;
0172: IF ((ImageName <> '') AND (DestName <> '')) THEN
0173: BEGIN
0174: SysUtils.DELETEFILE (DestName);
0175: ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
0176: IF (ImageFormat <> opmC_NAFormat) THEN
0177: TRY
0178: DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
0179: IF (DIB1 <> NIL) THEN
0180: BEGIN
0181: TRY
0182: CASE TargetFormat OF
0183: opmC_BMPFormat :
0184: IF (JPEGQuality > 0) THEN
0185: BEGIN
0186: PRopm_AttachComment (DIB1, CommentStr);
0187: FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
0188: END
0189: ELSE
0190: IF (FreeImage_GetBPP (DIB1) > 8) THEN
0191: TRY
0192: IF (JPEGQuality > 50) THEN
0193: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT)
0194: ELSE
0195: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_WUQUANT);
0196: PRopm_AttachComment (DIB2, CommentStr);
0197: FreeImage_Save (opmC_BMPFormat, DIB2, PCHAR (DestName), 0);
0198: FINALLY
0199: FreeImage_Unload (DIB2);
0200: END
0201: ELSE
0202: BEGIN
0203: PRopm_AttachComment (DIB1, CommentStr);
0204: FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
0205: END;
0206: opmC_PNGFormat :
0207: IF (JPEGQuality > 0) THEN
0208: BEGIN
0209: PRopm_AttachComment (DIB1, CommentStr);
0210: FreeImage_Save (opmC_PNGFormat, DIB1, PCHAR (DestName), 0);
0211: END
0212: ELSE
0213: TRY
0214: IF (JPEGQuality > 50) THEN
0215: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT)
0216: ELSE
0217: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_WUQUANT);
0218: PRopm_AttachComment (DIB2, CommentStr);
0219: FreeImage_Save (opmC_PNGFormat, DIB2, PCHAR (DestName), 0);
0220: FINALLY
0221: FreeImage_Unload (DIB2);
0222: END;
0223: opmC_JPEGFormat :
0224: BEGIN
0225: PRopm_AttachComment (DIB1, CommentStr);
0226: FreeImage_Save (opmC_JPEGFormat, DIB1, PCHAR (DestName), FNopm_SetQuality (JPEGQuality));
0227: END;
0228: END;
0229: FNopm_ConvertImage2 := TRUE;
0230: EXCEPT
0231: FNopm_ConvertImage2 := FALSE;
0232: END;
0233: END;
0234: FINALLY
0235: FreeImage_Unload (DIB1);
0236: END;
0237: END;
0238: END;
0239:
0240:
0241: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0242: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0243: FUNCTION FNopm_DirtyConvertImage (ImageName, DestName : STRING) : BOOLEAN;
0244: VAR
0245: DIB1 : FIBITMAP;
0246: ImageFormat : FREE_IMAGE_FORMAT;
0247: BEGIN
0248: FNopm_DirtyConvertImage := FALSE;
0249: DIB1 := NIL;
0250: IF ((ImageName <> '') AND (DestName <> '')) THEN
0251: BEGIN
0252: SysUtils.DELETEFILE (DestName);
0253: ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
0254: IF (ImageFormat <> opmC_NAFormat) THEN
0255: TRY
0256: DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
0257: IF (DIB1 <> NIL) THEN
0258: BEGIN
0259: TRY
0260: FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
0261: FNopm_DirtyConvertImage := TRUE;
0262: EXCEPT
0263: FNopm_DirtyConvertImage := FALSE;
0264: END;
0265: END;
0266: FINALLY
0267: FreeImage_Unload (DIB1);
0268: END;
0269: END;
0270: END;
0271:
0272:
0273: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0274: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0275: FUNCTION FNopm_ResizeImage2 (ImageName, DestName : STRING; XSize, YSize : LONGINT;
0276: KeepAspect, PadImage : LONGINT; PadColor : LONGINT) : BOOLEAN;
0277: VAR
0278: DIB1, DIB2, DIB3, DIB4, DIB5, DIB6 : FIBITMAP;
0279: ImageFormat : FREE_IMAGE_FORMAT;
0280: XRatio, YRatio : DOUBLE;
0281: XCurrent, YCurrent : LONGINT;
0282: NewXSize, NewYSize : LONGINT;
0283: BackColor : PRGBQUAD;
0284: BEGIN
0285: FNopm_ResizeImage2 := FALSE;
0286: DIB1 := NIL;
0287: DIB2 := NIL;
0288: DIB3 := NIL;
0289: DIB4 := NIL;
0290: DIB5 := NIL;
0291: DIB6 := NIL;
0292: BackColor := NIL;
0293: IF ((ImageName <> '') AND (DestName <> '')) THEN
0294: BEGIN
0295: SysUtils.DELETEFILE (DestName);
0296: ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
0297: IF (ImageFormat <> opmC_NAFormat) THEN
0298: TRY
0299: DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
0300: IF (DIB1 <> NIL) THEN
0301: BEGIN
0302: IF (KeepAspect > 0) THEN
0303: BEGIN
0304: XCurrent := FreeImage_GetWidth (DIB1);
0305: YCurrent := FreeImage_GetHeight (DIB1);
0306: XRatio := (XCurrent / XSize);
0307: YRatio := (YCurrent / YSize);
0308: IF (XRatio > YRatio) THEN
0309: BEGIN
0310: NewXSize := ROUND (XCurrent / XRatio);
0311: NewYSize := ROUND (YCurrent / XRatio);
0312: END
0313: ELSE
0314: BEGIN
0315: NewXSize := ROUND (XCurrent / YRatio);
0316: NewYSize := ROUND (YCurrent / YRatio);
0317: END;
0318: END
0319: ELSE
0320: BEGIN
0321: NewXSize := XSize;
0322: NewYSize := YSize;
0323: END;
0324: TRY
0325: DIB2 := FreeImage_ConvertTo32Bits (DIB1);
0326: DIB3 := FreeImage_Rescale (DIB2, NewXSize, NewYSize, FILTER_CATMULLROM);
0327: DIB4 := FreeImage_ConvertTo24Bits (DIB3);
0328: IF (PadImage > 0) THEN
0329: TRY
0330: DIB5 := FreeImage_Allocate (XSize, YSize, 24);
0331: NEW (BackColor);
0332: BackColor^.rgbRed := GetRValue (PadColor);
0333: BackColor^.rgbGreen := GetGValue (PadColor);
0334: BackColor^.rgbBlue := GetBValue (PadColor);
0335: BackColor^.rgbReserved := 0;
0336: FOR XCurrent := 0 TO (XSize - 1) DO
0337: FOR YCurrent := 0 TO (YSize - 1) DO
0338: FreeImage_SetPixelColor (DIB5, XCurrent, YCurrent, BackColor);
0339: DIB6 := FreeImage_Copy (DIB4, 0, 0, (NewXSize - 1), (NewYSize - 1));
0340: FreeImage_Paste (DIB5, DIB6, ROUND ((XSize - NewXSize) / 2), ROUND ((YSize - NewYSize) / 2), 255);
0341: FreeImage_Save (opmC_BMPFormat, DIB5, PCHAR (DestName), 0);
0342: FINALLY
0343: FreeImage_Unload (DIB5);
0344: FreeImage_Unload (DIB6);
0345: DISPOSE (BackColor);
0346: END
0347: ELSE FreeImage_Save (opmC_BMPFormat, DIB4, PCHAR (DestName), 0);
0348: FNopm_ResizeImage2 := TRUE;
0349: FINALLY
0350: FreeImage_Unload (DIB2);
0351: FreeImage_Unload (DIB3);
0352: FreeImage_Unload (DIB4);
0353: END;
0354: END;
0355: FINALLY
0356: FreeImage_Unload (DIB1);
0357: END;
0358: END;
0359: END;
0360:
0361:
0362:
0363: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0364: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0365: FUNCTION FNopm_GetImgTempPath : STRING;
0366: VAR
0367: TmpDir : STRING;
0368: BufSize : DWORD;
0369: BEGIN
0370: SETLENGTH (TmpDir, MAX_PATH);
0371: BufSize := GetTempPath (MAX_PATH, PCHAR (TmpDir));
0372: SETLENGTH (TmpDir, BufSize);
0373: FNopm_GetImgTempPath := TmpDir;
0374: END;
0375:
0376:
0377: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0378: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0379: PROCEDURE PRopm_AttachComment (VAR ImageDIB : FIBITMAP; CommentStr : STRING);
0380: VAR
0381: DIBTag : FITAG;
0382: CommentLen : LONGINT;
0383: CommentStrU : UTF8STRING;
0384: BEGIN
0385: DIBTag := NIL;
0386: CommentStrU := ANSITOUTF8 (CommentStr);
0387: CommentLen := SIZEOF (CommentStrU) + 1;
0388: IF (CommentStr <> '') THEN
0389: TRY
0390: DIBTag := FreeImage_CreateTag;
0391: IF (DIBTag <> NIL) THEN
0392: BEGIN
0393: FreeImage_SetTagKey (DIBTag, PCHAR ('Comment'));
0394: FreeImage_SetTagLength (DIBTag, CommentLen);
0395: FreeImage_SetTagCount (DIBTag, CommentLen);
0396: FreeImage_SetTagType (DIBTag, FIDT_ASCII);
0397: FreeImage_SetTagValue (DIBTag, PCHAR (CommentStr));
0398: FreeImage_SetMetadata (FIMD_COMMENTS, ImageDIB, FreeImage_GetTagKey (DIBTag), DIBTag);
0399: END;
0400: FINALLY
0401: FreeImage_DeleteTag (DIBTag);
0402: END;
0403: END;
0404:
0405:
0406: INITIALIZATION
0407:
0408: TPicture.RegisterFileFormat ('jpg', 'JPEG Image', opmT_GenericBitmap);
0409: TPicture.RegisterFileFormat ('png', 'PNG Image', opmT_GenericBitmap);
0410: TPicture.RegisterFileFormat ('tif', 'TIFF Image', opmT_GenericBitmap);
0411: TPicture.RegisterFileFormat ('pcx', 'PCX Image', opmT_GenericBitmap);
0412: TPicture.RegisterFileFormat ('gif', 'GIF Image', opmT_GenericBitmap);
0413: TPicture.RegisterFileFormat ('psd', 'Photoshop Image', opmT_GenericBitmap);
0414: TPicture.RegisterFileFormat ('tga', 'Targa Image', opmT_GenericBitmap);
0415: TPicture.RegisterFileFormat ('xbm', 'X11 Bitmap', opmT_GenericBitmap);
0416: TPicture.RegisterFileFormat ('xpm', 'X11 Pixmap', opmT_GenericBitmap);
0417:
0418: opmG_ImgTMPPath := FNopm_GetImgTempPath;
0419:
0420:
0421: FINALIZATION
0422:
0423: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
0424: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpImg_Filename);
0425: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpBMP_Filename);
0426: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpJPG_Filename);
0427: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpPNG_Filename);
0428: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpGIF_Filename);
0429:
0430:
0431:
0432: END.
