V-Форум / Corel VBA / Тема: CorelDRAW VBA : Создание текста

CorelDRAW VBA : Создание текста

 20/02/2008 10:18:57 #Link

GoodvinVV

Создать текст- это просто!

CorelScript.CreateArtisticText "C M Y K" ', 10, 20
With ActiveDocument.Selection.Shapes.Item(1).Text.Story
.Font = "Arial"
.Size = 10
End With


Перекрасить целиком можно так:

Dim myText As Shape
For Each myText In ActiveSelection.Shapes
myText.Fill.ApplyUniformFill myColor
Next myText

Вопрос :
Как перекрасить его в разные цвета (каждую букву в свойцвет)? Например: C M Y K

Re: CorelDRAW VBA : Создание текста

 20/02/2008 10:44:14 #Link

wOxxOm

1. Лучше обходиться без CorelScript

ActiveDocument.unit = cdrMillimeter
With ActiveLayer.CreateArtisticText(10, 20, "CMYK", cdrRussian, cdrCharSetRussian, _
         "Arial", 12, Bold:=cdrTrue, Italic:=cdrFalse, Underline:=cdrNoFontLine, _
         Alignment:=cdrCenterAlignment)
   .text.Story.CharSpacing = 100
   .Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
End With


2. Обрабатывать в выделенном в цикле можно для надежности выбирая только текстовые объекты с помощью .FindShapes, что кстати позволяет обрабатывать внутри групп без разгруппировки

Dim myText As Shape, myColor as color
set myColor=CreateFixedColor(cdrPANTONECoated, _
          Palettes.OpenFixed(cdrPANTONECoated).FindColor("PANTONE 711 C"), 50)
For Each myText In ActiveSelection.Shapes.FindShapes(, cdrTextShape)
   myText.Fill.ApplyUniformFill myColor
Next myText


3. Перекрасить в разные цвета (каждую букву в свой цвет) например так:

dim i&,arrColors$()
arrColors=split("100,0,0,0+0,100,0,0+0,0,100,0+0,0,0,100","+")
for i=0 to ubound(arrColors)
   ActiveShape.Text.Story.Characters(i+1).Fill.ApplyUniformFill _
        CreateColor("CMYK,USER," & arrColors(i) & ",0")
next

Re: CorelDRAW VBA : Создание текста

 20/02/2008 17:30:53 #Link

izrukvruki

Пишу такой код
ActiveLayer.CreateParagraphText 0, 50, 60, 0, "Привет пока"

Но почему то буквы (РУССКИЕ) не отображаются - шрифты пробовал разные ставить... Английские буквы нормально отображаются... У меня Винда 98, Корел 10.

Re: CorelDRAW VBA : Создание текста

 20/02/2008 17:49:23 #Link

KarLsoN

izrukvruki, Винда 98 я уже забыл что это такое

Re: CorelDRAW VBA : Создание текста

 20/02/2008 21:02:08 #Link

GoodvinVV

Так еще не пробовал! Но попробую. А есть ли попроще код или метод ?

Re: CorelDRAW VBA : Создание текста

 21/02/2008 5:38:13 #Link

wOxxOm

GoodvinVV, зависит от количества цветов... то, что использовал я удобно когда цветов оооочень много

Re: CorelDRAW VBA : Создание текста

 21/02/2008 10:37:54 #Link

GoodvinVV

Спасибо за метод, мне оказалось достаточно вот этого...

ActiveDocument.Unit = cdrMillimeter
With ActiveLayer.CreateArtisticText(10, 20, "CMYK", cdrRussian, cdrCharSetRussian, _
"Arial", 12, Bold:=cdrTrue, Italic:=cdrFalse, Underline:=cdrNoFontLine, _
Alignment:=cdrCenterAlignment)
.Text.Story.CharSpacing = 100
.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
End With

ActiveShape.Text.Story.Characters(1).Fill.ApplyUniformFill CreateCMYKColor(100, 0, 0, 0)
ActiveShape.Text.Story.Characters(2).Fill.ApplyUniformFill CreateCMYKColor(0, 100, 0, 0)
ActiveShape.Text.Story.Characters(3).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 100, 0)
ActiveShape.Text.Story.Characters(4).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)

Еще раз спасибо!!!

Re: CorelDRAW VBA : Создание текста

 21/04/2008 16:12:58 #Link

Acsidian

А как можно сделать так чтобы набор букв разного размера (хаотично) заполнял область объекта

вот примерно так

Re: CorelDRAW VBA : Создание текста

 21/04/2008 23:18:39 #Link

wOxxOm

имхо проще самому накидать штук сто разных, потом из этого набора брать куски, масштабировать их, крутить по разному и складывать в общую кучу

Re: CorelDRAW VBA : Создание текста

 22/04/2008 10:00:17 #Link

Acsidian

так то понятно но задача не очень простая - нужно сделать таких объектвов много - и чтобы они были все разные

поэтому хотелось бы как то оптимизировать процесс создания
(1) 2 »

Источник: https://powerclip.ru/modules/newbb/viewtopic.php?topic_id=7229&start=0

Rambler's Top100