ASPPainter::Copy Resize Merge::Files.vbs
On Error Resume Next
Sub ResizeImg(Imagetype,readingpath,outputpath)
tw = 50
th = tw
Set im = CreateObject("ASPPainter.Pictures.1")
im.SetFormat Imagetype
' im.SetImageIndex 0
' msgbox readingpath & " " & outputpath
im.LoadFile readingpath
h = 10
w = 10
' msgbox "AFTER"
h = im.Height
w = im.Width
if h < w then
maxsize = w
else
maxsize = h
end if
ratio = tw/maxsize
nw = Cint(w*ratio)
nh = Cint(h*ratio)
im.SetImageIndex 1
im.Create tw,th
'im.DestroyImage
im.ResizeCopy 1,0,0,0,0,0,nw,nh,w,h
im.SaveToFile outputpath
if err <> 0 then
msgbox "LOAD" & err.Description & " " & outputfile
err.Clear
end if
'msgbox outputpath
im.DestroyAll
' im.DestroyImage
Set im = Nothing
End Sub
'Response.Write Now()
dim thefilex
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\foto")
Set colFiles = objFolder.Files
j = 0
For Each objFile in colFiles
j = j + 1
thefilex = objFile.name
inputfile = "C:\foto\" + thefilex
outputfile = "C:\foto\thumbnail\" + thefilex
'response.write thefilex & " " & inputfile & " " & outputfile & "
"
'response.end
ResizeImg 3, inputfile, outputfile
if err <> 0 then
' msgbox err.Description & " " & outputfile
err.Clear
end if
next
More samples:
Cat,
Copy, Copy_with_transparent,
Files,
Photo, Merge,
Merge cat, Resize,
Resize photo
See also:
SetFormat,
LoadFile, Width,
Height, Copy,
SetImageIndex, GetPixelAlpha,
GetPixelBlue,
GetPixelGreen, GetPixelRed,
SetColor,
SetColorAsTransparent,
SaveToFile, DestroyALL