|
|
Выравнивания текста по нижнему краю
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
TextBottomAlignment Me.Label01Test
End Sub
Private Sub TextBottomAlignment(Ctrl As Control)
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
WizHook.Key = 51488399
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
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
MSA-2007 и выше ( 39 kB) Пример
|
|