- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 压缩图片的程序加载图像失败 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=195820)
-- 发布时间：2025/3/11 15:32:00
-- 压缩图片的程序加载图像失败
Dim file As String = "f:\\g\\DSC01371.jpg"
Dim img As Image = getImage(file)
\' 检查 getImage 是否成功加载了图像
If img Is Nothing Then
MessageBox.Show("无法加载图像文件: " & file)
Return Nothing
End If
Dim bmp As Bitmap = Nothing
Try
\' 检查图像宽度是否大于 800
If img.Width > 800 Then
Dim newWidth As Integer = 800
Dim newHeight As Integer
\' 计算新的高度以保持宽高比
If 800 * (img.Height / img.Width) > 600 Then
newHeight = 600
newWidth = CInt(800 * (600 / img.Height))
Else
newHeight = CInt(800 * (img.Height / img.Width))
End If
\' 创建新的 Bitmap 对象
bmp = New Bitmap(img, newWidth, newHeight)
Else
\' 如果图像宽度不大于 800，直接使用原图
bmp = New Bitmap(img)
End If
\' 保存处理后的图像
bmp.Save("f:/g/VDSC01371.jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
Catch ex As Exception
\' 捕获并显示任何异常
MessageBox.Show("处理图像时发生错误: " & ex.Message)
Finally
\' 确保 Bitmap 对象被正确释放
If bmp IsNot Nothing Then
bmp.Dispose()
End If
End Try
以上代码在图片比较大时，6M以上，getImage 不能成功加载图像，有什么办法提高这个加载成功率吗，我主要目的是压缩图片，或有其它更好的压缩图片的程序吗
-- 发布时间：2025/3/11 15:37:00
--
特别大的图片建议还是使用专业的软件处理吧，比如Photoshop
-- 发布时间：2025/3/11 16:07:00
--
我的想法是上传到ftp的图片有些比较大，我用PictureBox控件做了个预览窗口，上传大图片的同时，生成一个压缩后的图片，预览就下载压缩后的图片，这样就可以快速看到图片，大图片的话要等好久才能看到，体验不好，那么有没有更好的预览大图片的方法？
-- 发布时间：2025/3/11 16:09:00
--
这些图片要上传留档的，不能压缩了再上传，一定要保留原图
-- 发布时间：2025/3/11 16:12:00
--
或者提供个调用其它图片软件用来压缩图片的代码，有吗？
-- 发布时间：2025/3/11 17:17:00
--
暂时没有办法，毕竟Foxtable不是专业作图的
-- 发布时间：2025/3/11 18:27:00
--
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.IO
Module ImageCompressor
Sub Main()
Dim inputPath As String = "f\\g\\DSC01371.jpg"
Dim outputPath As String = "f\\g\\vDSC01371.jpg"
Using originalImage As Image = Image.FromFile(inputPath)
\' 设置压缩质量（0-100）
Dim quality As Long = 50L
Dim jpgEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
\' 创建编码参数
Dim myEncoder As Encoder = Encoder.Quality
Dim myEncoderParameters As New EncoderParameters(1)
Dim myEncoderParameter As New EncoderParameter(myEncoder, CType(quality, Byte))
myEncoderParameters.Param[0] = myEncoderParameter
\' 保存压缩后的图像
originalImage.Save(outputPath, jpgEncoder, myEncoderParameters)
End Using
End Sub
Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
Dim myEncoder As ImageCodecInfo = Nothing
For Each codec As ImageCodecInfo In codecs
If codec.FormatID = format.Guid Then
myEncoder = codec
Exit For
End If
Next codec
Return myEncoder
End Function
End Module
这是网上找的个程序，但运行出错，要怎么改？能行吗？
-- 发布时间：2025/3/11 19:48:00
--
Dim inputPath As String = "f:\\g\\DSC01371.jpg"
Dim outputPath As String = "f:\\g\\vDSC01371.jpg"
Using originalImage As Image = Image.FromFile(inputPath)
\' 设置压缩质量（0-100）
Dim quality As Long = 50L
Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
Dim jpgEncoder As ImageCodecInfo = Nothing
For Each codec As ImageCodecInfo In codecs
If codec.FormatID = ImageFormat.Jpeg.Guid Then
jpgEncoder = codec
Exit For
End If
Next codec
\' 创建编码参数
Dim myEncoder As Encoder = Encoder.Quality
Dim myEncoderParameters As New EncoderParameters(1)
Dim myEncoderParameter As New EncoderParameter(myEncoder, CType(quality, Byte))
myEncoderParameters.Param(0) = myEncoderParameter
\' 保存压缩后的图像
originalImage.Save(outputPath, jpgEncoder, myEncoderParameters)
End Using
-- 发布时间：2025/3/12 9:17:00
--
你改过的代码运行还是有错，
此主题相关图片如下：qq_1741742132287.png
-- 发布时间：2025/3/12 9:38:00
--
Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality