Scrollable interior

Windows specific questions.
Post Reply
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I got it setting the Scroll Position... Now to get it scrolling the static?

How do you process the message, for the scroll bars?

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long scrollpos1=1 , getlast1=1
Dim Shared As Long scrollpos2=1 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics
dim shared as SCROLLINFO si

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE or WS_HSCROLL or WS_VSCROLL , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

EnableScrollBar(hWnd,SB_BOTH ,ESB_ENABLE_BOTH)

        'Set the scrolling range and page size
        si.cbSize = sizeof(si) 
        si.fMask  = SIF_RANGE or SIF_PAGE 
        si.nMin   = 0 
        si.nMax   = 1400\200 ' adjust here to change the thumb size
        si.nPage  = 1
        SetScrollInfo(hwnd, SB_VERT, @si, TRUE)
        SetScrollInfo(hwnd, SB_HORZ, @si, TRUE)
        
        SetScrollPos(hWnd, SB_HORZ , 1 , 1)
        SetScrollPos(hWnd, SB_VERT , 1 , 1)

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    'print msg.message , loword(msg.wparam) , hiword(msg.wparam) , loword(msg.lparam) , hiword(msg.lparam)
    
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                PostQuitMessage(0)
                'End
            end select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

@Dodicat

I got TrackBars working..

But , i can't figure out how to redraw them , when you resize the window. ??? any help?

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long trackpos1=1 , getlast1=1
Dim Shared As Long trackpos2=1 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics , TrackBar1 , TrackBar2
dim as point ep

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

TrackBar1  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_HORZ,10,530,740,35,hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(0,25))

TrackBar2  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_VERT,750,10,35,520,hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(0,20))

Dim As rect r
getwindowrect(statics,@r)
dim as long s_wide = r.right - r.left
dim as long s_high = r.bottom - r.top

ep.x = 0
ep.y = 0

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                PostQuitMessage(0)
                'End
            End Select
        case TrackBar1
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0)
                    if trackpos1 < getlast1 then 
                        getlast1-=1 : ep.x-=(s_wide\25)-25
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos1 > getlast1 then 
                        getlast1+=1 : ep.x+=(s_wide\25)-25
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
            End Select
        case TrackBar2
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
                    if trackpos2 < getlast2 then 
                        getlast2-=1 : ep.y-=(s_high\20)-20
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos2 > getlast2 then 
                        getlast2+=1 : ep.y+=(s_high\20)-20
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
           End Select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

Does any one know , how to send a message to the TrackBar to resize it?
I searched the Windows API , and they don't tell you how to resize a control.

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long trackpos1=0 , getlast1=1
Dim Shared As Long trackpos2=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics , TrackBar1 , TrackBar2
dim as point ep

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

TrackBar1  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_HORZ,10,530,740,35,hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(0,25))

TrackBar2  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_VERT,750,10,35,520,hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(0,20))

Dim As rect r
getwindowrect(statics,@r)
dim as long s_wide = r.right - r.left
dim as long s_high = r.bottom - r.top

ep.x = 0
ep.y = 0

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case 15 ', WM_MOUSEMOVE' resize event
                    Dim As rect w
                    getwindowrect(hWnd,@w)
                    dim as long w_wide = w.right - w.left
                    dim as long w_high = w.bottom - w.top
                    
                    'how to send message to trackbar to resize it?? 
                    
                    print w_wide , w_high
            End Select
        case TrackBar1
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0)
                    if trackpos1 < getlast1 then 
                        getlast1-=1 : ep.x-=(s_wide\25)-25
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos1 > getlast1 then 
                        getlast1+=1 : ep.x+=(s_wide\25)-25
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
            End Select
        case TrackBar2
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
                    if trackpos2 < getlast2 then 
                        getlast2-=1 : ep.y-=(s_high\20)-20
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos2 > getlast2 then 
                        getlast2+=1 : ep.y+=(s_high\20)-20
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
           End Select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

It should be something like: SendMessage( TarckBar1 , message , x , y , w , h )
I don't know what the "message" would be?

I've tried all kinds of thins and can't figure it out..
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I figured it out finally....

SetWindowPos(TrackBar1, 1 , 10, 500 , 300, 50, 0)

Code: Select all

Dim As rect w
getwindowrect(hWnd,@w)
dim as long w_wide = w.right - w.left
dim as long w_high = w.bottom - w.top

SetWindowPos(TrackBar1, 1 ,        10 , w_high-60 , w_wide-50,        50, 0)
SetWindowPos(TrackBar2, 1 , w_wide-50 ,        10 ,        50, w_high-60, 0)

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long trackpos1=0 , getlast1=1
Dim Shared As Long trackpos2=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics , TrackBar1 , TrackBar2
dim as point ep

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

TrackBar1  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_HORZ,10,530,740,35,hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(0,25))

TrackBar2  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_VERT,750,10,35,520,hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(0,20))

Dim As rect r
getwindowrect(statics,@r)
dim as long s_wide = r.right - r.left
dim as long s_high = r.bottom - r.top

Dim As rect w
getwindowrect(hWnd,@w)
dim as long w_wide = w.right - w.left
dim as long w_high = w.bottom - w.top

dim as ubyte toggle = 0

ep.x = 0
ep.y = 0

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
    
    
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case 15 , WM_MOUSEMOVE
                    getwindowrect(hWnd,@w)
                    w_wide = w.right - w.left
                    w_high = w.bottom - w.top
                    SetWindowPos(TrackBar1, 1 ,        10 , w_high-60 , w_wide-50,        50, 0)
                    SetWindowPos(TrackBar2, 1 , w_wide-50 ,        10 ,        50, w_high-60, 0)
            End Select
        case TrackBar1
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0)
                    if trackpos1 < getlast1 then 
                        getlast1-=1 : ep.x-=(s_wide\25)-10
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos1 > getlast1 then 
                        getlast1+=1 : ep.x+=(s_wide\25)-10
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
            End Select
        case TrackBar2
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
                    if trackpos2 < getlast2 then 
                        getlast2-=1 : ep.y-=(s_high\20)-10
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos2 > getlast2 then 
                        getlast2+=1 : ep.y+=(s_high\20)-10
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
           End Select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I've made some headway on ScrollBars.....

It's moving back and forth , when you ( mouse over ) the horizontal scroll bar..

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long Sbh=0 , getlast1=1
Dim Shared As Long Sbv=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics
dim shared as SCROLLINFO si_h , si_v

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE or WS_HSCROLL or WS_VSCROLL , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

EnableScrollBar(hWnd,SB_BOTH ,ESB_ENABLE_BOTH)
SendMessage(hWnd , SB_BOTH , SBM_ENABLE_ARROWS , ESB_ENABLE_BOTH)


        'Set the scrolling range and page size of horz
        si_h.cbSize = sizeof(si_h)
        si_h.fMask  = SIF_RANGE or SIF_PAGE
        si_h.nMin   = 0
        si_h.nMax   = 2300\200 ' adjust here to change the thumb size
        si_h.nPage  = 1
        SetScrollInfo(hwnd, SB_HORZ, @si_h, TRUE)
        
        'Set the scrolling range and page size of horz
        si_v.cbSize = sizeof(si_v)
        si_v.fMask  = SIF_RANGE or SIF_PAGE
        si_v.nMin   = 0
        si_v.nMax   = 1400\200 ' adjust here to change the thumb size
        si_v.nPage  = 1
        SetScrollInfo(hwnd, SB_VERT, @si_v, TRUE)
        
        SetScrollPos(hWnd, SB_HORZ , 5 , 1)
        SetScrollPos(hWnd, SB_VERT , 1 , 1)

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    'print msg.message , loword(msg.wparam) , hiword(msg.wparam) , loword(msg.lparam) , hiword(msg.lparam)
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case 160
                    select case loword(msg.wparam)
                        case 6 
                            sbh = GetScrollPos(hWnd, SB_HORZ)
                            if sbh < getlast1 then SetScrollPos(hWnd, SB_HORZ , sbh+1 , 1)
                            if sbh > getlast1 then SetScrollPos(hWnd, SB_HORZ , sbh-1 , 1)
                            getlast1 = sbh
                            'print "H SCROLL" , sbh
                            'print msg.message , loword(msg.wparam) , hiword(msg.wparam) , loword(msg.lparam) , hiword(msg.lparam)
                        case 7
                            sbv = GetScrollPos(hWnd, SB_VERT)
                            print "V SCROLL" , sbv
                    end select
            end select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I got the scroll bars moving with moue clicks...but it' not incrementing right..

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long Sbh=0 , getlast1=1
Dim Shared As Long Sbv=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics
dim shared as SCROLLINFO si_h , si_v

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE or WS_HSCROLL or WS_VSCROLL , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

EnableScrollBar(hWnd,SB_BOTH ,ESB_ENABLE_BOTH)
SendMessage(hWnd , SB_BOTH , SBM_ENABLE_ARROWS , ESB_ENABLE_BOTH)


        'Set the scrolling range and page size of horz
        si_h.cbSize = sizeof(si_h)
        si_h.fMask  = SIF_RANGE or SIF_PAGE
        si_h.nMin   = 1
        si_h.nMax   = 2300\200 ' adjust here to change the thumb size
        si_h.nPage  = 1
        SetScrollInfo(hwnd, SB_HORZ, @si_h, TRUE)
        
        'Set the scrolling range and page size of horz
        si_v.cbSize = sizeof(si_v)
        si_v.fMask  = SIF_RANGE or SIF_PAGE
        si_v.nMin   = 1
        si_v.nMax   = 1400\200 ' adjust here to change the thumb size
        si_v.nPage  = 1
        SetScrollInfo(hwnd, SB_VERT, @si_v, TRUE)
        
        SetScrollPos(hWnd, SB_HORZ , 5 , 1)
        SetScrollPos(hWnd, SB_VERT , 5 , 1)

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    'print msg.message , loword(msg.wparam) , hiword(msg.wparam) , loword(msg.lparam) , hiword(msg.lparam)
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case 161 'WM_LBUTTONDOWN
                    select case loword(msg.wparam)
                        case 6 
                            sbh = GetScrollPos(hWnd, SB_HORZ)
                            'print "H SCROLL" , "curr = " ; sbh , "last = "; getlast1  
                            if sbh > getlast1 then if getlast1 >  1 then getlast1-=1
                            if sbh < getlast1 then if getlast1 < 23 then getlast1+=1
                            SetScrollPos(hWnd, SB_HORZ , getlast1 , 1)
                            getlast1 = sbh
                        case 7
                            sbv = GetScrollPos(hWnd, SB_VERT)
                            'print "V SCROLL" , "curr = " ; sbv , "last = "; getlast2  
                            if sbv > getlast2 then if getlast2 >  1 then getlast2-=1
                            if sbv < getlast2 then if getlast2 < 23 then getlast2+=1
                            SetScrollPos(hWnd, SB_VERT , getlast2 , 1)
                            getlast2 = sbv
                    end select
            end select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I got scroll bars incramenting and decramenting.

But you have to go to the end or begining and then it reverses scroll direction..

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long Sbh=0 , getlast1=1
Dim Shared As Long Sbv=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics
dim shared as SCROLLINFO si_h , si_v

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE or WS_HSCROLL or WS_VSCROLL , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

EnableScrollBar(hWnd,SB_BOTH ,ESB_ENABLE_BOTH)
SendMessage(hWnd , SB_BOTH , SBM_ENABLE_ARROWS , ESB_ENABLE_BOTH)


        'Set the scrolling range and page size of horz
        si_h.cbSize = sizeof(si_h)
        si_h.fMask  = SIF_RANGE or SIF_PAGE
        si_h.nMin   = 1
        si_h.nMax   = 2300\200 ' adjust here to change the thumb size
        si_h.nPage  = 1
        SetScrollInfo(hwnd, SB_HORZ, @si_h, TRUE)
        
        'Set the scrolling range and page size of horz
        si_v.cbSize = sizeof(si_v)
        si_v.fMask  = SIF_RANGE or SIF_PAGE
        si_v.nMin   = 1
        si_v.nMax   = 1400\200 ' adjust here to change the thumb size
        si_v.nPage  = 1
        SetScrollInfo(hwnd, SB_VERT, @si_v, TRUE)
        
        SetScrollPos(hWnd, SB_HORZ , 1 , 1)
        SetScrollPos(hWnd, SB_VERT , 1 , 1)

dim as ubyte toggle1 = 0
dim as ubyte toggle2 = 0

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    'print msg.message , loword(msg.wparam) , hiword(msg.wparam) , loword(msg.lparam) , hiword(msg.lparam)
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case 161 'WM_LBUTTONDOWN
                    select case loword(msg.wparam)
                        case 6 
                            sbh = GetScrollPos(hWnd, SB_HORZ)
                            if toggle1 = 0 then getlast1+= 1 : if getlast1 = 2300\200+1 then toggle1 = 1
                            if toggle1 = 1 then getlast1-= 1 : if getlast1 =          0 then toggle1 = 0
                            SetScrollPos(hWnd, SB_HORZ , getlast1 , 1)
                            getlast1 = sbh
                        case 7
                            sbv = GetScrollPos(hWnd, SB_VERT)
                            if toggle2 = 0 then getlast2+= 1 : if getlast2 = 1400\200+1 then toggle2 = 1
                            if toggle2 = 1 then getlast2-= 1 : if getlast2 =          0 then toggle2 = 0
                            SetScrollPos(hWnd, SB_VERT , getlast2 , 1)
                            getlast2 = sbv
                    end select
            end select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I got scroll bars working.... L button down to decrement , R button down to increment..

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long Sbh=0 , getlast1=1
Dim Shared As Long Sbv=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics
dim shared as SCROLLINFO si_h , si_v

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE or WS_HSCROLL or WS_VSCROLL , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

EnableScrollBar(hWnd,SB_BOTH ,ESB_ENABLE_BOTH)
SendMessage(hWnd , SB_BOTH , SBM_ENABLE_ARROWS , ESB_ENABLE_BOTH)


        'Set the scrolling range and page size of horz
        si_h.cbSize = sizeof(si_h)
        si_h.fMask  = SIF_RANGE or SIF_PAGE
        si_h.nMin   = 1
        si_h.nMax   = 2300\460 ' adjust here to change the thumb size
        si_h.nPage  = 1
        SetScrollInfo(hwnd, SB_HORZ, @si_h, TRUE)
        
        'Set the scrolling range and page size of horz
        si_v.cbSize = sizeof(si_v)
        si_v.fMask  = SIF_RANGE or SIF_PAGE
        si_v.nMin   = 1
        si_v.nMax   = 1400\240 ' adjust here to change the thumb size
        si_v.nPage  = 1
        SetScrollInfo(hwnd, SB_VERT, @si_v, TRUE)
        
        SetScrollPos(hWnd, SB_HORZ , 1 , 1)
        SetScrollPos(hWnd, SB_VERT , 1 , 1)

dim as byte toggle1 = 0
dim as byte toggle2 = 0

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
 
    'print msg.message , loword(msg.wparam) , hiword(msg.wparam) , loword(msg.lparam) , hiword(msg.lparam)
    print
    print msg.message , loword(msg.message) , hiword(msg.message)
    print msg.hWnd    , loword(msg.hWnd   ) , hiword(msg.hWnd   )
    print msg.wparam  , loword(msg.wparam ) , hiword(msg.wparam )
    print msg.lparam  , loword(msg.lparam ) , hiword(msg.lparam )
    print @msg 
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case 161,163 ' left button down
                    select case loword(msg.wparam)
                        case 6
                            if getlast1 > 0 then getlast1-=1
                            SetScrollPos(hWnd, SB_HORZ , getlast1 , 1)
                        case 7
                            if getlast2 > 0 then getlast2-=1
                            SetScrollPos(hWnd, SB_VERT , getlast2 , 1)
                   end select
                case 164,165 ' Right button down
                    select case loword(msg.wparam)
                        case 6
                            if getlast1 < 2300\460+1 then getlast1+=1
                            SetScrollPos(hWnd, SB_HORZ , getlast1 , 1)
                        case 7
                            if getlast2 < 1400\240+1 then getlast2+=1
                            SetScrollPos(hWnd, SB_VERT , getlast2 , 1)
                    end select
            end select
    end select
Wend
PostQuitMessage(0)
END
Top
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Scrollable interior

Post by albert »

I like the TrackBars better than the ScrollBars...

Here the TrackBars:

Code: Select all


#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"

InitCommonControls()

Dim Shared As Long trackpos1=0 , getlast1=1
Dim Shared As Long trackpos2=0 , getlast2=1

Dim shared As MSG msg     ' Message variable (stores massages)
Dim shared As HWND hWnd , statics , TrackBar1 , TrackBar2
dim as point ep

hWnd = CreateWindowEx( 0, "#32770", "TrackBar Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )
statics = CreateWindowEx( 0, "STATIC", "" , WS_BORDER Or WS_VISIBLE Or WS_CHILD , 10 , 10 , 2300 , 1400 , hWnd, 0, 0, 0 )

TrackBar1  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_HORZ,10,530,740,35,hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(0,25))

TrackBar2  = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD or TBS_AUTOTICKS Or TBS_ENABLESELRANGE or TBS_VERT,750,10,35,520,hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(0,20))

Dim As rect w
getwindowrect(hWnd,@w)
dim as long w_wide = w.right - w.left
dim as long w_high = w.bottom - w.top
dim as long last_w = w_wide
dim as long last_h = w_high

Dim As rect r
getwindowrect(statics,@r)
dim as long s_wide = r.right - r.left
dim as long s_high = r.bottom - r.top
dim as long inc_h = (s_wide \ 25) - (s_wide\200)
dim as long inc_v = (s_high \ 20) - (s_high\200)

ep.x = 0
ep.y = 0

'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
   
    dim as WPARAM wparam
    dim as LPARAM lparam
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
    
    
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273
                    PostQuitMessage(0)
                    'End
                case WM_MOUSEMOVE
                    getwindowrect(hWnd,@w)
                    w_wide = w.right - w.left
                    w_high = w.bottom - w.top
                    if w_wide <> last_w or w_high <> last_h then
                        SetWindowPos(TrackBar1, 1 ,        10 , w_high-60 , w_wide-50,        50, 0)
                        SetWindowPos(TrackBar2, 1 , w_wide-50 ,        10 ,        50, w_high-60, 0)
                        last_w = w_wide
                        last_h = w_high
                        ep.x = (getlast1 * inc_h) - inc_h
                        ep.y = (getlast2 * inc_v) - inc_v
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
            End Select
        case TrackBar1
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0)
                    if trackpos1 < getlast1 then 
                        getlast1-=1
                        ep.x = (getlast1 * inc_h) - inc_h
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos1 > getlast1 then 
                        getlast1+=1
                        ep.x = (getlast1 * inc_h) - inc_h
                        SendMessage(TrackBar1, TBM_SETPOS,TRUE, getlast1)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
            End Select
        case TrackBar2
            Select Case msg.message
                Case WM_MOUSEMOVE , WM_LBUTTONDOWN
                    ShowWindow(TrackBar1, SW_HIDE)
                    ShowWindow(TrackBar2, SW_HIDE)
                    trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
                    if trackpos2 < getlast2 then 
                        getlast2-=1
                        ep.y = (getlast2 * inc_v) - inc_v
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    if trackpos2 > getlast2 then 
                        getlast2+=1
                        ep.y = (getlast2 * inc_v) - inc_v
                        SendMessage(TrackBar2, TBM_SETPOS,TRUE, getlast2)
                        movewindow(statics,-ep.x,-ep.y,s_wide,s_high,1)
                    end if
                    ShowWindow(TrackBar1, SW_SHOW)
                    ShowWindow(TrackBar2, SW_SHOW)
           End Select
    end select
Wend
PostQuitMessage(0)
END
Top
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Scrollable interior

Post by dodicat »

Seems to work OK Albert.
I have been messing around with pascal for a bit so I haven't been much help, not that you really need help anyway, you always get your own solutions.
Top
Wilko
Posts: 23
Joined: Oct 26, 2016 7:57

Re: Scrollable interior

Post by Wilko »

Dear albert, I suggest that you use the codes of the messages, not the numbers. That makes your code so much easier to understand when you later get back... They are defined in winuser.bi.
Top
Post Reply

Return to “Windows”