VBNet - Форум - ChooseColor

Вопрос: ChooseColor Добавлено: 05.10.04 09:26

Автор вопроса: Mihalыch | ICQ: 373-509-101

Подскажите, пожалуйста, как из этого кода можно выудить не только название шрифта, но и остальные его св-ва? Если конечно это возможно?
[CODE]
    Const FW_NORMAL = 400
    Const DEFAULT_CHARSET = 1
    Const OUT_DEFAULT_PRECIS = 0
    Const CLIP_DEFAULT_PRECIS = 0
    Const DEFAULT_QUALITY = 0
    Const DEFAULT_PITCH = 0
    Const FF_ROMAN = 16
    Const CF_PRINTERFONTS = &H2
    Const CF_SCREENFONTS = &H1
    Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
    Const CF_EFFECTS = &H100&
    Const CF_FORCEFONTEXIST = &H10000
    Const CF_INITTOLOGFONTSTRUCT = &H40&
    Const CF_LIMITSIZE = &H2000&
    Const REGULAR_FONTTYPE = &H400
    Const LF_FACESIZE = 32
    Const CCHDEVICENAME = 32
    Const CCHFORMNAME = 32
    Const GMEM_MOVEABLE = &H2
    Const GMEM_ZEROINIT = &H40
    Const DM_DUPLEX = &H1000&
    Const DM_ORIENTATION = &H1&
    Const PD_PRINTSETUP = &H40
    Const PD_DISABLEPRINTTOFILE = &H80000
    Private 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 * 31
    End Type
    Private Type ChooseFont
            lStructSize As Long
            hwndOwner As Long
            hDC As Long
            lpLogFont As Long
            iPointSize As Long
            flags As Long
            rgbColors As Long
            lCustData As Long
            lpfnHook As Long
            lpTemplateName As String
            hInstance As Long
            lpszStyle As String
            nFontType As Integer
            MISSING_ALIGNMENT As Integer
            nSizeMin As Long
            nSizeMax As Long
    End Type
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (ByRef pChoosefont As ChooseFont) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Dim strFontName As String

Private Sub Command1_Click()
    Dim cf As ChooseFont
    Dim lfont As LOGFONT
    Dim hMem As Long
    Dim pMem As Long
    Dim fontname As String
    Dim retval As Long
    With lfont
        .lfHeight = 0
        .lfWidth = 0
        .lfEscapement = 0
        .lfOrientation = 0
        .lfWeight = FW_NORMAL
        .lfCharSet = DEFAULT_CHARSET
        .lfOutPrecision = OUT_DEFAULT_PRECIS
        .lfClipPrecision = CLIP_DEFAULT_PRECIS
        .lfQuality = DEFAULT_QUALITY
        .lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN
        .lfFaceName = "Times New Roman" & vbNullChar
    End With
    hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
    pMem = GlobalLock(hMem)
    CopyMemory ByVal pMem, lfont, Len(lfont)
    With cf
        .lStructSize = Len(cf)
        .hwndOwner = Me.hWnd
        .hDC = Printer.hDC
        .lpLogFont = pMem
        .iPointSize = 120
        .flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
        .rgbColors = RGB(0, 0, 0)
        .nFontType = REGULAR_FONTTYPE
        .nSizeMin = 10
        .nSizeMax = 72
    End With
    retval = ChooseFont(cf)
    If retval <> 0 Then
        CopyMemory lfont, ByVal pMem, Len(lfont)
        MsgBox Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
    End If
    retval = GlobalUnlock(hMem)
    retval = GlobalFree(hMem)
End Sub
[/CODE]
Ответить

Ответы Всего ответов: 3

Номер ответа: 1 Автор ответа: Mihalыch ICQ: 373-509-101 Вопросов: 56 Ответов: 330	Профиль \| \| #1	Добавлено: 05.10.04 09:28
	Блин не ChooseColor, а ChooseFont конечно!!! Ответить

Номер ответа: 2 Автор ответа: *CyRax* Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229	Web-сайт: basicproduction.nm.ru Профиль \| \| #2	Добавлено: 05.10.04 09:46
	MSDN вот так ругается по этому поводу: If you set the CF_INITTOLOGFONTSTRUCT flag in the Flags member and initialize the LOGFONT members, the ChooseFont function initializes the dialog box with a font that is the closest possible match. Если верить тому что выплюнул переводчик: ChooseFont function инициализирует диалоговое меню с шрифтом, который - ближайшее возможное сопоставление то выше головы не прыгнешь Хотя ты дерзай. Авось получится что. Я вроде посылал пример использования ChooseFont на сайт. Или зайди на мой сайт. Там должно быть. Хотя я уже не помню что я там калякал, но всё равно посмотри. Ответить

Номер ответа: 3 Автор ответа: Mihalыch ICQ: 373-509-101 Вопросов: 56 Ответов: 330	Профиль \| \| #3	Добавлено: 05.10.04 09:59
	Большой сенкс, кажись разобрался! Ответить

Страница: 1 |