1 #Region "Microsoft.VisualBasic::47b09674bddfe48039144b211f47253c, Microsoft.VisualBasic.Core\Extensions\Image\TiffWriter.vb"
2
3     ' Author:
4     ' 
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     ' 
9     ' Copyright (c) 2018 GPL3 Licensed
10     ' 
11     ' 
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     ' 
14     ' 
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     ' 
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     ' 
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Class TiffWriter
35     ' 
36     '         Constructor: (+1 Overloads) Sub New
37     ' 
38     '         Function: __bitmaps, __getPageNumber, ConvertToBitonal, ExistingFileSave, GetCodec
39     '                   GetEnumerator, IEnumerable_GetEnumerator, MultipageTiffSave, SaveMultipage, SaveToExistingFile
40     ' 
41     '         Sub: __saveImageExistingMultiplePage, __saveImageExistingSinglePage, __saveMultipage, __saveToExistingFile, Add
42     ' 
43     ' 
44     ' /********************************************************************************/
45
46 #End Region
47
48 Imports System.ComponentModel
49 Imports System.Data
50 Imports System.Drawing
51 Imports System.Collections
52 Imports System.Windows.Forms
53 Imports System.Drawing.Imaging
54 Imports System.Runtime.InteropServices
55 Imports System.Runtime.InteropServices.Marshal
56 Imports System.IO
57 Imports Microsoft.VisualBasic.Language
58
59 Namespace Imaging
60
61     Public Class TiffWriter : Implements IEnumerable(Of Image)
62
63         Dim _imageLayers As List(Of Image)
64
65         Sub New(ParamArray Image As Image())
66             _imageLayers = Image.AsList
67         End Sub
68
69 #Region "Implements Generic.IEnumerable(Of Image)"
70
71         Public Sub Add(ParamArray images As Image())
72             Call _imageLayers.AddRange(images)
73         End Sub
74
75         Public Iterator Function GetEnumerator() As IEnumerator(Of Image) Implements IEnumerable(Of Image).GetEnumerator
76             For Each image As Image In _imageLayers
77                 Yield image
78             Next
79         End Function
80
81         Private Iterator Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
82             Yield GetEnumerator()
83         End Function
84 #End Region
85
86         Public Function MultipageTiffSave(path As String) As Boolean
87             If _imageLayers.Count = 0 Then
88                 Return False
89             Else
90                 Return SaveMultipage(_imageLayers, path, "TIFF")
91             End If
92         End Function
93
94         Public Function ExistingFileSave(path As String) As Boolean
95             If _imageLayers.IsNullOrEmpty Then
96                 Return False
97             End If
98
99             Dim Res = SaveToExistingFile(path, __bitmaps(_imageLayers), "TIFF")
100             Return Res
101         End Function
102
103         Public Shared Function SaveMultipage(bmp As List(Of Image), location As String, type As String) As Boolean
104             If bmp Is Nothing Then Return False
105
106             Try
107                 Call __saveMultipage(__bitmaps(bmp), location, type)
108                 Return True
109             Catch ex As Exception
110                 ex = New Exception(location.ToFileURL & " ===> " & type, ex)
111                 Call App.LogException(ex)
112             End Try
113
114             Return False
115         End Function
116
117         Private Shared Function __bitmaps(bmps As IEnumerable(Of Image)) As Image()
118             Return LinqAPI.Exec(Of Image) <=
119                 From image As Image
120                 In bmps
121                 Where Not image Is Nothing
122                 Let bitonal = ConvertToBitonal(DirectCast(image, Bitmap))
123                 Select DirectCast(bitonal, Image)
124         End Function
125
126         Private Shared Sub __saveMultipage(bmp As Image(), location As String, type As String)
127             Dim codecInfo As ImageCodecInfo = GetCodec(type)
128
129             If bmp.Length = 1 Then
130
131                 Dim iparams As New EncoderParameters(1)
132                 Dim iparam As Encoder = Encoder.Compression
133                 Dim iparamPara As New EncoderParameter(iparam, CLng(EncoderValue.CompressionCCITT4))
134                 iparams.Param(0) = iparamPara
135
136                 Call bmp(0).Save(location, codecInfo, iparams)
137
138             ElseIf bmp.Length > 1 Then
139
140                 Dim saveEncoder As Encoder = Encoder.SaveFlag
141                 Dim compressionEncoder As Encoder = Encoder.Compression
142                 Dim SaveEncodeParam As EncoderParameter
143                 Dim CompressionEncodeParam As EncoderParameter
144                 Dim EncoderParams As New EncoderParameters(2)
145
146                 ' Save the first page (frame).
147                 SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.MultiFrame))
148                 CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
149                 EncoderParams.Param(0) = CompressionEncodeParam
150                 EncoderParams.Param(1) = SaveEncodeParam
151
152                 Call IO.File.Delete(location)
153                 Call bmp(0).Save(location, codecInfo, EncoderParams)
154
155                 For i As Integer = 1 To bmp.Length - 1
156                     SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.FrameDimensionPage))
157                     CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
158                     EncoderParams.Param(0) = CompressionEncodeParam
159                     EncoderParams.Param(1) = SaveEncodeParam
160
161                     Call bmp(0).SaveAdd(bmp(i), EncoderParams)
162                 Next
163
164                 SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.Flush))
165                 EncoderParams.Param(0) = SaveEncodeParam
166                 Call bmp(0).SaveAdd(EncoderParams)
167             End If
168         End Sub
169
170         Public Shared Function GetCodec(type As String) As ImageCodecInfo
171             Dim info As ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()
172
173             For i As Integer = 0 To info.Length - 1
174                 Dim EnumName As String = type.ToString()
175                 If info(i).FormatDescription.Equals(EnumName) Then
176                     Return info(i)
177                 End If
178             Next
179
180             Return Nothing
181         End Function
182
183         ''' <summary>
184         ''' This function can save newly scanned images on existing single page or multipage file
185         ''' </summary>
186         ''' <param name="fileName"></param>
187         ''' <param name="bmp"></param>
188         ''' <param name="type"></param>
189         ''' <returns></returns>
190         Public Shared Function SaveToExistingFile(fileName As String, bmp As Image(), type As String) As Boolean
191             Try
192                 Call __saveToExistingFile(fileName, bmp, type)
193                 Return True
194             Catch ex As Exception
195                 Call App.LogException(ex)
196                 Return False
197             End Try
198         End Function
199
200         Private Shared Sub __saveToExistingFile(fileName As String, bmp As Image(), type As String)
201             'bmp[0] is containing Image from Existing file on which we will append newly scanned Images
202             'SO first we will dicide wheter existing file is single page or multipage
203             Dim fr As FileStream = IO.File.Open(fileName, FileMode.Open, FileAccess.ReadWrite)
204             Dim origionalFile As Image = Image.FromStream(fr)
205             Dim PageNumber As Integer = __getPageNumber(origionalFile)
206
207             If PageNumber > 1 Then        'Existing File is multi page tiff file
208                 __saveImageExistingMultiplePage(bmp, origionalFile, type, PageNumber, "shreeTemp.tif")
209             ElseIf PageNumber = 1 Then                    'Existing file is single page file
210                 __saveImageExistingSinglePage(bmp, origionalFile, type, "shreeTemp.tif")
211             End If
212
213             Call fr.Flush()
214             Call fr.Close()
215
216             Call IO.File.Replace("shreeTemp.tif", fileName, "Backup.tif", True)
217         End Sub
218
219         Private Shared Sub __saveImageExistingSinglePage(bmp As Image(), origionalFile As Image, type As String, location As String)
220             Dim codecInfo As ImageCodecInfo = GetCodec(type)
221             Dim saveEncoder As Encoder
222             Dim compressionEncoder As Encoder
223             Dim SaveEncodeParam As EncoderParameter
224             Dim CompressionEncodeParam As EncoderParameter
225             Dim EncoderParams As New EncoderParameters(2)
226
227             saveEncoder = Encoder.SaveFlag
228             compressionEncoder = Encoder.Compression
229             SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.MultiFrame))
230             CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
231             EncoderParams.Param(0) = CompressionEncodeParam
232             EncoderParams.Param(1) = SaveEncodeParam
233             origionalFile = ConvertToBitonal(DirectCast(origionalFile, Bitmap))
234             origionalFile.Save(location, codecInfo, EncoderParams)
235
236             For i As Integer = 0 To bmp.Count - 1
237                 SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.FrameDimensionPage))
238                 CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
239                 EncoderParams.Param(0) = CompressionEncodeParam
240                 EncoderParams.Param(1) = SaveEncodeParam
241
242                 origionalFile.SaveAdd(bmp(i), EncoderParams)
243             Next
244
245             SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.Flush))
246             EncoderParams.Param(0) = SaveEncodeParam
247             origionalFile.SaveAdd(EncoderParams)
248         End Sub
249
250         Private Shared Sub __saveImageExistingMultiplePage(bmp As Image(), origionalFile As Image, type As String, PageNumber As Integer, location As String)
251             Dim codecInfo As ImageCodecInfo = GetCodec(type)
252             Dim saveEncoder As Encoder
253             Dim compressionEncoder As Encoder
254             Dim SaveEncodeParam As EncoderParameter
255             Dim CompressionEncodeParam As EncoderParameter
256             Dim EncoderParams As New EncoderParameters(2)
257             Dim pages As Bitmap
258             Dim NextPage As Bitmap
259
260             saveEncoder = Encoder.SaveFlag
261             compressionEncoder = Encoder.Compression
262
263             origionalFile.SelectActiveFrame(FrameDimension.Page, 0)
264             pages = New Bitmap(origionalFile)
265             pages = ConvertToBitonal(pages)
266
267             ' Save the first page (frame).
268             SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.MultiFrame))
269             CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
270             EncoderParams.Param(0) = CompressionEncodeParam
271             EncoderParams.Param(1) = SaveEncodeParam
272
273             pages.Save(location, codecInfo, EncoderParams)
274
275
276             For i As Integer = 1 To PageNumber - 1
277                 SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.FrameDimensionPage))
278                 CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
279                 EncoderParams.Param(0) = CompressionEncodeParam
280                 EncoderParams.Param(1) = SaveEncodeParam
281
282                 origionalFile.SelectActiveFrame(FrameDimension.Page, i)
283                 NextPage = New Bitmap(origionalFile)
284                 NextPage = ConvertToBitonal(NextPage)
285
286                 pages.SaveAdd(NextPage, EncoderParams)
287             Next
288
289             For i As Integer = 0 To bmp.Count - 1
290                 SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.FrameDimensionPage))
291                 CompressionEncodeParam = New EncoderParameter(compressionEncoder, CLng(EncoderValue.CompressionCCITT4))
292                 EncoderParams.Param(0) = CompressionEncodeParam
293                 EncoderParams.Param(1) = SaveEncodeParam
294                 bmp(i) = DirectCast(ConvertToBitonal(DirectCast(bmp(i), Bitmap)), Bitmap)
295
296                 pages.SaveAdd(bmp(i), EncoderParams)
297             Next
298
299             SaveEncodeParam = New EncoderParameter(saveEncoder, CLng(EncoderValue.Flush))
300             EncoderParams.Param(0) = SaveEncodeParam
301             pages.SaveAdd(EncoderParams)
302         End Sub
303
304         Private Shared Function __getPageNumber(img As Image) As Integer
305             Dim objGuid As Guid = img.FrameDimensionsList(0)
306             Dim objDimension As New FrameDimension(objGuid)
307             'Gets the total number of frames in the .tiff file
308             Dim PageNumber As Integer = img.GetFrameCount(objDimension)
309             Return PageNumber
310         End Function
311
312         Public Shared Function ConvertToBitonal(original As Bitmap) As Bitmap
313             Dim source As Bitmap = Nothing
314
315             ' If original bitmap is not already in 32 BPP, ARGB format, then convert
316             If original.PixelFormat <> PixelFormat.Format32bppArgb Then
317                 source = New Bitmap(original.Width, original.Height, PixelFormat.Format32bppArgb)
318                 source.SetResolution(original.HorizontalResolution, original.VerticalResolution)
319                 Using g As Graphics = Graphics.FromImage(source)
320                     g.DrawImageUnscaled(original, 0, 0)
321                 End Using
322             Else
323                 source = original
324             End If
325
326             ' Lock source bitmap in memory
327             Dim sourceData As BitmapData = source.LockBits(
328                 New Rectangle(0, 0, source.Width, source.Height),
329                 ImageLockMode.[ReadOnly],
330                 PixelFormat.Format32bppArgb)
331
332             ' Copy image data to binary array
333             Dim imageSize As Integer = sourceData.Stride * sourceData.Height
334             Dim sourceBuffer As Byte() = New Byte(imageSize - 1) {}
335             Copy(sourceData.Scan0, sourceBuffer, 0, imageSize)
336
337             ' Unlock source bitmap
338             source.UnlockBits(sourceData)
339
340             ' Create destination bitmap
341             Dim destination As New Bitmap(source.Width, source.Height, PixelFormat.Format1bppIndexed)
342
343             ' Lock destination bitmap in memory
344             Dim destinationData As BitmapData = destination.LockBits(New Rectangle(0, 0, destination.Width, destination.Height), ImageLockMode.[WriteOnly], PixelFormat.Format1bppIndexed)
345
346             ' Create destination buffer
347             imageSize = destinationData.Stride * destinationData.Height
348             Dim destinationBuffer As Byte() = New Byte(imageSize - 1) {}
349
350             Dim sourceIndex As Integer = 0
351             Dim destinationIndex As Integer = 0
352             Dim pixelTotal As Integer = 0
353             Dim destinationValue As Byte = 0
354             Dim pixelValue As Integer = 128
355             Dim height As Integer = source.Height
356             Dim width As Integer = source.Width
357             Dim threshold As Integer = 500
358
359             ' Iterate lines
360             For y As Integer = 0 To height - 1
361                 sourceIndex = y * sourceData.Stride
362                 destinationIndex = y * destinationData.Stride
363                 destinationValue = 0
364                 pixelValue = 128
365
366                 ' Iterate pixels
367                 For x As Integer = 0 To width - 1
368                     ' Compute pixel brightness (i.e. total of Red, Green, and Blue values)
369                     pixelTotal = CInt(sourceBuffer(sourceIndex + 1)) + CInt(sourceBuffer(sourceIndex + 2)) + CInt(sourceBuffer(sourceIndex + 3))
370                     If pixelTotal > threshold Then
371                         destinationValue += CByte(pixelValue)
372                     End If
373                     If pixelValue = 1 Then
374                         destinationBuffer(destinationIndex) = destinationValue
375                         destinationIndex += 1
376                         destinationValue = 0
377                         pixelValue = 128
378                     Else
379                         pixelValue >>= 1
380                     End If
381                     sourceIndex += 4
382                 Next
383                 If pixelValue <> 128 Then
384                     destinationBuffer(destinationIndex) = destinationValue
385                 End If
386             Next
387
388             ' Copy binary image data to destination bitmap
389             Copy(destinationBuffer, 0, destinationData.Scan0, imageSize)
390
391             ' Unlock destination bitmap
392             destination.UnlockBits(destinationData)
393
394             Return destination
395         End Function
396     End Class
397 End Namespace