?
Solved

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

Posted on 2003-11-15
12
Medium Priority
?
2,056 Views
Last Modified: 2010-08-05
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
Comment
Question by:hexux
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
12 Comments
 
LVL 3

Accepted Solution

by:
NBrownoh earned 220 total points
ID: 9757104
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

by:qwertykeyboard
ID: 9758328
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

by:hexux
ID: 9761534
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
Technology Partners: 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!

 
LVL 3

Expert Comment

by:NBrownoh
ID: 9761652
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

by:NBrownoh
ID: 9761657
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 86

Assisted Solution

by:Mike Tomlinson
Mike Tomlinson earned 220 total points
ID: 9780085
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
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 9828378
Did you try my generic solution yet?
0
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 9872502
hexux,

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

Expert Comment

by:Mike Tomlinson
ID: 10164706
I would recommend splitting points between NBrownoh and myself.

Idle_Mind
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 10548427
Moderator, my recommended disposition is:

    Split points between: NBrownoh & Idle_Mind

Dan Rollins -- EE database cleanup volunteer
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…
Suggested Courses

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question