Source code of file oscpmwin/imageman.pas from the
osCommerce Product Manager for Windows.


0000:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001:   osCommerce Product Manager for Windows (oscpmwin).
0002:   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.
 
 
NA fum/lmd: 2007.07.15
Copyright ©1994-2018 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link