Изменение размера шрифта на шаг

[Diego__]

Есть текстовый range. Как размер шрифта изменить на "шаг". Например, есть текст "Парам пам пам рурам", в котором "Парам" - 16 размер, "пам пам " - 20, "рурам" - 56. Как сделать размеры шрифтов из 16.20.56 - 15,5.19,5.55,5 (уменьшить каждый символ на 0.5) или 17.20.56 (увеличить на 1)?
У font-a есть методы Grow и Shrink, но они уменьшают/увеличивают к следующему доступному значению.

Думаю, можно пробежаться по каждому символу, изменяя его. Можно ли это сделать как то быстрее? Например не по символам, а по пучками? Можно ли разбить исходный range на более мелкие range-ы внутри с одинаковым размером font-a, будет ли это быстрее?

[viter.alex]

А свойства Size ты у Font'а не увидел?

[Diego__]

Немного не то. У меня получается range с различными размерами. Если я ему делаю
range->GetFont()->Size += 0.5f;
получаю исключение.
если
float prevSize = range->GetFont()->GetSize();
range->GetFont()->PutSize(prevSize + 0.5f);
весь текст становится одинакового размера

Можно ли разбить исходный range на более мелкие range-ы внутри с одинаковым размером font-a? Пока вижу решение в виде создания range-a для каждого символа отдельно и соответственное изменение размера. Кажется, это будет весьма медленно

[viter.alex]

У Range есть коллекция Characters, каждый элемент которой является отдельным символом и имеет тип Range. Такой вот полиморфизм. Вот набросал:

Sub SameFontSizeRange()
  Dim oChar As Range
  Dim oRng As Range
  Dim oSameFontSizeRange As Range
  Set oRng = Selection.Range
  Set oSameFontSizeRange = Selection.Range: oSameFontSizeRange.Collapse wdCollapseStart
  While oSameFontSizeRange.Start < oRng.End
    'Раздвигаем диапазон, пока размер шрифта следующего символа равен размеру шрифта текущего символа
    While oSameFontSizeRange.Font.Size = ActiveDocument.Characters(oSameFontSizeRange.End + 1).Font.Size
      oSameFontSizeRange.SetRange oSameFontSizeRange.Start, oSameFontSizeRange.End + 1
    Wend
    'Тут уже получаем Range с одинаковым шрифтом.
    Debug.Print "Размер шрифта: " & oSameFontSizeRange.Font.Size & "; Текст: """ & oSameFontSizeRange.Text & """"
    oSameFontSizeRange.Collapse wdCollapseEnd
  Wend
End Sub

[Serge_Bliznykov]

рекомендую попробовать встроенную фукнцию

выделите текст и нажмите сочетание клавиш: Ctrl-ъ

если не сработает:
меню - Сервис - Настройка - кнопка "Клавиатура"
слева выберите "Все команды"
справа найдите GrowFontOnePoint
посмотрите, какое сочетание клавиш назначено (или назначьте своё). Затем выделите текст и нажмите это сочетание...

оно?..

_______________________________
оп-с... похоже ТС нужно это реализовать в коде VBA...
на VBA это выглядит так:
Selection.Font.Size = Selection.Font.Size + 1

или я чего-то не понял?...

[viter.alex]

TC это нужно реализовать на «плюсах»

Selection.Font.Size = Selection.Font.Size + 1

Не прокатит, если шрифт в выделении разного размера

[Serge_Bliznykov]

Не прокатит, если шрифт в выделении разного размера

согласен.
Тупой рекордер под MS Word записал VBA код, который Word не может выполнить!! ;( и непонятно, почему есть увеличение размера шрифта до следующего порогового значения: Font.Grow, но нет Font.GrowFontOnePoint Как же то Word по Ctrl-[ и Ctrl-] выполняет эту операцию?!

[Sasha_Smirnov]

Сообщение от Diego__

Думаю, можно пробежаться по каждому символу, изменяя его. Можно ли это сделать как то быстрее?

Бежим по символам — имитацией нажатия стрелки вправо (в файле жмите на F6).

Sub LetterWave()
Static s
Static i

If s = vbEmpty Then s = MsgBox("+0,5?", vbQuestion + vbYesNoCancel)
If i = vbEmpty Then i = 0.5
If s = vbNo Then s = MsgBox("–0,5?", vbQuestion + vbYesNoCancel): i = -0.5
If s <> vbYes Then MsgBox "Bye-bye! Закройте документ.": Exit Sub
    
    With Selection.Font
    
    SendKeys "+{right}", True 'выделение (Shift-стрелка вправо)'
    .Size = .Size + i
    SendKeys "{right}", True 'снятие выделения (стрелка вправо)'
    
    End With
End Sub

Быстрее — превратить текст в контуры (я это делал с помощью xara.exe) и сжимать/растягивать.

[Diego__]

viter.alex, спасибо за пример.
На плюсах реализовал так:

int charactersCount = m_Document->Characters->GetCount();
int charactersInRangeCount = totalRange->ComputeStatistics(Word::wdStatisticCharactersWithSpaces);
int firstCharacter = charactersCount - charactersInRangeCount - 1;

Word::CharactersPtr characters = m_Document->Characters;
Word::RangePtr currentRange = characters->Item(firstCharacter);

float currentFontSize = currentRange->Font->Size;
for (int i = firstCharacter + 1; i <= charactersCount; ++i)
{
	if (currentFontSize == characters->Item(i)->Font->Size)
		currentRange->SetRange(currentRange->Start, currentRange->End + 1);
	else
	{
		currentRange->Font->Size = currentFontSize + increase;
		currentRange = characters->Item(i);
		currentFontSize = currentRange->Font->Size;
	}
}
currentRange->Font->Size = currentFontSize + increase;