English
Source / code snippets

Image coloured Scroll bar Texturiert

 
Scroll bar Texturiert & coloured with images of Andreas Miethe:
CompileMarkSeparation
#######################
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

    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
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))

Whilenot En
Waitinput Wend
salvo, iF.
 
07/01/05  
 




Peter
Mallow
the Program stürtzt always ex.

the latest EndIf is To plenty. is it weck, then GEHTS
 
WinXP Pro SP2, XProfan 9 + XPSE
AMD Athlon 64 X2 3800
10/06/05  
 



thanks for the Feedback - habs naturally korrigiert!

salvo.
 
10/06/05  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

3.116 Views

Untitledvor 0 min.
H.Brill05/20/23
Thomas Freier11/21/21
maroro11/08/13
Julian Schmidt08/18/11

Themeninformationen

this Topic has 2 subscriber:

iF (2x)
Peter Mallow (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie