OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Exporting Transparent GIFs (http://forum.oberonplace.com/showthread.php?t=333)

RobC 13-01-2004 15:58

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:


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
    '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)
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,

Alex 13-01-2004 21:41

Re: Exporting Transparent GIFs

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:


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
        Filter.Transparency = 0
    End If
End Sub

RobC 14-01-2004 05:56

Your suggestion works like a champ. Thanks for the assist!

RobC 14-01-2004 14:07

I spoke too soon....

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

    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

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.'

Alex 14-01-2004 14:24

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.

RobC 14-01-2004 14:31

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!

All times are GMT -5. The time now is 11:24.

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