- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 压缩图片到新的文件夹地址下 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=190180)
-- 发布时间：2024/1/22 14:34:00
-- 压缩图片到新的文件夹地址下
希望达成
图库表
原图列 内容是原图地址 C:\\Users\\Administrator\\Desktop\\爆品资料\\0daf3cad-77ef-4fc1-a24e-a5bcc50e2106.jpg
缩略图列 拟定压缩图新地址 C:\\Users\\Administrator\\Desktop\\压缩图\\0daf3cad-77ef-4fc1-a24e-a5bcc50e2106.jpg
Dim ifo As new FileInfo(t11)
If Ifo.Length>40960 \'大于40k才压缩
Dim img1 As image = getImage(t11)
Dim bmp1 As bitmap
If img1.width > 400 Then
If 400 * (img1.height / img1.width) > 300 Then
bmp1 = new bitmap(img1, 400*(300/(400*(img1.height/img1.width))), 300)
Else
bmp1 = new bitmap(img1, 300, 300 * (img1.height / img1.width))
End If
bmp1.save(slt, img.RawFormat)
bmp1.Dispose
End If
-- 发布时间：2024/1/22 14:37:00
--
有什么问题？
-- 发布时间：2024/1/22 16:27:00
--
希望达成
图库表
原图列 内容是原图地址 C:\\Users\\Administrator\\Desktop\\爆品资料\\0daf3cad-77ef-4fc1-a24e-a5bcc50e2106.jpg
缩略图列 拟定压缩图新地址 C:\\Users\\Administrator\\Desktop\\压缩图\\0daf3cad-77ef-4fc1-a24e-a5bcc50e2106.jpg
-- 发布时间：2024/1/22 16:34:00
--
我问的是代码执行有什么问题？
把保存的地址改为自己期望的地址不就行了！
-- 发布时间：2024/1/23 1:27:00
--
For Each dr As DataRow In DataTables("表A").DataRows
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
bmp.save("C:\\Users\\Administrator\\Desktop\\爆品资料1\\" & dr("文件") , img.RawFormat)
bmp.Dispose
End If
dr("压缩") = "C:\\Users\\Administrator\\Desktop\\爆品资料1\\" & dr("文件")
Next
此主题相关图片如下：企业微信截图_20240123012634.png
此主题相关图片如下：企业微信截图_20240123012634.png解决了
[此贴子已经被作者于2024/1/23 1:32:13编辑过]
-- 发布时间：2024/1/23 4:27:00
--
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编辑过]
-- 发布时间：2024/1/23 8:46:00
--
http://www.foxtable.com/webhelp/topics/1476.htm
StatusBar.Message1 = "正在压缩中"
StatusBar.Message2 = cnt + 1
Application.DoEvents
-- 发布时间：2024/1/23 12:25:00
--
TopVisibleRow = CurrentTable.Current
正在编辑的行始终显示在屏幕中间 怎么添加
-- 发布时间：2024/1/23 13:32:00
--
http://www.foxtable.com/webhelp/topics/2358.htm
CurrentTable.TopVisibleRow = CurrentTable.Current.index
-- 发布时间：2024/1/26 22:55:00
--
还是不会居中显示