| scroll bar demo program

set procedure to scroll
set window type to 1+16+64	|single line border & title bar 
							|+ resizable + vertical scroll
create window "scroll" from 7,20 to 20,60
set window title to "Scroll Bar Demo"
setscroll(1,1)			|set vertical scroll bar to top
nline=0					|initialize to first line
drawwin(nline)			|draw window
do while .t.			|event loop
	nevent=getevent()
	naction=translateevent(nevent)
	perform(naction)
enddo
return

|Print the lines in the window starting with the line passed as
|a parameter.  It returns the number passed to it.
function drawwin()
parameter nline
private ncline

	ncline=1
	clear
	?? "Line "+str(nline)
	do while ncline<=wrow()-1
		? "Line "+str(nline+ncline)
		inc ncline
	enddo
return(nline)

|wait for an event and return the chkevent() number
function getevent()
private nevent

	nevent=chkevent()
	do while nevent=-1
		nevent=chkevent()
	enddo
return(nevent)

|Translate events into commands for perform.  Its main purpose is
|to provide seemless keyboard support.  If the event is not handled
|cNull is returned.
function translateevent()
parameter nevent

	do case
	case nevent=1		|keyboard event
		do case
		case lastkey()=cnPgUp
			return(cPgUp)
		case lastkey()=cnPgDn
			return(cPgDn)
		case lastkey()=cnArUp
			return(cArUp)
		case lastkey()=cnArDn
			return(cArDn)
		otherwise
			message("Unsupported Key Pressed","")
			return(cNull)
		endcase
	case nevent=7		|scroll bar event
		if hmenu()=0
			message("Horizontal Scroll bar Unsupported","")
		endif
		do case
		case vmenu()=1	|top arrow box clicked
			return(cArUp)
		case vmenu()=2	|bottom arrow box clicked
			return(cArDn)
		case vmenu()=3
			return(cPgUp)
		case vmenu()=4
			return(cPgDn)
		case vmenu()=5
			return(cDrag)
		endcase
	endcase
return(cNull)

|Act upon the commands passed by translateevent().  Returns .t. if performs
|an action, .f. otherwise
function perform()
parameter naction
private nline,nadjust

	if naction=cNull	|no action
		return(.f.)
	endif
	do case
	
|Up one line command
	case naction=cArUp
		nline=getscroll(1)-(1000/(cnLines-(wrow()-1)))	|get current pos-1
		if nline<1				|do not allow scroll position to go below 1
			nadjust=1
		else
			nadjust=nline
		endif
		setscroll(1,nadjust)							|update scroll pos
		nline=round(nadjust/(1000/(cnLines-(wrow()-1))),0)|convert to lines
		drawwin(nline)									| draw window
		
|Down one line command
	case naction=cArDn
		nline=getscroll(1)+(1000/(cnLines-(wrow()-1)))	|get current pos+1
		if nline>1000			|do not allow scroll pos to go above 1000
			nadjust=1000
		else
			nadjust=nline
		endif
		setscroll(1,nadjust)							|update scroll pos
		nline=round(nadjust/(1000/(cnLines-(wrow()-1))),0)|convert to lines
		drawwin(nline)									|draw window
		
|Up one page command
	case naction=cPgUp
		nline=getscroll(1)-(1000*(wrow()-1)/(cnLines-(wrow()-1)))
									|get current postion - number of rows
		if nline<1					|do not allow scroll pos to go below 1
			nadjust=1
		else
			nadjust=nline
		endif
		setscroll(1,nadjust)							|update scroll pos
		nline=round(nadjust/(1000/(cnLines-(wrow()-1))),0)|convert to lines
		drawwin(nline)									|draw window
		
|Down one page command
	case naction=cPgDn
		nline=getscroll(1)+(1000*(wrow()-1)/(cnLines-(wrow()-1)))
								|get current position + number of rows
		if nline>1000			|do not allow scroll pos to go above 1000
			nadjust=1000
		else
			nadjust=nline
		endif
		setscroll(1,nadjust)							|update scroll pos
		nline=round(nadjust/(1000/(cnLines-(wrow()-1))),0)|convert to lines
		drawwin(nline)									|draw window

|Thumb dragged command
	case naction=cDrag
		nline=mrow()			|get position dragged to
		setscroll(1,mrow())		|update position
		nline=round(nline/(1000/(cnLines-(wrow()-1))),0)|convert to lines
		if nline<1				|do not allow scroll pos to go below 1
			nline=1
		elseif nline>cnLines-(wrow()-1)
								|do not allow scroll pos to go above 1000
			nline=cnLines-(wrow()-1)
		endif
		drawwin(nline)			|draw window
	endcase
return(.t.)						|performed an action