title image


Smiley Stop! Moment, ich bin ja noch gar nicht fertig ....
Das da oben war nur ein Beispiel - Pflichtübungen :=)



Wie man in die Scrollbar ein Bild zaubert, folgt jetzt.

Nach der Pflicht folgt immer die Kür ;)



Zunächst: Wie baut man eine Picture ins Programm ein? Es führen viele Wege nach Rom. Am Besten über eine Bitmap-Resource des Programms!

Damit alle Bilder (ginge auch über die Resourcen) verwendet werden können und das Beispiel nachvollziehbar ist, habe ich das StdPicture-Objekt mal verwendet und dieses per LoadPicture(sFileName) mit einer beliebigen Bitmap gefüttert. Die Scrollbar soll eine feurige Flamme sein ....



Die Form:





Public tmpPicture As StdPicture

'

Private Sub Form_Load()

Set tmpPicture = LoadPicture("C:\Images\Test.bmp")

WinAPI.StartSubclass Form1.hWnd

End Sub

'

Private Sub Form_Terminate()

WinAPI.EndsubClass Form1.hWnd

End Sub



Und jetzt der Hammer im Modul:





Option Explicit

'

Private Const GWL_WNDPROC = (-4)

Private Const WM_CTLCOLORSCROLLBAR = &H137

'

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 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 CreatePatternBrush Lib "gdi32" ( _

ByVal hBitmap As Long) As Long

'

Private pOldWndProc As Long

'

Sub StartSubClass(ByVal hwnd As Long)

pOldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubClassProc)

End Sub

'

Sub EndSubClass(ByVal hwnd As Long)

SetWindowLong hwnd, GWL_WNDPROC, pOldWndProc

End Sub

'

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

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

Dim hBitmap As Long

Static hBrush As Long



If uMsg = WM_CTLCOLORSCROLLBAR Then

hBitmap = Form1.tmpPicture.Handle

If hBrush = 0 Then

hBrush = CreatePatternBrush(hBitmap)

End If

SubClassProc = hBrush

Exit Function

End If

SubClassProc = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, ByVal lParam)

End Function





Warum es mit dem Color-Beispiel bei einem ME nicht so recht klappen will ist auch klar: Der Callbackroutine muss der verwendete Brush als Return mitgegeben werden, sonst wird bei manchen OS'es das Einfärben ignoriert.



Ergo genügt in der WM_CTLCOLORSCROLLBAR:



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

SubClassFunc = hBrush



Man muss nur aufpassen, dass der Brush nur einmal definiert werden muss, sonst

legt das System bei jedem zuck in der Scrollbar einen neuen Brush an und

die GDI-Resourcen gehen irgendwann in den Jordan.




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: