*-- 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