Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 263
  • Last Modified:

Paint Fill

I would like to know how to get the screen to fill or be painted with respect to lines as boundries. Like the paint bucket in MSPaint.
0
bradsoblesky
Asked:
bradsoblesky
  • 4
  • 3
1 Solution
 
clifABBCommented:
The following subroutine will flood from the X-Y point you pass it in the color you pass it:

Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long

Private Sub FillArea(X As Long, Y As Long, lColor As Long)
  Dim lOldColor As Long
  Dim lFillType As Long
  Dim lRes      As Long
  Const FLOODFILLBORDER = 0  ' Fill until crColor& color encountered.
  Const FLOODFILLSURFACE = 1 ' Fill surface until crColor& color not
                             ' encountered.
  Picture1.FillColor = lColor
  lOldColor = Picture1.Point(X, Y)
  lFillType = FLOODFILLSURFACE
  lRes = ExtFloodFill(Picture1.hdc, X / Screen.TwipsPerPixelX, Y / Screen.TwipsPerPixelY, lOldColor, lFillType)
End Sub

0
 
bradsobleskyAuthor Commented:
Where do I put each of these? So I click on the picture or form and it does it.
0
 
clifABBCommented:
I would suggest the MouseUp event of the picture control:

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then
    'lColor is set elsewhere
    FillArea X, Y, lColor
  End If
End Sub

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
bradsobleskyAuthor Commented:
This is not working for me it tells me that lcolor is not defined and something about the part of the sub int "()" is not valid. Help.  

0
 
clifABBCommented:
You need to define lColor either globally or at module level and assign it a value (it would default to 0 which is black)

In the FillArea procedure, add the following line just before the FillColor line:
  Picture1.FillStyle = vbFSSolid
Finally, in the MouseUp routine, make this small change to the Call to FillArea():
    FillArea CLng(X), CLng(Y), lColor

0
 
bradsobleskyAuthor Commented:
Sorry about all the trouble. Thanks.
0
 
clifABBCommented:
No problem.  Glad I could help.  :)
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now