Получение списка установленных шрифтов

[dear]

На Вашем формуе в ветке "'Получение всех шрифтов в системе" (viewtopic.php?f=24&t=12150&p=81144) есть пример, как получить список всех установленных шрифтов.
Там, в объявлении LOGFONT есть строчка - "lfFaceName As String * 16 'LF_FACESIZE"
Видимо из-за нее, когда я вызываю EnumFonts "ИмяШрифтаДлинойБолее16Символов", EnumFontFamProc получает урезанное имя шрифта
Пытался менять эту строчку, но на выходе получаю абракадабру. Пытался поискать в гугле, сам ковырялся, но, видимо, опыта не хватает
Может, подскажете, как с этим бороться?

[Xcode]

Что-то коментарий не соответсвует, ведь константа LF_FACESIZE = 32

[dear]

я это заметил, но так написано в указанном примере.. Пытался поменять - получаю хрень

[Viper]

я это заметил, но так написано в указанном примере.. Пытался поменять - получаю хрень

Показывай измененный код. По идее константа LF_FACESIZE = 32.

[dear]

К сожалению сейчас не на рабочем компе - в Беларуси сегодня праздник-выходной
В коде убираю комменты и делаю так:

Было:

Код: Выделить всё

Private Type LOGFONT
.........
lfFaceName As String * 16  'LF_FACESIZE
.............
End Type

Public Type ENUMLOGFONTEX
    elfLogFont As LOGFONT
    elfFullName As String * 32  'LF_FULLFACESIZE
    elfStyle As String * 16 'LF_FACESIZE
    elfScript As String * 16 'LF_FACESIZE
End Type

Переделал на

Код: Выделить всё

Private Type LOGFONT
.........
lfFaceName As String * 'LF_FACESIZE
.............
End Type

Public Type ENUMLOGFONTEX
    elfLogFont As LOGFONT
    elfFullName As String * LF_FULLFACESIZE
    elfStyle As String * LF_FACESIZE
    elfScript As String * LF_FACESIZE
End Type

Заранее прошу прощения за ламерство - занимаюсь программированием не профессионально, больше для собственного удовольствия и дабы не закиснуть от однообразия основной работы

[MIT]

Ух ё...
А у тебя эти константы-то объявлены?

lfFaceName As String * 'LF_FACESIZE

[dear]

Прошу прощения, немного не правильно ответил, не убрал коммент

Код: Выделить всё

Private Type LOGFONT
.........
lfFaceName As String * LF_FACESIZE
.............
End Type


[dear]

Так и писал же не сам - брал и ковырял пример с
viewtopic.php?f=24&t=12150&p=81144

[MIT]

Они и стояли в виде комментариев, потому что не использовались... Объяви их.

Или зацени такой пример (классика):

Код: Выделить всё

'in a form
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Me.AutoRedraw = True
    EnumFonts Me.hDC, vbNullString, AddressOf EnumFontProc, 0
End Sub
'in a module
Private Const LF_FACESIZE = 32
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(LF_FACESIZE) As Byte
End Type
Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
    Dim LF As LOGFONT, FontName As String, ZeroPos As Long
    CopyMemory LF, ByVal lplf, LenB(LF)
    FontName = StrConv(LF.lfFaceName, vbUnicode)
    ZeroPos = InStr(1, FontName, Chr$(0))
    If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1)
    Form1.Print FontName
    EnumFontProc = 1
End Function


[dear]

Они были объявлены...
Доберусь до рабочего компьютера - буду пытаться что-нибудь сделать
А по поводу Вашего примера есть вопрос - смогу ли я из него получить перечисление начертаний шрифта - "bold", "italic" и т.д. ,
в общем того, что в том коде, на который я ссылался, находится в структуре

Код: Выделить всё

Public Type ENUMLOGFONTEX
    elfLogFont As LOGFONT
    elfFullName As String * 32  'LF_FULLFACESIZE
    elfStyle As String * 16 'LF_FACESIZE
    elfScript As String * 16 'LF_FACESIZE
End Type


ОГРОМНОЕ спасибо за помощь