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

时间:2012-09-24 20:46:14

标签: exception graphics parameters bitmap out-of-memory

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

有谁知道为什么这会发生在查看我的代码。或者,是否有代码可以设置图像的分辨率,以便内存标记更小?

感谢。

1 个答案:

答案 0 :(得分:1)

  

但我们无法看到你使用sourceImage和outImage做什么。

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

您使用此语句重新分配 image1变量。问题是,你从未处理过原始图像1。这也是一个主要的猜测,为什么你传递一个路径名,该方法根本不使用它。因此,一些不会忘记处理的更健全的代码应该是这样的:

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