• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2162
  • Last Modified:

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

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
hexux
Asked:
hexux
2 Solutions
 
NBrownohCommented:
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
 
qwertykeyboardCommented:
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
 
hexuxAuthor Commented:
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
NBrownohCommented:
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
 
NBrownohCommented:
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
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
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

Private Sub Form_Load()
    Set shapes = New Collection
    Me.ScaleMode = vbPixels
    createPolygons
End Sub

Private Sub Form_Unload(Cancel As Integer)
    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
    shapes.Add poly1
   
    ' 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
    shapes.Add poly1
       
    ' 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
    shapes.Add poly1
   
    ' 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
    shapes.Add poly1
   
    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
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
Did you try my generic solution yet?
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
hexux,

Have you tried NBrownoh's code or my post?
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
I would recommend splitting points between NBrownoh and myself.

Idle_Mind
0
 
DanRollinsCommented:
Moderator, my recommended disposition is:

    Split points between: NBrownoh & Idle_Mind

Dan Rollins -- EE database cleanup volunteer
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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