- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- [求助]压缩照片大小 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=157086)
-- 发布时间：2020/9/30 22:41:00
-- [求助]压缩照片大小
1、代码目的
将一个大文件夹中，多个文件夹中的照片尺寸，由900*675调整为291*218；
以下照片为调整结果：
此主题相关图片如下：qq截图20200930223050.png
此主题相关图片如下：qq截图20200930223022.png
2、错误提示
运行的过程中时不时的会出现以下问题，并且每次出现错误的地方不同，貌似是随机的，但也有少数情况会全部完成；
比如;大文件夹中有10个文件夹，运行的时候出错的位置可能在第4个或者第6个文件夹，不固定，但有时候会全部转换完成，出错原因应该与照片没啥关系。
此主题相关图片如下：qq截图20200930220049.png
3、具体代码
\'选择文件夹
Dim dlg As New FolderBrowserDialog
If dlg.ShowDialog = DialogResult.Ok Then
\'MessageBox.Show("你选择的目录是:" & dlg.SelectedPath,"提示")
End If
Dim Names As New List(Of String)
For Each dir As String In FileSys.GetDirectories(dlg.SelectedPath)
Names.Add( dir)
Next
\'调整照片大小 保存在缩略图文件夹中
If Names.Count > 0 Then
\'多个文件夹操作
For Each dir As String In FileSys.GetDirectories(dlg.SelectedPath) \'dir桥文件名路径,子目录
\'///压缩照片
For Each File As String In FileSys.GetFiles(dir) \'file照片路径
\'///新建文件夹
If FileSys.DirectoryExists(dir & "\\缩略图\\" ) Then \'如果目录C:\\MyFolder存在
Else
FileSys.CreateDirectory(dir & "\\缩略图\\" )
End If
\'////
Dim img As image = getImage(File)
If img.width > 700 Then
Dim bmp As new bitmap(img, 290.97,217.87 )
bmp.save(dir & "\\缩略图\\" & filesys.GetName(File))
bmp.Dispose
End If
\'////
Next
Next
Else
\'单个文件夹操作
For Each File As String In FileSys.GetFiles(dlg.SelectedPath) \'file照片路径
\'///新建文件夹
If FileSys.DirectoryExists(dlg.SelectedPath & "\\缩略图\\" ) Then \'如果目录C:\\MyFolder存在
Else
FileSys.CreateDirectory(dlg.SelectedPath & "\\缩略图\\" )
End If
\'////
Dim img As image = getImage(File)
If img.width > 700 Then
Dim bmp As new bitmap(img, 290.97,217.87 )
bmp.save(dlg.SelectedPath & "\\缩略图\\" & filesys.GetName(File))
bmp.Dispose
End If
\'////
Next
End If
MessageBox.Show("完成","提示")
[此贴子已经被作者于2020/10/5 9:46:04编辑过]
-- 发布时间：2020/10/6 8:42:00
--
代码应该没有问题，可能是有隐藏的系统文件引起的，比如系统生成的图片缩略图文件，试试判断一下图片类型
For Each File As String In FileSys.GetFiles(dir) \'file照片路径
If file.EndsWith(".jpg") OrElse file.EndsWith(".png")
……
-- 发布时间：2020/10/12 20:52:00
--
If file.EndsWith(".jpg") OrElse file.EndsWith(".png")
If file.EndsWith(".JPG") OrElse file.EndsWith(".PNG")
这个大小写貌似有区别，照片格式多的话好像不太方便，有没有啥好方法
[此贴子已经被作者于2020/10/12 21:01:32编辑过]
-- 发布时间：2020/10/12 21:40:00
--
dim arr() as string = file.split(".")
dim ef as string = arr(arr.length - 1).tolower()
select case ef
case ".jpg",".png","bmp",..........
……
end select