中文字幕免费精品_亚洲视频自拍_亚洲综合国产激情另类一区_色综合咪咪久久

這篇文章主要為大家分享了通過vbs調用Photoshop批量生成縮略圖，需要的朋友可以參考下

模仿騰訊新聞頁，給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);

更多信息請查看IT技術專欄