Selecting Obejcts with the same color - PLease help

Hi Folks,

I'm trying....


Sub Select_Same_Color()


Dim s As Shape
Dim n As Long
Dim R As Long
Dim G As Long
Dim B As Long




Set s = ActiveShape
ActiveShape.GetColor(R, G, B) = RGB

For Each s In ActiveDocument.ActivePage.Shapes


Is this correct till that point? How can i proof i now if the other objects have the
same color and select them or not?


161

[Alex]

Superfreak,

I'm not sure where you found the method you tried to use (Shape.GetColor) or what you tried to do by "ActiveShape.GetColor(R, G, B) = RGB" but if you want to select objects with the same fill color as the currently selected object, here is what you need to do:

• Make sure that your object has a uniform fill (not fountain, texture, etc)
• Get the fill color of the currently selected shape
• Go through each shape on the current page and see if shapes have uniform fill as well and the color is the same as that of the original shape
• Add all the matching shape to the selection

Sounds simple. And it actually is. Here is how you do it in CorelDRAW11:

Public Sub SelectSameColor()
    Dim s As Shape
    Dim c As Color
    
    If ActiveShape Is Nothing Then
        MsgBox "Nothing selected", vbCritical
        Exit Sub
    End If
    If ActiveShape.Fill.Type <> cdrUniformFill Then
        MsgBox "Please select an object with uniform fill", vbCritical
        Exit Sub
    End If
    Set c = ActiveShape.Fill.UniformColor
    ActiveDocument.ClearSelection
    For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then
            If s.Fill.UniformColor.IsSame(c) Then
                s.Selected = True
            End If
        End If
    Next s
End Sub

The color comparison is very easy in CorelDRAW 11 because of the new Color.IsSame method. If you are under CorelDRAW 10, this won't work and you need to do some more stuff youself.

The easiest way is to use Color.CorelScriptGetComponent method which returns you the 7 color components including color model (the 7 components are used in certain Hexachrome colors).

Here is the same routine for Draw 10:

Public Sub SelectSameColor10()
    Dim s As Shape
    Dim md1 As Long, c1 As Long, c2 As Long, c3 As Long
    Dim c4 As Long, c5 As Long, c6 As Long, c7 As Long
    Dim md2 As Long, v1 As Long, v2 As Long, v3 As Long
    Dim v4 As Long, v5 As Long, v6 As Long, v7 As Long
    
    If ActiveShape Is Nothing Then
        MsgBox "Nothing selected", vbCritical
        Exit Sub
    End If
    If ActiveShape.Fill.Type <> cdrUniformFill Then
        MsgBox "Please select an object with uniform fill", vbCritical
        Exit Sub
    End If
    ActiveShape.Fill.UniformColor.CorelScriptGetComponent md1, c1, c2, c3, c4, c5, c6, c7
    ActiveDocument.ClearSelection
    For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then
            s.Fill.UniformColor.CorelScriptGetComponent md2, v1, v2, v3, v4, v5, v6, v7
            If md1 = md2 And c1 = v1 And c2 = v2 And c3 = v3 And c4 = v4 And _
                c5 = v5 And c6 = v6 And c7 = v7 Then
                
                s.Selected = True
            End If
        End If
    Next s
End Sub

A little bit more complicated but still not that bad...

I hope this helps.

That is great. I hope in near future i have some more time to learn VBA.
But at least i understand the components.

What does <> mean?


Greetz


Superfreak

[Alex]

Originally Posted by Superfreak

What does <> mean?

"A <> B" means "A not equal to B"