Want to see what people are talking about? See the latest forum posts.

View \Form1.frm

MyFill 1.0

Submitted By: Subcynic
Rating: starstarstarstarstar (Rate It)


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
 
corner
© 1996-2008. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
Publisher: Lars Hagelin.
bootstrapLabs Logo A bootstrapLabs project.