VPF::Изменения цвета шрифта в TreeView - Форум программистов

Plamenk

Дата 7.6.2006, 16:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 258
Регистрация: 18.2.2003

Репутация: нет
Всего: 3

Всем Привет!

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

Как я понял штатными средствами это сделать нельзя, но может есть какой-нибудь обходной путь. smile

Заране Всем Большое СПАСИБО!

~FoX~

Дата 8.6.2006, 08:38 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Можно, но придется руками рисовать прям на Device Content - DC
Вот функции тебе нужные:

Код


Private Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long

TextOut - рисует текст на контенте
GetDC - возвращает тебе хэндл контента
SetTextColor - попробуй угадай smile

Дерзай

--------------------

…множественность никогда не следует полагать без необходимости…

Plamenk

Дата 8.6.2006, 14:14 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 258
Регистрация: 18.2.2003

Репутация: нет
Всего: 3

Спасибо за совет сейчас попробую!

А есть ли событие (сообщение) у TreeView, которое возникает (приходит), когда необходимо отрисовать узел дерева.
Просто у меня есть подозрение, что после перерисовки окна мои исправления изчезнут.

~FoX~

Дата 9.6.2006, 07:52 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Не знаю как на счет ВБ, но в делфи событие называется onDrawNode скорее всего есть аналаг и в ВБ

--------------------

…множественность никогда не следует полагать без необходимости…

Plamenk

Дата 9.6.2006, 13:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 258
Регистрация: 18.2.2003

Репутация: нет
Всего: 3

Кому интересно держите решение, если кто-найдет какие-либо ошибки пожалуйста напишите:

Код


Option Explicit

Private Const S_OK = &H0

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type DLLVERSIONINFO
    cbSize As Long
    dwMajor As Long
    dwMinor As Long
    dwBuildNumber As Long
    dwPlatformID As Long
End Type

Private Type NMHDR
    hWndFrom As Long
    idFrom As Long
    code As Long
End Type

Private Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDC As Long
    rc As RECT
    dwItemSpec As Long ' this is control specific, but it's how to specify an item.  valid only with CDDS_ITEM bit set
    uItemState As Long
    lItemlParam As Long
End Type

Private Type NMTVCUSTOMDRAW
    NMCD As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    iLevel As Long
End Type

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function DllGetVersion Lib "comctl32" (pdvi As DLLVERSIONINFO) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long

' CustomDraw paint stages.
Private Const CDDS_ITEM = &H10000
Private Const CDDS_POSTERASE = &H4
Private Const CDDS_POSTPAINT = &H2
Private Const CDDS_PREERASE = &H3
Private Const CDDS_PREPAINT = &H1
Private Const CDDS_ITEMPREPAINT = (&H10000 Or &H1)
Private Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)
Private Const CDDS_SUBITEM = &H20000

' CustomDraw Item states.
Private Const CDIS_SELECTED = &H1
Private Const CDIS_GRAYED = &H2
Private Const CDIS_DISABLED = &H4
Private Const CDIS_CHECKED = &H8
Private Const CDIS_FOCUS = &H10
Private Const CDIS_DEFAULT = &H20
Private Const CDIS_HOT = &H40
Private Const CDIS_MARKED = &H80
Private Const CDIS_INDETERMINATE = &H100

' CustomDraw return values.
Private Const CDRF_DODEFAULT = &H0
Private Const CDRF_NEWFONT = &H2
Private Const CDRF_SKIPDEFAULT = &H4

Private Const CDRF_NOTIFYITEMDRAW = &H20
Private Const CDRF_NOTIFYPOSTERASE = &H40
Private Const CDRF_NOTIFYPOSTPAINT = &H10
Private Const CDRF_NOTIFYSUBITEMDRAW = &H20

Private Const WM_USER = &H400

Private Const NM_FIRST = &H0& '(0U- 0U)
Private Const NM_CUSTOMDRAW = (NM_FIRST - 12)

' Other miskulanius (miscellaneous) messages.
Private Const WM_GETFONT = &H31
Private Const WM_SETFONT = &H30
Private Const TTM_GETTIPBKCOLOR = (WM_USER + 22)
Private Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)

' See KB Q261289
Private Const UM_CHECKSTATECHANGED = WM_USER + &H112
'
Private Const UM_STARTDRAG = WM_USER + &H113

Private Const GWL_WNDPROC = -4
Private Const WM_NOTIFY = &H4E

Private lpPrevWndProc As Long
Private m_lMajor As Long
Private m_lMinor As Long

Public Function ComCtlVersion( _
        ByRef lMajor As Long, _
        ByRef lMinor As Long, _
        Optional ByRef lBuild As Long _
    ) As Boolean
Dim hMod As Long
Dim lR As Long
Dim lptrDLLVersion As Long
Dim tDVI As DLLVERSIONINFO

    lMajor = 0: lMinor = 0: lBuild = 0

    hMod = LoadLibrary("comctl32.dll")
    If (hMod <> 0) Then
        lR = S_OK
        '/*
        ' You must get this function explicitly because earlier versions of the DLL
        ' don't implement this function. That makes the lack of implementation of the
        ' function a version marker in itself. */
        lptrDLLVersion = GetProcAddress(hMod, "DllGetVersion")
        If (lptrDLLVersion <> 0) Then
            tDVI.cbSize = Len(tDVI)
            lR = DllGetVersion(tDVI)
            If (lR = S_OK) Then
                lMajor = tDVI.dwMajor
                lMinor = tDVI.dwMinor
                lBuild = tDVI.dwBuildNumber
            End If
        Else
            'If GetProcAddress failed, then the DLL is a version previous to the one
            'shipped with IE 3.x.
            lMajor = 4
        End If
        FreeLibrary hMod
        ComCtlVersion = True
    End If
End Function

Private Function CustomDraw(ByVal lParam As Long) As Long
    Dim NMTVCD As NMTVCUSTOMDRAW
    Dim lLen As Long
    Dim UDT_NMHDR As NMHDR
    
    CustomDraw = CDRF_DODEFAULT
    CopyMemory UDT_NMHDR, ByVal lParam, 12&
    
    If UDT_NMHDR.code = NM_CUSTOMDRAW Then
        lLen = Len(NMTVCD)
        If m_lMajor < 4 Or (m_lMajor = 4 And m_lMinor < 71) Then
           lLen = lLen - 4
        End If
        CopyMemory NMTVCD, ByVal lParam, lLen
         
        ' First see what stage of painting:
        Select Case (NMTVCD.NMCD.dwDrawStage)
         Case CDDS_ITEMPREPAINT
             If (NMTVCD.NMCD.uItemState And CDIS_SELECTED) = CDIS_SELECTED Then
                 NMTVCD.clrText = TranslateColor(vbRed)
             End If
             CopyMemory ByVal lParam, NMTVCD, Len(NMTVCD)
        End Select
    End If

End Function

Public Sub Hook(ByVal hWnd As Long)
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    Call ComCtlVersion(m_lMajor, m_lMinor)
End Sub

Public Sub Unhook(ByVal hWnd As Long)
    Call SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As _
                    Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'Debug.Print Hex(uMsg)
    Dim lRes As Long
    
    Select Case (uMsg And WM_NOTIFY)
        Case WM_NOTIFY:
            WindowProc = CustomDraw(lParam)
        Case Else:
            WindowProc = 0
    End Select
    lRes = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    If WindowProc = 0 Then WindowProc = lRes

End Function

Private Function TranslateColor(ByVal clr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, TranslateColor) Then
        TranslateColor = -1
    End If
End Function

Для работы вызывается Функция Hook, в которую передается HWND окна TreeView.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »