Martin Cooke Martin Cooke - 1 year ago 271 Question

using and LibTiff to convert large tiff images

I'm using and LibTiff to convert large Tiff images, the good news is that the sample given on there site works:

I'm using this to convert large images into images that are just black n white and can be saved a lot easier. However, its actually a bit too efficient in that its removing a bit too much of the detail in my images. I wondered if anybody knew quite where I can adjust this code so that its not removing quite so many pixels/detail. Need somebody who understands the inner workings of this code/how the tiff file format works I reckon.

I've no doubt there is a setting somewhere in this code somewhere that will allow me to save more of the image and not have quite so much lost.

Below is the code I've been working with from the LibTiff site:


Imports System
Imports System.Diagnostics
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.IO
Imports System.Runtime.InteropServices

Imports BitMiracle.LibTiff.Classic

Namespace BitMiracle.LibTiff.Samples
Public NotInheritable Class ImageToBitonalTiff
Private Sub New()
End Sub
Public Shared Sub Main()
Using bmp As New Bitmap("Sample data\rgb.jpg")
' convert using WriteEncodedStrip
Dim tiffBytes As Byte() = GetTiffImageBytes(bmp, False)
File.WriteAllBytes("ImageToBitonalTiff.tif", tiffBytes)

' make another conversion using WriteScanline
tiffBytes = GetTiffImageBytes(bmp, True)
File.WriteAllBytes("ImageToTiff_ByScanlines.tif", tiffBytes)

End Using
End Sub

Public Shared Function GetTiffImageBytes(ByVal img As Bitmap, ByVal byScanlines As Boolean) As Byte()
Dim raster As Byte() = GetImageRasterBytes(img)

Using ms As New MemoryStream()
Using tif As Tiff = Tiff.ClientOpen("InMemory", "w", ms, New TiffStream())
If tif Is Nothing Then
Return Nothing
End If

tif.SetField(TiffTag.IMAGEWIDTH, img.Width)
tif.SetField(TiffTag.IMAGELENGTH, img.Height)
tif.SetField(TiffTag.COMPRESSION, Compression.CCITTFAX4)
tif.SetField(TiffTag.PHOTOMETRIC, Photometric.MINISBLACK)

tif.SetField(TiffTag.ROWSPERSTRIP, img.Height)

tif.SetField(TiffTag.XRESOLUTION, img.HorizontalResolution)
tif.SetField(TiffTag.YRESOLUTION, img.VerticalResolution)

tif.SetField(TiffTag.SUBFILETYPE, 0)
tif.SetField(TiffTag.BITSPERSAMPLE, 1)
tif.SetField(TiffTag.FILLORDER, FillOrder.MSB2LSB)
tif.SetField(TiffTag.ORIENTATION, Orientation.TOPLEFT)

tif.SetField(TiffTag.SAMPLESPERPIXEL, 1)
tif.SetField(TiffTag.T6OPTIONS, 0)
tif.SetField(TiffTag.RESOLUTIONUNIT, ResUnit.INCH)

tif.SetField(TiffTag.PLANARCONFIG, PlanarConfig.CONTIG)

Dim tiffStride As Integer = tif.ScanlineSize()
Dim stride As Integer = raster.Length / img.Height

If byScanlines Then
' raster stride MAY be bigger than TIFF stride (due to padding in raster raster)
Dim i As Integer = 0, offset As Integer = 0
While i < img.Height
Dim res As Boolean = tif.WriteScanline(raster, offset, i, 0)
If Not res Then
Return Nothing
End If

offset += stride
i += 1
End While
If tiffStride < stride Then
' raster stride is bigger than TIFF stride
' this is due to padding in raster bits
' we need to create correct TIFF strip and write it into TIFF

Dim stripBits As Byte() = New Byte(tiffStride * img.Height - 1) {}
Dim i As Integer = 0, rasterPos As Integer = 0, stripPos As Integer = 0
While i < img.Height
System.Buffer.BlockCopy(raster, rasterPos, stripBits, stripPos, tiffStride)
rasterPos += stride
stripPos += tiffStride
i += 1
End While

' Write the information to the file
Dim n As Integer = tif.WriteEncodedStrip(0, stripBits, stripBits.Length)
If n <= 0 Then
Return Nothing
End If
' Write the information to the file
Dim n As Integer = tif.WriteEncodedStrip(0, raster, raster.Length)
If n <= 0 Then
Return Nothing
End If
End If
End If
End Using

Return ms.GetBuffer()
End Using
Catch generatedExceptionName As Exception
Return Nothing
End Try
End Function

Public Shared Function GetImageRasterBytes(ByVal img As Bitmap) As Byte()
' Specify full image
Dim rect As New Rectangle(0, 0, img.Width, img.Height)

Dim bmp As Bitmap = img
Dim bits As Byte() = Nothing

' Lock the managed memory
If img.PixelFormat <> PixelFormat.Format1bppIndexed Then
bmp = convertToBitonal(img)
End If

Dim bmpdata As BitmapData = bmp.LockBits(rect, ImageLockMode.[ReadOnly], PixelFormat.Format1bppIndexed)

' Declare an array to hold the bytes of the bitmap.
bits = New Byte(bmpdata.Stride * bmpdata.Height - 1) {}

' Copy the sample values into the array.
Marshal.Copy(bmpdata.Scan0, bits, 0, bits.Length)

' Release managed memory
If Not Object.ReferenceEquals(bmp, img) Then
End If
End Try

Return bits
End Function

Private Shared Function convertToBitonal(ByVal original As Bitmap) As Bitmap
Dim sourceStride As Integer
Dim sourceBuffer As Byte() = extractBytes(original, sourceStride)

' Create destination bitmap
Dim destination As New Bitmap(original.Width, original.Height, PixelFormat.Format1bppIndexed)

destination.SetResolution(original.HorizontalResolution, original.VerticalResolution)

' Lock destination bitmap in memory
Dim destinationData As BitmapData = destination.LockBits(New Rectangle(0, 0, destination.Width, destination.Height), ImageLockMode.[WriteOnly], PixelFormat.Format1bppIndexed)

' Create buffer for destination bitmap bits
Dim imageSize As Integer = destinationData.Stride * destinationData.Height
Dim destinationBuffer As Byte() = New Byte(imageSize - 1) {}

Dim sourceIndex As Integer = 0
Dim destinationIndex As Integer = 0
Dim pixelTotal As Integer = 0
Dim destinationValue As Byte = 0
Dim pixelValue As Integer = 128
Dim height As Integer = destination.Height
Dim width As Integer = destination.Width
Dim threshold As Integer = 500

For y As Integer = 0 To height - 1
sourceIndex = y * sourceStride
destinationIndex = y * destinationData.Stride
destinationValue = 0
pixelValue = 128

For x As Integer = 0 To width - 1
' Compute pixel brightness (i.e. total of Red, Green, and Blue values)
pixelTotal = CType(sourceBuffer(sourceIndex + 1), Integer) + CType(sourceBuffer(sourceIndex + 2), Integer) + CType(sourceBuffer(sourceIndex + 3), Integer)

If pixelTotal > threshold Then
destinationValue += CByte(pixelValue)
End If

If pixelValue = 1 Then
destinationBuffer(destinationIndex) = destinationValue
destinationIndex += 1
destinationValue = 0
pixelValue = 128
pixelValue >>= 1
End If

sourceIndex += 4

If pixelValue <> 128 Then
destinationBuffer(destinationIndex) = destinationValue
End If

Marshal.Copy(destinationBuffer, 0, destinationData.Scan0, imageSize)
Return destination
End Function

Private Shared Function extractBytes(ByVal original As Bitmap, ByRef stride As Integer) As Byte()
Dim source As Bitmap = Nothing

' If original bitmap is not already in 32 BPP, ARGB format, then convert
If original.PixelFormat <> PixelFormat.Format32bppArgb Then
source = New Bitmap(original.Width, original.Height, PixelFormat.Format32bppArgb)
source.SetResolution(original.HorizontalResolution, original.VerticalResolution)
Using g As Graphics = Graphics.FromImage(source)
g.DrawImageUnscaled(original, 0, 0)
End Using
source = original
End If

' Lock source bitmap in memory
Dim sourceData As BitmapData = source.LockBits(New Rectangle(0, 0, source.Width, source.Height), ImageLockMode.[ReadOnly], PixelFormat.Format32bppArgb)

' Copy image data to binary array
Dim imageSize As Integer = sourceData.Stride * sourceData.Height
Dim sourceBuffer As Byte() = New Byte(imageSize - 1) {}
Marshal.Copy(sourceData.Scan0, sourceBuffer, 0, imageSize)

' Unlock source bitmap

stride = sourceData.Stride
Return sourceBuffer
If Not Object.ReferenceEquals(source, original) Then
End If
End Try

End Function
End Class
End Namespace

Answer Source

You should tweak threshold value. The value is used to decide what pixels will become white and what will remain black.

 Dim threshold As Integer = 500 
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download