VBA, MS Access MS Access в примерах

Выравнивания текста по нижнему краю

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    TextBottomAlignment Me.Label01Test
End Sub

Private Sub TextBottomAlignment(Ctrl As Control)
' es LE 17.02.2024 v004
' Выравнивания текста по нижнему краю в текстовом поле или ярлыке
' Bottom text alignment in Label or TextBox
' -------------------------------------------------------------------------------------------------/
Dim iBorderWidth As Integer
Dim lCtrlInsideWidth&, lCtrlInsideHeight, lNumberOfLines&, lTextHeight&
Dim sCtrlText$, lx As Long, ly As Long
Const ciTwipsPerPoint% = 20
Const ciMinMargin% = 80 'Мин. отступ (для красоты) - на случай если не выставлены в свойствах
' -------------------------------------------------------------------------------------------------/
On Error GoTo TextBottomAlignment_Err

    Select Case Ctrl.ControlType
        Case acLabel:   sCtrlText = Ctrl.Caption
        Case acTextBox: sCtrlText = Ctrl.Text
        Case Else:      Exit Sub
    End Select

' Проверка и правка отступов
    If Ctrl.LeftMargin = 0 Then Ctrl.LeftMargin = ciMinMargin
    If Ctrl.RightMargin = 0 Then Ctrl.RightMargin = ciMinMargin
    If Ctrl.BottomMargin = 0 Then Ctrl.BottomMargin = ciMinMargin

' Ширина и высота текста контрола в твипах (lx, ly) одной строкой (без преносов)
    WizHook.Key = 51488399 ' Initialize WizHook
    WizHook.TwipsFromFont Ctrl.FontName, Ctrl.FontSize, Ctrl.FontWeight, _
                          Ctrl.FontItalic, Ctrl.FontUnderline, 0, sCtrlText, 0, lx, ly

' Расчёт верхнего отступа:
    iBorderWidth = (Ctrl.BorderWidth * ciTwipsPerPoint) / 2
    lCtrlInsideWidth = Ctrl.Width - Ctrl.LeftMargin - Ctrl.RightMargin - iBorderWidth
    lCtrlInsideHeight = Ctrl.Height - Ctrl.BottomMargin - iBorderWidth ' No TopMargin!
    
    lNumberOfLines = lx \ lCtrlInsideWidth + 1 ' Кол-во строк
    lTextHeight = lNumberOfLines * ly          ' Суммарная высота текста
    
' Пермещение текста вниз за счёт увеличения отступа сверху:
    Ctrl.TopMargin = lCtrlInsideHeight - lTextHeight
    Exit Sub

TextBottomAlignment_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub :" & _
        "TextBottomAlignment.", vbCritical, "Error!"
    Err.Clear
End Sub

Picture




Скачать

MSA-2007 и выше ( 39 kB) Пример


Назад ToTop
L.E. 17.02.2024
Рейтинг@Mail.ru