OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 29-01-2006, 10:51
akayani
Guest
 
Posts: n/a
Default CCM get profile

Code:

Sub Dotgain()
' Description: Dot Gain with Field Insert
'
'
Dim CMYKProfileUsed As String
Dim OrigSelection As ShapeRange
Set CMYKProfileUsed = ColorManager.CurrentProfile(2).ColorProfile.Name
'the above line is in error... I can't find an example got any clues?
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Profile").Value = CMYKProfileUsed
ActiveWindow.Refresh
End Sub

Yani
Reply With Quote
  #2  
Old 29-01-2006, 15:54
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,791
Blog Entries: 13
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 ColorProfile

Take out the colorprofile like this:

ColorManager.CurrentProfile(clrSeparationPrinter).Name

At least this works in CorelDRAW X3.

Thanks,

Shelby
Reply With Quote
  #3  
Old 29-01-2006, 23:12
akayani
Guest
 
Posts: n/a
Default

That makes sense... Now I have a Compile error on
Set CMYKProfileUsed...

Thanks Shelby. I'm going to need a bit of a hand with this I'm less than flash at macros in draw...

...

Sub DotgainBW()
'
' Description:
' Dot Gain with Field Insert
'
'Gets the name of the current profile in use
'
Dim CMYKProfileUsed As String
CMYKProfileUsed = ColorManager.CurrentProfile(clrSeparationPrinter).Name
'
'Inputs the Profile Name into the Ojbect Data Field "Profile"
'
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Profile").Value = CMYKProfileUsed
'
'Resample the bitmap and converts to the current profile
'
Dim myBitmap As Shape
Set myBitmap = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)
End Sub

The above is what the final macro will look like...

I sorted out that you don't use "set".

And I can make this code work in parts.

But when I put it together is breaks.

Stuffed if I can see why?

Yani

Last edited by akayani; 30-01-2006 at 01:08.
Reply With Quote
  #4  
Old 30-01-2006, 04:44
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,791
Blog Entries: 13
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 CCM get Profile

I am really not sure what you are trying to do. Saving the profile to the objectData and then converting that object to a bitmap looses those settings. But this code here works and generate no errors. If I knew exactly what you were trying to do I might be able to help a little more.

I added the CheckDataItem sub so that is checks to see if the DataItem is there, if not it creates it. I do believe X3 has an easier way to do this, but this is code I all ready have and know works.
Code:
Sub DotgainBW()

Dim CMYKProfileUsed As String
CMYKProfileUsed = ColorManager.CurrentProfile(clrSeparationPrinter).Name

Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
CheckDataItem ("Profile")
ActiveSelection.ObjectData("Profile").Value = CMYKProfileUsed

Dim myBitmap As Shape
Set myBitmap = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)

End Sub

Private Sub CheckDataItem(diName As String)

Dim bFound As Boolean
Dim df As DataField

bFound = False

For Each df In ActiveDocument.DataFields
    If df.Name = diName Then
        bFound = True
        Exit For
    End If
Next df

If bFound = False Then ActiveDocument.DataFields.Add diName, , True, True

End Sub
Hope it helps,
Shelby
Reply With Quote
  #5  
Old 30-01-2006, 05:50
akayani
Guest
 
Posts: n/a
Default

Thanks that was one of the questions I hadn't even asked yet...

Code:

Sub Macro2()
'
' Recorded 30/01/2006
'
' Description:
'
'
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Profile").Value = "my silly name"
Dim s1 As Shape
Set s1 = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)
End Sub

The above works but once I introduce the var for current profile it fails...

"What am I trying to do?"

Take a number of processes that I do manually automate them so that a comment is made in the Object Data Field so I can track which objects have been processed.

applying a profile to B&W bitmaps
converting RGB bitmaps to CMYK

stuff like that.

Yani
Reply With Quote
  #6  
Old 30-01-2006, 06:25
akayani
Guest
 
Posts: n/a
Default

OK I think I kinda see what is happening...

If I convert the bitmap first I loose the selection.

If I add the Data Field first then playing with the bitmap makes a new object and deletes the data.

Yet for some reason the recorded macro which did the same stuff works fine as long as the field is a "string" and not a variable.

Yani
Reply With Quote
  #7  
Old 30-01-2006, 08:04
akayani
Guest
 
Posts: n/a
Default

Code...

Sub DotgainBW()

Dim CMYKProfileUsed As String
CMYKProfileUsed = ColorManager.CurrentProfile(clrSeparationPrinter).Name

Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
Dim myBitmap As Shape
Set myBitmap = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)

CheckDataItem ("Profile")
myBitmap.ObjectData("Profile").Value = CMYKProfileUsed

myBitmap.Selected = True

Application.Refresh
Refresh

End Sub

Private Sub CheckDataItem(diName As String)

Dim bFound As Boolean
Dim df As DataField

bFound = False

For Each df In ActiveDocument.DataFields
If df.Name = diName Then
bFound = True
Exit For
End If
Next df

If bFound = False Then ActiveDocument.DataFields.Add diName, , True, True

End Sub


That works...

Thanks for the help much appreciated.

Yani
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

Similar Threads
Thread Thread Starter Forum Replies Last Post
Corel Draw 12 and Color Management... meandirtyjoe General 7 31-12-2005 17:57
color profile problem in Photo Paint 9 flip Corel Photo-Paint VBA 2 11-07-2003 04:55


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


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