Определение размера символа для текущего шрифта - VB
Формулировка задачи:
Используя DirectX, я вывожу текст на поверхность:
ddsBack.DrawText kx, ky, Value, False
Я хочу, что бы текст помещался в определенный объект, а не вылезал за его пределы. Поскольку каждый символ имеет свой размер, как узнать размер символа для данного шрифта? И как менять шрифт в DX ?
Решение задачи: «Определение размера символа для текущего шрифта»
textual
Листинг программы
Option Explicit Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long Private Type SIZE cx As Long cy As Long End Type Public Function vbGetTextWidth(ByVal strSource As String, Font As StdFont) As Long Dim myFont As IFont ' We want the IFont interface Dim hFont As Long Dim mySize As SIZE Dim hdc As Long Set myFont = Font ' switch interface myFont.SIZE = Font.SIZE * 1000 ' increases accuracy since resultant mysize only hold longs hdc = CreateCompatibleDC(0) ' compatible with screen display hFont = SelectObject(hdc, myFont.hFont) GetTextExtentPoint32 hdc, strSource, Len(strSource), mySize 'Clean up as much as we need to SelectObject hdc, hFont DeleteDC hdc vbGetTextWidth = mySize.cx / 1000 ' bring back to normal End Function Private Sub Command1_Click() Dim lngTextWidth As Long lngTextWidth = vbGetTextWidth("A", Me.Font) End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д