Этюды для программистов Microsoft Word

Home ] Up ] Этюд 1.1. Подгонка размера текста ] Этюд 1.2. Изменение регистра символов ] Этюд 1.3. Поиск и раскраска гиперссылок ] Этюд 1.4. Стили ] Этюд 1.5. Вставка форматированного текста ] Этюд 1.6. Вычисление высоты текста. ] Этюд 1.7. Форматирование заголовка. ]


Этюд 1.6. Вычисление высоты текста в колонке

СТОЛБЕЦ. Ряд коротких строк, расположенных одна под другой и образующих колонку текста.

Толковый словарь Ушакова. http://dic.academic.ru/dic.nsf/ushakov/1043862

In typography, a column is one or more vertical blocks of text positioned on a page, separated by margins and/or rules. Columns are most commonly used to break up large bodies of text that cannot fit in a single block of text on a page. Additionally, columns are used to improve page composition and readability. Newspapers very frequently use complex multi-column layouts to break up different stories and longer bodies of texts within a story. Column can also more generally refer to the vertical delineations created by a typographic grid system which type and image may be positioned.

http://en.wikipedia.org/wiki/Column_(typography)

 

Все мы видели вертикальную и горизонтальную линейки вокруг текста документа. А многие ли пользовались ими для вычисления размера текста или выделения? Удобно ли ими пользоваться?

В этом этюде рассматривается задача, часто возникающая у пользователей, пишуших текст для газетных или журнальных колонок. Или, по крайней мере, у людей, которые создают стандартные шаблоны или подгоняют размеры шрифтов текста и заголовков для того, чтобы некоторый текст разместился точно в отведенном ему месте на газетной или журнальной странице. В самом деле, ведь неудобно набирать текст сразу в одной или нескольких узких колонках.

Идея задачи вычисления высоты текста состоит в том, чтобы иметь возможность в любой момент времени вычислить высоту текста на некоторой другой странице, размеры которой заданы.

Задание. Объекты TextColumn и PageSetup.

Пришло время познакомиться с объектами, отвечающими за расположение текста на странице.

Если Вы не знакомы с объектами PageSetup, TextColumn и LineNumbering, то сейчас самое подходящее время, чтобы их изучить. Справочная информация, как обычно, находится в Приложении. [Читать!]

Ресурсы

Шаблон "AhTextDepth.dot", 40 Кб, формат ZIP [скачать].

Функциональная спецификация

Задача

Необходимо создать шаблон "AhTextDepth.dot", в котором будут размещены макросы для вычисления глубины текста и панель инструментов "AhTextDepth". При наличии выделения глубина текста должна вычисляться для выделенного текста, в противном случае глубина текста должна вычисляться для всего документа.

Панель инструментов "AhTextDepth"

Панель инструментов "AhTextDepth" имеет следующий вид:

Краткое описание кнопок панели инстументов "AhTextDepth" приведено в следующей таблице.

Кнопка

Макрос

Краткое описание

Help

AhTextDepthHelp

Краткая подсказка по кнопкам панели инструментов.

Compute

AhTextDepth

Вычисление высоты текста для заданных значений параметров.

Settings

AhTextDepthParams

Диалог для ввода параметров для вычисления высота текста.

Краткая подсказка

Краткая подсказка по кнопкам панели инструментов имеет следующий вид.

Диалог "'Text Depth In Column' Settings"

Для ввода параметров используется диалог "'Text Depth In Column' Settings", который имеет следующий вид.

Краткое описание параметров приведено в следующей таблице.

Параметр

Краткое описание

Page Width

Этот параметр отвечает за ширину колонки, в которую требуется вписать выделенный текст (или весь документ).

Диапазон допустимых значений [7.2-1584].

Значение по умолчанию 146.

Вычисление высоты текста

 

Для вычисления высоты текста Microsoft Word переводится в режим "Normal View", устанавливаются необходимые параметры страницы. Затем, функция AhTextDepthPoints двигает выделение от строки к строке, учитывая высоту строки и размер межстрочных интервалов.

После вычислений исходное состояние окна восстанавливается.

 

Результат вычислений округляется до двух знаков после запятой и показывается в следующем виде:

 

 

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

 

Чтобы увидеть как работают приведенные в этом этюде макросы следует использовать отладчик.

Реализация - шаблон "AhTextDepth.dot"

В шаблоне "AhTextDepth.dot" реализована функция вычисления "глубины" текста (в колонке заданной ширины). Панель инструментов "AhTextDepth" предоставляет простой интерфейс для вычисления "глубины" текста.

В шаблоне "AhTextHeadline" содержатся следующие модули:

Модуль

Краткое описание

AhTextDepth

Основные макросы.

AhTextDepthSettingsDialog

Диалог "'Text Depth In Column' Settings".

 

Функция перемещения по тексту от строки к строке есть только у объекта Selection. Рассматриваемая задача представляет собой редкий пример задачи, которую нельзя решить используя только объект Range.

Модуль AhTextDepthSettingsDialog (Форма)

В модуле "AhTextDepthSettingsDialog" реализован диалог установки дополнительных параметров. Диалог "'Text Depth In Column' Settings" имеет следующий вид.


'
' File AhTextDepth.dot|AhTextDepthSettingsDialog
'
' Etudes for Microsoft Word Programmers.
' Etude 1.6. Text Depth in Column.
'
' First published on http://www.transcriber.ru/
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
Option Explicit
 

Члены класса

'
' Workhorses
'
Private m_fDefaultPageWidth As Single
'
' Dialog result
'
Public dwDialogResult As Long
 

Конструктор

'
' Constructor
'
Private Sub UserForm_Initialize()
    dwDialogResult = vbCancel

End Sub

Деструктор

'
' Destructor
'
Private Sub UserForm_Terminate()
End Sub

Нажатие кнопки "Defaults" - значения по умолчанию

'
' Defaults
'
Private Sub btnDefault_Click()
    InitDialogData False

End Sub

Нажатие кнопки "Cancel"

'
' Cancel
'
Private Sub btnCancel_Click()
    dwDialogResult = vbCancel
    Unload Me
End Sub

Нажатие кнопки "OK"

'
' OK
'
Private Sub btnOK_Click()
    '
    ' set global settings
    '
    g_fDefaultPageWidth = m_fDefaultPageWidth
    
    dwDialogResult = vbOK
    Unload Me
End Sub

Изменение данных

'
' Text Box Change
'
Private Sub tBox_PageWidth_Change()
    EnableControls

End Sub

Функция IsInRange - проверка диапазона

'
' IsInRange
'
Private Function IsInRange(ByVal fValue As Single, ByVal fMin As Single, ByVal fMax As Single) As Boolean
    If (fMin <= fValue) And (fValue <= fMax) Then
        IsInRange = True
    Else
        IsInRange = False
    End If
End Function

Процедура EnableControls

'
' EnableControls
'
Public Sub EnableControls()
Dim bEnableOk As Boolean
bEnableOk = False
On Error GoTo ErrorLabel
'
' get data from the dialog
'
m_fDefaultPageWidth = CSng(tBox_PageWidth.Text)
'
' check whether values are in valid ranges
'
If Not IsInRange(m_fDefaultPageWidth, g_fDefaultPageWidthMin, g_fDefaultPageWidthMax) Then GoTo ErrorLabel
bEnableOk = True
ErrorLabel:
btnOK.Enabled = bEnableOk
End Sub

Процедура InitDialogData

'
' InitDialogData
'
Public Sub InitDialogData(ByVal bSettingsWereSet As Boolean)
    If bSettingsWereSet Then

        '
        ' use last data
        '
        tBox_PageWidth.Text = CStr(g_fDefaultPageWidth)
    Else
        '
        ' use defaults
        '
        tBox_PageWidth.Text = CStr(g_fDefaultPageWidthDef)
    End If

    EnableControls
End Sub

Модуль AhWaitCursor (Класс)

'
' File AhTextDepth.dot|AhWaitCursor
'
' Etudes for Microsoft Word Programmers.
' Etude 1.6. Text Depth in Column.
'
' First published on http://www.transcriber.ru/
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
' Saves cursor in constructor, restores cursor in destructor.
'
Option Explicit

'
' Class members.
'
Private hCursor As Long
'
' Constructor
'
Private Sub Class_Initialize()
    On Error Resume Next
    CursorSave
    System.Cursor = wdCursorWait    ' set
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
    On Error Resume Next
    CursorRestore
End Sub
'
' CursorSave
'
Private Sub CursorSave()
    hCursor = System.Cursor         ' save cursor
End Sub
'
' CursorRestore
'
Private Sub CursorRestore()
    System.Cursor = hCursor         ' restore cursor
End Sub

Модуль AhTextDepth

В модуле "AhTextDepth" расположены макросы вычисления высоты текста в колонке заданной ширины.

'
' File AhTextDepth.dot|AhTextDepth
'
' Etudes for Microsoft Word Programmers.
' Etude 1.6. Text Depth in Column.
'
' First published on http://www.transcriber.ru/
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved.
'
'
Option Explicit
 

Константы

'
' Constants/Parameters
'
Private Const cStrAhTextDepthHelp As String = _
"Etudes for Microsoft Word Programmers." & vbCrLf & _
"Etude 1.6. Text Depth in Column." & vbCrLf & _
"http://www.transcriber.ru" & vbCrLf & vbCrLf & _
"Template AhTextDepth.dot" & vbCrLf & vbCrLf & _
"Calculating text depth in column." & vbCrLf & vbCrLf & _
"Settings are selected from the dialog."
Private Const cbIncludeHiddenText As Boolean = False ' don't count hidden text

'
' Settings dialog data
'

'
' g_fDefaultPageWidth
'
Public g_fDefaultPageWidth As Single
Public Const g_fDefaultPageWidthMin As Single = 7.2
Public Const g_fDefaultPageWidthMax As Single = 1584
Public Const g_fDefaultPageWidthDef As Single = 146
'
' bSettingsWereSet
'
Private bSettingsWereSet As Boolean

Процедура AhTextDepthHelp

'
' AhTextDepthHelp
'
Sub AhTextDepthHelp()
    MsgBox cStrAhTextDepthHelp

End Sub

Процедура AhTextDepthParams

'
' AhTextDepthParams
'
Sub AhTextDepthParams()
    If DoAhTextDepthSettingsDialog Then
        bSettingsWereSet = True
    End If
End Sub

Процедура DoAhTextDepthSettingsDialog

'
' DoAhTextDepthSettingsDialog
'
Private Function DoAhTextDepthSettingsDialog() As Boolean
DoAhTextDepthSettingsDialog = False
'
' do settings dialog
'
Dim dlg As AhTextDepthSettingsDialog
Set dlg = New AhTextDepthSettingsDialog
With dlg
   .InitDialogData bSettingsWereSet
   .Show vbModal
   If dlg.dwDialogResult = vbOK Then
      DoAhTextDepthSettingsDialog = True
   End If
End With
Set dlg = Nothing
End Function

Процедура AhTextDepth

'
' AhTextDepth - calculates selected/document height (depth).
' Displays result in points, inches and centimeters.
'
Public Sub AhTextDepth()
Dim hei_pt As Single
Dim hei_in As Single
Dim hei_cm As Single

If Not bSettingsWereSet Then
If Not DoAhTextDepthSettingsDialog Then Exit Sub
End If

StatusBar = "Please wait..."
On Error Resume Next
Dim wc As New AhWaitCursor
hei_pt = AhTextDepthPoints(g_fDefaultPageWidth)
Set wc = Nothing
StatusBar = ""
'
' round result to 2 decimal points
'
hei_in = CDbl(CLng(PointsToInches(hei_pt) * 100)) / 100
hei_cm = CDbl(CLng(PointsToCentimeters(hei_pt) * 100)) / 100

MsgBox "Height [pt] = " & CStr(hei_pt) & vbCrLf & _
"Height [in] = " & CStr(hei_in) & vbCrLf & _
"Height [cm] = " & CStr(hei_cm)

End Sub
 

Процедура AhTextDepthPoints

'
' AhTextDepthPoints
'
Public Function AhTextDepthPoints(ByVal fDefPageWidth As Single) As Single
' fDefPageWidth [7.2 - 1584] pt
Dim fTotal, fTotalPar, fFontSize, fRealFontSize As Single
Dim fOldRightMargin, fOldLeftMargin, fOldPageWidth As Single
Dim bDocSaveStatus, bOldHyphen, bOldCaps, bFirstLine, bFirstPar As Boolean
Dim bIsSelection, bRestoreSelection As Boolean

Dim c, dwCharCount, dwAlerts, dwOldZone, dwOldLimits, dwSelectionPrev, dwOldView As Long
Dim iSelStartEnd, dwOldSStart, dwOldSEnd As Long

Dim ParRange, DocRange As Range
Dim Par As Paragraph

    AhTextDepthPoints = 0
    If Documents.Count <= 0 Then Exit Function
    '
    ' Application
    '
    dwAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = wdAlertsNone
    Application.ScreenUpdating = False
    '
    ' View
    '
    dwOldView = ActiveDocument.ActiveWindow.View.Type
    ActiveDocument.ActiveWindow.View.Type = wdNormalView
   
    bDocSaveStatus = ActiveDocument.Saved
   
    Debug.Print "AhTextDepthPoints +++"
   
    With Selection
    '
    ' save selection
    '
    If .Start = .End Then
        bRestoreSelection = True
        bIsSelection = False
        iSelStartEnd = .Start
        .WholeStory
        Debug.Print "WholeStory Selection [" & .Start & ";" & .End & "]"
        Set DocRange = .Range
    Else
        bRestoreSelection = False
        bIsSelection = True
        Set DocRange = ActiveDocument.Range(Start:=.Start, End:=.End)
    End If
    '
    ' don't count hidden text
    '
    DocRange.TextRetrievalMode.IncludeHiddenText = cbIncludeHiddenText

    dwOldSStart = .Start
    dwOldSEnd = .End

    End With
   
    '
    ' set indents
    '
    With DocRange.ParagraphFormat
        .RightIndent = 0
        .LeftIndent = 0
    End With
   
    '
    ' page setup, page width
    '
    With ActiveDocument
        bOldHyphen = .AutoHyphenation
        bOldCaps = .HyphenateCaps
        dwOldZone = .HyphenationZone
        dwOldLimits = .ConsecutiveHyphensLimit
        .AutoHyphenation = True
        .HyphenateCaps = True
        .HyphenationZone = InchesToPoints(0.1)
        .ConsecutiveHyphensLimit = 0
       
        With .PageSetup
            fOldRightMargin = .RightMargin
            fOldLeftMargin = .LeftMargin
            fOldPageWidth = .PageWidth
            .LeftMargin = 0
            .RightMargin = 0
           
            On Error GoTo ErrPageWidth
            .PageWidth = fDefPageWidth
           
            On Error GoTo 0
        End With
    End With
   
    Selection.HomeKey Unit:=wdStory
  
    bFirstLine = True
    bFirstPar = True
  
    Dim nPara, nPars As Long
    nPara = 0
    nPars = DocRange.Paragraphs.Count
    Debug.Print "Processing paragraphs: ", nPars
  
    Dim ahRangeStr As String
    Dim ahRangeLen As Long
   
    For Each Par In DocRange.Paragraphs
        nPara = nPara + 1
       
        ahRangeStr = Par.Range.Text
        ahRangeLen = Len(ahRangeStr)
       
        Debug.Print "Processing paragraph ", nPara, " Range = [", Par.Range.Start, ";", Par.Range.End, "]. Len = ", ahRangeLen
       
        With Selection
       
        .Start = Par.Range.Start
        fTotalPar = 0
       
        '
        ' Move selection line by line
        '
        Do
            .MoveEnd Unit:=wdLine, Count:=1 ', Extend:=wdExtend
     
            If .Font.Size = wdUndefined Then
            ' means we have different fonts on this line
                fFontSize = 0
                dwCharCount = .Characters.Count
                For c = 1 To dwCharCount
                    With .Characters(c).Font
                    If (.Hidden <> True) Then
                        If .Size > fFontSize Then
                            fFontSize = .Size
                        End If
                    End If
                    End With
                Next
            Else
              fFontSize = .Font.Size
            End If
            
            fRealFontSize = fFontSize
                  
           
            If .Font.Hidden <> True Then
                If Not bFirstLine Then
                    Select Case Par.LineSpacingRule
                        Case wdLineSpaceSingle
                            fFontSize = fFontSize * 1
                        Case wdLineSpace1pt5
                            fFontSize = fFontSize * 1.5
                        Case wdLineSpaceDouble
                            fFontSize = fFontSize * 2
                        Case wdLineSpaceAtLeast, wdLineSpaceExactly
                            fFontSize = Par.LineSpacing * 1#
                        Case wdLineSpaceMultiple
                            fFontSize = Par.LineSpacing * fFontSize
                    End Select
                End If
                fTotalPar = fTotalPar + fFontSize
                bFirstLine = False
            End If
           
            If .End >= DocRange.End Then Exit Do
           
            dwSelectionPrev = .Start
           
            ' skip empty paragraph
            If (ahRangeLen <= 1) Then Exit Do
           
            .GoToNext wdGoToLine     ' hangs on empty paragraph
           
            '
            ' check loop conditions
            '
            If (dwSelectionPrev = .Start) Then Exit Do
            If (.Start >= Par.Range.End) Or (.Start + 1 >= DocRange.End) Then Exit Do
        Loop
   
        '
        ' count paragraph
        '
        If fTotalPar <> 0 Then
             If bFirstPar Then
                fTotal = fTotal + fTotalPar + Par.SpaceAfter
                bFirstPar = False
             Else
                fTotal = fTotal + fTotalPar + Par.SpaceAfter + Par.SpaceBefore
             End If
        End If
       
        End With
    Next Par
   
    '
    ' Cut off "space before" for first paragraph
    ' and "space after" for last paragraph.
    '
    fTotal = fTotal - DocRange.Paragraphs.Last.SpaceAfter
   
    '
    ' restore view and page setup
    '
    With Selection
        .Start = dwOldSStart
        .End = dwOldSEnd
    End With
   
    With ActiveDocument
        .ActiveWindow.View.Type = dwOldView
        On Error Resume Next
        .AutoHyphenation = bOldHyphen
        .HyphenateCaps = bOldCaps
        .HyphenationZone = dwOldZone
        .ConsecutiveHyphensLimit = dwOldLimits
        On Error GoTo 0
        With .PageSetup
             .PageWidth = fOldPageWidth
             .RightMargin = fOldRightMargin
             .LeftMargin = fOldLeftMargin
        End With
        .Saved = bDocSaveStatus 'make sure we didn't make it dirty
    End With
    '
    ' restore Application properties
    '
    Application.ScreenUpdating = True
    Application.DisplayAlerts = dwAlerts
   
    AhTextDepthPoints = fTotal
    '
    ' restore selection
    '
    If bRestoreSelection Then
        Selection.SetRange iSelStartEnd, iSelStartEnd
    End If
   
    Debug.Print "AhTextDepthPoints =="
    Exit Function
   
ErrPageWidth:
    '
    ' Page setup error.
    '
    MsgBox "Error in AhTextDepthPoints. " & _
            "Column width = " & CStr(fDefPageWidth) & " is out of range." & vbCrLf & _
            "The calculated text depth could be incorrect." & vbCrLf & vbCrLf & _
            Err.Description
    Resume Next
End Function

Выводы

В этой главе рассмотрены операции вычисления высоты текста.

На основе спецификации создан шаблон "AhTextDepth.dot", который содержит макросы вычисления высоты текста в колонке заданной ширины и диалог для изменения значений параметров. Панель инструментов "AhTextDepth" предоставляет простой интерфейс к операции вычисления высоты текста и установке вспомогательных параметров.

Задание 1

Приведенный код работает не совсем правильно в случае, когда текст содержит гиперссылки. Понимаете ли Вы почему? Усовершенствуйте код макросов таким образом, чтобы глубина текста с гиперссылками вычислялась правильно.

 

Задание 2

Приведенный код работает неправильно в случае, когда межстрочное расстояние установлено не для параграфа, а для шрифта в закладке "Character Spacing" диалога "Font" меню "Format". Измените код макросов таким образом, чтобы глубина текста и в этом случае вычислялась правильно.

 


Этюды для программистов Microsoft Word. Этюд 1.6. Вычисление высоты текста в колонке.


© 2000-2009 Евгений Ахунджанов, Все Права Сохранены.
www.transcriber.ru | Послать письмо автору