VBS调用Photoshop批量生成缩略图的代码，vbsphotoshop
VBS调用Photoshop批量生成缩略图的代码，vbsphotoshop
模仿腾讯新闻页，给KingCms添加了新闻页图片点播的代码，代码要求的图片点播格式如下：
0###http://www.website.org/UploadFile/123.jpg@@@/small/123.gif@@@8标题一***http://www.website.org/UploadFile/456.jpg@@@/small/456.gif@@@标题二***http://www.website.org/UploadFile/789.jpg@@@/small/789.gif@@@标题三
格式解释如下：
0代表第0页出现图片点播；
http://www.website.org/UploadFile/123.jpg是第一幅原图地址。/small/123.gif是第一幅缩略图地址，原图和缩略图名字一样，后缀不一样，原图是jpg，缩略图是gif。标题一是第一幅图片的说明文字；
第二幅、第三幅图片格式和第一幅图一样；
###、@@@、***为相应的分隔符。
-------------------------------------------------分割线--------------------------------------------------------
开始我是用手工来写这些图片格式，发现效率很低，一下午只发布了两篇新闻，就编写了相应的VBS脚本。
脚本一：采集新闻图片，并生成相应的图片格式代码
Directory = "原始图"
Directory = CreateObject("Scripting.FileSystemObject").GetFolder(".").Path & "\" & Directory & "\"
Call DeleteFiles(Directory)
strUrl = InputBox("请输入网址：")
If strUrl <> "" Then
Call getImages(strUrl)
End If
Function getImages(strUrl)
Set ie = WScript.CreateObject("InternetExplorer.Application")
ie.visible = True
ie.navigate strUrl
Do
Wscript.Sleep 500
Loop Until ie.ReadyState=4
Set objImgs = ie.document.getElementById("fontzoom").getElementsByTagName("img")
strTitles = InputBox("请输入图片配字：")
arrTitles = Split(strTitles, " ")
strCode = "0###"
For i=0 To objImgs.length - 1
If i>0 Then strCode = strCode + "***"
smallPic = Replace(Mid(objImgs(i).src, InStrRev(objImgs(i).src, "/")+1), "jpg", "gif")
strCode = strCode + objImgs(i).src + "@@@/small/" + smallPic + "@@@" + arrTitles(i)
SaveRemoteFile objImgs(i).src
Next
ie.Quit
InputBox "请复制结果：", , strCode
End Function
Sub SaveRemoteFile(RemoteFileUrl)
LocalFile = Directory & Mid(RemoteFileUrl, InStrRev(RemoteFileUrl, "/")+1)
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
With xmlhttp
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set xmlhttp = Nothing
Set Ads = CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile LocalFile, 2
.Cancel()
.Close()
End With
Set Ads=nothing
End Sub
Function DeleteFiles(strFolder)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set objFiles = objFolder.Files
For Each objFile in objFiles
objFile.Delete
Next
Set objFSO = Nothing
End Function
脚本二：调用Photoshop批量生成缩略图
Directory = "原始图" '原始图像的文件夹
NewDirectory = "缩略图" '保存缩小图的文件夹
Const psDoNotSaveChanges = 2
Const PsExtensionType_psLowercase = 2
Const psDisplayNoDialogs = 3
Const psLocalSelective = 7
Const psBlackWhite = 2
Const psNoDither = 1
limitHeight = 58 '最大高度
ImgResolution = 72 '解析度
Call DeleteFiles(NewDirectory)
Call Convert2Gif(Directory)
Function ReSizeImg(doc)
rsHeight = doc.height
Scale = 1.0
if rsHeight > limitHeight Then
Scale = limitHeight / (doc.height + 0.0)
rsWidth = doc.width * Scale
rsHeight = doc.height * Scale
End If
doc.resizeImage rsWidth, rsHeight, ImgResolution, 3
End Function
Function Convert2Gif(Directory)
Set app = CreateObject( "Photoshop.Application" )
app.bringToFront()
app.preferences.rulerUnits = 1 'psPixels
app.DisplayDialogs = psDisplayNoDialogs
Set gifOpt = CreateObject("Photoshop.GIFSaveOptions")
With gifOpt
.Palette = psLocalSelective
.Colors = 256
.Forced = psBlackWhite
.Transparency = False
.Dither = psNoDither
.Interlaced = False
End With
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(Directory) Then
MsgBox "Photo Directory NOT Exists."
Exit Function
End If
Set objFiles = fso.GetFolder(Directory).Files
NewDirectory = fso.GetFolder(".").Path & "\" & NewDirectory & "\"
For Each objFile In objFiles
If Split(objFile.Name, ".")(1) <> "db" Then
Set doc = app.Open(objFile.Path)
Set app.ActiveDocument = doc
ReSizeImg(doc)
doc.SaveAs NewDirectory & Split(objFile.Name, ".")(0) & ".gif", gifOpt, True, PsExtensionType_psLowercase
Call doc.Close(psDoNotSaveChanges)
Set doc = Nothing
End If
Next
Set app = Nothing
End Function
Function DeleteFiles(strFolder)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set objFiles = objFolder.Files
For Each objFile in objFiles
objFile.Delete
Next
Set objFSO = Nothing
End Function
比较了一下，gif缩略图体积最小，所以就gif缩略图。关于VBS调用Photoshop，在Photoshop的C:\Program Files\Adobe\Adobe Photoshop CS4\Scripting\Documents目录下是说明文档，C:\Program Files\Adobe\Adobe Photoshop CS4\Scripting\Sample Scripts目录下是示例代码。如果要生成png缩略图，可以参考文档修改脚本相应的代码即可：
Set pngOpt = CreateObject("Photoshop.PNGSaveOptions")
With pngOpt
.Interlaced = False
End With
开始打算是调用Set Jpeg = CreateObject("Persits.Jpeg")来生成缩略图，好处是不用加载庞大的Photoshop，生成缩略图速度很快，但比起Photoshop图片质量差了一些，就放弃了。
本来的打算是不保存原图，直接打开网路图片，然后直接生成缩略图到本地。虽然Photoshop可以打开网络图片，但在脚本里调用Photoshop打开网络图片就不行，只好先保存网络图片到本地，然后再生成缩略图。
其实Photoshop自带了图片批处理功能：
窗口->动作->创建新动作->在PS中打开所有你想做的图片->选择其中一张图片，调整大小，另存为gif格式->关闭你已做好的图片->停止播放/记录。
文件->自动->批处理->“动作”栏中选你刚刚新创建的动作名称->点“源”下面的“选择”选择你想要处理照片的文件夹->“目标”下面“选择”另外一个你想保存缩略图的文件夹->确定。就OK了！
但比起程序来，显然程序要灵活的多，而且很多批处理效果只能靠程序实现，所以没有通过录制动作来生成缩略图。
生成相应的图片格式代码，也可以在地址栏输入以下JS代码：
javascript:D=prompt("图片配字","");E=D.split(" ");A=document.getElementById("fontzoom");B=A.getElementsByTagName("img");C="0###";for(i=0;i<B.length;i++){if(i>0) C+="***";C=C+B[i].src+"@@@/small/"+B[i].src.substring(B[i].src.lastIndexOf("/")+1).replace("jpg","gif")+"@@@"+E[i];}window.prompt("复制",C);void(0);
直接拉进去
有人问怎么将图片变成 1寸8张的动作。这里详细解释下，希望其它朋友也能吸收点经验，以后在动作上不至于犯愁！ 大家常见到 一张5寸照片上8张一寸的相片组。这样的相片组如何从任意图片转化过来呢？ 首先理解下： 1寸照片的尺寸 2.5*3.5cm 413*295px 300ppi ，如果想做8张1寸的组合照片，沿用横4竖2的理论，就需要有一张最小尺寸 1180*826px 的背景图，这里再把出血的边框考虑进去加上3mm就需要一张尺寸为 1204*838的背景图。 好了理论讲完，下面说过程： 1.点击动作面板，新建动作，录制动作。
2.后面都是如何制作的过程了，录制动作有一点需要注意“一定尽可能简化思路”，你在录制之前，尽可能把步骤简化到最少。 随便导入一张图片 ， 尺寸最好是大于1寸照片的尺寸，避免小片放大造成失真。
下面是将任意图片变成标准300ppi一寸照的方法，大家牢记！ 先取消约束比例，一定注意这步。然后按照 2、3、4 去做，照片的像素值就自动变成413*295px了。
这是我们得到的修改后的图片
然后我们要做的是放大图像尺寸，这步反应到前面说的“1204*838的背景图”了。双击背景层解锁，再新建一层，将新的透明图层放到图层组的最下方，然后修改“画布大小”至1204*838。
放到图层到能看到标尺的显示级别至 1mm,不是px ！,(大约700%或更高，小心眼睛很花的)，拉制参考线，共16根尺寸如图。
最复杂的一步做完之后，就是复制图层了，点击相片那层 CTRL+J 7次，8张1寸照OK ！ 然后利用参考线的吸附功能，移动你的每层照片至合适位置，注意不要超出参考线。移动最后一张照片时候，给自己留点空间。
现在1张5寸300ppi的图片大功告成，一定记得先停止你的动作！ 然后再打开其它的图片来试验下，测试动作的完整性。
有步裁片的方法没做上来，因为来源片不同，有的时候加上裁片可能整个动作连下来会造成错误。所以先做下剪裁工作！ 方法附上：先按比例伸缩片子宽度至295，使片子的高度保持在413之上，然后将剪裁工具设为295*413 & 300ppi的值，再用剪裁工具裁一下。然后再用动作播放，保证出片100%成功率~！ 出血设置那里，可以视实际情况定下，有细心的朋友可以到网上搜索下寸片的尺寸，一定会看到5寸片的尺寸是基于一个低值扩大的，这就是给出血留的位置，如果感觉后期裁片时候出血留的小，可以适当放大出血的尺寸。 今后遇到1寸变8张这种问题，轻点一下播放OK。www.23ps.com/photoshop/cjjc/
评论关闭