Solved

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

Posted on 2003-11-15
12
1,960 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
12 Comments
 
LVL 3

Accepted Solution

by:
NBrownoh earned 55 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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

by:NBrownoh
Comment Utility
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
Comment Utility
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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 85

Assisted Solution

by:Mike Tomlinson
Mike Tomlinson earned 55 total points
Comment Utility
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 85

Expert Comment

by:Mike Tomlinson
Comment Utility
Did you try my generic solution yet?
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
Comment Utility
hexux,

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

Expert Comment

by:Mike Tomlinson
Comment Utility
I would recommend splitting points between NBrownoh and myself.

Idle_Mind
0
 
LVL 49

Expert Comment

by:DanRollins
Comment Utility
Moderator, my recommended disposition is:

    Split points between: NBrownoh & Idle_Mind

Dan Rollins -- EE database cleanup volunteer
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
Article by: Martin
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…

763 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

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now