Dim cnt As Integer = 1
SystemReady = False
Try
'追加数据代码
For Each dr As DataRow In DataTables("产品_图库资源").DataRows
Dim ifo As New FileInfo(dr("原始_文件地址"))
StatusBar.Message1 = "正在压缩中"
StatusBar.Message2 = cnt + 1
看不到状态 等显示出来已经结束了 中间就是像死机一样。怎么可以看到数字跳动
十万条数据要好久 能有状态就不焦虑了
' MessageBox.Show(fml)
' If FileSys.DirectoryExists(ifo.Path & "\压缩图片\") Then '如果目录C:\MyFolder存在
' FileSys.DeleteDirectory(ifo.Path & "\压缩图片\", 2, 3) '则删除之
' dr("网络_文件地址") = ""
' dr("网络_缩略图") = ""
' End If
Dim file As String = dr("原始_文件地址")
Dim img As image = getImage(file)
Dim bmp As bitmap
If img.width > 600 Then
If 600 * (img.height / img.width) > 338 Then
bmp = New bitmap(img, 600 * (338 / (600 * (img.height / img.width))), 338)
Else
bmp = New bitmap(img, 600, 600 * (img.height / img.width))
End If
If FileSys.DirectoryExists(ifo.Path & "\压缩图片\") Then '如果目录C:\MyFolder存在
Else
FileSys.CreateDirectory(ifo.Path & "\压缩图片\") '创建目录
End If
dr("网络_文件地址") = ifo.Path & "\压缩图片\"
dr("网络_缩略图") = dr("原始_文件名")
dr("网络_文件目录") = dr("网络_文件地址") & dr("网络_缩略图")
bmp.save(dr("网络_文件目录"), img.RawFormat)
bmp.Dispose
Dim ifo1 As New FileInfo(dr("网络_文件目录"))
dr("网络_文件大小") = Round2(ifo1.Length / 10240, 2) & " kb"
End If
Next
Catch ex As Exception
MessageBox.Show("压缩图片失败")
End Try
SystemReady = True
Tables("产品_图库资源").Save
MessageBox.Show("图片压缩转换成功!")
[此贴子已经被作者于2024/1/23 4:46:37编辑过]
加好友 
发短信
Post By：2024/1/22 14:34:00 [只看该作者]
此主题相关图片如下：企业微信截图_20240123012634.png