OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 07-07-2010, 15:57
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default Converting ALL bitmaps to CMYK including on Power Clip

Ola!

I trying to make a macro to convert all bitmaps to CMYK including on PowerClip.
This code is an modification of the User Alex (posted on: http://forum.oberonplace.com/showthr...powerclip+cmyk)

Code:
Sub Convert_All_Bitmaps_to_CMYK()
'Convert all bitmaps to CMYK including included in powerclip's.
Dim s As Shape, sp As Shape
Dim pwc As PowerClip
Dim ChangeCountPowerClip As Integer
Dim ChangeCount As Integer

ChangeCountPowerClip = 0
ChangeCount = 0

For Each s In ActiveDocument.ActivePage.Shapes
    Set pwc = Nothing
    Set pwc = s.PowerClip
    
    If Not pwc Is Nothing Then
        For Each sp In pwc.Shapes
            If sp.Type = cdrBitmapShape Then
                If sp.Bitmap.Mode <> cdrCMYKColorImage Then
                   sp.Bitmap.ConvertTo cdrCMYKColorImage
                   ChangeCountPowerClip = ChangeCountPowerClip + 1
                End If
            End If
        Next sp
    End If
    
    If s.Type = cdrBitmapShape Then
        If s.Bitmap.Mode <> cdrCMYKColorImage Then
            s.Bitmap.ConvertTo cdrCMYKColorImage
            ChangeCount = ChangeCount + 1
        End If
    End If

Next s
MsgBox ChangeCount & " Bitmaps converted and + " & ChangeCountPowerClip & " inside on PowerClips"
End Sub
And it's working. But I neet to convert the resolution too, for 350DPI.

I try to put this code in thu, but this blow up the macro (hehehe).
Code:
ConvertToBitmapEx cdrCMYKColorImage, False, True, 350, cdrNormalAntiAliasing, True, False, 95
Some one know how do this?

Thanks for now.
Reply With Quote
  #2  
Old 07-07-2010, 18:22
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 Resample....

It is easiest to just resample the bitmap. I also added a check so that for bitmaps lower than 350 would not be upsampled to 350.

Code:
Sub Convert_All_Bitmaps_to_CMYK()
    'Convert all bitmaps to CMYK including included in powerclip's.
    Dim s As Shape, sp As Shape
    Dim pwc As PowerClip
    Dim ChangeCountPowerClip As Integer
    Dim ChangeCount As Integer

    ChangeCountPowerClip = 0
    ChangeCount = 0

    For Each s In ActiveDocument.ActivePage.Shapes
        Set pwc = Nothing
        Set pwc = s.PowerClip
        
        If Not pwc Is Nothing Then
            For Each sp In pwc.Shapes
                If sp.Type = cdrBitmapShape Then
                    If (sp.Bitmap.ResolutionX > 350) Or (sp.Bitmap.ResolutionY > 350) Then sp.Bitmap.Resample , , True, 350, 350
                    If sp.Bitmap.Mode <> cdrCMYKColorImage Then
                       sp.Bitmap.ConvertTo cdrCMYKColorImage
                       ChangeCountPowerClip = ChangeCountPowerClip + 1
                    End If
                End If
            Next sp
        End If
        
        If s.Type = cdrBitmapShape Then
            If (s.Bitmap.ResolutionX > 350) Or (s.Bitmap.ResolutionY > 350) Then s.Bitmap.Resample , , True, 350, 350
            If s.Bitmap.Mode <> cdrCMYKColorImage Then
                s.Bitmap.ConvertTo cdrCMYKColorImage
                ChangeCount = ChangeCount + 1
            End If
        End If
    
    Next s
    MsgBox ChangeCount & " Bitmaps converted and + " & ChangeCountPowerClip & " inside on PowerClips"
End Sub
Best of luck,

-Shelby
Reply With Quote
  #3  
Old 08-07-2010, 12:42
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default Nada Feito!

It's not working shelbym.

The code is in there, but, it's not resampling.
Reply With Quote
  #4  
Old 08-07-2010, 12:51
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 Resample...

Are your bitmaps less than 350? It will only resample if they are greater.

-Shelby
Reply With Quote
  #5  
Old 08-07-2010, 14:38
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default That's It!!!

I have many diferent resolutions. so I change the code:

Code:
Sub Convert_All_Bitmaps_to_CMYK()
    'Convert all bitmaps to CMYK including included in powerclip's.
    Dim s As Shape, sp As Shape
    Dim pwc As PowerClip
    Dim ChangeCountPowerClip As Integer
    Dim ChangeCount As Integer

    ChangeCountPowerClip = 0
    ChangeCount = 0

    For Each s In ActiveDocument.ActivePage.Shapes
        Set pwc = Nothing
        Set pwc = s.PowerClip
        
        If Not pwc Is Nothing Then
            For Each sp In pwc.Shapes
                If sp.Type = cdrBitmapShape Then
                    If (sp.Bitmap.ResolutionX <> 350) Or (sp.Bitmap.ResolutionY <> 350) Then sp.Bitmap.Resample , , True, 350, 350
                    If sp.Bitmap.Mode <> cdrCMYKColorImage Then
                       sp.Bitmap.ConvertTo cdrCMYKColorImage
                       ChangeCountPowerClip = ChangeCountPowerClip + 1
                    End If
                End If
            Next sp
        End If
        
        If s.Type = cdrBitmapShape Then
            If (s.Bitmap.ResolutionX <> 350) Or (s.Bitmap.ResolutionY > 350) Then s.Bitmap.Resample , , True, 350, 350
            If s.Bitmap.Mode <> cdrCMYKColorImage Then
                s.Bitmap.ConvertTo cdrCMYKColorImage
                ChangeCount = ChangeCount + 1
            End If
        End If
    
    Next s
    MsgBox ChangeCount & " Bitmaps converted and + " & ChangeCountPowerClip & " inside on PowerClips"
End Sub
The code does not change the bitmaps that are grouped.
Do You know how to make it also applied to bitmaps grouped inside ou/and outside the powerclips?

Thank's Shelby
Reply With Quote
  #6  
Old 08-07-2010, 15:47
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 Bitmaps

What version of CorelDRAW are you using?

-Shelby
Reply With Quote
  #7  
Old 08-07-2010, 17:06
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default

X4 and X5.




tkx
Reply With Quote
  #8  
Old 08-07-2010, 18:10
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
I haven't tested but this could eliminate some code:

Code:
Option Explicit

Sub Convert_All_Bitmaps_to_CMYK()
    'Convert all bitmaps to CMYK including included in powerclip's.
    Dim s As Shape, sp As Shape
    Dim pwc As PowerClip
    Dim ChangeCountPowerClip As Integer
    Dim ChangeCount As Integer

    ChangeCountPowerClip = 0
    ChangeCount = 0

    For Each s In ActiveDocument.ActivePage.Shapes
        Set pwc = Nothing
        Set pwc = s.PowerClip
        
        If Not pwc Is Nothing Then
            For Each sp In pwc.Shapes
                ChangeCountPowerClip = ChangeCountPowerClip + processBitmap(sp)
            Next sp
        End If
        
       ChangeCount = processBitmap(s) + ChangeCount
    Next s
    
    MsgBox ChangeCount & " Bitmaps converted and + " & ChangeCountPowerClip & " inside on PowerClips"
End Sub

Private Function processBitmap(s As Shape) As Integer
    processBitmap = 0
    If s.Type = cdrBitmapShape Then
        s.Bitmap.Resample , , True, 350, 350
        If s.Bitmap.Mode <> cdrCMYKColorImage Then s.Bitmap.ConvertTo cdrCMYKColorImage
        processBitmap = 1
    End If
End Function
-John
Reply With Quote
  #9  
Old 09-07-2010, 12:50
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default Really Cool

It's working and fine.

But, the code does not change the bitmaps that are grouped.
Like the other.
Do you know how make change in grouped bitmaps, in or out PowerClip?



Thank's John and Shelby.
Reply With Quote
  #10  
Old 09-07-2010, 13:30
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
I'm sorry I don't have time to test, but findshapes used in this should dig deeper.

Code:
Option Explicit

Sub Convert_All_Bitmaps_to_CMYK()
    'Convert all bitmaps to CMYK including included in powerclip's.
    Dim s As Shape, sp As Shape
    Dim pwc As PowerClip
    Dim ChangeCountPowerClip As Integer
    Dim ChangeCount As Integer

    ChangeCountPowerClip = 0
    ChangeCount = 0

    For Each s In ActiveDocument.ActivePage.Shapes.FindShapes(, cdrBitmapShape)
        Set pwc = Nothing
        Set pwc = s.PowerClip
        
        If Not pwc Is Nothing Then
            For Each sp In pwc.Shapes.FindShapes(, cdrBitmapShape)
                ChangeCountPowerClip = ChangeCountPowerClip + processBitmap(sp)
            Next sp
        End If
        
       ChangeCount = processBitmap(s) + ChangeCount
    Next s
    
    MsgBox ChangeCount & " Bitmaps converted and + " & ChangeCountPowerClip & " inside on PowerClips"
End Sub

Private Function processBitmap(s As Shape) As Integer
    processBitmap = 0
    If s.Type = cdrBitmapShape Then
        s.Bitmap.Resample , , True, 350, 350
        If s.Bitmap.Mode <> cdrCMYKColorImage Then s.Bitmap.ConvertTo cdrCMYKColorImage
        processBitmap = 1
    End If
End Function
-John
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
power trace - can it? runflacruiser Feature requests/wishlist 0 01-10-2009 20:02
Finish editing power clip contents very slow Kursad General 11 31-01-2008 16:52
Did CorelDraw 11 for Mac include clip art/fonts? Diomedes General 0 24-05-2005 20:56
How to get the size of an object including the outline. CORNMEN CorelDRAW/Corel DESIGNER VBA 2 03-05-2005 17:03
New macro to clip curves w.r.t. a border Gerard Hermans Macros/Add-ons 0 09-06-2003 08:50


All times are GMT -5. The time now is 15:05.


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