Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Image Resizing Program
Message
 
To
All
General information
Forum:
Visual FoxPro
Category:
West Wind Web Connection
Title:
Image Resizing Program
Miscellaneous
Thread ID:
00815253
Message ID:
00815253
Views:
56
Here's a little program that recurses through a folder hierarchy and resizes the images it finds. It optioanlly creates thumbnails and an index page for each folder.

Requires WWC

Relased into the public domain. Use at your own risk, YYMV, contents may be hot etc ...
* resizes all of the pictures in a source folder (recurses through the folder structure)
* based on the parameters here
** Andrew Coates
** 2003-07-31

#DEFINE CR CHR(13) + CHR(10)

** image types we can handle -- all other files are simply copied
#DEFINE IMAGES_HANDLED '|gif|jpg|jpeg|png|tif|tiff|bmp|'

** if images are smaller than this, don't resize -- just copy
#DEFINE MIN_SIZE_BYTES  50000

** make images at least this small 
#DEFINE MAX_WIDTH_PIXELS  640
#DEFINE MAX_HEIGHT_PIXELS  480

** JPEG compression level to use
#DEFINE COMPRESSION_LEVEL  5

** should we create thumbnails and a thumbnail index page too?
#DEFINE CREATE_THUMBS  .t.
#DEFINE THUMB_PREFIX  't_'
#DEFINE THUMB_MAX_WIDTH  100
#DEFINE THUMB_MAX_HEIGHT  100

** should we create an index page
#DEFINE CREATE_INDEX  .t.
#DEFINE INDEX_PAGE_NAME  'index.htm'

** save some settings
LOCAL lcSafety
lcSafety = SET("Safety")
SET SAFETY OFF

** set the procedure library
** You'll need to change the path or make sure the classes folder is in SET('PATH')
SET PROCEDURE TO d:\wc4\classes\wwAPI addi
SET PROCEDURE TO d:\wc4\classes\wwUtils addi
SET PROCEDURE TO d:\wc4\classes\wwResponseString addi
SET PROCEDURE TO d:\wc4\classes\wwHTTPHeader addi

* get the root folder of the tree to resize
LOCAL lcRootFolder
lcRootFolder = GETDIR([], 'Start where', 'Image Resizer')
IF EMPTY(lcRootFolder) OR ! DIRECTORY(lcRootFolder)
  ** restore settings
  SET SAFETY &lcSafety.
  RETURN .f.
ENDIF

* get the name of the destination folder
LOCAL lcDestFolder
lcDestFolder = GETDIR([], 'Put where', 'Image Resizer')
IF EMPTY(lcDestFolder)
  ** restore settings
  SET SAFETY &lcSafety.
  RETURN .f.
ENDIF

* call the (recursive) resizefolder method
ResizeFolder(lcRootFolder, lcDestFolder)

** restore settings
SET SAFETY &lcSafety.


PROCEDURE ResizeFolder(tcRootFolder, tcDestFolder)

LOCAL lnFiles, lnFile, laFiles[1], lcRootFolder, lcIndex, loResponse, loHTTPHeader, loHTMLHeader


* if the destination folder doesn't exist, create it
IF ! DIRECTORY(tcDestFolder)
  MD (tcDestFolder)
ENDIF

IF CREATE_INDEX
  loResponse = CREATEOBJECT('wwResponseString')
  loHTTPHeader = CREATEOBJECT('wwHTTPHeader', loResponse)
  loHTMLHeader = CREATEOBJECT('wwHTMLHeader', loResponse)

  loHTTPHeader.DefaultHeader()

  loHTMLHeader.AddTitle("Index of Pictures")
  loHTMLheader.cBodyTag = [<body bgcolor="#FFFFFF">]

  loResponse.Clear()
  loResponse.HTMLHeaderEx(loHTMLHeader,loHTTPHeader)

  loResponse.Write("<h1>Index of Pictures</h1>" + CR)
  loResponse.Write([<p><a href="..">Parent Folder</a></p>] + CR)

ENDIF

* load a list of the files
lnFiles = ADIR(laFiles, ADDBS(tcRootFolder) + '*.*', "D", 1)
* go through each file
FOR lnFile = 1 TO lnFiles

  DO CASE 

  * if this file's a folder, Call this method again to fix all the files in it
  CASE 'D' $ UPPER(laFiles(lnFile, 5))
    * first, if this is the '.' or the '..' entry, ignore it
    IF laFiles(lnFile, 1) == '.' OR laFiles(lnFile, 1) == '..'
      LOOP 
    ENDIF
    
    * add an entry to the index page so the user can navigate to the sub folder
    IF CREATE_INDEX
      loResponse.Write([<p><a href="] + ALLTRIM(laFiles(lnFile, 1)) + [/">] + ;
        ALLTRIM(laFiles(lnFile, 1)) + [</a></p>] + CR)
    ENDIF
    
    * work out the new folder names and call this method again
    ResizeFolder(ADDBS(tcRootFolder) + ALLTRIM(laFiles(lnFile, 1)), ;
      ADDBS(tcDestFolder) + ALLTRIM(laFiles(lnFile, 1)))

  * if this file's an image, resize it (and thumbnail it etc if required)
  CASE '|' + ALLTRIM(LOWER(JUSTEXT(laFiles(lnFile, 1)))) + '|' $ IMAGES_HANDLED
    * IF the file size is less than MIN_SIZE, just copy it
    IF laFiles(lnFIle, 2) <= MIN_SIZE_BYTES
      COPY FILE (ADDBS(tcRootFolder) + laFiles(lnFile,1)) TO (ADDBS(tcDestFolder) + laFiles(lnFile,1))
    
    * otherwise, resize it
    ELSE
      ResizeImage(ADDBS(tcRootFolder) + laFiles(lnFile,1), ADDBS(tcDestFolder) + laFiles(lnFile,1), ;
        MAX_WIDTH_PIXELS, MAX_HEIGHT_PIXELS, COMPRESSION_LEVEL)
    ENDIF
    
    * if we're thumbnailing too, do that
    IF CREATE_THUMBS
      CreateThumbnail(ADDBS(tcRootFolder) + laFiles(lnFile,1), ;
        ADDBS(tcDestFolder) + THUMB_PREFIX + laFiles(lnFile,1), ;
        THUMB_MAX_WIDTH, THUMB_MAX_HEIGHT)
    ENDIF
    
    
    * if we're creating an index, do that too
    IF CREATE_INDEX
      loResponse.Write([<p><a href="] + laFiles(lnFile,1) + [">])
      
      IF CREATE_THUMBS
        loResponse.write([<img src="] + THUMB_PREFIX + laFiles(lnFile,1) + [" alt="])
      ENDIF
      
      loResponse.write(laFiles(lnFile,1))
      
      IF CREATE_THUMBS
        loResponse.write([">])
      ENDIF
      
      loResponse.Write([</a></p>] + CR)
      
    ENDIF 

  * otherwise, just copy this file to the destination folder
  OTHERWISE
    COPY FILE (ADDBS(tcRootFolder) + laFiles(lnFile,1)) TO (ADDBS(tcDestFolder) + laFiles(lnFile,1))
  
  ENDCASE
  
ENDFOR

* write out the index if required
IF CREATE_INDEX
  loResponse.Write([<HR><p class="footer">Generated ] + TRANSFORM(DATETIME()) + ;
    [</p>] + CR)
        
  loResponse.HTMLFooter()
  
  STRTOFILE(loResponse.GetOutput(), ADDBS(tcDestFolder) + INDEX_PAGE_NAME)
ENDIF

ENDPROC

If we were to introduce Visual FoxBase+, would we be able to work from the dotNet Prompt?

From Top 22 Developer Responses to defects in Software
2. "It’s not a bug, it’s a feature."
1. "I thought I fixed that."

All my FoxTalk and other articles are available on my web site.

Unless specifically identified otherwise, anthing posted here is purely my opinion and may or may not reflect the policies or practices of Microsoft.
Reply
Map
View

Click here to load this message in the networking platform