Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Need an Image Class Tested
Message
 
 
To
All
General information
Forum:
Visual FoxPro
Category:
Classes - VCX
Title:
Need an Image Class Tested
Miscellaneous
Thread ID:
00673497
Message ID:
00673497
Views:
62
Thanks to Andrew R for pointing me in the right direction on the MS FoxPro NG.

I have created a class to resize all JPG files in a specified folder that I would like to have others test. The class works, however the Image Control is inconsistent on the resulting size of the file. I am resizing JPG images that are of identical size and resolution. When I resize them to a thumbnail size, the resulting h/w varies which is most annoying.

I would appreciate feedback if this works for you, and if you also see the size variations that I do. If you know why the results vary and how to correct this problem, I would appreciate that as well. This class will prompt you for a location of JPG files. It will then create a THUMBNAILS sub-folder and COPY your JPG files to that sub-folder. The class will then resize the copies in the THUMBNAILS sub-folder.

Please make sure you have different JPG files that are of the same size, resolution and orientation for testing.

There is starter code at the beginning of the PRG, so all you have to do is copy the code below into a TN_CLASS.PRG file and type:

DO TN_CLASS

from the Command window.

Feel free to use this class. I am releasing this as a public domain class. As-is, no warranties, use at your own risk, etc.

This requires at least VFP 6 because I use an Assign method. It may even require VFP 7 because this is what I use. Otherwise, you will need to modify the class to work with prior versions.

TIA! Here's the class code:
*-- JPG File Resizer Class --*
*--
*--   Author:  Mark E. McCasland
*--            M & J Software
*--            mmccasla@airmail.net
*--            http://www.mctweedle.com
*--
*--   THIS VFP CLASS IS SUBMITTED AS PUBLIC DOMAIN BY THE AUTHOR.
*--   THIS CODE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
*--   EITHER EXPRESSED OR IMPLIED. IN NO EVENT WILL THE AUTHOR BE
*--   LIABLE TO THE DEVELOPER/USER FOR ANY DAMAGES, INCLUDING ANY
*--   LOST PROFITS, LOST SAVINGS OR OTHER INCIDENTAL OR CONSEQUENTIAL
*--   DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS PRODUCT.
*--   
*--   NOTE: This code is not a product of, or supported by, Microsoft.
*--   Please e-mail questions and comments to the Author
*--
LOCAL lcPath, loShrinker
lcPath = GETDIR()
IF EMPTY(lcPath)
   RETURN
ENDIF
loShrinker = NEWOBJECT('Reducer', 'tn_class.prg')
WITH loShrinker
   .lThumbnails = .t.
   .cSourcePath = lcPath
   .cTargetPath = ADDBS(lcPath) + [Thumbnails]
   .Shrink()
ENDWITH
loShrinker.Release()
RETURN


DEFINE CLASS Reducer AS FORM

   AUTOCENTER = .T.
   CAPTION = [Image Reducer]
   DATASESSION = 2
   HEIGHT = 340
   WIDTH = 440

   cSourcePath = []
   cTargetPath = []
   lThumbnails = .F.  && Set to .T. if you want to create Thumbnails

   PROTECTED cFileName
   PROTECTED lPortrait
   PROTECTED lInvalidFile
   PROTECTED nImageWidth
   PROTECTED nImageHeight
   cFileName = []     && Current Image File being reduced
   nImageWidth = 0    && Original Image width in pixels
   nImageHeight = 0   && Original Image height in pixels

   nThumbnailPortraitWidth = 54
       && What to reduce the image to if
       && lThumbnails = .T. and lPortrait = .T.

   nThumbnailLandscapeWidth = 72
       && What to reduce the image to if
       && lThumbnails = .T. and lPortrait = .F.

   nReducedPortraitWidth = 300
       && What to reduce the image to if
       && lThumbnails = .F. and lPortrait = .T.

   nReducedLandscapeWidth = 400
       && What to reduce the image to if
       && lThumbnails = .F. and lPortrait = .F.

   DIMENSION aFiles[1] PROTECTED

   DIMENSION aBadFiles[1]
   lBadFiles = .F.

   ADD OBJECT oleImageControl AS OLECONTROL WITH ;
      OLECLASS = 'Imaging.EditCtrl.1', ;
      TOP = 20, ;
      LEFT = 20, ;
      HEIGHT = 300, ;
      WIDTH = 400, ;
      VISIBLE = .T.

   PROTECTED PROCEDURE INIT
      SET TALK OFF
      SET SAFETY OFF
      THIS.aBadFiles = []
   ENDPROC
   PROCEDURE Shrink
      IF EMPTY(THIS.cSourcePath) OR EMPTY(THIS.cTargetPath)
         RETURN .F.
      ENDIF
      LOCAL lnI
      WITH THIS
         IF NOT DIRECTORY(.cTargetPath)
            MD (.cTargetPath)
         ELSE
            ERASE ADDBS(.cTargetPath) + [*.*] RECYCLE
         ENDIF
         COPY FILE ADDBS(.cSourcePath) + [*.jpg] ;
            TO ADDBS(.cTargetPath) + [*.jpg]
         lnRetVal = ADIR(.aFiles, ADDBS(.cTargetPath) + [*.jpg])
         ASORT(.aFiles)
         IF lnRetVal = 0
            RETURN .F.
         ENDIF
         FOR lnI = 1 TO lnRetVal
            WAIT WINDOW NOWAIT [File: ] + .aFiles[lnI, 1]
            .cFileName = ADDBS(THIS.cTargetPath) + .aFiles[lnI, 1]
            IF .lInvalidFile
               LOOP
            ENDIF
            .ReduceImage()
         ENDFOR
         WAIT CLEAR
      ENDWITH
   ENDPROC
   PROTECTED PROCEDURE ReduceImage
      WITH THIS.oleImageControl
         .DISPLAY()
         IF THIS.lThumbnails
            IF THIS.lPortrait
               .WIDTH = THIS.nThumbnailPortraitWidth + 2
            ELSE
               .WIDTH = THIS.nThumbnailLandscapeWidth + 2
            ENDIF
         ELSE
            IF THIS.lPortrait
               .WIDTH = THIS.nReducedPortraitWidth + 2
            ELSE
               .WIDTH = THIS.nReducedLandscapeWidth + 2
            ENDIF
         ENDIF
*!*      .Height = INT((.Width * .ImageHeight)/.ImageWidth)
         .FitTo(1, .T.)    && 1 - Fit to width

*!*      .Width  = .ImageScaleWidth + 2
             && width needed to eliminate scrollbar

*!*      .Height = .ImageScaleHeight + 2
             && height needed to eliminate scrollbar

         .SAVE(.T.)
         .IMAGE = []
         .HEIGHT = 300
         .WIDTH = 400
      ENDWITH
   ENDPROC
   PROTECTED PROCEDURE GetOrientation
      WITH THIS
         .oleImageControl.IMAGE = .cFileName
         .lPortrait = .F.
         .nImageHeight = .oleImageControl.ImageHeight
         .nImageWidth  = .oleImageControl.ImageWidth
         IF .nImageHeight > .nImageWidth
            .lPortrait = .T.
         ENDIF
      ENDWITH
   ENDPROC
   PROTECTED PROCEDURE LogBadFile
      LPARAMETERS tcFile
      IF NOT EMPTY(THIS.aBadFiles[1])
         DIMENSION THIS.aBadFiles(ALEN(THIS.aBadFiles,1) + 1)
      ENDIF
      THIS.aBadFiles(ALEN(THIS.aBadFiles,1)) = tcFile
   ENDPROC

   *!* Assign Methods

   PROTECTED PROCEDURE cFileName_Assign
      LPARAMETERS tcFile
      IF NOT FILE(tcFile)
         THIS.lBadFiles = .T.
         THIS.lInvalidFile = .T.
         THIS.LogBadFile(tcFile)
         RETURN .F.
      ENDIF
      THIS.lInvalidFile = .F.
      THIS.cFileName = tcFile
      THIS.GetOrientation()
   ENDPROC
ENDDEFINE
Mark McCasland
Midlothian, TX USA
Next
Reply
Map
View

Click here to load this message in the networking platform