Member 13358124 Ответов: 1

Автоматическое изменение размера шрифта в заданном поле (visualbasic)

Я пытаюсь написать коды, чтобы получить правильный размер шрифта, который подходит к данному окну. Вот я и дал 
New Rectangle(0, 100, 100, 100)
как новый новый прямоугольник.
Но иногда он не дает правильного размера шрифта, когда в поле есть две текстовые строки.
Помогите мне решить эту проблему или предложите любое другое решение.
THNAK ВАС!

Что я уже пробовал:

titleRect = New Rectangle(0, 100, 100, 100)
        Dim titleFont As Font
        Dim titleFontStyle As New FontStyle
        titleFont = New Font("Arial", 2, titleFontStyle)
dim articelTitle="THIS IS A TEST 1234567890"
   Dim titleFontSize As Integer = 2
        Do Until TextRenderer.MeasureText(articelTitle, titleFont).Width >= titleRect.Width Or TextRenderer.MeasureText(articelTitle, titleFont).Height >= titleRect.Height = True
            titleFontSize = titleFontSize + 1
            titleFont = New Font(fontName, titleFontSize - 2, titleFontStyle)

 Dim titleStringFormat As StringFormat = New StringFormat
        titleStringFormat.LineAlignment = StringAlignment.Center
        titleStringFormat.Alignment = StringAlignment.Center

        Loop

Richard MacCutchan

Вам нужно разделить высоту прямоугольника на количество строк, чтобы получить правильную высоту шрифта.

Member 13358124

СПАСИБО!
Я понятия не имею, как писать коды, чтобы получить количество строк.Не могли бы вы пожалуйста помочь мне сделать это.

1 Ответов

Рейтинг:
7

Ralf Meier

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

Function GetFontSizeMatch(ByVal myText As String, ByVal myFont As Font, ByVal mySize As Size) As Single

     If Trim(myText).Length <= 0 Then myText = "X"

     Dim currentSize As Single = CSng(myFont.Size)
     Dim workFont As Font = New Font(myFont.Name, currentSize, myFont.Style)
     Dim myTextSize As SizeF

     If (mySize.Width >= 1) AndAlso (mySize.Height >= 1) Then
         Do
             currentSize += 4.0 : If currentSize > 50.0 Then Exit Do
             workFont = New Font(workFont.Name, currentSize, workFont.Style)
             myTextSize = TextRenderer.MeasureText(myText, workFont)
         Loop Until (myTextSize.Width > mySize.Width) Or (myTextSize.Height > mySize.Height)

         Do
             currentSize -= 0.5 : If currentSize < 5.0 Then Exit Do
             workFont = New Font(workFont.Name, currentSize, workFont.Style)
             myTextSize = TextRenderer.MeasureText(myText, workFont)
         Loop Until (myTextSize.Width <= mySize.Width) AndAlso (myTextSize.Height <= mySize.Height)

     End If

     Return currentSize

 End Function


Внутри функции есть 2 петли. Первый цикл увеличивает размер шрифта из вашей строки до тех пор, пока он не достигнет одной из границ (с большими шагами). Второго контура уменьшается Fontsite мелкими шажками, чтобы соответствовать внутри дает размер. Результатом работы этой функции является максимально возможный размер шрифта для данного размера.
удачи...

Member 13358124

Большое вам спасибо...!

Ralf Meier

Пожалуйста...
Спасибо, что проголосовали ...