title image


Smiley WM_CTLCOLORSCROLLBAR
Also:



In die Form1 wurde eine VSCrollbar gesetzt (aufpassen: sowohl die VScroll als auch die HScroll durchlaufen dieselbe Message wenn sie nach Farbe verlangen!)



In die Form1:





Private Sub Form_Load()

WinAPI.StartSubClass Form1.hwnd

End Sub



Private Sub Form_Terminate()

WinAPI.EndSubClass Form1.hwnd

End Sub



In ein Modul (ich habe es WinAPI genannt) dieser Code. Vorsicht: Machst Du in dieser Callbackroutine einen Fehler, hat noch nicht einmal mehr eine Execption Zeit sich zu Wort zu melden! VB schmiert Kommentarlos ab. Ein Devicekontext (der Wert wird von Windows in wParam mitgeliefert) der mit FillRect eingemalt werden kann, kann auch mit einem Bild bestückt werden. Dazu komme ich heute aber nicht mehr :(



Gib ihm blaue Farbe!







      

Private Const GWL_WNDPROC As Long = -4

Private Const WM_CTLCOLORSCROLLBAR As Long = &H137

Private Const SM_CXHSCROLL As Long = 21

Private Const SM_CXHTHUMB As Long = 10

Private Const SM_CYVSCROLL As Long = 20

Private Const SM_CYVTHUMB As Long = 9

Private Const SM_CYHSCROLL As Long = 3



Private Type RECT

    Left As Long

    Top As Long

    Right As Long

    Bottom As Long

End Type



Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _

     ByVal hwnd As Long, _

     ByVal nIndex As Long, _

     ByVal dwNewLong As Long) As Long



Private Declare Function CallWindowProc Lib "user32.dll" 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 GetClientRect Lib "user32.dll" ( _

     ByVal hwnd As Long, _

     ByRef lpRect As RECT) As Long

     

Private Declare Function GetSystemMetrics Lib "user32.dll" ( _

     ByVal nIndex As Long) As Long

     

Private Declare Function CreateSolidBrush Lib "gdi32.dll" ( _

     ByVal crColor As Long) As Long



Private Declare Function SelectObject Lib "gdi32.dll" ( _

     ByVal hdc As Long, _

     ByVal hObject As Long) As Long



Private Declare Function DeleteObject Lib "gdi32.dll" ( _

     ByVal hObject As Long) As Long



Private Declare Function FillRect Lib "user32.dll" ( _

     ByVal hdc As Long, _

     ByRef lpRect As RECT, _

     ByVal hBrush As Long) As Long

     

Private Declare Function ReleaseDC Lib "user32.dll" ( _

     ByVal hwnd As Long, _

     ByVal hdc As Long) As Long



Private pOldProc As Long



Sub StartSubClass(ByVal hwnd As Long)

    pOldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubClassFunc)

End Sub



Sub EndSubClass(ByVal hwnd As Long)

    SetWindowLong hwnd, GWL_WNDPROC, pOldProc

End Sub



Function SubClassFunc(ByVal hwnd As Long, ByVal uMsg As Long, _

                      ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim cr       As RECT

    Dim drawRect As RECT

    Dim hBrush   As Long

    Dim hOBrush  As Long

    

    If uMsg = WM_CTLCOLORSCROLLBAR Then

        GetClientRect lParam, cr

        hBrush = CreateSolidBrush(RGB(0, 0, 255))

        hOBrush = SelectObject(wParam, hBrush)

        'Vertikal Metrics

        cr.Top = cr.Top + GetSystemMetrics(SM_CYHSCROLL)

        cr.Bottom = cr.Bottom - GetSystemMetrics(SM_CYHSCROLL)

        FillRect wParam, cr, hBrush

        SelectObject wParam, hOBrush

        DeleteObject hBrush

        ReleaseDC lParam, wParam

        Exit Function

    End If

    

    SubClassFunc = CallWindowProc(pOldProc, hwnd, uMsg, wParam, ByVal lParam)

End Function



 



Code eingefügt mit Syntaxhighlighter 3.0








geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: