1 |
#Region "Microsoft.VisualBasic::47b09674bddfe48039144b211f47253c, Microsoft.VisualBasic.Core\Extensions\Image\TiffWriter.vb"
|
2 |
|
3 |
|
4 |
|
5 |
|
6 |
|
7 |
|
8 |
|
9 |
|
10 |
|
11 |
|
12 |
|
13 |
|
14 |
|
15 |
|
16 |
|
17 |
|
18 |
|
19 |
|
20 |
|
21 |
|
22 |
|
23 |
|
24 |
|
25 |
|
26 |
|
27 |
|
28 |
|
29 |
|
30 |
|
31 |
|
32 |
|
33 |
|
34 |
|
35 |
|
36 |
|
37 |
|
38 |
|
39 |
|
40 |
|
41 |
|
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 |
|
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 |
|
184 |
|
185 |
|
186 |
|
187 |
|
188 |
|
189 |
|
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 |
|
202 |
|
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
|
208 |
__saveImageExistingMultiplePage(bmp, origionalFile, type, PageNumber, "shreeTemp.tif")
|
209 |
ElseIf PageNumber = 1 Then
|
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 |
|
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 |
|
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 |
|
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 |
|
327 |
Dim sourceData As BitmapData = source.LockBits(
|
328 |
New Rectangle(0, 0, source.Width, source.Height),
|
329 |
ImageLockMode.[ReadOnly],
|
330 |
PixelFormat.Format32bppArgb)
|
331 |
|
332 |
|
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 |
|
338 |
source.UnlockBits(sourceData)
|
339 |
|
340 |
|
341 |
Dim destination As New Bitmap(source.Width, source.Height, PixelFormat.Format1bppIndexed)
|
342 |
|
343 |
|
344 |
Dim destinationData As BitmapData = destination.LockBits(New Rectangle(0, 0, destination.Width, destination.Height), ImageLockMode.[WriteOnly], PixelFormat.Format1bppIndexed)
|
345 |
|
346 |
|
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 |
|
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 |
|
367 |
For x As Integer = 0 To width - 1
|
368 |
|
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 |
|
389 |
Copy(destinationBuffer, 0, destinationData.Scan0, imageSize)
|
390 |
|
391 |
|
392 |
destination.UnlockBits(destinationData)
|
393 |
|
394 |
Return destination
|
395 |
End Function
|
396 |
End Class
|
397 |
End Namespace
|