' привел не все объявления использ. функций
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Public Sub FindWidthFont()
Dim LF As LOGFONT
Dim hdc As Long
' брал hDc экрана
hdc = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
' или своей программы
'hDc = GetDC(Application.hwnd)
LF.lfCharSet = DEFAULT_CHARSET
LF.lfFaceName = "Arial" & Chr$(0)
' получ. список доступных шрифтов
EnumFontFamiliesEx hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
' освобождаем
DeleteDC (hdc)
End Sub
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As Long
Dim FaceName As String
Dim Width As String
'convert the returned string to Unicode
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
FaceName = Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
Width = StrConv(lpNLF.lfWidth, vbUnicode)
Width = Left$(Width, InStr(Width, vbNullChar) - 1)
Debug.Print "Название шрифта - " & FaceName
Debug.Print "Ср. ширина шрифта - " & Width
' продолжаем беребирать
EnumFontFamProc = 1
End Function
Определить ширину Font
Задача: Определить ширину опред. шрифта (известно его название и размер в points), под шириной я понимаю ср. ширину символа.
Пытаюсь сделать это через API, но либо я чего не допонял, либо еще что, но получается какая-то фигня.
Сначала делал так:
В итоге жонглирования свойством LF.lfCharSet, LF.lfFaceName, а также разными hDc(экран, окно программы) получаю немного разный шрифтов, НО с lpNLF.lfWidth=1, а lpNLF.lfHeight=3,4
Ладно думаю, попытался заранее задать высоту шрифта:
SizePoint=20
LF.lfHeight = -MulDiv(SizePoint, GetDeviceCaps(hdc, LOGPIXELSY), 72)
получил ту же фигню
Ладно, думаю создам тогда свой шрифт, выберу его в hDc и погляжу на него:
Результаты ноль. Опять ширина 1, а высота шрифтов 3 или 4.
Кто-нибудь в курсе как же можно получить ср. ширину символа конкр. шрифта (хоть в пикселах, хоть в пойнтах, все равно) или может, какие мысли, что я делаю не так в выше приведенном коде, почему получаются такие странные значения или ониимеют какой-то странный смысл???
Заранее спасибо за любую подсказку.
Пытаюсь сделать это через API, но либо я чего не допонял, либо еще что, но получается какая-то фигня.
Сначала делал так:
Код:
В итоге жонглирования свойством LF.lfCharSet, LF.lfFaceName, а также разными hDc(экран, окно программы) получаю немного разный шрифтов, НО с lpNLF.lfWidth=1, а lpNLF.lfHeight=3,4
Ладно думаю, попытался заранее задать высоту шрифта:
SizePoint=20
LF.lfHeight = -MulDiv(SizePoint, GetDeviceCaps(hdc, LOGPIXELSY), 72)
получил ту же фигню
Ладно, думаю создам тогда свой шрифт, выберу его в hDc и погляжу на него:
Код:
Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long
'Create a specified font
CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function
rFont = CreateMyFont(70, 0)
' hdc экрана
hdc = GetDC(0)
' выбираем его там
Curent = SelectObject(hdc, rFont)
' запуск. свою пред. процедуру по пол. все шрифтов
Call FindWidthFont()
'Create a specified font
CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function
rFont = CreateMyFont(70, 0)
' hdc экрана
hdc = GetDC(0)
' выбираем его там
Curent = SelectObject(hdc, rFont)
' запуск. свою пред. процедуру по пол. все шрифтов
Call FindWidthFont()
Результаты ноль. Опять ширина 1, а высота шрифтов 3 или 4.
Кто-нибудь в курсе как же можно получить ср. ширину символа конкр. шрифта (хоть в пикселах, хоть в пойнтах, все равно) или может, какие мысли, что я делаю не так в выше приведенном коде, почему получаются такие странные значения или ониимеют какой-то странный смысл???
Заранее спасибо за любую подсказку.
Цитата:
Originally posted by SergeySV
Задача: Определить ширину опред. шрифта (известно его название и размер в points), под шириной я понимаю ср. ширину символа.
Пытаюсь сделать это через API, но либо я чего не допонял, либо еще что, но получается какая-то фигня.
Сначала делал так:
В итоге жонглирования свойством LF.lfCharSet, LF.lfFaceName, а также разными hDc(экран, окно программы) получаю немного разный шрифтов, НО с lpNLF.lfWidth=1, а lpNLF.lfHeight=3,4
Ладно думаю, попытался заранее задать высоту шрифта:
SizePoint=20
LF.lfHeight = -MulDiv(SizePoint, GetDeviceCaps(hdc, LOGPIXELSY), 72)
получил ту же фигню
Ладно, думаю создам тогда свой шрифт, выберу его в hDc и погляжу на него:
Результаты ноль. Опять ширина 1, а высота шрифтов 3 или 4.
Кто-нибудь в курсе как же можно получить ср. ширину символа конкр. шрифта (хоть в пикселах, хоть в пойнтах, все равно) или может, какие мысли, что я делаю не так в выше приведенном коде, почему получаются такие странные значения или ониимеют какой-то странный смысл???
Заранее спасибо за любую подсказку.
Задача: Определить ширину опред. шрифта (известно его название и размер в points), под шириной я понимаю ср. ширину символа.
Пытаюсь сделать это через API, но либо я чего не допонял, либо еще что, но получается какая-то фигня.
Сначала делал так:
Код:
' привел не все объявления использ. функций
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Public Sub FindWidthFont()
Dim LF As LOGFONT
Dim hdc As Long
' брал hDc экрана
hdc = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
' или своей программы
'hDc = GetDC(Application.hwnd)
LF.lfCharSet = DEFAULT_CHARSET
LF.lfFaceName = "Arial" & Chr$(0)
' получ. список доступных шрифтов
EnumFontFamiliesEx hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
' освобождаем
DeleteDC (hdc)
End Sub
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As Long
Dim FaceName As String
Dim Width As String
'convert the returned string to Unicode
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
FaceName = Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
Width = StrConv(lpNLF.lfWidth, vbUnicode)
Width = Left$(Width, InStr(Width, vbNullChar) - 1)
Debug.Print "Название шрифта - " & FaceName
Debug.Print "Ср. ширина шрифта - " & Width
' продолжаем беребирать
EnumFontFamProc = 1
End Function
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Public Sub FindWidthFont()
Dim LF As LOGFONT
Dim hdc As Long
' брал hDc экрана
hdc = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
' или своей программы
'hDc = GetDC(Application.hwnd)
LF.lfCharSet = DEFAULT_CHARSET
LF.lfFaceName = "Arial" & Chr$(0)
' получ. список доступных шрифтов
EnumFontFamiliesEx hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
' освобождаем
DeleteDC (hdc)
End Sub
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As Long
Dim FaceName As String
Dim Width As String
'convert the returned string to Unicode
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
FaceName = Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
Width = StrConv(lpNLF.lfWidth, vbUnicode)
Width = Left$(Width, InStr(Width, vbNullChar) - 1)
Debug.Print "Название шрифта - " & FaceName
Debug.Print "Ср. ширина шрифта - " & Width
' продолжаем беребирать
EnumFontFamProc = 1
End Function
В итоге жонглирования свойством LF.lfCharSet, LF.lfFaceName, а также разными hDc(экран, окно программы) получаю немного разный шрифтов, НО с lpNLF.lfWidth=1, а lpNLF.lfHeight=3,4
Ладно думаю, попытался заранее задать высоту шрифта:
SizePoint=20
LF.lfHeight = -MulDiv(SizePoint, GetDeviceCaps(hdc, LOGPIXELSY), 72)
получил ту же фигню
Ладно, думаю создам тогда свой шрифт, выберу его в hDc и погляжу на него:
Код:
Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long
'Create a specified font
CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function
rFont = CreateMyFont(70, 0)
' hdc экрана
hdc = GetDC(0)
' выбираем его там
Curent = SelectObject(hdc, rFont)
' запуск. свою пред. процедуру по пол. все шрифтов
Call FindWidthFont()
'Create a specified font
CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function
rFont = CreateMyFont(70, 0)
' hdc экрана
hdc = GetDC(0)
' выбираем его там
Curent = SelectObject(hdc, rFont)
' запуск. свою пред. процедуру по пол. все шрифтов
Call FindWidthFont()
Результаты ноль. Опять ширина 1, а высота шрифтов 3 или 4.
Кто-нибудь в курсе как же можно получить ср. ширину символа конкр. шрифта (хоть в пикселах, хоть в пойнтах, все равно) или может, какие мысли, что я делаю не так в выше приведенном коде, почему получаются такие странные значения или ониимеют какой-то странный смысл???
Заранее спасибо за любую подсказку.
интересно, а зачем тебе это? ведь если шрифт не фиксированный, то получишь только среднюю величину ширины символа. Если тебе нужно узнать длину строки в пикселях, то надо использовать GetTextExtentPoint32
Цитата:
Originally posted by Br@in RIPper
интересно, а зачем тебе это? ведь если шрифт не фиксированный, то получишь только среднюю величину ширины символа. Если тебе нужно узнать длину строки в пикселях, то надо использовать GetTextExtentPoint32
интересно, а зачем тебе это? ведь если шрифт не фиксированный, то получишь только среднюю величину ширины символа. Если тебе нужно узнать длину строки в пикселях, то надо использовать GetTextExtentPoint32
Зачем, спрашиваешь ... (пытаюсь сдержать поток нецензурных выражений)... просто, милые программисты MSExcel решили осчастливить пользователей и сделали, так что ширина столбца в Excel задается в очень интересных единицах - это кол-во символов используемого шрифта по умолчанию (это который в Параметрах на вкладке Общие) умещающихся в ячейке.
Т.е. когда ты ставишь ширину 8, то имеется ввиду что уместится 8 ст. символов этого шрифта по умолчанию.
Моя проблема такова, что необходимо получить физ. ширину этого столбца, а он его гад, хранит токо в своих относительных единицах и даже никакой функции для конвертации не дали, вообщем жопа...
А вот на счет твоего предложения (с GetTextExtentPoint32), это идея, может действительно, загнать туда например символ "а" и пусть покажет его ширину...
хотя конечно интересно узнать, почему выше указанные функции такие странные значения с высотой и шириной возвращают, нет, ну интересно просто, в чем фигня
Цитата:
Originally posted by SergeySV
Зачем, спрашиваешь ... (пытаюсь сдержать поток нецензурных выражений)... просто, милые программисты MSExcel решили осчастливить пользователей и сделали, так что ширина столбца в Excel задается в очень интересных единицах - это кол-во символов используемого шрифта по умолчанию (это который в Параметрах на вкладке Общие) умещающихся в ячейке.
Т.е. когда ты ставишь ширину 8, то имеется ввиду что уместится 8 ст. символов этого шрифта по умолчанию.
Моя проблема такова, что необходимо получить физ. ширину этого столбца, а он его гад, хранит токо в своих относительных единицах и даже никакой функции для конвертации не дали, вообщем жопа...
А вот на счет твоего предложения (с GetTextExtentPoint32), это идея, может действительно, загнать туда например символ "а" и пусть покажет его ширину...
хотя конечно интересно узнать, почему выше указанные функции такие странные значения с высотой и шириной возвращают, нет, ну интересно просто, в чем фигня
Зачем, спрашиваешь ... (пытаюсь сдержать поток нецензурных выражений)... просто, милые программисты MSExcel решили осчастливить пользователей и сделали, так что ширина столбца в Excel задается в очень интересных единицах - это кол-во символов используемого шрифта по умолчанию (это который в Параметрах на вкладке Общие) умещающихся в ячейке.
Т.е. когда ты ставишь ширину 8, то имеется ввиду что уместится 8 ст. символов этого шрифта по умолчанию.
Моя проблема такова, что необходимо получить физ. ширину этого столбца, а он его гад, хранит токо в своих относительных единицах и даже никакой функции для конвертации не дали, вообщем жопа...
А вот на счет твоего предложения (с GetTextExtentPoint32), это идея, может действительно, загнать туда например символ "а" и пусть покажет его ширину...
хотя конечно интересно узнать, почему выше указанные функции такие странные значения с высотой и шириной возвращают, нет, ну интересно просто, в чем фигня
как-то я это делал... к сожалению исходников с собой нет. посмотрю дома, мож найду. Попробуй функцию GetTextMetrics.
Там какая-то заморочка, что эти шрифтовые функции могут выдавать значения в разных единицах: пикселях, кеглях... это все задается. но по моему по умолчанию включены пиксели
Цитата:
Originally posted by Br@in RIPper
как-то я это делал... к сожалению исходников с собой нет. посмотрю дома, мож найду. Попробуй функцию GetTextMetrics.
Там какая-то заморочка, что эти шрифтовые функции могут выдавать значения в разных единицах: пикселях, кеглях... это все задается. но по моему по умолчанию включены пиксели
как-то я это делал... к сожалению исходников с собой нет. посмотрю дома, мож найду. Попробуй функцию GetTextMetrics.
Там какая-то заморочка, что эти шрифтовые функции могут выдавать значения в разных единицах: пикселях, кеглях... это все задается. но по моему по умолчанию включены пиксели
Ок, спасибо, попробую...
Но ты если че найдешь,... ну ты понимаешь... ;-), неси, не забывай нас
Спасибо за подсказку, с GetTextMetrics разобрался и написал функцию по вычислению ср. ширины символа указанного шрифта.
Щас допишу еще функции по переводу в points в пиксели и обратно, оформлю в виде модуля и выложу в Исходниках->Офисные приложения как mdlSysMetrics.
P.S. он конечно на VB, но если кто-то очень заинтересуется то сможет переделать, это не проблема.
Щас допишу еще функции по переводу в points в пиксели и обратно, оформлю в виде модуля и выложу в Исходниках->Офисные приложения как mdlSysMetrics.
P.S. он конечно на VB, но если кто-то очень заинтересуется то сможет переделать, это не проблема.