Source code of file oscpmwin/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: FUNCTION FNopm_WatermarkImage2 (WaterName, DestName : STRING; Blending : LONGINT) : BOOLEAN;
0065: PROCEDURE PRopm_AttachComment (VAR ImageDIB : FIBITMAP; CommentStr : STRING);
0066:
0067:
0068: VAR
0069: opmG_ImgTMPPath : STRING;
0070:
0071:
0072: IMPLEMENTATION
0073:
0074: USES gnugettext;
0075:
0076:
0077:
0078:
0079: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0080: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0081: PROCEDURE opmT_GenericBitmap.LoadFromFile (CONST GrahicFileName : STRING);
0082: VAR
0083: GenDIB : TBITMAP;
0084: BEGIN
0085: IF (FNopm_DirtyConvertImage (GrahicFileName, opmG_ImgTMPPath + opmC_TmpLoad_Filename) = TRUE) THEN
0086: BEGIN
0087: TRY
0088: GenDIB := TBitmap.Create;
0089: TRY
0090: GenDIB.LoadFromFile (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
0091: Assign (GenDIB);
0092: FINALLY
0093: GenDIB.Free;
0094: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
0095: END;
0096: EXCEPT
0097: END;
0098: END
0099: ELSE
0100: RAISE EInvalidGraphic.Create ('Invalid image!');
0101: END;
0102:
0103:
0104:
0105:
0106: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0107: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0108: FUNCTION FNopm_ImageNameIsJPEG (ImageName : STRING) : BOOLEAN;
0109: BEGIN
0110: IF ((ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.JPG') OR
0111: (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.JPEG')) THEN
0112: FNopm_ImageNameIsJPEG := TRUE
0113: ELSE
0114: FNopm_ImageNameIsJPEG := FALSE;
0115: END;
0116:
0117:
0118: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0119: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0120: FUNCTION FNopm_ImageNameIsPNG (ImageName : STRING) : BOOLEAN;
0121: BEGIN
0122: IF (ANSIUPPERCASE (ExtractFileExt (ImageName)) = '.PNG') THEN
0123: FNopm_ImageNameIsPNG := TRUE
0124: ELSE
0125: FNopm_ImageNameIsPNG := FALSE;
0126: END;
0127:
0128:
0129:
0130: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0131: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0132: FUNCTION FNopm_SetQuality (NumericQuality : LONGINT) : LONGINT;
0133: BEGIN
0134: CASE ABS (NumericQuality) OF
0135: 76..100 : FNopm_SetQuality := JPEG_QUALITYSUPERB;
0136: 51..75 : FNopm_SetQuality := JPEG_QUALITYGOOD;
0137: 26..50 : FNopm_SetQuality := JPEG_QUALITYNORMAL;
0138: 11..25 : FNopm_SetQuality := JPEG_QUALITYAVERAGE;
0139: 0..10 : FNopm_SetQuality := JPEG_QUALITYBAD;
0140: ELSE
0141: FNopm_SetQuality := JPEG_DEFAULT;
0142: END;
0143: END;
0144:
0145:
0146: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0147: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0148: FUNCTION FNopm_QualityExplain (NumericQuality : INTEGER) : STRING;
0149: BEGIN
0150: CASE ABS (NumericQuality) OF
0151: 76..100 : FNopm_QualityExplain := _('Superb quality');
0152: 51..75 : FNopm_QualityExplain := _('Good quality');
0153: 26..50 : FNopm_QualityExplain := _('Normal quality');
0154: 11..25 : FNopm_QualityExplain := _('Average quality');
0155: 0..10 : FNopm_QualityExplain := _('Bad quality');
0156: ELSE
0157: FNopm_QualityExplain := '';
0158: END;
0159: END;
0160:
0161:
0162:
0163: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0164: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0165: FUNCTION FNopm_ConvertImage2 (ImageName, DestName : STRING; TargetFormat : FREE_IMAGE_FORMAT; JPEGQuality : LONGINT; CommentStr : STRING) : BOOLEAN;
0166: VAR
0167: DIB1, DIB2 : FIBITMAP;
0168: ImageFormat : FREE_IMAGE_FORMAT;
0169: BEGIN
0170: FNopm_ConvertImage2 := FALSE;
0171: DIB1 := NIL;
0172: DIB2 := NIL;
0173: IF ((ImageName <> '') AND (DestName <> '')) THEN
0174: BEGIN
0175: SysUtils.DELETEFILE (DestName);
0176: ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
0177: IF (ImageFormat <> opmC_NAFormat) THEN
0178: TRY
0179: DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
0180: IF (DIB1 <> NIL) THEN
0181: BEGIN
0182: TRY
0183: CASE TargetFormat OF
0184: opmC_BMPFormat :
0185: IF (JPEGQuality > 0) THEN
0186: BEGIN
0187: PRopm_AttachComment (DIB1, CommentStr);
0188: FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
0189: END
0190: ELSE
0191: IF (FreeImage_GetBPP (DIB1) > 8) THEN
0192: TRY
0193: IF (JPEGQuality > 50) THEN
0194: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT)
0195: ELSE
0196: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_WUQUANT);
0197: PRopm_AttachComment (DIB2, CommentStr);
0198: FreeImage_Save (opmC_BMPFormat, DIB2, PCHAR (DestName), 0);
0199: FINALLY
0200: FreeImage_Unload (DIB2);
0201: END
0202: ELSE
0203: BEGIN
0204: PRopm_AttachComment (DIB1, CommentStr);
0205: FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
0206: END;
0207: opmC_PNGFormat :
0208: IF (JPEGQuality > 0) THEN
0209: BEGIN
0210: PRopm_AttachComment (DIB1, CommentStr);
0211: FreeImage_Save (opmC_PNGFormat, DIB1, PCHAR (DestName), 0);
0212: END
0213: ELSE
0214: TRY
0215: IF (JPEGQuality > 50) THEN
0216: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_NNQUANT)
0217: ELSE
0218: DIB2 := FreeImage_ColorQuantize (DIB1, FIQ_WUQUANT);
0219: PRopm_AttachComment (DIB2, CommentStr);
0220: FreeImage_Save (opmC_PNGFormat, DIB2, PCHAR (DestName), 0);
0221: FINALLY
0222: FreeImage_Unload (DIB2);
0223: END;
0224: opmC_JPEGFormat :
0225: BEGIN
0226: PRopm_AttachComment (DIB1, CommentStr);
0227: FreeImage_Save (opmC_JPEGFormat, DIB1, PCHAR (DestName), FNopm_SetQuality (JPEGQuality));
0228: END;
0229: END;
0230: FNopm_ConvertImage2 := TRUE;
0231: EXCEPT
0232: FNopm_ConvertImage2 := FALSE;
0233: END;
0234: END;
0235: FINALLY
0236: FreeImage_Unload (DIB1);
0237: END;
0238: END;
0239: END;
0240:
0241:
0242: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0243: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0244: FUNCTION FNopm_DirtyConvertImage (ImageName, DestName : STRING) : BOOLEAN;
0245: VAR
0246: DIB1 : FIBITMAP;
0247: ImageFormat : FREE_IMAGE_FORMAT;
0248: BEGIN
0249: FNopm_DirtyConvertImage := FALSE;
0250: DIB1 := NIL;
0251: IF ((ImageName <> '') AND (DestName <> '')) THEN
0252: BEGIN
0253: SysUtils.DELETEFILE (DestName);
0254: ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
0255: IF (ImageFormat <> opmC_NAFormat) THEN
0256: TRY
0257: DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
0258: IF (DIB1 <> NIL) THEN
0259: BEGIN
0260: TRY
0261: FreeImage_Save (opmC_BMPFormat, DIB1, PCHAR (DestName), 0);
0262: FNopm_DirtyConvertImage := TRUE;
0263: EXCEPT
0264: FNopm_DirtyConvertImage := FALSE;
0265: END;
0266: END;
0267: FINALLY
0268: FreeImage_Unload (DIB1);
0269: END;
0270: END;
0271: END;
0272:
0273:
0274: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0275: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0276: FUNCTION FNopm_ResizeImage2 (ImageName, DestName : STRING; XSize, YSize : LONGINT;
0277: KeepAspect, PadImage : LONGINT; PadColor : LONGINT) : BOOLEAN;
0278: VAR
0279: DIB1, DIB2, DIB3, DIB4, DIB5, DIB6 : FIBITMAP;
0280: ImageFormat : FREE_IMAGE_FORMAT;
0281: XRatio, YRatio : DOUBLE;
0282: XCurrent, YCurrent : LONGINT;
0283: NewXSize, NewYSize : LONGINT;
0284: BackColor : PRGBQUAD;
0285: BEGIN
0286: FNopm_ResizeImage2 := FALSE;
0287: DIB1 := NIL;
0288: DIB2 := NIL;
0289: DIB3 := NIL;
0290: DIB4 := NIL;
0291: DIB5 := NIL;
0292: DIB6 := NIL;
0293: BackColor := NIL;
0294: IF ((ImageName <> '') AND (DestName <> '')) THEN
0295: BEGIN
0296: SysUtils.DELETEFILE (DestName);
0297: ImageFormat := FreeImage_GetFileType (PCHAR (ImageName), 0);
0298: IF (ImageFormat <> opmC_NAFormat) THEN
0299: TRY
0300: DIB1 := FreeImage_Load (ImageFormat, PCHAR (ImageName), 0);
0301: IF (DIB1 <> NIL) THEN
0302: BEGIN
0303: IF (KeepAspect > 0) THEN
0304: BEGIN
0305: XCurrent := FreeImage_GetWidth (DIB1);
0306: YCurrent := FreeImage_GetHeight (DIB1);
0307: XRatio := (XCurrent / XSize);
0308: YRatio := (YCurrent / YSize);
0309: IF (XRatio > YRatio) THEN
0310: BEGIN
0311: NewXSize := ROUND (XCurrent / XRatio);
0312: NewYSize := ROUND (YCurrent / XRatio);
0313: END
0314: ELSE
0315: BEGIN
0316: NewXSize := ROUND (XCurrent / YRatio);
0317: NewYSize := ROUND (YCurrent / YRatio);
0318: END;
0319: END
0320: ELSE
0321: BEGIN
0322: NewXSize := XSize;
0323: NewYSize := YSize;
0324: END;
0325: TRY
0326: DIB2 := FreeImage_ConvertTo32Bits (DIB1);
0327: DIB3 := FreeImage_Rescale (DIB2, NewXSize, NewYSize, FILTER_CATMULLROM);
0328: DIB4 := FreeImage_ConvertTo24Bits (DIB3);
0329: IF (PadImage > 0) THEN
0330: TRY
0331: DIB5 := FreeImage_Allocate (XSize, YSize, 24);
0332: NEW (BackColor);
0333: BackColor^.rgbRed := GetRValue (PadColor);
0334: BackColor^.rgbGreen := GetGValue (PadColor);
0335: BackColor^.rgbBlue := GetBValue (PadColor);
0336: BackColor^.rgbReserved := 0;
0337: FOR XCurrent := 0 TO (XSize - 1) DO
0338: FOR YCurrent := 0 TO (YSize - 1) DO
0339: FreeImage_SetPixelColor (DIB5, XCurrent, YCurrent, BackColor);
0340: DIB6 := FreeImage_Copy (DIB4, 0, 0, (NewXSize - 1), (NewYSize - 1));
0341: FreeImage_Paste (DIB5, DIB6, ROUND ((XSize - NewXSize) / 2), ROUND ((YSize - NewYSize) / 2), 255);
0342: FreeImage_Save (opmC_BMPFormat, DIB5, PCHAR (DestName), 0);
0343: FINALLY
0344: FreeImage_Unload (DIB5);
0345: FreeImage_Unload (DIB6);
0346: DISPOSE (BackColor);
0347: END
0348: ELSE FreeImage_Save (opmC_BMPFormat, DIB4, PCHAR (DestName), 0);
0349: FNopm_ResizeImage2 := TRUE;
0350: FINALLY
0351: FreeImage_Unload (DIB2);
0352: FreeImage_Unload (DIB3);
0353: FreeImage_Unload (DIB4);
0354: END;
0355: END;
0356: FINALLY
0357: FreeImage_Unload (DIB1);
0358: END;
0359: END;
0360: END;
0361:
0362:
0363:
0364:
0365:
0366: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0367: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0368: FUNCTION FNopm_WatermarkImage2 (WaterName, DestName : STRING; Blending : LONGINT) : BOOLEAN;
0369: VAR
0370: DIBWater, DIBTarget, DIBTmpGray8, DIBTmpGray24, DIBTmpWhite, DIBWater32, DIBTarget24, DIBWater32X, DIBAlpha, DIBComposite32, DIBComposite24 : FIBITMAP;
0371: ImageFormat1, ImageFormat2 : FREE_IMAGE_FORMAT;
0372: XWater, YWater, XTarget, YTarget : LONGINT;
0373: XCurrent, YCurrent : LONGINT;
0374: BackColor : PRGBQUAD;
0375: BEGIN
0376: FNopm_WatermarkImage2 := FALSE;
0377: DIBWater := NIL;
0378: DIBTarget := NIL;
0379: DIBTmpGray8 := NIL;
0380: DIBTmpGray24 := NIL;
0381: DIBTmpWhite := NIL;
0382: DIBWater32 := NIL;
0383: DIBTarget24 := NIL;
0384: DIBWater32X := NIL;
0385: DIBAlpha := NIL;
0386: DIBComposite32 := NIL;
0387: DIBComposite24 := NIL;
0388: BackColor := NIL;
0389: IF ((WaterName <> '') AND (DestName <> '')) THEN
0390: BEGIN
0391: {Check the watermark and target images have a known format.}
0392: ImageFormat1 := FreeImage_GetFileType (PCHAR (WaterName), 0);
0393: ImageFormat2 := FreeImage_GetFileType (PCHAR (DestName), 0);
0394: IF ((ImageFormat1 <> opmC_NAFormat) AND (ImageFormat2 <> opmC_NAFormat)) THEN
0395: TRY
0396: {Load the watermark and target images.}
0397: DIBWater := FreeImage_Load (ImageFormat1, PCHAR (WaterName), 0);
0398: DIBTarget := FreeImage_Load (ImageFormat2, PCHAR (DestName), 0);
0399: IF ((DIBWater <> NIL) AND (DIBTarget <> NIL)) THEN
0400: BEGIN
0401: TRY
0402: {Copy a grayscale copy of the watermark, convert it to 24-bits,
0403: convert the watermark to 32-bits and the target to 24-bits}
0404: DIBTmpGray8 := FreeImage_ConvertToGreyscale (DIBWater);
0405: DIBTmpGray24 := FreeImage_ConvertTo24Bits (DIBTmpGray8);
0406: DIBWater32 := FreeImage_ConvertTo32Bits (DIBWater);
0407: DIBTarget24 := FreeImage_ConvertTo24Bits (DIBTarget);
0408: IF ((DIBWater32 <> NIL) AND (DIBTarget24 <> NIL) AND (DIBTmpGray24 <> NIL)) THEN
0409: BEGIN
0410: {Create a 24-bits empty image of the same size than the water,
0411: then fill it with white color.}
0412: XWater := FreeImage_GetWidth (DIBWater32);
0413: YWater := FreeImage_GetHeight (DIBWater32);
0414: DIBTmpWhite := FreeImage_Allocate (XWater, YWater, 24);
0415: IF (DIBTmpWhite <> NIL) THEN
0416: BEGIN
0417: NEW (BackColor);
0418: BackColor^.rgbRed := 255;
0419: BackColor^.rgbGreen := 255;
0420: BackColor^.rgbBlue := 255;
0421: BackColor^.rgbReserved := 0;
0422: FOR XCurrent := 0 TO (XWater - 1) DO
0423: FOR YCurrent := 0 TO (YWater - 1) DO
0424: FreeImage_SetPixelColor (DIBTmpWhite, XCurrent, YCurrent, BackColor);
0425: {Alpha-blend the grayscale watermark with the white backgroud.}
0426: FreeImage_Paste (DIBTmpGray24, DIBTmpWhite, 0, 0, ROUND (Blending * 2.55));
0427: {Extract the red channel from the grayscale watermark...}
0428: DIBAlpha := FreeImage_GetChannel (DIBTmpGray24, FICC_RED);
0429: IF (DIBAlpha <> NIL) THEN
0430: BEGIN
0431: {...then invert the channel and parte it to the alpha channel
0432: of the color watermark image. This causes the lighter areas of
0433: the image to become more transparent. (This is an automatic alpha mask.)}
0434: FreeImage_Invert (DIBAlpha);
0435: FreeImage_SetChannel (DIBWater32, DIBAlpha, FICC_ALPHA);
0436: {If the watermark is of different size than the target, resize it.}
0437: XTarget := FreeImage_GetWidth (DIBTarget24);
0438: YTarget := FreeImage_GetHeight (DIBTarget24);
0439: IF ((XWater <> XTarget) OR (YWater <> YTarget)) THEN
0440: BEGIN
0441: DIBWater32X := FreeImage_Rescale (DIBWater32, XTarget, YTarget, FILTER_BSPLINE);
0442: END
0443: ELSE
0444: BEGIN
0445: DIBWater32X := DIBWater32;
0446: DIBWater32 := NIL;
0447: END;
0448: IF (DIBWater32X <> NIL) THEN
0449: BEGIN
0450: {Compose an image placing the partially transparent watermark
0451: over the target image.}
0452: DIBComposite32 := FreeImage_Composite (DIBWater32X, FALSE, NIL, DIBTarget24);
0453: IF (DIBComposite32 <> NIL) THEN
0454: BEGIN
0455: DIBComposite24 := FreeImage_ConvertTo24Bits (DIBComposite32);
0456: IF (DIBComposite24 <> NIL) THEN
0457: {Save the watermarked image in BMP format.}
0458: FNopm_WatermarkImage2 := FreeImage_Save (opmC_BMPFormat, DIBComposite24, PCHAR (DestName), 0);
0459: END;
0460: END;
0461: END;
0462: END;
0463: END;
0464: FINALLY
0465: FreeImage_Unload (DIBTmpGray8);
0466: FreeImage_Unload (DIBTmpGray24);
0467: FreeImage_Unload (DIBWater32);
0468: FreeImage_Unload (DIBTarget24);
0469: FreeImage_Unload (DIBTmpWhite);
0470: FreeImage_Unload (DIBWater32X);
0471: FreeImage_Unload (DIBAlpha);
0472: FreeImage_Unload (DIBComposite32);
0473: FreeImage_Unload (DIBComposite24);
0474: DISPOSE (BackColor);
0475: END;
0476: END;
0477: FINALLY
0478: FreeImage_Unload (DIBWater);
0479: FreeImage_Unload (DIBTarget);
0480: END;
0481: END;
0482: END;
0483:
0484:
0485:
0486: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0487: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0488: FUNCTION FNopm_GetImgTempPath : STRING;
0489: VAR
0490: TmpDir : STRING;
0491: BufSize : DWORD;
0492: BEGIN
0493: SETLENGTH (TmpDir, MAX_PATH);
0494: BufSize := GetTempPath (MAX_PATH, PCHAR (TmpDir));
0495: SETLENGTH (TmpDir, BufSize);
0496: FNopm_GetImgTempPath := TmpDir;
0497: END;
0498:
0499:
0500: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0501: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0502: PROCEDURE PRopm_AttachComment (VAR ImageDIB : FIBITMAP; CommentStr : STRING);
0503: VAR
0504: DIBTag : FITAG;
0505: CommentLen : LONGINT;
0506: CommentStrU : UTF8STRING;
0507: BEGIN
0508: DIBTag := NIL;
0509: CommentStrU := ANSITOUTF8 (CommentStr);
0510: CommentLen := LENGTH (CommentStrU) + 1;
0511: IF (CommentStr <> '') THEN
0512: TRY
0513: DIBTag := FreeImage_CreateTag;
0514: IF (DIBTag <> NIL) THEN
0515: BEGIN
0516: FreeImage_SetTagKey (DIBTag, PCHAR ('Comment'));
0517: FreeImage_SetTagLength (DIBTag, CommentLen);
0518: FreeImage_SetTagCount (DIBTag, CommentLen);
0519: FreeImage_SetTagType (DIBTag, FIDT_ASCII);
0520: FreeImage_SetTagValue (DIBTag, PCHAR (CommentStr));
0521: FreeImage_SetMetadata (FIMD_COMMENTS, ImageDIB, FreeImage_GetTagKey (DIBTag), DIBTag);
0522: END;
0523: FINALLY
0524: FreeImage_DeleteTag (DIBTag);
0525: END;
0526: END;
0527:
0528:
0529: INITIALIZATION
0530:
0531: TPicture.RegisterFileFormat ('jpg', 'JPEG Image', opmT_GenericBitmap);
0532: TPicture.RegisterFileFormat ('png', 'PNG Image', opmT_GenericBitmap);
0533: TPicture.RegisterFileFormat ('tif', 'TIFF Image', opmT_GenericBitmap);
0534: TPicture.RegisterFileFormat ('pcx', 'PCX Image', opmT_GenericBitmap);
0535: TPicture.RegisterFileFormat ('gif', 'GIF Image', opmT_GenericBitmap);
0536: TPicture.RegisterFileFormat ('psd', 'Photoshop Image', opmT_GenericBitmap);
0537: TPicture.RegisterFileFormat ('tga', 'Targa Image', opmT_GenericBitmap);
0538: TPicture.RegisterFileFormat ('xbm', 'X11 Bitmap', opmT_GenericBitmap);
0539: TPicture.RegisterFileFormat ('xpm', 'X11 Pixmap', opmT_GenericBitmap);
0540:
0541: opmG_ImgTMPPath := FNopm_GetImgTempPath;
0542:
0543:
0544: FINALIZATION
0545:
0546: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpLoad_Filename);
0547: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpImg_Filename);
0548: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpBMP_Filename);
0549: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpJPG_Filename);
0550: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpPNG_Filename);
0551: SysUtils.DELETEFILE (opmG_ImgTMPPath + opmC_TmpGIF_Filename);
0552:
0553:
0554:
0555: END.
