位图问题 - 参数无效且内存不足

Question

我有一个 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)

有谁知道为什么会发生这种情况，看看我的代码。 或者，是否有代码可以在某处设置图像的分辨率，以使内存标记更小？

谢谢。

Answer 1

但是我们看不到你对sourceImage和outImage做了什么。

   image1 = SetResolution(image1, 50, strFilePath & "" & Path.GetFileName(S))

您正在使用此语句重新分配 image1 变量。 问题是，您从未处理过原始图像1。 这也是一个主要的猜测，为什么你传递一个路径名，该方法根本不使用它。 因此，不会忘记释放的更理智的代码应该如下所示：

   Dim newImage = SetResolution(image1, 50)
   image1.Dispose()
   image1 = newImage