OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 13-12-2011, 10:00
ashishbindal93
Guest
 
Posts: n/a
Default Need help spliting strings in coreldraw

HI,
I am new to vba and trying to write a simple color picker code which stores the "activeshape.Fill.UniformColor.ToString" into a string variable.

Then i need to break the color components from the saved color and get them in different variables.

Can anyone help me out?Please..

my code:

Dim q As Double, w As Double, p As Double, colcount As Double, shr As ShapeRange, _
mycols() As String, mycolsname() As String

Private Sub update_pal()

p = 1: q = 0: w = 0: Set shr = Nothing

If colcount > 0 Then
For w = 1 To colcount
mycols(w) = ""
Next w

For w = 1 To colcount
mycolsname(w) = ""
Next w
End If

q = ActiveSelectionRange.shapes.count
Set shr = ActiveSelectionRange

For w = 1 To q
If shr.shapes.Item(w).Fill.Type = cdrUniformFill Then
ReDim Preserve mycols(1 To p)
ReDim Preserve mycolsname(1 To p)
mycols(p) = shr.shapes.Item(w).Fill.UniformColor.ToString
mycolsname(p) = shr.shapes.Item(w).Fill.UniformColor.Name
p = p + 1
End If
Next w
colcount = p - 1

For w = 1 To p - 1
MsgBox mycols(w) + mycolsname(w)
Next w


End Sub

Private Sub UserForm_Initialize()
colcount = 0
update_pal
End Sub

Output:

msgbox:


CMYK,USER,0,100,100,0


I want to store this CMYK seperately and the cmyk values seperately

Last edited by ashishbindal93; 13-12-2011 at 10:08.
Reply With Quote
  #2  
Old 13-12-2011, 12:32
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Color Values

There are several ways to do this, you can use the Split Function like this:
Code:
Sub MyColor()
    Dim vColor As Variant
    
    vColor = Split(ActiveShape.Fill.UniformColor.ToString, ",")
    
    MsgBox "Mode: " & vColor(0) & " C: " & vColor(2) & " M: " & vColor(3) & " Y: " & vColor(4) & " K: " & vColor(5)
End Sub
or you can just grab each component color like this:
Code:
Sub MyColor()
    Dim c As Color
    
    Set c = ActiveShape.Fill.UniformColor
    
    MsgBox "C: " & c.CMYKCyan & " M: " & c.CMYKMagenta & " Y: " & c.CMYKYellow & " K: " & c.CMYKBlack
End Sub
Hope that helps,

-Shelby
Reply With Quote
  #3  
Old 14-12-2011, 09:42
ashishbindal93
Guest
 
Posts: n/a
Smile

oh really thanks shelby.It worked for me very well

but i have faced a new problem

when a user changes the color components from the fill property of an object manually then your script...

Sub MyColor()
Dim vColor As Variant,mcol As New Color

vColor = Split(ActiveShape.Fill.UniformColor.ToString, ",")

MsgBox "Mode: " & vColor(0) & " C: " & vColor(2) & " M: " & vColor(3) & " Y: " & vColor(4) & " K: " & vColor(5)

If vColor(0) = "CMYK" Or vColor(0) = "CMYK100" Then
mcol.CMYKAssign vColor(2), vColor(3), vColor(4), vColor(5)
end if
End Sub

msgbox...

CMYK100,USER,0,340,150,80

creates an error as the color model changes to CMYK100 and the c,m,y,k values have gone beyond '100'.The CMYKAssign cannot assign the values

Please help me out with this!
Thanks in advance

Last edited by ashishbindal93; 14-12-2011 at 09:46.
Reply With Quote
  #4  
Old 15-12-2011, 07:54
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Color Values

If you are not making any changes to the color, why are you breaking it out to begin with? You can simply copy the color, if you do need to save it, you can us the .ToString then bring it back in and recreate it.
Code:
    Dim c As New Color
    Dim s As Shape, rect As Shape
    
    Set s = ActiveShape
    
    If s.Fill.Type = cdrUniformFill Then
        c.CopyAssign s.Fill.UniformColor
    End If
    
    Set rect = ActiveLayer.CreateRectangle2(0, 0, 2, 2)
    rect.Fill.ApplyUniformFill c
Hope that helps,

-Shelby
Reply With Quote
  #5  
Old 17-12-2011, 23:59
ashishbindal93
Guest
 
Posts: n/a
Default colors in cql

Very Much thanks shelby...
You are a genious..

Your script really aided me but i came upon another problem.

Can you please suggest me how to check for colors in cql..
my errored code

dim myquery as string,mycolors() as color,mynewselection as shaperange,myshapes as shaperange

set myshapes = activeselectionrange
redim mycolors(1)
mycolors(1).copyassign myshapes.shapes.item(1).fill.uniformcolor

myquery = "@colors.find(" & mycolors(1) & ")"
mynewselection.AddRange myshapes.Shapes.FindShapes(query:=myquery)
mynewselection.createselection

The basic problem is that i do not want to break the color components of color.I want to check for color as it is

Please help me out
Reply With Quote
  #6  
Old 18-12-2011, 00:19
ashishbindal93
Guest
 
Posts: n/a
Default Link to 2nd problem

Hey Shelby I think you didnt get to a part of my last problem.

I had a problem that when a user clicks on a object and changes color from this dialog box as show in picture the color model changes from cmyk to cmyk100 and c,m,y,k values as shown are 1,74,96,0 resp. will change to 3,189,245,0

How to Cope up with this problem

thanks in advance
Attached Images
 
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -5. The time now is 03:38.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com