Find objects by properties

Sorry if this appears twice - didn't seem to work the first time!

The problem with Corels Find and Replace is that you have to know exactly what you're looking for. If you're searching for red, 100%M and 100%Y is not the same as 100%M & 99%Y. Similarly, an outline with 1mm width is not the same as .99mm. And so on.

I'm working on a project that samples an object, stores it's properties then searches on those properties. So far I can search on colour fill and outline colour - works fine. I'm having a problem with outline width though. Later I'll add more such as outline overprint, outline scalable etc.

What do you guys think?

Initialise....

Option Explicit
Public s As Shape
Public c As New Color
Public cl As New Color
Public sr As ShapeRange
Public CSet As New Color
Public md As Long, c1 As Long, c2 As Long, c3 As Long
Public c4 As Long, c5 As Long, c6 As Long, c7 As Long
Public OLmd As Long, OLc1 As Long, OLc2 As Long, OLc3 As Long
Public OLc4 As Long, OLc5 As Long, OLc6 As Long, OLc7 As Long
Public ColStr As String
Public ColStr1 As String
Public ColStrOL As String
Public ColStrOL1 As String
Public OLWidth As Double
Public OLWidth1 As Double



Sub OpenForm()
ActiveDocument.Unit = cdrMillimeter
MainForm.Show vbModeless
End Sub

Code associated with main form.....
The messages are for my error checking ATM, and there is no "IF/Then" code associated with the check boxes yet

Private Sub CmdSelectColor_Click()

Dim CntOb

With ActiveSelection.Shapes
CntOb = .Count
If CntOb > 1 Then
        MsgBox "More than one object selected"
        Exit Sub
    End If
End With

Set s = ActiveShape
    If s Is Nothing Then
        MsgBox "Nothing Selected, select Object first"
        Exit Sub
    End If
    


For Each s In ActiveSelection.Shapes
    'fill colour
    If s.Fill.Type = cdrUniformFill Then
        c.CopyAssign s.Fill.UniformColor
        CSet.CopyAssign s.Fill.UniformColor
        CSet.CorelScriptGetComponent md, c1, c2, c3, c4, c5, c6, c7
        ColStr = (md & c1 & c2 & c3 & c4 & c5 & c6 & c7)
        Else:
        ColStr = "Nothing"
    End If
    'outline colour
    If s.Outline.Type = cdrOutline Then
        cl.CopyAssign s.Outline.Color
        CSet.CopyAssign s.Outline.Color
        CSet.CorelScriptGetComponent OLmd, OLc1, OLc2, OLc3, OLc4, OLc5, OLc6, OLc7
        ColStrOL = (OLmd & OLc1 & OLc2 & OLc3 & OLc4 & OLc5 & OLc6 & OLc7)
        Else:
        ColStrOL = "Nothing"
    End If
    'outline properties
    If s.Outline.Type = cdrOutline Then
    OLWidth = ActiveShape.Outline.Width
    End If
Next s
   
'fill button
If ColStr <> "Nothing" Then
    c.ConvertToRGB
    MainForm.cmFindFill.BackColor = RGB(c.RGBRed, c.RGBGreen, c.RGBBlue)
    MainForm.cmFindFill.Caption = "Find Objects of Fill"
    c.ConvertToGray
        If c.Gray < 150 Then
            MainForm.cmFindFill.ForeColor = RGB(255, 255, 255)
            Else:
            MainForm.cmFindFill.ForeColor = RGB(0, 0, 0)
        End If
    Else:
        MainForm.cmFindFill.BackColor = RGB(255, 255, 255)
        MainForm.cmFindFill.ForeColor = RGB(0, 0, 0)
        MainForm.cmFindFill.Caption = "Find objects with no Fill"
End If
'outline button
If ColStrOL <> "Nothing" Then
    cl.ConvertToRGB
    MainForm.cmOLCol.BackColor = RGB(cl.RGBRed, cl.RGBGreen, cl.RGBBlue)
    MainForm.cmOLCol.Caption = "Find Outlines of Colour"
    cl.ConvertToGray
        If cl.Gray < 150 Then
            MainForm.cmOLCol.ForeColor = RGB(255, 255, 255)
            Else:
            MainForm.cmOLCol.ForeColor = RGB(0, 0, 0)
        End If
    Else:
        MainForm.cmOLCol.BackColor = RGB(255, 255, 255)
        MainForm.cmOLCol.ForeColor = RGB(0, 0, 0)
        MainForm.cmOLCol.Caption = "Find objects with no Outline"
End If
End Sub

Private Sub cmFindFill_Click()

For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then
            CSet.CopyAssign s.Fill.UniformColor
            CSet.CorelScriptGetComponent md, c1, c2, c3, c4, c5, c6, c7
            ColStr1 = (md & c1 & c2 & c3 & c4 & c5 & c6 & c7)
            Else:
            ColStr1 = "Nothing"
        End If
        
        If ColStr1 = ColStr Then
            s.Selected = True
        End If
    Next s
   
End Sub

Private Sub cmOLCol_Click()

For Each s In ActivePage.Shapes
        If s.Outline.Type = cdrOutline Then
            CSet.CopyAssign s.Outline.Color
            CSet.CorelScriptGetComponent OLmd, OLc1, OLc2, OLc3, OLc4, OLc5, OLc6, OLc7
            ColStrOL1 = (OLmd & OLc1 & OLc2 & OLc3 & OLc4 & OLc5 & OLc6 & OLc7)
            Else:
            ColStrOL1 = "Nothing"
        End If
        
        If ColStrOL1 = ColStrOL Then
            s.Selected = True
        End If
    Next s

End Sub

Private Sub cmOLPar_Click()

For Each s In ActivePage.Shapes
        If s.Outline.Type = cdrOutline Then
            OLWidth1 = ActiveShape.Outline.Width
        End If
        MsgBox OLWidth1
        If OLWidth1 = OLWidth Then
            s.Selected = True
            MsgBox "selecting"
        End If
Next s
End Sub

The form has been attached

Cheers!

[Alex]

Webster,

It is definitely a great start. I can clearly see the logic of what you are doing and why you are doing it from just looking at your code. However I hava a few comments/suggestions, if you don't mind. Hope others will find them useful too:

1. What's up with the null operator after ELSE? Why do you keep writing Else statement as if it is a label or something? Instead of:

If condition Then
    Something
    Else:
    SomethingElse
End If

You should write:

If condition Then
    Something
Else
    SomethingElse
End If

There should be no color ( : ) after Else and it's better to use the same identation for If..Else..End If parts of the statement. The reason why it happens to work is that normally ( : ) is a statement delimiter. You just put an empty statement right after Else and separate it from another empty one on that line. Weird and doesn't help reading the code either.

2. You should try and limit the amount of global variables. What is the reason of having every single variable used in your project defined globally at the top of code module? It is difficult to read, very error prone (you never know which variable is used where) and you can't tell if you need to re-use an existing variable without breaking some other piece of code which relies on the variable's state. Consider the following piece of code for example:

Option Explicit
Dim s As Shape
Dim col as Color
Dim r As Long, g As Long, b As Long

Sub Subroutine1()
    For Each s in ActivePage.Shapes
         Set col = s.Fill.UniformColor
         Subroutine2
    Next s
End Sub

Sub Subroutine2()
    r = col.RGBGreen
    g = col.RGBGreen
    b = col.RGBBlue
    s.Outline.Color.RGBAssign 255-r, 255-g, 255-b
End Sub

Now Subroutine1 loops through shapes on the page and calls Subroutine2 to set the shape's outline to the inverse color of its fill (assuming uniform RGB fills here for simplicity).

Instead of using global variable s and col to pass data between subroutines 1 and 2, I should have just added parameters to subroutine2 and declared all the variables on a local scope of their respective subroutines:

Option Explicit

Sub Subroutine1()
    Dim s As Shape
    Dim col as Color

    For Each s in ActivePage.Shapes
         Set col = s.Fill.UniformColor
         Subroutine2 s, col
    Next s
End Sub

Sub Subroutine2(ByVal s As Shape, ByVal col As Color)
    Dim r As Long, g As Long, b As Long
    r = col.RGBGreen
    g = col.RGBGreen
    b = col.RGBBlue
    s.Outline.Color.RGBAssign 255-r, 255-g, 255-b
End Sub

This way you can clearly see that variables s and col are set in subroutine 1, then passed in as parameters to subroutine 2. The sub2 uses variables r, g, and b for its own purposes. Anyway, I guess you've got the point...

Of course, sometimes you'll have to use global variables. Especially when you need to communicate with a form. If your form has a lot of parameters, I would opt to create a class that holds all those and use just a single global instance of the class to transfer data to and from the form.

For example, create a new class module in VBA and give it a name, say, clsSettings. Define the class as follows:

Option Explicit

Public OutlineColor As Color
Public FillColor As Color
Public OutlineWidth as Double

Now in your code module, add a global instance of this class:

Option Explicit

Public FormSettings As New clsSettings

And then whenever you need to access any of those settings, just specify them directly like this: FormSettings.OutlineColor for example. It becomes much easier to read and understand the code, the settings are localized to a single class and separated from any other global data.

3. Instead of comparing color component by component, why not use Color.IsSame method?

So, extending the settings class I introduced above, you can change your code as follows:

' Fill Color
If s.Fill.Type = cdrUniformFill Then
    Set FormSettings.FillColor = s.Fill.UniformColor
Else
    Set FormSettings.FillColor = Nothing
End If

' Outline Color
If s.Outline.Type = cdrOutline Then
    Set FormSettings.OutlineColor = s.Outline.Color
Else
    Set FormSettings.OutlineColor = Nothing
End If

Now when you are actually looking for shapes with these attributes, you just need to do this:

Private Sub cmFindFill_Click()
    Dim s As Shape, srFound As New ShapeRange
    For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill And Not FormSettings.FillColor Is Nothing Then
            If s.Fill.UniformColor.IsSame(FormSettings.FillColor) Then
                ' Shape found. Add it to the range
                srFound.Add s
            End If
        End If
    Next s
    ' Now just create a selection of all shapes found...
    srFound.CreateSelection
End Sub

4. Finally the last issue. In CmdSelectColor_Click you fist check to ensure there is only one object selected and then you go fetch its fill/outline colors. What's the point of "For Each" loop there? You should just refer to the sole selected shape as ActiveShape and remove the loop altogether.

I hope this helps.

Thanks for your comments Alex. I'll impliment the ones that I can.

Unfortunately I can't use Color.IsSame as I only have Corel 10.

I've nutted out the problem I had with the outline width, but one thing that I've struck now and before is that in VBA, outlines do not always read their true width when an object has been rescaled.

For example, a rectangle with a non scaleable 5mm outline is reduced in size, the outline is re-set to scaleable and to (say) 3mm. The property bar in Corel shows 3mm when the rectangle is selected, and Find And Replace will find the rectangle when exactly 3mm is set.

But in VBA, this rectangle returns anything but the 3mm outline width. Depending on how it's been scaled it can return quite wildly different amounts - .2mm, 12.5mm etc.

Is this a known problem with VBA. Is there a way around it?

Thanks!

[Alex]

Well, it could be a problem, of course. I can't try out Draw 10 for now, but I did try it in both Draw 11 and 12 and the outline seems to work correctly...

For the moment (until I find out a better way) when the outline is selected, I check to see if it is scaleable or not. If it is, I change it to not scalable then get it's width attribute, then change it back to scaleable.

This seems to work.

It seems strange that in CD10 VBA, any outline that has been rescaled will not show it's true width while it is scalable, but will when it is not scaleable.

Cheers!

Although I am quite inept at coding myself, I think this is something that I've personally been wanting. Specifically, I want to be able to select everything in a document that has the same color. Is that what this is intended for? Do you have this in a completed state yet?

I'm not too fond of the one built into Corel as you have to know what you are looking for (as you stated). Alex was on to something with his "Color Replacer" but I'd like it to go a step further and be able to select colors from the objects on screen and then select all of same color/type (either via a single select or a window select).

GraphiXtreme,

It works well for selecting colours.

You can select an object, it colour values are evaluated and when activated all objects of that colour are selected enabling you to make changes (colour, overprints etc) to all objects of that colour. Both outline and fill.

Later I intend to add other selection crieria such as outline widths, outline over prints etc. The problem is I only have CD 10, and VBA in 10 has some bugs/limitations.

I too find Corels Edit/Find And Replace a bit limiting - for starters you need to know exactly what to look for. When you've got 1000's of objects this is not practical, but when you discover you've got 756 objects filled with 0C, 100M, 100Y, 0K and the colour should have been PMS 485 you've got a lot of work to do!

The problems I'm having are with returning outline propertires - they seem to be a CD 10 thing. I haven't implimented Alex's suggested changes (though some of them require CD 11 or C D12)

It will work if you are only interested in colour FTM. If you are interested I'll post the GMS.

Cheers!

I am currently running v12. Yes, I'd love to have the code!

I'm in the process of trying to learn Visual Basic, and in fact have VB.net coming as we speak. I've done some coding ages ago in Pascal (college days), but was never very swift with it. I've toyed around with an older version of VB and have an Excel project that I want to convert to VB as a standalone program.

I was messing around with VB in Corel last night and I think I hosed one of the projects that comes with Corel, but I can always copy it back in.

So please excuse my ignorance, but I'm trying!

Ok, here it is as a zip

Bare in mind it is experimental ATM, but I'm using it all the time and really saves time.

Also, have a look at Alex's excellent Curve Effects project. This may help you as well. You can nominate a colour to find (outline or fill) and nominate a colour to change all objects of the first colour to change to. But you still need to know the colour breakup to be able to select.

I have added a button to his form with this bit of code to overcome that.......


[/code]
Dim MyPalette As Palette
Set MyPalette = Palettes.CreateFromDocument("PaletteChange", True)

If cfg.clrFind.UserAssignEx() Then
UpdateFind
UpdatePreserve
End If
[code]

......this addition creates a new palette from all the colours in your current drawing, opens it and lets you pick the colour you need to change without needing to know what the colour components are. Very handy - Alex might have some comments an this. You may need to create a palette called "PaletteChange" first for it to work. I think it will work in CD12.

My advice is learn your VBA. It is fun, and will prove to be invaluable in the future. Years ago I started dabbling with CorelScript in CD6 (or was it 5?). From there, the skills learned led me into Visual Basic, VBA for Access and Excell (that's where you can really see the power of VB) and wrote quoting programs, job production lists etc for my business. I'm no guru, and muddle my through simply by using the help files, but now and then things seem to work :wink:

Cheers!