たくさんの画像を取得して解像度を小さいサイズに変更しようとする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)
私のコードを見て、なぜこれが起こっているのか誰かが知っていますか？または、メモリスタンプがはるかに小さくなるように画像の解像度を設定できるコードはどこかにありますか？
ありがとう。