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 13-01-2004, 16:58
RobC
Guest
 
Posts: n/a
Default Exporting Transparent GIFs

Hi Gang,

I need to create GIFs from CorelDraw11 CDRs, making the white areas transparent. I wrote the following code to do this:



Code:
Private Function saveFile(strName As String) As String
    Dim ExFilter As ExportFilter
    Dim pOpts As StructPaletteOptions
    Dim shpBG As CorelDRAW.Shape
    
    'build pallette options
    Set pOpts = Application.CreateStructPaletteOptions
    pOpts.NumColors = 16
    pOpts.PaletteType = cdrPaletteOptimized
    
    'Create background shape
    Set shpBG = ActiveLayer.CreateRectangle2(1.75, 0.5, 11.5, 11.5)
    shpBG.Outline.Type = cdrNoOutline
    shpBG.Fill.UniformColor.RGBAssign 255, 255, 255
    shpBG.OrderToBack
    
    'create selection
    With ActivePage
        .SelectShapesFromRectangle .CenterX - .SizeWidth / 2, .CenterY - .SizeHeight / 2, .CenterX + .SizeWidth / 2, .CenterY + .SizeHeight / 2, False
    End With
    
    'build path to save to
    saveFile = "w:\" & strName & ".gif"
    
    'build and execute the export filter
    Set ExFilter = Draw11.ActiveDocument.ExportBitmap(saveFile, cdrGIF, cdrSelection, , 225, 225, , , , , False, , , cdrCompressionRLE_LW, pOpts)
    ExFilter.Finish
End Function
the 'False' parameter in the ExportBitmap call is the Transparency option. It turns out that this option does not work for GIFs (according to the help file, as well as my experience). The help file suggests that there is a way of setting the transparency color of the exportFilter after the filter has been created, but all I can see is the ability to bring up a dialog prior to the '.Finish' call. I need to do this processing without human intervention, so setting transparency via a dialog is not a good option.

Any ideas? Have I overlooked something?

What would be very cool is the ability to put a pallette index into the transparency option. How about it?

Thanks in Advance,
Rob
Reply With Quote
  #2  
Old 13-01-2004, 22:41
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Exporting Transparent GIFs

Rob,

Here is an article which will explain how to access filter properties during export: http://www.oberonplace.com/vba/exportex.htm

The transparency and compression parameters of ExportBitmap only affect formats such as TIFF. Do NOT specify the transparency parameter nor the compression for the GIF. Instead, using the export filter object to specify the color index in the GIF palette which will be transparent. For this, you need to loop through all the colors in the resulting palette to find the entry for white, and then specify that color.

Here is an example:

Code:
Sub Test()
    Dim pal As New StructPaletteOptions
    Dim Filter As ExportFilter
    Dim n As Long, idx As Long
    With pal
        .DitherType = cdrDitherNone
        .NumColors = 64
        .PaletteType = cdrPaletteOptimized
        .ColorSensitive = False
    End With
    Set Filter = ActiveDocument.ExportBitmap("C:\Temp\Test.gif", cdrGIF, _
            cdrCurrentPage, cdrPalettedImage, PaletteOptions:=pal)
    Filter.Interlaced = True
    idx = 0
    For n = 1 To Filter.NumColors
        If Filter.PaletteColor(n) = RGB(255, 255, 255) Then
            idx = n
            Exit For
        End If
    Next n
    If idx <> 0 Then
        Filter.Transparency = 1
        Filter.ColorIndex = idx
    Else
        Filter.Transparency = 0
    End If
    Filter.Finish
End Sub

Last edited by Alex; 31-08-2006 at 09:39.
Reply With Quote
  #3  
Old 14-01-2004, 06:56
RobC
Guest
 
Posts: n/a
Default

Your suggestion works like a champ. Thanks for the assist!
Reply With Quote
  #4  
Old 14-01-2004, 15:07
RobC
Guest
 
Posts: n/a
Default I spoke too soon....

Alex-

Your suggestion worked nicely when I ran your code in VBA. It failed when I used it from VB6.

Here is how I applied your code
Code:
    Dim pal As StructPaletteOptions
    Dim Filter As ExportFilter
    Dim n As Long, idx As Long
    
    Set pal = New StructPaletteOptions
    
    With pal
        .DitherType = cdrDitherNone
        .NumColors = 64
        .PaletteType = cdrPaletteOptimized
        .ColorSensitive = False
    End With
*snip*
as soon as
pal.dithertype executes, it throws an error 430: Class does not support Automation or does not support expected interface
The problem occurs whether i use 'With' or 'pal.'
Reply With Quote
  #5  
Old 14-01-2004, 15:24
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: I spoke too soon....

Try replacing "Set pal = New StructPaletteOptions" with "Set pal = Application.CreateStructPaletteOptions"

Generally if New doesn't work, it means you have some application registration issues on your machine.
Reply With Quote
  #6  
Old 14-01-2004, 15:31
RobC
Guest
 
Posts: n/a
Default

DING DING DING! We have a winner!

createstructpalletteoptions worked perfectly, and takes the prize for one of the longest method names i've had to use.


Thanks, Alex!
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
Exporting Illustrator files bbolte CorelDRAW/Corel DESIGNER VBA 8 15-03-2005 12:22
Exporting Vectors Anonymous Jigsaw Puzzle Creator 3 18-11-2004 14:31
exporting text object co-ordinates. vr_driver CorelDRAW/Corel DESIGNER VBA 2 20-08-2004 00:20
Exporting Grouped Objects ddonnahoe CorelDRAW/Corel DESIGNER VBA 4 15-05-2004 10:12
exporting to jpg ddonnahoe CorelDRAW/Corel DESIGNER VBA 7 26-01-2004 12:53


All times are GMT -5. The time now is 13:30.


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