|
Последнее обновление 11/21/02.
| |
| Функция HyphText, решающая
задачу размещения многострочного
текста в PictureBox с организацией переноса
слов. |
Function HyphText(D As Control, Text As String, HyphWidth
As Single, HyphZone As Variant) As String
'-----------------------------------------------------------------------
'D - Элемент
типа PictureBox, в котором размещается текст
'Text - Текст, который надо
перенести
'HyphWidth - Ширина, в которую надо вместить
текст
'HyphZone - Величина зоны, насколько можно
изменять
'
HyphWidth, чтобы текст переносился по словам.
'
Если равна 0, то текст будет переносится
' "насильно".
Если HyphZone задан целым числом
' (Integer
или Long), то ширина задана в символах,
'
если тип данных Single или Double - то в
'
текущих единицах измерения.
'------------------------------------------------------------------------
Dim HyphMode As Integer
If D.TextWidth(Text) <= HyphWidth Then HyphText = Text: Exit Function
Select Case VarType(HyphZone)
Case 2, 3
HyphMode = 1
Case 4, 5, 6
HyphMode = 2
Case Else
HyphMode = 0
HyphZone = 0
End Select
Dim I As Integer, Z As String, txt As String
Dim P As Integer, W As Single
ReDim s(1 To 1) As String
txt = Text
If D.TextWidth(txt) <= HyphWidth Then
HyphText = txt
Exit Function
End If
P = 0: W = 0
Z = ""
Do
If Mid(txt, Len(Z) + 1 * Abs(Len(Z) = 0), 1) = " " Then P
= Len(Z): W = D.TextWidth(Z)
If D.TextWidth(Z) <= HyphWidth Then
If Len(Z) < Len(txt) Then
Z = Z & Mid$(txt,
Len(Z) + 1, 1)
Else
s(UBound(s)) = Z
txt = ""
End If
Else
Z = Left$(Z, Len(Z) - 1)
Select Case HyphMode
Case 0
s(UBound(s)) =
RTrim$(Z)
ReDim Preserve s(1
To UBound(s) + 1)
txt = LTrim$(Mid$(txt,
Len(Z) + 1))
Z = ""
Case 1
If P > 0 Then If
(Len(Z) - P) <= HyphZone Then Z = Left$(Z, P)
s(UBound(s)) =
RTrim$(Z)
ReDim Preserve s(1
To UBound(s) + 1)
txt = LTrim$(Mid$(txt,
Len(Z) + 1))
Z = ""
Case 2
If P > 0 Then If
(D.TextWidth(Z) - W) <= HyphZone Then Z = Left$(Z, P)
s(UBound(s)) =
RTrim$(Z)
ReDim Preserve s(1
To UBound(s) + 1)
txt = LTrim$(Mid$(txt,
Len(Z) + 1))
Z = ""
End Select
End If
If txt = "" Then Exit Do
Loop
Z = "": For I = LBound(s) To UBound(s) - 1: Z = Z + s(I) + Chr$(10):
Next I: Z = Z + s(UBound(s))
HyphText = Z
End Function |
| |
|
