用VBScript编程控制Photoshop自动处理批量图片

' VBScript source code
'==========================================================================
' NAME             : 用VBScript编程控制Photoshop自动处理批量图片
'                          (VBScript Control Photoshop for auto resize photos...)
' AUTHOR       : 淡月清风 QQ:259177377 E-Mail:dgx_lsyd3@163.com
' DATE             : 2009年5月14日23:51:22
' COMMENT   :  遍历指定目录下的所有图片(包括子目录),对图片的大小进行调整,并存储。
'                           当然，用Photoshop录制动作，再执行批处理也可以勉强实现。
' VERSION     :  1.0
'==========================================================================
 
'//设置Photoshop的单位是像素
Const DEF_psPixels = 1
'//要处理的目录  
Const DEF_Directory = "C:\Documents and Settings\Administrator\桌面\照片"
 
Set fso=CreateObject("Scripting.FileSystemObject")
Set objPhotoshopApp=CreateObject("Photoshop.Application")
Call InitPhotoshop(objPhotoshopApp)     '//初始化PS
Call TraversingFolder(DEF_Directory)    '//处理制定目录下的所有图片
Call ExitPhotoshop(objPhotoshopApp)     '//退出PS
 
'------------------------------------------------------
'//遍历所有文件夹
Sub TraversingFolder(FolderPath)
 
 If fso.FolderExists(FolderPath) Then
    Set ofolder=fso.GetFolder(FolderPath)
   
    '//FolderPath目录下的所有文件
    Set files=ofolder.Files
    For Each file In files
       'WScript.Echo file.Path
       Call ResizePhoto(file.Path)  
    Next
   
    '//FolderPath目录下的所有子目录
    Set SubFolders=ofolder.SubFolders
    For Each folder in SubFolders
      Call TraversingFolder(folder.Path)
    Next
 
 End If
End Sub
 
'//调整照片大小
Sub ResizePhoto(ImageFilePath)
 'On Error Resume Next
 
 '//仅处理jpg格式的
 If LCase(Right(ImageFilePath,4))<>".jpg" Then
      Exit Sub
 End If
 
 Dim objDocument
 '//WScript.Echo ImageFilePath
 Set objDocument=OpenImage(objPhotoshopApp,ImageFilePath)
 
 If IsNull(objDocument) Then'//打开了无效文件
    Call CloseImage(objDocument)
    Exit Sub
 End If
 
 Dim nWidth,nHeight
 nWidth=GetImageWidth(objDocument)
 nHeight=GetImageHeight(objDocument)
 If nWidth=2048 And nHeight=1536 Then      '//横向的
    Call ResizeImage(objDocument,1600,1200,96)
 ElseIf nWidth=1536 And nHeight=2048 Then '//纵向的
    Call ResizeImage(objDocument,1200,1600,96)
 Else
    Call CloseImage(objDocument)
    Exit Sub
 End If
 
 Call CloseImage(objDocument)
 Exit Sub
End Sub
 
'//打开图片
Function OpenImage(oPhotoshop,ImageFilePath)
 Dim oDocument
 Set oDocument=Nothing
 If fso.FileExists(ImageFilePath) Then
    oPhotoshop.Open(ImageFilePath)
    Set oDocument=oPhotoshop.Documents.Item(1)
    Set OpenImage=oDocument
 End If
End Function
 
'//关闭图片
Sub CloseImage(oDocument)
 oDocument.Close
end Sub
 
'//获取图片宽度
Function GetImageWidth(oDocument)
 GetImageWidth=oDocument.Width
End Function
 
'//获取图片高度
Function GetImageHeight(oDocument)
 GetImageHeight=oDocument.Height
End Function
 
'//修改图片大小
Sub ResizeImage(oDocument,nWidth,nHeight,nResolution)
 oDocument.ResizeImage nWidth,nHeight,nResolution,3 '参数依次为：宽，高，分辨率(比如96像素/英寸)，采样类型
 oDocument.Save
End Sub
 
'//初始化Photoshop
Sub InitPhotoshop(oPhotoshop)
    oPhotoshop.Preferences.RulerUnits=DEF_psPixels '设置默认单位为像素
    Do While oPhotoshop.Documents.Count          '关闭所有已打开的文档
        oPhotoshop.ActiveDocument.Close
    Loop
End Sub
 
'//退出Photoshop
Sub ExitPhotoshop(oPhotoshop)
    objPhotoshopApp.Quit
End Sub

本文链接地址： 用VBScript编程控制Photoshop自动处理批量图片
https://blog.qingfengju.com/index.asp?id=24

上一篇： XP Embedded 下的控制面板组件
下一篇： 一个串口类CSerialPort及其简单使用

分类：脚本编程 查看次数：7131 发布时间：2009/5/15 19:43:28