flashercs

保存为 "图片剪裁.bat",能处理当前目录和所有子目录中的图片,直接覆盖原图. 先测试.

' &cls&@cscript -nologo -e:vbscript "%~f0" "%~dp0" & pause & exit /b
' 脚本功能:剪裁图片-Crop Image, 四周剪裁10%,并覆盖源文件
' 用法:script.vbs file1 file2 ... folder1 folder2 ...
Option Explicit
On Error Resume Next
If WScript.Arguments.Count = 0 Then
  WScript.Echo "参数个数不能为0"
  WScript.Quit 1
End If

Const conIMAGETYPES = "|jpg|jpeg|png|bmp|tiff|gif|" ' 图片类型列表
Const conRECURSE = True ' 是否遍历子目录
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
With CreateObject("WScript.Shell")
  .CurrentDirectory = fso.GetParentFolderName(WScript.ScriptFullName)
End With 

Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
IP.Filters.Add IP.FilterInfos("Crop").FilterID
ShowError

Dim i,strArgi
For i = 0 To WScript.Arguments.Count - 1
  strArgi = WScript.Arguments(i)
  If fso.FileExists(strArgi) Then
    GenFile fso.GetFile(strArgi)
  ElseIf fso.FolderExists(strArgi) Then
    GenFolder fso.GetFolder(strArgi)
  Else
    WScript.Echo "找不到文件或目录:" & strArgi 
  End If
Next
ShowError
Set fso = Nothing
Set Img = Nothing
Set IP = Nothing
WScript.Quit 0

' Sub functions
Sub GenFile(objFile)
  On Error Resume Next
  If InStr(1,conIMAGETYPES,"|" & fso.GetExtensionName(objFile.Name) & "|",vbTextCompare) Then
    WScript.Echo "处理图片:" & objFile.Path
    CropImage objFile.Path,objFile.Path
  Else
   ' WScript.Echo "未处理图片:" & objFile.Path
  End If
  ShowError
End Sub

Sub GenFolder(objFolder)
  On Error Resume Next
  Dim objFile,objSubFolder
  ' WScript.Echo "处理目录:" & objFolder.Path
  For Each objFile In objFolder.Files
    GenFile objFile
  Next
  If conRECURSE Then
    For Each objSubFolder In objFolder.SubFolders
      GenFolder objSubFolder
    Next
  End If
  ShowError
End Sub

Sub CropImage(strImageSrc,strImageDst)
  On Error Resume Next
  Img.LoadFile strImageSrc
  IP.Filters(1).Properties("Left") = Img.Width \ 10
  IP.Filters(1).Properties("Top") = Img.Height \ 10
  IP.Filters(1).Properties("Right") = Img.Width \ 10
  IP.Filters(1).Properties("Bottom") = Img.Height \ 10
  Set Img = IP.Apply(Img)
  If fso.FileExists(strImageDst) Then
    fso.DeleteFile strImageDst,True
  End If
  Img.SaveFile strImageDst
  ShowError
End Sub

Sub ShowError()
  If Err.Number <> 0 Then
    WScript.Echo "Err # " & Err.Number & vbNewLine & _
    "Description: " & Err.Description & vbnewline & _
    "Source: " & Err.Source
    Err.Clear
  End If
End Sub
复制代码

flashercs

回复 6# went

用GDI处理图片要建议:
    1.新图片的dpi最好保持与原图片一致,比如原图是350dpi,新图也要是350dpi,而Graphics画出默认是96dpi
2.新图片jpeg的压缩率要保持与原图片一致或接近.而jpeg默认保存的压缩率是50%