1 #Region "Microsoft.VisualBasic::8558b2fb94b68822f62a8bb63df7db18, Microsoft.VisualBasic.Core\Extensions\Image\Bitmap\BitmapScale.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     '     Module BitmapScale
35     
36     '         FunctionGetBinaryBitmap
37     '         Enum BinarizationStyles
38     
39     
40     
41     
42     '         Delegate Sub
43     
44     '             FunctionByteLength, Colors, Grayscale, (+2 Overloads) GrayScale
45     
46     '             Sub: AdjustContrast, Binarization, BitmapPixelScans
47     
48     
49     ' /********************************************************************************/
50
51 #End Region
52
53 Imports System.Drawing
54 Imports System.Drawing.Imaging
55 Imports System.Math
56 Imports System.Runtime.CompilerServices
57 Imports Microsoft.VisualBasic.Emit
58 Imports sys = System.Math
59
60 Namespace Imaging.BitmapImage
61
62     ''' <summary>
63     ''' Grayscale and binarization extensions
64     ''' </summary>
65     Public Module BitmapScale
66
67         <Extension>
68         Public Function GetBinaryBitmap(res As Image, Optional style As BinarizationStyles = BinarizationStyles.Binary) As Bitmap
69             Dim bmp As New Bitmap(DirectCast(res.Clone, Image))
70             bmp.Binarization(style)
71             Return bmp
72         End Function
73
74         Public Enum BinarizationStyles
75             SparseGray = 3
76             Binary = 4
77         End Enum
78
79         ''' <summary>
80         ''' 
81         ''' </summary>
82         ''' <param name="byts">Unmanaged memory pointer that point to the bitmap data buffer.</param>
83         Public Delegate Sub PixelScanPointer(byts As Marshal.Byte)
84
85         ''' <summary>
86         ''' A generic bitmap pixel scan framework that using memory pointer
87         ''' </summary>
88         ''' <param name="curBitmap"></param>
89         ''' <param name="scan"></param>
90         <Extension>
91         Public Sub BitmapPixelScans(ByRef curBitmap As Bitmap, scan As PixelScanPointer)
92             ' Lock the bitmap's bits.  
93             Dim rect As New Rectangle(0, 0, curBitmap.Width, curBitmap.Height)
94             Dim bmpData As BitmapData = curBitmap.LockBits(
95                 rect,
96                 ImageLockMode.ReadWrite,
97                 curBitmap.PixelFormat
98             )
99             Get the address of the first line.
100             Dim ptr As IntPtr = bmpData.Scan0
101             Declare an array to hold the bytes of the bitmap.
102             Dim bytes As Integer = sys.Abs(bmpData.Stride) * curBitmap.Height
103
104             Using rgbValues As Marshal.Byte = New Marshal.Byte(ptr, bytes)
105                 Calls unmanaged memory write when this 
106                 ' memory pointer was disposed
107                 Call scan(rgbValues)
108             End Using
109
110             ' Unlock the bits.
111             Call curBitmap.UnlockBits(bmpData)
112         End Sub
113
114         ''' <summary>
115         ''' 
116         ''' </summary>
117         ''' <param name="curBitmap"></param>
118         ''' <remarks>
119         ''' http://www.codeproject.com/Articles/1094534/Image-Binarization-Using-Program-Languages
120         ''' 
121         ''' The .net Bitmap object keeps a reference to HBITMAP handle, Not to the underlying bitmap itself.
122         ''' So, single pixel access call to <see cref="Bitmap.SetPixel"/>/<see cref="Bitmap.GetPixel"/> Or 
123         ''' even retrieve Width/Height properties does something Like
124         ''' lock handle In place-Get/Set value/unlock handle. It Is the most inefficient way To manipulate bitmaps In .NET. 
125         ''' The author should read about <see cref="Bitmap.LockBits"/> first.
126         ''' </remarks>
127         <Extension> Public Sub Binarization(ByRef curBitmap As Bitmap, Optional style As BinarizationStyles = BinarizationStyles.Binary)
128             Dim iR As Integer = 0 ' Red
129             Dim iG As Integer = 0 ' Green
130             Dim iB As Integer = 0 ' Blue
131             Dim scanInternal As PixelScanPointer =
132  _
133                 Sub(byts As Marshal.Byte)
134
135                     Set every third value to 255. A 24bpp bitmap will binarization.  
136                     Do While Not byts.NullEnd(3)
137                         Get the red channel
138                         iR = byts(2)
139                         Get the green channel
140                         iG = byts(1)
141                         Get the blue channel
142                         iB = byts(0)
143
144                         If the gray value more than threshold and then set a white pixel.
145                         If (iR + iG + iB) / 3 > 100 Then
146                             ' White pixel
147                             byts(2) = 255
148                             byts(1) = 255
149                             byts(0) = 255
150                         Else
151                             ' Black pixel
152                             byts(2) = 0
153                             byts(1) = 0
154                             byts(0) = 0
155                         End If
156
157                         ' move forward this memory pointer by a specific offset.
158                         byts += style
159                     Loop
160                 End Sub
161
162             Call curBitmap.BitmapPixelScans(scanInternal)
163         End Sub
164
165         ''' <summary>
166         ''' 调整图像的对比度
167         ''' </summary>
168         ''' <param name="bmp"></param>
169         ''' <param name="contrast#"></param>
170         <Extension> Public Sub AdjustContrast(ByRef bmp As Bitmap, contrast#)
171             Dim contrastLookup As Byte() = New Byte(255) {}
172             Dim newValue As Double = 0
173             Dim c As Double = (100.0 + contrast) / 100.0
174
175             c *= c
176
177             For i As Integer = 0 To 255
178                 newValue = CDbl(i)
179                 newValue /= 255.0
180                 newValue -= 0.5
181                 newValue *= c
182                 newValue += 0.5
183                 newValue *= 255
184
185                 If newValue < 0 Then
186                     newValue = 0
187                 End If
188                 If newValue > 255 Then
189                     newValue = 255
190                 End If
191
192                 contrastLookup(i) = CByte(Truncate(newValue))
193             Next
194
195             Using bitmapdata As BitmapBuffer = BitmapBuffer.FromBitmap(bmp)
196                 Dim destPixels As BitmapBuffer = bitmapdata
197
198                 For y As Integer = 0 To bitmapdata.Height - 1
199                     destPixels += bitmapdata.Stride
200
201                     For x As Integer = 0 To bitmapdata.Width - 1
202                         destPixels(x * PixelSize) = contrastLookup(destPixels(x * PixelSize))
203                         destPixels(x * PixelSize + 1) = contrastLookup(destPixels(x * PixelSize + 1))
204                         destPixels(x * PixelSize + 2) = contrastLookup(destPixels(x * PixelSize + 2))
205                     Next
206                 Next
207             End Using
208         End Sub
209
210         ''' <summary>
211         ''' convert color bitmaps to grayscale.(灰度图)
212         ''' </summary>
213         ''' <param name="source"></param>
214         ''' <returns></returns>
215         <Extension> Public Function Grayscale(source As Image) As Bitmap
216             Dim curBitmap As New Bitmap(source)
217             Dim iR As Integer = 0 ' Red
218             Dim iG As Integer = 0 ' Green
219             Dim iB As Integer = 0 ' Blue
220             Dim scanInternal As PixelScanPointer =
221  _
222                 Sub(byts As Marshal.Byte)
223                     Set every third value to 255. A 24bpp bitmap will binarization.  
224                     Do While Not byts.NullEnd(3)
225                         Get the red channel
226                         iR = byts(2)
227                         Get the green channel
228                         iG = byts(1)
229                         Get the blue channel
230                         iB = byts(0)
231
232                         Dim luma% = GrayScale(iR, iG, iB)
233                         ' gray pixel
234                         byts(2) = luma
235                         byts(1) = luma
236                         byts(0) = luma
237
238                         byts += BinarizationStyles.Binary
239                     Loop
240                 End Sub
241
242             Call curBitmap.BitmapPixelScans(scanInternal)
243             Return curBitmap
244         End Function
245
246         <MethodImpl(MethodImplOptions.AggressiveInlining)>
247         Public Function GrayScale(R%, G%, B%) As Integer
248             Return CInt(Truncate(R * 0.3 + G * 0.59 + B * 0.11))
249         End Function
250
251         ''' <summary>
252         ''' Color gray scale
253         ''' </summary>
254         ''' <param name="c"></param>
255         ''' <returns></returns>
256         ''' 
257         <MethodImpl(MethodImplOptions.AggressiveInlining)>
258         <Extension>
259         Public Function GrayScale(c As Color) As Integer
260             Return GrayScale(c.R, c.G, c.B)
261         End Function
262
263         ''' <summary>
264         ''' How many bytes does this bitmap contains?
265         ''' </summary>
266         ''' <param name="rect">The bitmap size or a specific region on the bitmap.</param>
267         ''' <returns></returns>
268         <Extension>
269         Public Function ByteLength(rect As Rectangle) As Integer
270             Dim width As Integer = rect.Width * PixelSize  ' ARGB -> 4
271             Return width * rect.Height
272         End Function
273
274         ''' <summary>
275         ''' Convert the bitmap memory bytes into pixels
276         ''' </summary>
277         ''' <param name="buffer"></param>
278         ''' <returns></returns>
279         <Extension>
280         Public Iterator Function Colors(buffer As Byte()) As IEnumerable(Of Color)
281             Dim iR As Byte
282             Dim iG As Byte
283             Dim iB As Byte
284
285             ' offset ARGB 4 bytes
286             For i As Integer = 0 To buffer.Length - 1 Step PixelSize
287                 iR = buffer(i + 2)
288                 iG = buffer(i + 1)
289                 iB = buffer(i + 0)
290
291                 Yield Color.FromArgb(CInt(iR), CInt(iG), CInt(iB))
292             Next
293         End Function
294     End Module
295 End Namespace