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