麻豆小视频在线观看_中文黄色一级片_久久久成人精品_成片免费观看视频大全_午夜精品久久久久久久99热浪潮_成人一区二区三区四区

首頁(yè) > 編程 > VBScript > 正文

VBS調(diào)用Photoshop批量生成縮略圖的代碼

2020-07-26 11:47:26
字體:
來(lái)源:轉(zhuǎn)載
供稿:網(wǎng)友

模仿騰訊新聞頁(yè),給KingCms添加了新聞頁(yè)圖片點(diǎn)播的代碼,代碼要求的圖片點(diǎn)播格式如下:

0###http://www.website.org/UploadFile/123.jpg@@@/small/123.gif@@@8標(biāo)題一***http://www.website.org/UploadFile/456.jpg@@@/small/456.gif@@@標(biāo)題二***http://www.website.org/UploadFile/789.jpg@@@/small/789.gif@@@標(biāo)題三

格式解釋如下:

0代表第0頁(yè)出現(xiàn)圖片點(diǎn)播;

http://www.website.org/UploadFile/123.jpg是第一幅原圖地址。/small/123.gif是第一幅縮略圖地址,原圖和縮略圖名字一樣,后綴不一樣,原圖是jpg,縮略圖是gif。標(biāo)題一是第一幅圖片的說(shuō)明文字;

第二幅、第三幅圖片格式和第一幅圖一樣;

###、@@@、***為相應(yīng)的分隔符。

-------------------------------------------------分割線--------------------------------------------------------

開(kāi)始我是用手工來(lái)寫(xiě)這些圖片格式,發(fā)現(xiàn)效率很低,一下午只發(fā)布了兩篇新聞,就編寫(xiě)了相應(yīng)的VBS腳本。

腳本一:采集新聞圖片,并生成相應(yīng)的圖片格式代碼

Directory = "原始圖"
Directory = CreateObject("Scripting.FileSystemObject").GetFolder(".").Path & "/" & Directory & "/"

Call DeleteFiles(Directory)

strUrl = InputBox("請(qǐng)輸入網(wǎng)址:")
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("請(qǐng)輸入圖片配字:")
     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 "請(qǐng)復(fù)制結(jié)果:", , 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

腳本二:調(diào)用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縮略圖。關(guān)于VBS調(diào)用Photoshop,在Photoshop的C:/Program Files/Adobe/Adobe Photoshop CS4/Scripting/Documents目錄下是說(shuō)明文檔,C:/Program Files/Adobe/Adobe Photoshop CS4/Scripting/Sample Scripts目錄下是示例代碼。如果要生成png縮略圖,可以參考文檔修改腳本相應(yīng)的代碼即可:

Set pngOpt = CreateObject("Photoshop.PNGSaveOptions")
With pngOpt
      .Interlaced = False
End With

開(kāi)始打算是調(diào)用Set Jpeg = CreateObject("Persits.Jpeg")來(lái)生成縮略圖,好處是不用加載龐大的Photoshop,生成縮略圖速度很快,但比起Photoshop圖片質(zhì)量差了一些,就放棄了。

本來(lái)的打算是不保存原圖,直接打開(kāi)網(wǎng)路圖片,然后直接生成縮略圖到本地。雖然Photoshop可以打開(kāi)網(wǎng)絡(luò)圖片,但在腳本里調(diào)用Photoshop打開(kāi)網(wǎng)絡(luò)圖片就不行,只好先保存網(wǎng)絡(luò)圖片到本地,然后再生成縮略圖。

其實(shí)Photoshop自帶了圖片批處理功能:

窗口->動(dòng)作->創(chuàng)建新動(dòng)作->在PS中打開(kāi)所有你想做的圖片->選擇其中一張圖片,調(diào)整大小,另存為gif格式->關(guān)閉你已做好的圖片->停止播放/記錄。
文件->自動(dòng)->批處理->“動(dòng)作”欄中選你剛剛新創(chuàng)建的動(dòng)作名稱->點(diǎn)“源”下面的“選擇”選擇你想要處理照片的文件夾->“目標(biāo)”下面“選擇”另外一個(gè)你想保存縮略圖的文件夾->確定。就OK了!

但比起程序來(lái),顯然程序要靈活的多,而且很多批處理效果只能靠程序?qū)崿F(xiàn),所以沒(méi)有通過(guò)錄制動(dòng)作來(lái)生成縮略圖。

生成相應(yīng)的圖片格式代碼,也可以在地址欄輸入以下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("復(fù)制",C);void(0);

發(fā)表評(píng)論 共有條評(píng)論
用戶名: 密碼:
驗(yàn)證碼: 匿名發(fā)表
主站蜘蛛池模板: 黄色试看视频 | 国产日韩精品欧美一区视频 | av电影免费在线看 | 精品久久久久久久久亚洲 | 亚洲成人精品视频 | 日韩欧美电影在线观看 | 国产精品性夜天天视频 | 黄色免费在线网站 | 日本视频免费看 | 高清av在线| 福利在线国产 | 亚洲影视中文字幕 | 视频一区 中文字幕 | 黄色一级毛片免费看 | 亚洲嫩草av | av电影在线观看网站 | 黄色成人小视频 | 久久艹艹艹 | 国产精品久久久免费看 | 久久久久国产一区二区三区不卡 | 欧美成人一区二区三区 | 久久超| 国产一区二区成人在线 | 一区二区视 | 蜜桃网在线观看 | 免费观看黄色一级视频 | 久久久久国产一区二区三区不卡 | 福利在线小视频 | 一级空姐毛片 | 久久精品一区二区三区四区五区 | 国产亚洲精品影达达兔 | 小雪奶水翁胀公吸小说最新章节 | 中文日韩在线视频 | 一级黄色欧美 | 国产精品99久久久久久大便 | 中文字幕在线视频日本 | 国产一区二区在线观看视频 | 在线播放亚洲 | 欧美日韩成人一区二区 | 日韩视频一区二区三区四区 | 国产精品剧情一区二区在线观看 |