Resize Multipage Tiff

MattP

Well-known member
Joined
Feb 29, 2008
Messages
1,206
Location
WY, USA
Programming Experience
5-10
I've run into a situation where I'm trying to resize/compress multipage tiff documents that were scanned at a huge resolution and color depth to a managable file size.

Here's the code I have so far. It works in creating a new file with the reduced resolution but I've run into a couple of snags with compression and color depth.

VB.NET:
		Dim fs As FileStream = File.Open("C:\Temp\Big\File2.tif", FileMode.Open, FileAccess.Read)
		Dim bmp As Bitmap = CType(Bitmap.FromStream(fs), Bitmap)

		Dim resizeRatio As Double = 96 / bmp.HorizontalResolution

		Dim ici As ImageCodecInfo = Nothing
		For Each info As ImageCodecInfo In ImageCodecInfo.GetImageEncoders()
			If info.MimeType = "image/tiff" Then
				ici = info
			End If
		Next

		Dim ep As New EncoderParameters(3)

		ep.Param(0) = New EncoderParameter(Encoder.SaveFlag, CLng(EncoderValue.MultiFrame))
		ep.Param(1) = New EncoderParameter(Encoder.Compression, CLng(EncoderValue.CompressionLZW))
		ep.Param(2) = New EncoderParameter(Encoder.ColorDepth, 24L)

		Dim outFile As Bitmap = Nothing

		For i As Integer = 0 To CInt(bmp.GetFrameCount(FrameDimension.Page) - 1)

			bmp.SelectActiveFrame(FrameDimension.Page, i)
			Dim temp As New Bitmap(CInt(resizeRatio * bmp.Width), CInt(resizeRatio * bmp.Height))
			Dim g As Graphics = Graphics.FromImage(temp)
			g.DrawImage(bmp, New Rectangle(0, 0, temp.Width, temp.Height), _
			 0, 0, bmp.Width, bmp.Height, GraphicsUnit.Pixel)
			g.Dispose()

			If i = 0 Then
				outFile = temp
				outFile.Save("C:\Temp\Normal\File2.tif", ici, ep)
			Else
				ep.Param(0) = New EncoderParameter(Encoder.SaveFlag, CLng(EncoderValue.FrameDimensionPage))
				outFile.SaveAdd(temp, ep)
			End If

			If i = CInt(bmp.GetFrameCount(FrameDimension.Page) - 1) Then
				ep.Param(0) = New EncoderParameter(Encoder.SaveFlag, CLng(EncoderValue.Flush))
				outFile.SaveAdd(ep)
			End If

		Next

The parts I'm having issues with

VB.NET:
		ep.Param(1) = New EncoderParameter(Encoder.Compression, CLng(EncoderValue.CompressionLZW))
		ep.Param(2) = New EncoderParameter(Encoder.ColorDepth, 24L)

If I change the Compression to any value besides EncoderValue.CompressionLZW I get an error 'parameter is not valid.

If I change the ColorDepth to anything less than 24L I get a message that 'A generic error occurred in GDI+'.

-----

Ideally I'd like to be able to output the files with the same compression and same/lower color depth than the original image. The original compression is CCITT T.6 (which I don't see available) and the color depth can be anywhere from 1 to 32 which I'd like to reduce to B/W or Grayscale.

If anyone can point me in the right direction I'd really appreciate it.
 
If I change the Compression to any value besides EncoderValue.CompressionLZW I get an error 'parameter is not valid.
TiffCompressOption Enumeration (System.Windows.Media.Imaging)
help said:
The Ccitt3, Ccitt4, and Rle require that the PixelFormat value be set to BlackWhite.
If I change the ColorDepth to anything less than 24L I get a message that 'A generic error occurred in GDI+'.
I have no idea... it could be that the source image must be that pixel format first, it could be that the value parameter in this case can't be a Long, Tiffs and the GDI+ encoding is weird, those two errors you posted pretty much sums up my experience with this format.
 
Looking into this situation further it appears that Graphics can't draw on a bitonal image. The workaround is to do direct image byte manipulation (ugh).

Fine...so I need to know what the original image is stored at so that I can generate a black and white page from the original. Instead of writing a different method for converting from 24bppArgb, 32bppArgb, 16bppGrayscale, etc is to create a temporary page @ Format32bppArgb and convert this middle image to black and white.

The solution isn't going to be the quickest as I'm upconverting the files before I change them to BW but I'm writing a stop-gap program with a limited lifetime so I'm not terribly concerned.

Refactoring to be done yet but this is working well enough for me to post the solution.

VB.NET:
	Private Sub ResaveTiffBlackWhite(ByVal sourcePath As String, ByVal destPath As String)

		Dim fs As FileStream = File.Open(sourcePath, FileMode.Open, FileAccess.Read)
		Dim srcBmp As Bitmap = CType(Bitmap.FromStream(fs), Bitmap)
		Dim totalPages As Integer = CInt(srcBmp.GetFrameCount(FrameDimension.Page) - 1)

		Dim ici As ImageCodecInfo = GetTiffCodec()
		Dim ep As EncoderParameters = GetBWEncoderParams()

		Dim resizeRatio As Double = 1.0

		Dim destFile As Bitmap = Nothing

		For currentPage As Integer = 0 To totalPages

			srcBmp.SelectActiveFrame(FrameDimension.Page, currentPage)

			Dim tempBmp As Bitmap = GetRGBPage(srcBmp, resizeRatio)
			Dim tempBmd As BitmapData = tempBmp.LockBits(New Rectangle(0, 0, tempBmp.Width, tempBmp.Height), ImageLockMode.ReadOnly, tempBmp.PixelFormat)
			Dim imageSize As Integer = tempBmd.Stride * tempBmd.Height
			Dim tempBuffer(imageSize) As Byte
			System.Runtime.InteropServices.Marshal.Copy(tempBmd.Scan0, tempBuffer, 0, imageSize)
			tempBmp.UnlockBits(tempBmd)

			Dim destPage As New Bitmap(tempBmp.Width, tempBmp.Height, PixelFormat.Format1bppIndexed)
			Dim destBmd As BitmapData = _
			 destPage.LockBits(New Rectangle(0, 0, destPage.Width, destPage.Height), ImageLockMode.WriteOnly, PixelFormat.Format1bppIndexed)
			imageSize = destBmd.Stride * destBmd.Height
			Dim destBuffer(imageSize) As Byte

			destPage = GetBWPage(tempBmp, tempBmd, tempBuffer, destPage, destBmd, destBuffer, imageSize)

			If currentPage = 0 Then
				destFile = destPage
				destFile.Save(destPath, ici, ep)
			Else
				ep.Param(0) = New EncoderParameter(Encoder.SaveFlag, CLng(EncoderValue.FrameDimensionPage))
				destFile.SaveAdd(destPage, ep)
			End If

			If currentPage = CInt(srcBmp.GetFrameCount(FrameDimension.Page) - 1) Then
				ep.Param(0) = New EncoderParameter(Encoder.SaveFlag, CLng(EncoderValue.Flush))
				destFile.SaveAdd(ep)
			End If

		Next

	End Sub

	Private Function GetTiffCodec() As ImageCodecInfo
		For Each ici As ImageCodecInfo In ImageCodecInfo.GetImageEncoders()
			If ici.MimeType = "image/tiff" Then
				Return ici
			End If
		Next
		Return Nothing
	End Function

	Private Function GetBWEncoderParams() As EncoderParameters

		Dim ep As New EncoderParameters(3)
		ep.Param(0) = New EncoderParameter(Encoder.SaveFlag, CLng(EncoderValue.MultiFrame))
		ep.Param(1) = New EncoderParameter(Encoder.Compression, CLng(EncoderValue.CompressionCCITT4))
		ep.Param(2) = New EncoderParameter(Encoder.ColorDepth, 1)

		Return ep

	End Function

	Private Function GetRGBPage(ByVal srcBmp As Bitmap, ByVal resizeRatio As Double) As Bitmap

		Dim tempBmp As New Bitmap(CInt(resizeRatio * srcBmp.Width), CInt(resizeRatio * srcBmp.Height), PixelFormat.Format32bppArgb)
		Dim g As Graphics = Graphics.FromImage(tempBmp)
		g.DrawImage(srcBmp, New Rectangle(0, 0, tempBmp.Width, tempBmp.Height), _
		 0, 0, srcBmp.Width, srcBmp.Height, GraphicsUnit.Pixel)
		g.Dispose()

		Return tempBmp

	End Function

	Private Function GetBWPage(ByVal srcBitmap As Bitmap, _
	   ByVal srcBitmapData As BitmapData, _
	   ByVal srcBuffer() As Byte, _
	   ByVal destBitmap As Bitmap, _
	   ByVal destBitmapData As BitmapData, _
	   ByVal destBuffer() As Byte, _
	   ByVal imageSize As Integer) _
	As Bitmap

		Dim srcIndex As Integer = 0
		Dim destIndex As Integer = 0
		Dim pixTotal As Integer = 0
		Dim destValue As Byte = 0
		Dim pixValue As Byte = 0
		Dim thresh As Integer = 600

		For y As Integer = 0 To srcBitmap.Height - 1
			srcIndex = y * srcBitmapData.Stride
			destIndex = y * destBitmapData.Stride
			destValue = 0
			pixValue = 128

			For x As Integer = 0 To srcBitmap.Width - 1
				pixTotal = srcBuffer(srcIndex + 2)
				pixTotal += srcBuffer(srcIndex + 2)
				pixTotal += srcBuffer(srcIndex + 3)

				If pixTotal > thresh Then
					destValue += CType(pixValue, Byte)
				End If

				If pixValue = 1 Then
					destBuffer(destIndex) = destValue
					destIndex += 1
					destValue = 0
					pixValue = 128
				Else
					pixValue >>= 1
				End If
				srcIndex += 4
			Next
			If pixValue <> 128 Then
				destBuffer(destIndex) = destValue
			End If
		Next

		System.Runtime.InteropServices.Marshal.Copy(destBuffer, 0, destBitmapData.Scan0, imageSize)
		destBitmap.UnlockBits(destBitmapData)

		Return destBitmap

	End Function
 
Thank you very much for doing it in VB.net, i've tried it and it works. :D

BTW, a little enhancement:

At the end of the function: ResaveTiffBlackWhite(ByVal sourcePath As String, ByVal destPath As String), will need to add in the following code to prevent the source file from being locked:

fs.close()
 
At the end of the function: ResaveTiffBlackWhite(ByVal sourcePath As String, ByVal destPath As String), will need to add in the following code to prevent the source file from being locked:

fs.close()

;)

I probably should have come back and corrected the thread when I found that, but it was irrelevant to the thread's purpose.

-----

You're welcome on the solution. It was a fun learning experience for me since I rarely get to work with images.
 
Hi Matt,

Though, this is old post, very useful for me.

I tried both of your solutions and works Fantastic. Thanks very much.

The first solution is faster but the image size is growing bigger. Original size of 3.87 MB goes to 17.7 MB;
The second solution manages the size much better, but very slow. to convert a 20 page doc, takes about 75 sec.

My actual requirement is, just reduce the resolution if the size is bigger than 1800 X 2200, without loosing the image quality.

Could you please suggest me any better solution?

Thanks again for your codes.
 
Back
Top