OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Placing a custom envelope on Text (http://forum.oberonplace.com/showthread.php?t=126)

larrypanattoni 19-04-2003 09:10

Placing a custom envelope on Text
 
I need to place an envelope effect on text. I want the text to have a curved bottom while keeping the top flat and keeping the text its original width.
I could not access “envelope single arc mode” from CdrVB, so I created the shape I want, for the envelope effect, by using trim. But I have been unable to get this shape onto the text as an envelope effect.

My code is listed below.
Any ideas?

Thanks,
Larry

Sub TextCurveBottom()
Dim s As Shape, sellipse As Shape, sTrimmed As Shape
Dim sRectangle As Shape, eff As Effect
Dim x As Double, y As Double, s1 As Shape, sx As Shape, s2 As Shape

ActiveDocument.ReferencePoint = cdrBottomLeft

Set s1 = ActiveLayer.CreateArtisticText(2.75, 5, "TESTING")
With s1.Text.FontProperties
.Name = "Arial Black"
.Size = 150
End With

'Get text position
s1.GetPosition x, y

'UseText size - Create rectangle and ellipse to trim for envelope shape
Set sRectangle = ActiveLayer.CreateRectangle2(x, y + 3, _
s1.Size Width, s1.SizeHeight)
Set sellipse = ActiveLayer.CreateEllipse2(x + 0.5 * (s1.SizeWidth), _
y + 3, 0.45 * (s1.SizeWidth), 0.25 * s1.SizeHeight)

'Trim rectangle and ellipse to envelope shape
Set sTrimmed = sellipse.Trim(sRectangle, False, False)

Set eff = s1.CreateEnvelope(1, cdrEnvelopePutty, True)

eff.Envelope.CreateFrom sTrimmed

End Sub

Alex 22-04-2003 21:59

Re: Placing a custom envelope on Text
 
Hi Larry,

I looked into the issue and it does look like a bug. Actually there are two problems as I discovered.

1. After you trimmed the rectangle, it is left selected. Then you try to create an envelope on the text and Envelope.CreateFrom seems to require the text to be selected. Normally it should have been done internally in the implementation of that method.

2. After you create an envelope from your curve, the envelope shape is created but not actually applied to the text, meaning that the text is still not transformed.

Fortunately I think these problems can be worked around.

To fix the problem #1, just make sure you select the text before applying the envelope to it. Problem #2 can be solved by changing the envelope somewhat after it was created to force it to regenerate. Here is how your last several lines of code should look:

'Trim rectangle and ellipse to envelope shape
Set sTrimmed = sellipse.Trim(sRectangle, False, False)
s1.CreateSelection
Set eff = s1.CreateEnvelope(1, cdrEnvelopePutty, True)
eff.Envelope.CreateFrom sTrimmed
eff.Envelope.Mode = cdrEnvelopePutty

Or the complete code snippet:
Code:

Sub TextCurveBottom()
    Dim s As Shape, sellipse As Shape, sTrimmed As Shape
    Dim sRectangle As Shape, eff As Effect
    Dim x As Double, y As Double, s1 As Shape, sx As Shape, s2 As Shape
   
    ActiveDocument.ReferencePoint = cdrBottomLeft
   
    Set s1 = ActiveLayer.CreateArtisticText(2.75, 5, "TESTING")
    With s1.Text.FontProperties
        .Name = "Arial Black"
        .Size = 150
    End With
   
    'Get text position
    s1.GetPosition x, y
   
    'UseText size - Create rectangle and ellipse to trim for envelope shape
    Set sRectangle = ActiveLayer.CreateRectangle2(x, y + 3, s1.SizeWidth, s1.SizeHeight)
    Set sellipse = ActiveLayer.CreateEllipse2(x + 0.5 * (s1.SizeWidth), y + 3, 0.45 * (s1.SizeWidth), 0.25 * s1.SizeHeight)
   
    'Trim rectangle and ellipse to envelope shape
    Set sTrimmed = sellipse.Trim(sRectangle, False, False)
    s1.CreateSelection
    Set eff = s1.CreateEnvelope(1, cdrEnvelopePutty, True)
    eff.Envelope.CreateFrom sTrimmed
    eff.Envelope.Mode = cdrEnvelopePutty
   
    ActiveDocument.ClearSelection
End Sub

This should work for you. I hope this helps.

larrypanattoni 23-04-2003 08:44

Thanks, Alex
 
Your response is just what I needed. I was unfamiliar with the process and you explained it good. This will help me with future codes.
Again, Thanks alot.
Larry :D

Alex 23-04-2003 09:18

Re: Thanks, Alex
 
I just wanted to mention that none of the two workarounds I suggested should have been needed. Normally you don't have to pre-select a shape to do something with it. The suggestion I made was due to a bug in the implementation of the method. Just don't assume you have to do the same in all other cases :)


All times are GMT -5. The time now is 00:47.

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