XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Scrollbalken (farbig und mit Bitmap)
#######################
Thema : Subclassing
#######################
Scrollbalken
#######################
Andreas Miethe
September 2003
#######################
 $H windows.ph
 $H messages.ph
DEF HiWord(1) And(&(1)>>16,$FFFF)
DEF LoWord(1) And(&(1),$FFFF)
set(FastMode,1)

PROC SetPattern

    Parameters wParam&,Tile&

    IF Brush&

        ~DeleteObject(Brush&)

    endif

    Brush& = ~CreatePatternBrush(Tile&)
    RETURN Brush&

endproc

PROC SetColor

    Parameters wParam&,col&

    IF Brush&

        ~DeleteObject(Brush&)

    endif

    Brush& = ~CreateSolidBrush(Col&)
    RETURN Brush&

endproc

Proc WindowProc

    Parameters Wnd&, Msg&, wParam&, lParam&

    If Msg& = ~WM_CTLCOLORSCROLLBAR

        If lParam& = hScrollBar&

            return SetPattern(wParam&,Tile&)

        endif

        If lParam& = vScrollBar&

            return SetColor(wParam&,RGB(0,255,0))

        endif

    Endif

    If Msg& = ~WM_HSCROLL

        If LoWord(wParam&) = ~SB_LINEUP

            hScrollPos& = hScrollPos& - 1

        EndIf

        If LoWord(wParam&) = ~SB_LINEDOWN

            hScrollPos& = hScrollPos& + 1

        EndIf

        If LoWord(wParam&) = ~SB_PAGEUP

            hScrollPos& = hScrollPos& - 100

        EndIf

        If LoWord(wParam&) = ~SB_PAGEDOWN

            hScrollPos& = hScrollPos& + 100

        EndIf

        If LoWord(wParam&) = ~SB_THUMBTRACK

            hScrollPos& = HiWord(wParam&)

        EndIf

        SetText %hwnd,Str$(GetScrollPos(lParam&))

    Endif

    If Msg& = ~WM_VSCROLL

        If LoWord(wParam&) = ~SB_LINEUP

            vScrollPos& = vScrollPos& - 1

        EndIf

        If LoWord(wParam&) = ~SB_LINEDOWN

            vScrollPos& = vScrollPos& + 1

        EndIf

        If LoWord(wParam&) = ~SB_PAGEUP

            vScrollPos& = vScrollPos& - 100

        EndIf

        If LoWord(wParam&) = ~SB_PAGEDOWN

            vScrollPos& = vScrollPos& + 100

        EndIf

        If LoWord(wParam&) = ~SB_THUMBTRACK

            vScrollPos& = HiWord(wParam&)

        EndIf

        SetText %hwnd,Str$(GetScrollPos(lParam&))

    Endif

Endif

alle anderen Meldungen an die Original-Prozedur weiterleiten
return ~CallWindowProc(OldProc&,Wnd&, Msg&, WParam&, LParam&)

endProc

Declare Ende&,OldProc&,hScrollBar&,vScrollBar&,hScrollPos&,vScrollPos&,Brush&
Declare Tile&,BackBrush&
SetTrueColor 1
WindowTitle ColorScroller
CLS ~GetSysColor(~COLOR_BTNFACE)
Tile& = ~LoadImage(0,Tile.bmp,~IMAGE_BITMAP,0,40,~LR_LOADFROMFILE)
hScrollBar& = Create(HScroll,%hwnd,,10,30,480,20)
vScrollBar& = Create(VScroll,%hwnd,,10,50,20,320)
SetScrollRange hScrollBar&,0,1000
SetScrollRange vScrollBar&,0,1000
hScrollPos& = 0
vScrollPos& = 0
Window-Prozedur ersetzen
OldProc& = ~SetWindowLong(%hwnd,~GWL_WNDPROC, ProcAddr(WindowProc,4))
clear ende&

Whilenot Ende&

Waitinput

Wend