VB.NET中應用種子填充算法完成給圖片著色的例子。本站提示廣大學習愛好者：（VB.NET中應用種子填充算法完成給圖片著色的例子）文章只能為提供參考，不一定能成為您想要的結果。以下是VB.NET中應用種子填充算法完成給圖片著色的例子正文
或人比來在應用C#寫一個相似Windows的繪圖對象，在填色的部門卡住了。勞資要他應用種子填充算法著色（不要挪用Windows供給的API，不然還錘煉個毛線），如今我把這個功效完成了，法式的效力很高。如今在這裡年夜概寫一下完成辦法。
法式是用VB.NET寫的，C#寫法相似（並且還不須要應用Marshal類拜訪非托管資本，加倍便利）。法式的運轉成果以下：
種子填充算法說白了就是寬度優先搜刮算法（BFS），假如你不曉得這是甚麼器械，那解釋你數據構造基本就沒有學，請自行彌補響應的常識。
第一步：完成“鉛筆”對象
我們界說以下的全局變量（窗體類的公有成員），感化是啥一看名字就曉得：
Private Enum DrawStyle
Drawing = 0
Fill = 1
DrawDragging = 2
End Enum
Private _fillColor() As Color = {Color.Blue, Color.Green, Color.Red, Color.LightGray, Color.LightPink, Color.LightSkyBlue, _
Color.GreenYellow, Color.Gold, Color.LightSeaGreen}
Private _drawStyle As DrawStyle = DrawStyle.Drawing
Private _imgMain As Bitmap
Private _g As Graphics
Private _lastPosition As Point
Private _drawingPen As Pen
這個法式中填充的色彩是隨機決議的（都懶得做一個選色彩的功效了），可以填充的色彩在_fillColor數組中。_drawStyle界說以後的畫圖形式（Drawing表現應用鉛筆對象，但未按下，Fill表現預備填充，DrawDragging表現鼠標正按下並拖拽）。
_imgMain是繪制的圖片，_g是創立在這個Bitmap上的Graphics對象。
須要留意的是，Drawing和Drawing2D類不供給畫點的辦法，我們須要經由過程畫直線或畫矩形來模仿。至於_lastPosition的感化，因為鼠標拖拽進程中，假如速渡過快，那末MouseMove事宜中的坐標點（每次MouseMove事宜被觸發）其實不是持續的，所以我們須要在以後點和上一次的鼠標地位之間畫一條直線，不然畫出來的線是連續的。
MouseDown、MouseMove和MouseUp完成鉛筆對象的根本功效，代碼以下：
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
If CheckBox1.Checked Then _drawStyle = DrawStyle.Fill Else _drawStyle = DrawStyle.Drawing
If _drawStyle = DrawStyle.Fill Then
Call FillRegion(e.Location, _fillColor(New Random().Next(_fillColor.Count)))
Else
_drawStyle = DrawStyle.DrawDragging
_lastPosition = e.Location
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If _drawStyle = DrawStyle.DrawDragging Then
_g.DrawLine(_drawingPen, _lastPosition, e.Location)
_lastPosition = e.Location
PictureBox1.Image = _imgMain
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
_drawStyle = DrawStyle.Drawing
End Sub
2、正題——種子填充算法的完成
下面說了一堆空話，如今終究可以開端完成填充的算法了。
當用戶點擊圖片中某一個點後，須要填充與這個點相鄰的、色彩雷同的其他點。為何要叫“種子填充”呢？年夜概是如許：你在點中的誰人點中播下一顆種子，它開花成果（色彩釀成目的色彩），然後它又收獲出新的種子（與它高低閣下相鄰且色彩等於本來色彩的點）；新種子再開花成果（變色彩），收獲新種子…… 如斯來去，直到沒有處所收獲了為止，算法停止。
依照BFS平日的完成方法，可使用輪回隊列作為數據構造。關於BFS算法來講，須要的存儲空間較年夜，詳細須要若干還真欠好預算。這裡給年夜家一個參考，我的這個法式圖片框年夜小是832*450，年夜概是37萬像素，輪回隊列的容量設置為1600可以知足需求（全體著色）。假如你的圖片框比擬年夜，可以先取一個較年夜的數值（好比8000），再逐步減少，重復測驗考試。
完成這個輪回隊列直接界說成一個一維數組便可以了，沒有需要應用ConcurrentQueue類，不然機能會降低，也沒有這個需要。
起首，因為要向四個偏向填充，為了不相似的代碼重復寫招致法式丑惡非常，我們可以界說一個fill_direction數組：
Dim fill_direction() As Point = {New Point(-1, 0), New Point(1, 0), New Point(0, -1), New Point(0, 1)}
如許，應用一個For輪回便可以完成四個偏向的操作了。
依照起首說的思緒，法式的完成就很簡略了：起首將點擊的誰人點入隊，記載這個點的色彩。然後應用一個輪回，掏出隊首元素，並向四個偏向撒種子（色彩雷同，且沒有越出圖片框界限），將每個種子的色彩轉變成目的色彩並入隊。如斯來去直到隊列為空為止。代碼以下：
Private Sub FillRegion2(sourcePoint As Point, destinationColor As Color)
Dim new_bitmap As Bitmap = DirectCast(PictureBox1.Image, Bitmap)
Dim source_color As Color = new_bitmap.GetPixel(sourcePoint.X, sourcePoint.Y)
Dim MIN_X As Integer = 0, MIN_Y As Integer = 0
Dim MAX_X As Integer = PictureBox1.Width - 1, MAX_Y As Integer = PictureBox1.Height - 1
Dim fill_queue(MAX_FILL_QUEUE) As Point
Dim fill_direction() As Point = {New Point(-1, 0), New Point(1, 0), New Point(0, -1), New Point(0, 1)}
Dim queue_head As Integer = 0
Dim queue_tail As Integer = 1
fill_queue(queue_tail) = sourcePoint
Do While queue_head <> queue_tail
queue_head = (queue_head + 1) Mod MAX_FILL_QUEUE
Dim current_point As Point = fill_queue(queue_head)
For i As Integer = 0 To 3
Dim new_point_x As Integer = current_point.X + fill_direction(i).X
Dim new_point_y As Integer = current_point.Y + fill_direction(i).Y
If new_point_x < MIN_X OrElse new_point_y < MIN_Y OrElse new_point_x > MAX_X OrElse new_point_y > MAX_Y Then Continue For
If new_bitmap.GetPixel(new_point_x, new_point_y) = source_color Then
new_bitmap.SetPixel(new_point_x, new_point_y, destinationColor)
queue_tail = (queue_tail + 1) Mod MAX_FILL_QUEUE
fill_queue(queue_tail) = New Point(new_point_x, new_point_y)
End If
Next
Loop
PictureBox1.Image = new_bitmap
End Sub
能夠會有一個成績，就是第一個點在入隊前應當要先改成目的色彩，但我這裡沒有改。後果實際上是一樣的，由於它旁邊的點在撒種子的時刻發明這個點色彩沒變，照樣會將它入隊（留意：假如只要一個點須要填充，即肇端點沒有相鄰的點，那末會招致這個點不被填充成目的色彩，請自行改良算法）。我們在這裡疏忽這個小成績。
運轉法式，可以發明曾經可以完成填充的功效了。
備注：假如目的色彩和肇端點的色彩雷同，且肇端點有相鄰的、雷同色彩的點，那末會招致雷同的點重復入隊，終究招致隊列溢出。此時隊首指針等於隊尾指針，法式會以為隊列為空而終止填充，是以終究成果沒有變更（假如不是采取輪回隊列，會招致法式逝世輪回）。為了不這類情形，應當在停止填充前斷定目的色彩能否和原點色彩雷同，雷同時直接停止。在這裡我沒有停止如許的斷定。
3、晉升效力
在運轉法式時發明了一個成績，就是假如填色區域過年夜（好比直接填充全部圖片框），法式會很慢，年夜概須要2秒閣下能力填充完。發生這個成績的重要緣由是GetPixel和SetPixel的機能不高，每次挪用這兩個辦法時都邑做許多額定的操作，在我之前應用匯編說話挪用DOS中止畫點時就有這個成績。
為此，M$供給了LockBits和UnlockBits辦法。LockBits辦法可以將圖片鎖定到內存中，以便經由過程拜訪內存直接對這些數據停止修正。在C#中我們可以直接應用指針拜訪這片數據，但關於VB是不可的，由於VB不許可應用指針，我們可以借助System.Runtime.InteropServices.Marshal類到達直接拜訪內存的功效。
關於LockBits的具體引見可以參考這篇日記：http://www.bobpowell.net/lockingbits.htm
個中很主要的一點就是要弄清晰若何盤算圖片上某一點的內存地址。
如這張圖所示（圖片來自那篇博文），坐標為(X,Y)的點在內存中的地址就是Scan0 + (Y * Stride) + X * k。k與圖片中每一個點占用的字節有關，我們這裡應用的是32位ARPG，每一個像素占4個字節，是以k就是4。別的留意Stride其實不必定是n*k（n表現每行存n個像素），由於末尾能夠有過剩的位使數組對齊（與處置機的字長婚配）。不管若何，我們可以經由過程BitmapData對象的Stride屬性獲得。
因為一個ARGB值是4個字節，所以我們須要挪用Marshal類的ReadInt32和WriteInt32辦法對每一個像素點的色彩停止讀取和寫入。我們要操作的是色彩的ARGB值而不是Color對象。
那末把下面的代碼略加改革，便可以寫出以下法式：
Private Sub FillRegion(sourcePoint As Point, destinationColor As Color)
Dim new_bitmap As Bitmap = DirectCast(PictureBox1.Image, Bitmap)
Dim source_color_int As Integer = new_bitmap.GetPixel(sourcePoint.X, sourcePoint.Y).ToArgb
Dim bitmap_data As BitmapData = new_bitmap.LockBits(New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height), _
Imaging.ImageLockMode.ReadWrite, new_bitmap.PixelFormat)
Dim stride As Integer = Math.Abs(bitmap_data.Stride)
Dim scan0 As IntPtr = bitmap_data.Scan0
Dim bytes As Integer = stride * new_bitmap.Height
Dim MIN_X As Integer = 1, MIN_Y As Integer = 1
Dim MAX_X As Integer = PictureBox1.Width - 1, MAX_Y As Integer = PictureBox1.Height - 1
Dim fill_queue(MAX_FILL_QUEUE) As Point
Dim fill_direction() As Point = {New Point(-1, 0), New Point(1, 0), New Point(0, -1), New Point(0, 1)}
Dim destination_color_int As Integer = destinationColor.ToArgb
Dim queue_head As Integer = 0
Dim queue_tail As Integer = 1
fill_queue(queue_tail) = sourcePoint
Do While queue_head <> queue_tail
queue_head = (queue_head + 1) Mod MAX_FILL_QUEUE
Dim current_point As Point = fill_queue(queue_head)
For i As Integer = 0 To 3
Dim new_point_x As Integer = current_point.X + fill_direction(i).X
Dim new_point_y As Integer = current_point.Y + fill_direction(i).Y
If new_point_x < MIN_X OrElse new_point_y < MIN_Y OrElse new_point_x > MAX_X OrElse new_point_y > MAX_Y Then Continue For
Dim offset As Integer = (new_point_y * stride) + new_point_x * 4
Dim current_color_int As Integer = System.Runtime.InteropServices.Marshal.ReadInt32(scan0, offset)
If current_color_int = source_color_int Then
System.Runtime.InteropServices.Marshal.WriteInt32(scan0, offset, destination_color_int)
queue_tail = (queue_tail + 1) Mod MAX_FILL_QUEUE
fill_queue(queue_tail) = New Point(new_point_x, new_point_y)
End If
Next
Loop
new_bitmap.UnlockBits(bitmap_data)
PictureBox1.Image = new_bitmap
End Sub
固然，假如你還有其他更好的完成辦法，還請多多指教。（啊，不要告知我應用Windows的API。。。） 如今運轉一下法式，發明效力急劇上升。我測試了一下，在我的電腦上，填充37萬個像素年夜概只須要50~60毫秒閣下，效力照樣使人滿足的。
