使用 VB.Net 合并大图像
Merge large images with VB.Net
我希望有人能帮助我将几张大图像 (PNG) 合并为一张。我有多达 30 张 20000x2000 的图像,并且想合并它们。输出是可以加载到 GIS 软件中的图像。
我遇到的问题是我在第 4 张图片后内存不足。
我下面的代码在拼接时基本上将整个图像保存在内存中。有什么方法可以有效地拼接图像而不将其全部加载到内存中,或者增加内存余量并利用我所有的 RAM and/or 虚拟内存?
Public Function stitchAllImagesOnXAxis(imageDirectoryPath As String, outputImagePath As String) As Boolean
Try
Dim evolvingImage As Bitmap
Dim filenames() As String = IO.Directory.GetFiles(imageDirectoryPath)
For i As Integer = 0 To filenames.Count - 1
If Not filenames(i).EndsWith(".png") Then filenames = filenames.RemoveAt(i)
Next i
If filenames.Count = 0 Then Return False
Dim FS As New IO.FileStream(filenames(0), IO.FileMode.Open)
evolvingImage = Bitmap.FromStream(FS)
FS.Close()
For i As Integer = 1 To filenames.Count - 1
FS = New IO.FileStream(filenames(i), IO.FileMode.Open)
evolvingImage = stitchImagesOnXAxis(evolvingImage, Bitmap.FromStream(FS), 5)
FS.Close()
Next
evolvingImage.Save(outputImagePath, Imaging.ImageFormat.Png)
evolvingImage.Dispose()
Return True
Catch ex As Exception
Debug.WriteLine(ex.Message)
Return False
End Try
Public Function stitchAllImagesOnXAxisSO(imageDirectoryPath As String, outputImagePath As String, tolerance As Integer) As Boolean
Try
'blank 54 byte header for BMP
Dim headerBytes() As Byte = blankHeader()
'track the total width of the bmp for the header information
Dim totalWidth As Integer = 0
'the height of the BMP (assumes all images being joined are the same height)
Dim height As Integer = 0
'the files in the directory specified
Dim filenames() As String = IO.Directory.GetFiles(imageDirectoryPath)
'the filestream used to read each file
Dim FS As IO.FileStream
'a class to read the header information of the BMP files
Dim dynamicHeaderInfo As BMPHeaderInformation
'byte array to copy the bytes read to
Dim copyBuffer() As Byte
'ensure each file is a bmp file
For i As Integer = 1 To filenames.Count - 1
If Not filenames(i).EndsWith(".bmp") Then filenames = filenames.RemoveAt(i)
Next i
'if there isn't more than one image available then exit
If filenames.Count < 2 Then Return False
'if the output image exists than delete it
If IO.File.Exists(outputImagePath) Then IO.File.Delete(outputImagePath)
'and open it as new
Dim evolvingImageFS As New IO.FileStream(outputImagePath, IO.FileMode.OpenOrCreate)
'write a blank header
evolvingImageFS.Write(headerBytes, 0, headerBytes.Length)
'set the height of the overall image (all images assumed the same height)
dynamicHeaderInfo = New BMPHeaderInformation(filenames(0))
height = dynamicHeaderInfo.width
'writing one row at a time from one image at a time
For row As Integer = 0 To height - 1
For i As Integer = 0 To filenames.Count - 1
'get the header data
dynamicHeaderInfo = New BMPHeaderInformation(filenames(i))
'open the file
FS = New IO.FileStream(filenames(i), IO.FileMode.Open)
'each time we are looking at the first row of an image add that width to the overall width
If row = 0 Then totalWidth += dynamicHeaderInfo.width
'set the position of the stream
FS.Position = dynamicHeaderInfo.headerLength + (row * dynamicHeaderInfo.width * 3) + (row * dynamicHeaderInfo.rowPaddingLength)
'set up the byte array to read in the bytes
ReDim copyBuffer((dynamicHeaderInfo.width * 3) - 1)
FS.Read(copyBuffer, 0, dynamicHeaderInfo.width * 3)
'write the bytes to the new stream
evolvingImageFS.Write(copyBuffer, 0, dynamicHeaderInfo.width * 3)
'if we are at the last image and the total width is less than 500, write the trailing zeros on the row
If i = filenames.Count - 1 Then padRowFromStream(totalWidth, evolvingImageFS)
'close the stream
FS.Close()
FS.Dispose()
Next
Next
'set the new header information
setNewWidth(totalWidth, evolvingImageFS)
setNewheight(height, evolvingImageFS)
setNewImageFileSize(evolvingImageFS.Length, evolvingImageFS)
setNewImageAreaSize(evolvingImageFS.Length - headerBytes.Length, evolvingImageFS)
'close off the stream
evolvingImageFS.Close()
evolvingImageFS.Dispose()
Return True
Catch ex As Exception
Debug.WriteLine(ex.Message)
Return False
End Try
End Function
对于任何感兴趣的人,我已经发布了我的解决方案。这对我来说效果很好,但可能需要针对个人用途进行一些调整。这也受限于 bmp 文件的理论限制为 16^8 字节。
我希望有人能帮助我将几张大图像 (PNG) 合并为一张。我有多达 30 张 20000x2000 的图像,并且想合并它们。输出是可以加载到 GIS 软件中的图像。
我遇到的问题是我在第 4 张图片后内存不足。
我下面的代码在拼接时基本上将整个图像保存在内存中。有什么方法可以有效地拼接图像而不将其全部加载到内存中,或者增加内存余量并利用我所有的 RAM and/or 虚拟内存?
Public Function stitchAllImagesOnXAxis(imageDirectoryPath As String, outputImagePath As String) As Boolean
Try
Dim evolvingImage As Bitmap
Dim filenames() As String = IO.Directory.GetFiles(imageDirectoryPath)
For i As Integer = 0 To filenames.Count - 1
If Not filenames(i).EndsWith(".png") Then filenames = filenames.RemoveAt(i)
Next i
If filenames.Count = 0 Then Return False
Dim FS As New IO.FileStream(filenames(0), IO.FileMode.Open)
evolvingImage = Bitmap.FromStream(FS)
FS.Close()
For i As Integer = 1 To filenames.Count - 1
FS = New IO.FileStream(filenames(i), IO.FileMode.Open)
evolvingImage = stitchImagesOnXAxis(evolvingImage, Bitmap.FromStream(FS), 5)
FS.Close()
Next
evolvingImage.Save(outputImagePath, Imaging.ImageFormat.Png)
evolvingImage.Dispose()
Return True
Catch ex As Exception
Debug.WriteLine(ex.Message)
Return False
End Try
Public Function stitchAllImagesOnXAxisSO(imageDirectoryPath As String, outputImagePath As String, tolerance As Integer) As Boolean
Try
'blank 54 byte header for BMP
Dim headerBytes() As Byte = blankHeader()
'track the total width of the bmp for the header information
Dim totalWidth As Integer = 0
'the height of the BMP (assumes all images being joined are the same height)
Dim height As Integer = 0
'the files in the directory specified
Dim filenames() As String = IO.Directory.GetFiles(imageDirectoryPath)
'the filestream used to read each file
Dim FS As IO.FileStream
'a class to read the header information of the BMP files
Dim dynamicHeaderInfo As BMPHeaderInformation
'byte array to copy the bytes read to
Dim copyBuffer() As Byte
'ensure each file is a bmp file
For i As Integer = 1 To filenames.Count - 1
If Not filenames(i).EndsWith(".bmp") Then filenames = filenames.RemoveAt(i)
Next i
'if there isn't more than one image available then exit
If filenames.Count < 2 Then Return False
'if the output image exists than delete it
If IO.File.Exists(outputImagePath) Then IO.File.Delete(outputImagePath)
'and open it as new
Dim evolvingImageFS As New IO.FileStream(outputImagePath, IO.FileMode.OpenOrCreate)
'write a blank header
evolvingImageFS.Write(headerBytes, 0, headerBytes.Length)
'set the height of the overall image (all images assumed the same height)
dynamicHeaderInfo = New BMPHeaderInformation(filenames(0))
height = dynamicHeaderInfo.width
'writing one row at a time from one image at a time
For row As Integer = 0 To height - 1
For i As Integer = 0 To filenames.Count - 1
'get the header data
dynamicHeaderInfo = New BMPHeaderInformation(filenames(i))
'open the file
FS = New IO.FileStream(filenames(i), IO.FileMode.Open)
'each time we are looking at the first row of an image add that width to the overall width
If row = 0 Then totalWidth += dynamicHeaderInfo.width
'set the position of the stream
FS.Position = dynamicHeaderInfo.headerLength + (row * dynamicHeaderInfo.width * 3) + (row * dynamicHeaderInfo.rowPaddingLength)
'set up the byte array to read in the bytes
ReDim copyBuffer((dynamicHeaderInfo.width * 3) - 1)
FS.Read(copyBuffer, 0, dynamicHeaderInfo.width * 3)
'write the bytes to the new stream
evolvingImageFS.Write(copyBuffer, 0, dynamicHeaderInfo.width * 3)
'if we are at the last image and the total width is less than 500, write the trailing zeros on the row
If i = filenames.Count - 1 Then padRowFromStream(totalWidth, evolvingImageFS)
'close the stream
FS.Close()
FS.Dispose()
Next
Next
'set the new header information
setNewWidth(totalWidth, evolvingImageFS)
setNewheight(height, evolvingImageFS)
setNewImageFileSize(evolvingImageFS.Length, evolvingImageFS)
setNewImageAreaSize(evolvingImageFS.Length - headerBytes.Length, evolvingImageFS)
'close off the stream
evolvingImageFS.Close()
evolvingImageFS.Dispose()
Return True
Catch ex As Exception
Debug.WriteLine(ex.Message)
Return False
End Try
End Function
对于任何感兴趣的人,我已经发布了我的解决方案。这对我来说效果很好,但可能需要针对个人用途进行一些调整。这也受限于 bmp 文件的理论限制为 16^8 字节。