我有一个 vb.net 程序，它试图拍摄一堆图像并将分辨率更改为更小的尺寸。我的程序尝试使用下面的代码遍历所有图像以完成此操作。我已经发布了函数和调用它的按钮单击。它将通过 27 个图像正常，但在 28 日将出现“参数无效”错误。
Friend Shared Function SetResolution(ByVal sourceImage As Image, ByVal resolution As Integer, ByVal strFullPath As String) As Image
Try
Dim reduction As Double = resolution / CInt(sourceImage.HorizontalResolution)
Using newImage As New Bitmap(sourceImage.Width, sourceImage.Height, sourceImage.PixelFormat)
newImage.SetResolution(resolution, resolution)
Dim outImage As New Bitmap(sourceImage, CInt(sourceImage.Width * reduction), CInt(sourceImage.Height * reduction))
Using g As Graphics = Graphics.FromImage(newImage)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(outImage, 0, 0)
g.Dispose()
End Using
newImage.Dispose()
Return outImage
End Using
Catch ex As Exception
MsgBox("An error occurred with the SetResolution function - " & ex.Message)
End Try
End Function
Private Sub btnSaveImages_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSaveImages.Click
Dim S As String
Dim Box As MsgBoxResult = MsgBox("Any previous images saved to this location will be overwritten. Are you sure you want to save these images?", MsgBoxStyle.YesNo)
Dim strFolderPath As String = ""
Dim strFolderReportPath As String = txtBrowse.Text & "\Report"
'Try
'the Report folder may not exist. Create it if needed.
If Not Directory.Exists(strFolderReportPath) Then
Directory.CreateDirectory(strFolderReportPath)
Else
'if it does exist then we need to either delete the folder or clean out all the files.
Dim downloadedMessageInfo As System.IO.DirectoryInfo = New DirectoryInfo(strFolderReportPath)
For Each file As FileInfo In downloadedMessageInfo.GetFiles()
file.Delete()
Next
For Each dir As DirectoryInfo In downloadedMessageInfo.GetDirectories()
dir.Delete(True)
Next
End If
If Box = MsgBoxResult.Yes Then
If lstSelectedImages.Items.Count <> 0 Then
For Each S In lstSelectedImages.Items
'MessageBox.Show(S)
Dim image1 As Image = Image.FromFile(S)
Dim strFilePath As String = Path.GetDirectoryName(S)
strFolderPath = Path.GetDirectoryName(S)
Dim strFileName As String = Path.GetFileName(S)
Dim strNewFolder As String = strFilePath & "\Report\"
strFileName = strFileName.Replace(".", "-Report.")
Dim strFullPath As String = strFilePath & "\Report\" & strFileName
image1 = SetResolution(image1, 50, strFilePath & "\" & Path.GetFileName(S))
'the Report folder may not exist. Create it if needed
If Not Directory.Exists(strNewFolder) Then
Directory.CreateDirectory(strNewFolder)
End If
image1.Save(strFullPath, System.Drawing.Imaging.ImageFormat.Jpeg)
image1.Dispose()
image1 = Nothing
Next
Dim di As New DirectoryInfo(strFolderReportPath)
'PopulateReportViewer(lstSelectedImages)
PopulateReportViewerByDir(di)
lblImageFolderLocation.Text = "Image Location: " & strFolderReportPath
MsgBox("Images saved to " & strFolderReportPath)
Else
MsgBox("Please select images to be saved into the Selected Images list box", MsgBoxStyle.Information)
End If
Else
End If
tbSelectCompressImages.TabPages.Add(TabPage2)
tbSelectCompressImages.SelectedIndex = 1
'Catch ex As Exception
' MsgBox("An error occurred with the Save Images button - " & ex.Message)
'End Try
End Sub
所以，我对此感到非常困惑，并决定对位图的创建方式进行一些小改动。我能够再次保存 28 张图像，但这次收到 Graphics.FromImage 行的内存不足错误。
Dim newimage As Bitmap = DirectCast(Image.FromFile(strPath), Bitmap)
有谁知道为什么会发生这种情况，看看我的代码。或者，是否有代码可以让我设置图像的分辨率，从而使内存标记更小？
谢谢。