VERSION 5.00
Begin VB.Form Form1
BorderStyle = 4 'Fixed ToolWindow
ClientHeight = 3615
ClientLeft = 45
ClientTop = 315
ClientWidth = 4110
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3615
ScaleWidth = 4110
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command1
Caption = "Fill"
Height = 315
Left = 3120
TabIndex = 1
Top = 120
Width = 855
End
Begin VB.PictureBox map
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
ForeColor = &H80000008&
Height = 2655
Left = 120
ScaleHeight = 175
ScaleMode = 3 'Pixel
ScaleWidth = 255
TabIndex = 0
Top = 840
Width = 3855
End
Begin VB.Label Label1
Caption = "Scribble on the picture below using the mouse and then click 'Fill' and the area on the picture that you would like to fill."
Height = 735
Left = 120
TabIndex = 2
Top = 120
Width = 2895
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Fill algorithm
'Liam Galvin 2005
Dim check(3000000, 1 To 2) As Integer
Dim start(1) As Integer
Dim releaseready As Boolean
Dim cn As Long
Dim mast As Long
Dim started As Boolean
Dim fillcol As Long
Private Sub Command1_Click()
release
End Sub
Private Sub Form_Load()
map.DrawWidth = 2
map.FontSize = 36
map.ForeColor = vbWhite
map.Print " Fill Here"
Me.Show
End Sub
Private Sub map_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
start(0) = X
start(1) = Y
End Sub
Private Sub map_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If (start(0) = 0) And (start(1) = 0) Then
start(0) = X
start(1) = Y
End If
map.Line (start(0), start(1))-(X, Y), vbWhite
start(0) = X
start(1) = Y
Else
start(0) = 0
start(1) = 0
End If
End Sub
Private Sub release()
Command1.Enabled = False
releaseready = True
End Sub
Private Sub manage(k As Integer, l As Integer)
map.DrawWidth = 1
mast = 0
cn = 2
check(1, 1) = k
check(1, 2) = l
ps = 0
Do
mast = mast + 1
driveloop check(mast, 1), check(mast, 2)
Loop Until mast >= cn
Command1.Enabled = True
map.DrawWidth = 2
End Sub
Private Sub driveloop(xp As Integer, yp As Integer)
If (check(mast, 1) < 1) Or (check(mast, 1) > map.Height - 1) _
Or (check(mast, 2) < 1) Or (check(mast, 2) > map.Height - 1) Then Exit Sub
If map.Point(xp - 1, yp) = fillcol Then
check(cn, 1) = xp - 1
check(cn, 2) = yp
map.PSet (xp - 1, yp), vbRed
cn = cn + 1
End If
If map.Point(xp + 1, yp) = fillcol Then
check(cn, 1) = xp + 1
check(cn, 2) = yp
map.PSet (xp + 1, yp), vbRed
cn = cn + 1
End If
If map.Point(xp, yp - 1) = fillcol Then
check(cn, 1) = xp
check(cn, 2) = yp - 1
map.PSet (xp, yp - 1), vbRed
cn = cn + 1
End If
If map.Point(xp, yp + 1) = fillcol Then
check(cn, 1) = xp
check(cn, 2) = yp + 1
map.PSet (xp, yp + 1), vbRed
cn = cn + 1
End If
End Sub
Private Sub map_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If releaseready = True Then
releaseready = False
started = True
fillcol = map.Point(X, Y)
manage start(0), start(1)
End If
End Sub