Image Resizing Tool

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Image Resizing Tool

Logged in as: Guest

arrSession:exec spGetSession 2,16,32218

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Image Resizing Tool
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Image Resizing Tool - 3/13/2006 2:26:16 AM

rOOs

Posts: 63
Score: 0
Joined: 2/28/2006
From: Switzerland
Status: offline

I created a Tool that can take all files in Source and resize it to a given maximum width and/or height and save them to a output directory...
It will show a status bar when it progresses the files...

if you doubleclick on the folderinputs you can select a folder with your mouse... ;-)

To run it, you need the wiaaut.dll in the same directory, or registered in winsysdir
Get it here: http://www.ilixis.com/developer/wia.html

Its not much commented, because its not heavyweight code ;-) and i didn't have time to. And the Messages are in German, but it's not a problem to change them...

Try it, and if you like it, maybe i make a better documented Version of it...

<html>
<head>
<title id="title">ImageResizer</title>
<HTA:APPLICATION 
    ID="Liste"
    APPLICATIONNAME="ImageResizer"
    SCROLL="yes"
    SINGLEINSTANCE="yes"
    caption="yes"
    BORDER="thin"
    BORDERSTYLE="normal"
    MAXIMIZEBUTTON="yes"
    MINIMIZEBUTTON="yes"
    SYSMENU="no"
    WINDOWSTATE="normal"
    CONTEXTMENU="NO"
    SELECTION="NO"
    navigable="yes"
    />
<SCRIPT Language="VBScript">
' -------------------------------------------------------------------------------
' ::: ImageResizer :::
' -------------------------------------------------------------------------------
' CHANGE-LOG:
' 27.09.05 JOS 1.0 Erste Version
' 27.09.05 JOS 2.0 Fix Installation Procedure
' 05.10.05 JOS 3.0 Final Version
' 13.03.06 JOS 4.0 Ordner per Click auslesen
strVer = "4.0"
' -------------------------------------------------------------------------------
' (c) Reto Jossi ([email=info@stageweb.net]info@stageweb.net[/email])
' -------------------------------------------------------------------------------
' Variable f�r Fehlerhandling
Dim strCount, objExplorer
strExit = 0
Sub Window_Onload
 document.title = document.title & " | Version: "&strVer
 window.resizeTo 500,600
End Sub
Sub Doit
' Test ob wiaaut.dll installiert
 On Error Resume Next
 Set Img = CreateObject("WIA.ImageFile")
   If Err.Number <> 0 Then
     Installieren
     If strExit <> 0 Then
       Exit Sub
     End If
   End If
 On Error GoTo 0
 Set Img = Nothing
 strSRC = document.getElementById("SRC").Value
 If right(strSRC, 1) <> "\" Then
   strSRC = strSRC & "\"
 End If
 strDST = document.getElementById("DST").Value
 If right(strDST, 1) <> "\" Then
   strDST = strDST & "\"
 End If
 Call StatusBar("Start")
 strBREITE = document.getElementById("BREITE").Value
 strHOEHE = document.getElementById("HOEHE").Value
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set folderSRC = objFSO.GetFolder(strSRC)
 Set folderDST = objFSO.GetFolder(strDST)
 For each file in folderDST.Files
   objFSO.DeleteFile(file)
 Next
 For each file in folderSRC.Files
  If lcase(right(file.Name, 3)) = "jpg" Then
   Set Img = CreateObject("WIA.ImageFile")
   Set IP = CreateObject("WIA.ImageProcess")
     Img.LoadFile file
       IP.Filters.Add IP.FilterInfos("Scale").FilterID
       IP.Filters(1).Properties("MaximumWidth") = strBREITE
       IP.Filters(1).Properties("MaximumHeight") = strHOEHE
   Set Img = IP.Apply(Img)
     Img.SaveFile strDST & file.Name
   Set Img = Nothing
   Set IP = Nothing
  End If
 Call StatusBar("Inc")
 Next
 Call StatusBar("Stop")
End Sub
Sub OrdnerAuslesenSRC()
 On Error Resume Next
 Set objSA = CreateObject("Shell.Application")
 Set oFolder = objSA.BrowseForFolder(0, "Quell-Ordner ausw�hlen:", 0, document.all.item("SRC").Value)          
 If oFolder.Items.Item <> "" Then
   Set oFolderItem = oFolder.Items.Item   
   document.all.item("SRC").innerText = oFolderItem.Path
 End If
 On Error GoTo 0
End Sub
Sub OrdnerAuslesenDST()
 On Error Resume Next
 Set objSA = CreateObject("Shell.Application")
 Set oFolder = objSA.BrowseForFolder(0, "Ziel-Ordner ausw�hlen:", 0, document.all.item("DST").Value)          
 If oFolder.Items.Item <> "" Then
   Set oFolderItem = oFolder.Items.Item   
   document.all.item("DST").innerText = oFolderItem.Path
 End If
 On Error GoTo 0
End Sub
Function StatusBar(actstat)
If actstat = "Start" Then
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set folderSRC = objFSO.GetFolder(document.getElementById("SRC").Value)
     strCount = 0
     For each file in folderSRC.Files
       strCount = strCount + 1
     Next

document.getElementById("StatusArea").innerHTML = "..."
 'Explorer Open! yeahh! 
 strHTML = "<html><body><p><object classid='clsid:35053A22-8589-11D1-B16A-00C0F0283628' id='ProgressBar1' height='20' width='800'><param name='Min' value='0'><param name='Max' value='"&strCount&"'><param name='Orientation' value='0'><param name='Scrolling' value='1'></object></p></body></html>"
 Set objExplorer = CreateObject("InternetExplorer.Application")
 objExplorer.Navigate "about:blank"
 objExplorer.Document.title = "Bitte warten . . ."   
 objExplorer.Document.body.bgcolor = "buttonface"
 objExplorer.Document.body.Innerhtml = strHTML
 objExplorer.ToolBar = 0
 objExplorer.StatusBar = 0
 objExplorer.Width = 850
 objExplorer.Height = 90 
 objExplorer.Left = 50
 objExplorer.Top = 50
 objExplorer.Visible = 1             
 
 Do While (objExplorer.Busy)
     Wscript.Sleep 200
 Loop

Elseif actstat = "Inc" Then
 objExplorer.Document.Body.All.ProgressBar1.Value = objExplorer.Document.Body.All.ProgressBar1.Value  + 1
   
   Elseif actstat = "Stop" Then 
       objExplorer.Quit
 StatusArea.innerhtml = "<b>Fertig</b>"
   End If
End Function
Sub Installieren
 Set WshShell = CreateObject("WScript.Shell")
 Set fso = CreateObject ("Scripting.FileSystemObject")
 If (fso.FileExists("wiaaut.dll")) Then
   strCMD = "copy wiaaut.dll C:\windows\system32\wiaaut.dll"
   Return = WshShell.Run("cmd /c" & strCMD,,True)
   strCMD = "regsvr32 C:\windows\system32\wiaaut.dll -s"
   Return = WshShell.Run("cmd /c" & strCMD,,True)
 Else
   MsgBox "wiaaut.dll nicht gefunden"
   strExit = 1
 End If
End Sub
</SCRIPT>
<style>
body,td,a {font-family:Arial;font-size:12px;text-decoration:none;color:black;}
body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#FFFFFF', EndColorStr='#9999FF')}
fieldset, legend {padding: 10px;}
</style>
</head>
<body topmargin="0">
<center>
<table width="400">
 <tr>
   <td><fieldset><legend>Quellverzeichnis</legend><center><input name='SRC' size=40 value='' onDblClick=OrdnerAuslesenSRC()></center></fieldset></td>
 </tr>
 <tr>
   <td><fieldset><legend>Zielverzeichnis</legend><center><input name='DST' size=40 value='' onDblClick=OrdnerAuslesenDST()></center></fieldset></td>
 </tr>  
 <tr>
   <td><fieldset><legend>Optionen</legend><center>
       <table>
         <tr>
           <td>maximale Breite:</td>
           <td><input name='BREITE' size=4 value='800'> pixel</td>
         </tr>
         <tr>
           <td>maximale H�he:</td>
           <td><input name='HOEHE' size=4 value='600'> pixel</td>
         </tr>
       </table>
   </center></fieldset></td>
 </tr>  
 <tr>
   <td><fieldset><legend>Status</legend><span id="StatusArea"><b>ACHTUNG: Dateien im Zielverzeichnis werden vorher gel�scht.</b></span></fieldset></td>
 </tr>
 <tr>
   <td><fieldset><legend>Steuerung</legend><center>
     <table>
        <tr>
         <td><input type='button' name='OKButton' value=' Starten . . . ' onclick="Doit()"></td>
         <td><input type='button' name='CloseButton' value=' Schliessen ' onclick="Close()"></td>
       </tr>
     </table>
   </fieldset></td>
 </tr>  
</center>    
</body>
</html>

Post #: 1

RE: Image Resizing Tool - 3/19/2006 5:18:10 PM

rOOs

Posts: 63
Score: 0
Joined: 2/28/2006
From: Switzerland
Status: offline

is no one really testing this out?

(in reply to rOOs)

Post #: 2

RE: Image Resizing Tool - 3/20/2006 12:20:33 AM

mbouchard

Posts: 1856
Score: 14
Joined: 5/15/2003
From: USA
Status: offline

Very nice, sorry I missed this the first time around.. Just gave it a test drive and worked well. About the only thing I can see an issue with is what will happen to a picture that is not 1024x786 (only using this number as a reference)? If you resize all pictures to 800x600 the file will look off.. Maybe have an additional option for pictures that do not start at 1024x786?

So, if the picture starts out at 1024x768 option 1 is used to change it to 800x600. But if the picture starts out at 768x1024 then it is changed to 600x800 or whatever the size would be...

Also, a browse button might be good to get the source and destination folders.

Also, if you won't mind, since it appears that your English is much much better than my German, which is non-existant, could you check the translations below to make sure they are close? Thanks..

ACHTUNG: Dateien im Zielverzeichnis werden vorher gel�scht.
NOTE: Files in the goal listing are deleted before.

Steuerung
Control

Starten
Start

Schliessen
Latches (I take it that this should be close??)

Quellverzeichnis
Source listing

Zielverzeichnis
Goal listing

nicht gefunden
Not Found

Bitte warten
Please Wait

Ziel-Ordner ausw�hlen
Goal files select

Quell-Ordner ausw�hlen:
Source files select:

maximale H�he:
maximum height:

maximale Breite:
maximum width:

Fertig
Finished

_____________________________

Mike

For useful Scripting links see the Read Me First stickey!

Always remember Search is your friend.

(in reply to rOOs)

Post #: 3

RE: Image Resizing Tool - 3/27/2006 4:28:46 PM

rOOs

Posts: 63
Score: 0
Joined: 2/28/2006
From: Switzerland
Status: offline

There is a Browse Function, just double click on the input fields...

The Rest i will Check/Correct...

Thanks for your reply.

(in reply to mbouchard)

Post #: 4

RE: Image Resizing Tool - 3/28/2006 12:07:45 AM

mbouchard

Posts: 1856
Score: 14
Joined: 5/15/2003
From: USA
Status: offline

quote:

ORIGINAL: rOOs

There is a Browse Function, just double click on the input fields...

Ahh, very nice. I did not see that.

_____________________________

Mike

For useful Scripting links see the Read Me First stickey!

Always remember Search is your friend.

(in reply to rOOs)

Post #: 5

RE: Image Resizing Tool - 10/12/2006 7:28:37 PM

est

Posts: 39
Score: 0
Joined: 10/12/2006
Status: offline

kool!

I didn't notice the Germany that you will delete the source folder and my test script is deleted, lol

In Windows Vista, HTA is not 'trusted' at all. If you open IE7 and the .hta above, IE7 will prompt "Use ActiveX Object?"

(in reply to rOOs)

Post #: 6

RE: Image Resizing Tool - 10/13/2006 12:11:46 AM

DiGiTAL.SkReAM

Posts: 1152
Score: 7
Joined: 9/6/2005
From: Florida, USA
Status: online

It is known that IE7 breaks several things with .HTA files... fonts are displayed differently, etc.

_____________________________

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

(in reply to est)