$include "windowssdk.inc"

uint FirstColor = rgb(255,255,192)
uint SecondColor = rgb(255,192,192)
uint Border = 0
uint Background = rgb(192,192,255)

ENUM Controls
	ScrBar = 1
	
endenum

window w1
string Items[200]		'Items to display
string Item[14]		'Item to display after made to fit box
int ItemCount			'item info
int TopY = 0, MaxHeight = 24000
int ii

'--- put some info in to test -------------------
for ii = 0 to 199
	Items[ii] = "This is line " + str$(ii + 1) + ". Let's see if it works like it is suppose to when the line is long and has nothing to say."
next ii

ItemCount = 200

OPENWINDOW w1,0, 0,800, 600, @minbox | @maxbox | @size, 0, "Window to Scroll Text entries", &mainproc
CONTROL w1,@SCROLLBAR,"",780,0,20,600,@CTSCROLLVERT,ScrBar
setscrollrange w1, ScrBar, 0, MaxHeight

UpDateWin()

cwin = 1
WAITuntil cwin = 0

closewindow w1
end

SUB mainproc( ),INT
	int l, t, w, h, iz, zdraw = 0
	
	select @message
		case @idcreate
			centerwindow w1			
			
		case @idclosewindow
			cwin = 0
			
		case @idvscroll
			select @controlid
				case ScrBar
					if @notifycode = 0
						GETCLIENTSIZE w1,l,t,w,h			
						
						zdraw=0
						SELECT @WPARAM
							CASE @SBTHUMBTRACK							
								iz = GETTHUMBPOS(w1, ScrBar)
								IF TopY <> iz
									zdraw = 1
								ENDIF
								TopY=iz

							CASE @SBPAGEDOWN								
								IF TopY <> MaxHeight
									zdraw = 1
								ENDIF
								TopY += h
								IF TopY > MaxHeight
									TopY = MaxHeight
								ENDIF

							CASE @SBPAGEUP									
								IF TopY <> 0
									zdraw = 1
								ENDIF
								TopY -= h
								IF TopY < 0
									TopY = 0
								ENDIF

							CASE @SBLINEUP								
								IF TopY <> 0
									zdraw = 1
								ENDIF
								TopY -= h / 20
								IF TopY < 0
									TopY = 0
								ENDIF

							CASE @SBLINEDOWN								
								IF TopY <> MaxHeight
									zdraw = 1
								ENDIF
								TopY += h / 20
								IF TopY > MaxHeight
									TopY = MaxHeight
								ENDIF

						ENDSELECT
						SETSCROLLPOS w1, ScrBar, TopY
						ENABLECONTROL w1,ScrBar,1
						
						IF zdraw=1						
							UpDateWin()
						ENDIF				
					endif
					
			endselect
			
		case @idsize			
			UpDateWin()
			
	endselect
	return 0
endsub

sub UpDateWin(), int
	int scrl,scrt,scrw,scrh
	int wl,wt,ww,wh
	INT phdc,pchdc
	int bx,by,bw,bh
	INT cnt, lcnt, numlines
	
	'---- high speed routine from Sapero ------
	phdc = w1.m_hPrintDC
	w1.m_hPrintDC=GETHDC(w1)

	'---- reposition and resize scrollbar -----
	getclientsize w1, wl,wt,ww,wh
	getsize w1,scrl, scrt, scrw, scrh, ScrBar
	setsize w1, ww-scrw, 0, scrw, wh, ScrBar
	drawmode w1, @transparent

	'---- set variables -----------------------
	bw = ww / 2	'width of boxes
	bh = 0 'varies depending on how many lines to show
	bx = (ww - bw) / 2	'left side of boxes, center in screen
	by = -getscrollpos(w1, ScrBar) + 10	'this is where you start drawing, it can be way outside the screen
	
	'---- display items -----------------------
	rect w1,wl, wt, ww, wh, Background, Background	'cls
	for cnt = 0 to ItemCount-1
		BreakLine (Items[cnt], bw - 20, numlines, bh)	'this places info into Item[]
		'draw box
		if ((bh + 20) > 0) and (by < wh)
			if (cnt % 2) = 0
				RECT w1, bx, by, bw, bh + 20, Border, FirstColor
			else
				RECT w1, bx, by, bw, bh + 20, Border, SecondColor
			endif
		end if
		
		'print text
		by += 10
		if ((by + bh * numlines)>0) or (by < wh)
			for lcnt = 0 to numlines - 1
				PrintText (w1, Item[lcnt], bx + 10, by, 0)
				by += bh / numlines
			next lcnt
		else
			by += bh
		end if
		by += 20
		
		if by > wh then breakfor
			
	next cnt
	
	'---- release high speed routine ----------
	pchdc=w1.m_hPrintDC
	w1.m_hPrintDC=phdc
	RELEASEHDC w1,pchdc
	'------------------------------------------
	return 0
endsub

sub BreakLine(string txt, int width, int numlines byref, int height byref)
	'----------------------------------------------------------------
	'     Break line at spaces
	'----------------------------------------------------------------
	int s_cnt, cnt, bl_width, bl_height
	int index, lspc
	
	index = 0
	s_cnt = 1
	cnt = 1
	
	while (s_cnt + (cnt - 1)) <= len(txt)											'when the text length is reached, stop
		gettextsize w1, mid$(txt,s_cnt,cnt), bl_width, bl_height				'get the width of the line of text
		while (bl_width < width) and ((s_cnt + (cnt - 1)) <= len(txt))		'if the width of text is < our desired width, or we haven't reached the length of then text
			if mid$(txt, s_cnt + cnt, 1) = " "										'if the character being checked is a space
				lspc = cnt																	'save it so we can break on spaces
			endif
			cnt ++																			'point to next character
			gettextsize w1, mid$(txt,s_cnt,cnt), bl_width, bl_height			'get the width of the line of text again
		endwhile
		if (s_cnt + (cnt - 1)) <= len(txt)											'if it wasn't the length of text reached, break on last space found
			Item[index] = mid$(txt, s_cnt, lspc)									'store line
			s_cnt = s_cnt + lspc + 1													'set next character after last space
			index ++																			'increment index
			cnt -= lspc																		'set character count to next character
		else																					'if we are at length of text
			cnt --																			'increment cnt so we don't have to keep subracting 1
			Item[index] = mid$(txt, s_cnt, cnt)										'store last entry
			s_cnt = s_cnt + cnt
			index ++
			cnt = 1																			'increment index to show how many entries there are
		endif
	endwhile
	
	numlines = index																		'store number of lines
	gettextsize w1, "Zg", bl_width, bl_height										'get the height of of one line of text
	height = bl_height * numlines														'calc total extents and store in return value
		
endsub

SUB PrintText(WINDOW w, STRING txt, INT x, INT y, INT pos)
	INT pw,ph,px,py

	GETTEXTSIZE w,txt,pw,ph

	py=y:px=x

	SELECT pos
		CASE 1	'right
			px-=pw			
		CASE 2	'center
			px-=pw/2			
		CASE 3	'decimal
			IF INSTR(txt,".",1)>0
				GETTEXTSIZE w,LEFT$(txt,INSTR(txt,".",1)),pw,ph
			ENDIF
			px-=pw			
		DEFAULT	'where it is
		
	ENDSELECT
	MOVE w, px, py
	PRINT w, txt
ENDSUB