Форумы HiProg.com - MS ACCESS, VBA, VB

ник: Lukas

... я должна оценить именно число строк, которое получится из введенного текста...

С некоторой погрешностью, можно попытаться сделать это как-то так
(на скорую руку, сильно не тестил, левые правые отступы в контроле не учитывал):

Public Function GetRowsCount(ctrl As Control, text As String) As Integer     Dim Words, i As Integer, temp As String, temp2 As String          If GetTextWidth(ctrl, text) <= ctrl.Width Then 'текст поместился целиком, без переносов         GetRowsCount = GetRowsCount + 1     Else         If InStr(1, text, " ") = 0 Then 'Последнее слово (не поместилось)             GetRowsCount = GetRowsCount + 1 + GetRowsCount(ctrl, Mid(text, GetParthWord(ctrl, text) + 1))         Else 'не последнее слово             Words = Split(text, " ")             If GetTextWidth(ctrl, Words(0) & " ") > ctrl.Width Then 'первое слово не поместилось                 GetRowsCount = GetRowsCount + 1 + GetRowsCount(ctrl, Mid(text, GetParthWord(ctrl, text) + 1))             Else 'первое слово поместилось                 'пытаемся добавить слово                 temp = Words(0) & " "                 Do While i <= UBound(Words) And GetTextWidth(ctrl, temp) <= ctrl.Width                     i = i + 1                     temp2 = temp                     temp = temp & Words(i) & " "                 Loop                 GetRowsCount = GetRowsCount + 1 + GetRowsCount(ctrl, Mid(text, Len(temp2) + 1))             End If         End If      End If End Function Private Function GetTextWidth(ctrl As Control, text As String) As Long     Dim wzCch As Long     Dim wzMaxWidthCch As Long     Dim wzdx As Long     Dim wzdy As Long        WizHook.Key = 51488399     With ctrl         WizHook.TwipsFromFont .FontName, .FontSize, .FontWeight, _                           .FontItalic, .FontUnderline, wzCch, _                           text, wzMaxWidthCch, wzdx, wzdy     End With     GetTextWidth = wzdx End Function ' Здесь бывает врет на единичку Private Function GetParthWord(ctrl As Control, text As String) As Integer     Dim i As Integer          Do While GetTextWidth(ctrl, Mid(text, 1, Len(text) - i)) > ctrl.Width         i = i + 1     Loop     GetParthWord = Len(text) - i End Function