Solved

# how to fill a shape (triangle, hexagon, rectangle, etc) with colors

Posted on 2003-11-15
1,960 Views
I created some figures or shapes (like triangles, squares, rectangles) inside a picture object with picture.line(x,y), that's very easy, now I want to change the internal color of the figure only clicking one time at any internal point of the figure. I'm working with VB6.
0
Question by:hexux

LVL 3

Accepted Solution

NBrownoh earned 55 total points
your going to need to raise the points by a whole lot on this one.  Your talking about a lot of math and API calls to fill a space.
0

Expert Comment

Is it actually possible if you are using line. Woulnd't is be simpler to just draw pictures and change the infill there? If not u could use lots of thick lines to fill them up!!! Bad ideas perhaps, but never the less, still possibilities
0

Author Comment

example:

Private Sub Command1_Click()
Picture1.Cls
Picture1_Paint
Picture1.DrawWidth = 2
x1 = Val(Text1)
y1 = Val(Text2)

x2 = Val(Text3)
y2 = Val(Text4)

x3 = Val(Text5)
y3 = Val(Text6)

Picture1.Line (x1, y1)-(x2, y2), vbRed
Picture1.Line (x2, y2)-(x3, y3), vbRed
Picture1.Line (x3, y3)-(x1, y1), vbRed

End Sub

I want to fill the triangle with a color just clicking once over its internal surface
0

LVL 3

Expert Comment

Private Type COORD
x As Long
y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Const WINDING = 2 ' constants for FillMode.
Const BLACKBRUSH = 4 ' Constant for brush type.
Dim poly(1 To 3) As COORD, NumCoords As Long

Private Sub Command1_Click()
On Error Resume Next
Dim hBrush As Long, hRgn As Long
Picture1.Cls
NumCoords = 3
Picture1.ScaleMode = vbPixels
poly(1).x = Text1
poly(1).y = Text2
poly(2).x = Text3
poly(2).y = Text4
poly(3).x = Text5
poly(3).y = Text6
Polygon Picture1.hdc, poly(1), NumCoords
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
DeleteObject hRgn
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
If PtInRegion(hRgn, x, y) <> 0 Then
hBrush = GetStockObject(BLACKBRUSH)
If hRgn Then FillRgn Picture1.hdc, hRgn, hBrush
End If
DeleteObject hRgn
End Sub

This code will turn the triangle you click black
0

LVL 3

Expert Comment

oops, you can remove the hBrush from the Dim statement in the Command1_Click event, its not needed there, also add this line to the top of the Picture1_MouseDown event.
Dim hBrush As Long, hRgn As Long

and there ya go, that works perfectly.
0

LVL 85

Assisted Solution

Mike Tomlinson earned 55 total points
Alrighty,

Here is a completely generic answer to your problem.  Create a new project and add a class.  Paste the code below into the appropriate area.

If you are really bored, you can see the first draft and second drafts that I wrote here:

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20799428.html

Regards,

Idle_Mind

' ************************* Code for Form1 *************************
Option Explicit

Private shapes As Collection

Set shapes = New Collection
Me.ScaleMode = vbPixels
createPolygons
End Sub

Dim shape As Variant

Do While shapes.Count() > 0
Set shape = shapes.Item(1)
shapes.Remove 1
Set shape = Nothing
Loop
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim shape As Variant
Dim rgbColor As Long

For Each shape In shapes
If shape.pointInRegion(x, y) Then
shape.hasBeenClicked = True
rgbColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
shape.fillColor = rgbColor
shape.drawPolygon Me.hDC
Exit For
End If
Next shape
End Sub

Private Sub Form_Paint()
Dim shape As Variant

Me.Cls
For Each shape In shapes
shape.drawPolygon Me.hDC
Next shape
End Sub

Private Sub createPolygons()
Dim poly1 As Class1

' Square in Upper Left
Set poly1 = New Class1
poly1.addVertex Me.ScaleWidth / 8, Me.ScaleHeight / 8
poly1.addVertex 3 * Me.ScaleWidth / 8, Me.ScaleHeight / 8
poly1.addVertex 3 * Me.ScaleWidth / 8, 3 * Me.ScaleHeight / 8
poly1.addVertex Me.ScaleWidth / 8, 3 * Me.ScaleHeight / 8
poly1.addVertex Me.ScaleWidth / 8, Me.ScaleHeight / 8

' Triangle in Upper Right
Set poly1 = New Class1
poly1.addVertex 6 * Me.ScaleWidth / 8, Me.ScaleHeight / 8
poly1.addVertex 7 * Me.ScaleWidth / 8, 3 * Me.ScaleHeight / 8
poly1.addVertex 5 * Me.ScaleWidth / 8, 3 * Me.ScaleHeight / 8
poly1.addVertex 6 * Me.ScaleWidth / 8, Me.ScaleHeight / 8

' Diamond in Bottom Left
Set poly1 = New Class1
poly1.addVertex Me.ScaleWidth / 8, 6 * Me.ScaleHeight / 8
poly1.addVertex 2 * Me.ScaleWidth / 8, 5 * Me.ScaleHeight / 8
poly1.addVertex 3 * Me.ScaleWidth / 8, 6 * Me.ScaleHeight / 8
poly1.addVertex 2 * Me.ScaleWidth / 8, 7 * Me.ScaleHeight / 8
poly1.addVertex Me.ScaleWidth / 8, 6 * Me.ScaleHeight / 8

' Odd Thing in Bottom Right
Set poly1 = New Class1
poly1.addVertex 5 * Me.ScaleWidth / 8, 6 * Me.ScaleHeight / 8
poly1.addVertex 6 * Me.ScaleWidth / 8, 5 * Me.ScaleHeight / 8
poly1.addVertex 7 * Me.ScaleWidth / 8, 5 * Me.ScaleHeight / 8
poly1.addVertex 7 * Me.ScaleWidth / 8, 7 * Me.ScaleHeight / 8
poly1.addVertex 13 * Me.ScaleWidth / 16, 12 * Me.ScaleHeight / 16
poly1.addVertex 5 * Me.ScaleWidth / 8, 7 * Me.ScaleHeight / 8
poly1.addVertex 5 * Me.ScaleWidth / 8, 6 * Me.ScaleHeight / 8

Set poly1 = Nothing
End Sub

' ************************* Code for Class1 *************************
Option Explicit

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hbrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Type point
x As Long
y As Long
End Type

Private Const FLOODFILLBORDER = 0
Private Const FLOODFILLSURFACE = 1
Private Const ALTERNATE = 1
Private Const WINDING = 2
Private Const BLACKBRUSH = 4
Private Const NULLBRUSH = 5

Private points() As point
Private numPoints As Integer
Private clicked As Boolean
Private polygonColor As Long
Private polygonRegion As Long

Private Sub Class_Initialize()
numPoints = 0
clicked = False
polygonRegion = 0
polygonColor = 0
End Sub

Private Sub Class_Terminate()
If polygonRegion <> 0 Then
DeleteObject polygonRegion
End If
End Sub

Public Property Get hasBeenClicked() As Boolean
hasBeenClicked = clicked
End Property

Public Property Let hasBeenClicked(newClickValue As Boolean)
clicked = newClickValue
End Property

Public Property Get fillColor() As Long
fillColor = polygonColor
End Property

Public Property Let fillColor(newFillColor As Long)
polygonColor = newFillColor
End Property

Public Property Get vertices() As String
vertices = CStr(VarPtr(points(0))) & "|" & Me.numVertices
End Property

Public Property Get numVertices() As Integer
numVertices = numPoints
End Property

Public Property Get regionHandle() As Long
regionHandle = polygonRegion
End Property

Public Sub drawPolygon(hDC As Long)
Dim hbrush As Long
Dim ret As Long

If Me.numVertices() >= 2 Then
hbrush = GetStockObject(NULLBRUSH)
ret = SelectObject(hDC, hbrush)
Polygon hDC, points(0), Me.numVertices
SelectObject hDC, ret
DeleteObject hbrush
If Me.hasBeenClicked() Then
hbrush = GetStockObject(BLACKBRUSH)
SelectObject hDC, hbrush
FillRgn hDC, polygonRegion, hbrush
SelectObject hDC, ret
DeleteObject hbrush

hbrush = CreateSolidBrush(polygonColor)
SelectObject hDC, hbrush
ExtFloodFill hDC, points(0).x, points(0).y, GetPixel(hDC, points(0).x, points(0).y), FLOODFILLSURFACE
SelectObject hDC, ret
DeleteObject hbrush
End If
End If
End Sub

Public Function pointInRegion(x As Single, y As Single) As Boolean
If polygonRegion = 0 Then
pointInRegion = False
Else
pointInRegion = PtInRegion(polygonRegion, x, y)
End If
End Function

Public Sub addVertex(x As Long, y As Long)
Dim newPoint As point
newPoint.x = x
newPoint.y = y
numPoints = numPoints + 1
ReDim Preserve points(numPoints)
points(numPoints - 1) = newPoint
If numPoints >= 2 Then
If polygonRegion <> 0 Then
DeleteObject polygonRegion
End If
polygonRegion = CreatePolygonRgn(points(0), Me.numVertices, ALTERNATE)
End If
End Sub
0

LVL 85

Expert Comment

Did you try my generic solution yet?
0

LVL 85

Expert Comment

hexux,

Have you tried NBrownoh's code or my post?
0

LVL 85

Expert Comment

I would recommend splitting points between NBrownoh and myself.

Idle_Mind
0

LVL 49

Expert Comment

Moderator, my recommended disposition is:

Split points between: NBrownoh & Idle_Mind

Dan Rollins -- EE database cleanup volunteer
0

## Featured Post

### Suggested Solutions

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…