'
' TextBox.cba 
'----------------------------------------------------------------------
AUTODEFINE "OFF"

' Declares for gcLabel:
DECLARE "gdi32.dll",RoundRect(hdc:int, X1:int, Y1:int, X2 As int, Y2:int, X3 As int, Y3:int),int
DECLARE "gdi32.dll", BitBlt(hdc:int, x:int, y:int, cx:int, cy:int, hdcSrc:int, x1:int, y1:int, rop:int)
DECLARE TextBox(wnd:window,x:int,y:int,msg$:string,bgcolor:int)
DECLARE DrawInfo()

def SRCCOPY:int
SRCCOPY = &HCC0020

'--- Test program -------------------------------------------------------
'
DEF win,w1,w2,w3:window
def i,run,nlines,status:int
def CRLF:string
DEF message1$[2048],message2$[2048]:istring
DEF PRIORITY,ROUTINE:int

PRIORITY = RGB(255,188,202)
ROUTINE = RGB(255,255,188)

def lft,top,wth,hgt,hgt2:int

message1$ = " In a dual-polarization system, MAP65 optimally matches the linear polarization angle of each signal, "
message2$ = " China is one of the few countries increasing its presence on the medium wave (AM) radio dial, as DXers have been able to observe. Identifying Chinese stations can however be tricky if you don't understand the language."
WINDOW win,0,0,760,480,@MINBOX|@MAXBOX|@SIZE,0," Scrolling Text Demo",main
'WINDOW win,0,0,760,480,0,0," Scrolling Text Demo",main
GETCLIENTSIZE win,lft,top,wth,hgt
SETWINDOWCOLOR win,rgb(190,200,240)

'----------------------------------------------------------------------

'----main window child -----------
Window w1,200,top,wth-200,hgt,@NOCAPTION,win,"Scrolling Window",main
setwindowcolor w1,RGB(222,222,222)

'----scrolling window child -----------
Window w2,0,0,wth-200,hgt,@VSCROLL|@NOCAPTION,w1,"Child Window",main2
drawmode w2,@TRANSPARENT 
setwindowcolor w2,RGB(222,222,222)

'----temp scrolling window  ---------------
'set same size as w2 but outside of screen
' any size changes to w2 should also change w3 size
'------------------------------------------
Window w3,-1000,0,wth-200,hgt,@NOCAPTION,w1,"Child Window",main
drawmode w3,@TRANSPARENT 
setwindowcolor w3,RGB(222,222,222)
SetSize w3,0,1,wth-200,hgt 

SetSize w2,0,1,wth-200,hgt 
i = DrawInfo() * 15 + 6 - hgt
SETSCROLLRANGE w2,-2 ,0, i

run = 1
WAITUNTIL run = 0
END


SUB main

	SELECT @class

		CASE @idclosewindow
			CLOSEWINDOW win
			CLOSEWINDOW w1
			CLOSEWINDOW w2
			CLOSEWINDOW w3
			run=0

		CASE @IDCREATE
			CenterWindow win


		ENDSELECT
	
RETURN

SUB main2

	SELECT @class

		CASE @IDVSCROLL : ' Scrollbar handler

			' determine scroll direction (UP or DOWN)
			' scroll w2 content up or down
			' set scrollbar in new position

			SELECT @CODE
				CASE @SBLINEUP
					SETSCROLLPOS w2, -2, (GETSCROLLPOS(w2, -2))-2
				CASE @SBLINEDOWN
					SETSCROLLPOS w2, -2, (GETSCROLLPOS(w2, -2))+2
				CASE @SBPAGEUP
					SETSCROLLPOS w2, -2, (GETSCROLLPOS(w2, -2))-20
				CASE @SBPAGEDOWN
					SETSCROLLPOS w2, -2, (GETSCROLLPOS(w2, -2))+20
				CASE @SBTHUMBPOS
					SETSCROLLPOS w2, -2, @QUAL
				CASE @SBTHUMBTRACK
					SETSCROLLPOS w2, -2, @QUAL		
			ENDSELECT
			DrawInfo
	ENDSELECT
	
RETURN


SUB DrawInfo()
	'¤¤¤¤¤¤¤¤¤¤¤¤¤  These lines are for testing scroll functions only!!! ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
	def starty, sy, w2l, w2t, w2w, w2h:int
	def hdc2, hdc3:int

	GETCLIENTSIZE w2, w2l, w2t, w2w, w2h

	starty = GETSCROLLPOS(w2, -2)
	nlines = 0
	status = PRIORITY

	'draw everything to w3
	
	RECT w3, w2l, w2t, w2w, w2h, RGB(222,222,222), RGB(222,222,222)

	for i = 1 to 100
		if status = PRIORITY
			status = ROUTINE
		else
			status = PRIORITY
		endif

		sy = -starty + 10 + (nlines * 15) 
		if (i = 5) | (i = 20)
			nlines = nlines + TextBox(w3, 10, sy, str$(i) + message2$,status)
		else
			nlines = nlines + TextBox(w3, 10, sy, str$(i) + message1$,status)
		endif
	next i
	
	'copy w3 to w2
	hdc3 = GetHDC w3
	hdc2 = GETHDC w2

	BitBlt hdc2,0,0,w2w,w2h,hdc3,0,0,SRCCOPY

	releasehdc w3,hdc3
	releasehdc w2,hdc2
	'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
RETURN nlines	

'
SUB TextBox(wnd:window,x:int,y:int,msg$:string,bgcolor:int)
'----------------------------------------------------------------------------------------
' Draws colored textboxes with border - 71 characters wide with selfdimensioning heights.
' Parameters:
' x, y: Upper left corner of rounded Label
' msg$: Label text
' bgcolor: Fill color
'----------------------------------------------------------------------------------------
def hdc,tcount,lcount,i,tmp:int
def textwidth,textheight,textlength,lines:int
def tmsg$[4096]:istring

tmsg$ = msg$ + " "

	textlength = len(tmsg$)	:'number of characters
	lines = textlength/71	:'number of lines
	if textlength > (lines * 71) then lines = lines + 1
	tcount = 71	:'used for dividing line lengths to fit TextBox
	lcount = 1  :'linecount
	SETFONT wnd,"Consolas",10,400
	GETTEXTSIZE wnd, tmsg$, textwidth, textheight

	'print box:
	hdc = GetHDC wnd
	RoundRect(hdc, x,y,(x + 6 + (7*72)), (y+(lines*15)+6),5,5)
	RELEASEHDC(wnd,hdc)
	FLOODFILL wnd, x+3,y+2,bgcolor
	FLOODFILL wnd, x+3,(y+(lines*15)+4),bgcolor

	tmp = textlength
	x = x+8		:' left side of text
	y = y + 2	:' top of text
	i = 0

	do
		move wnd, x,y	
		' find end of last complete word for dividing text
		while (mid$(tmsg$,tcount,1) <> " ") 
			tcount = tcount - 1
		endwhile
		' print line
		if tmp > 71
			print wnd,left$(tmsg$,tcount)
			tmp = tmp - tcount
			tmsg$ = right$(tmsg$,tmp)
		else
			print wnd,tmsg$
		endif

		if tmp > 71
			tcount = 71
		else
			tmp = len(tmsg$)
			tcount = tmp
		endif
	
		y = y + 15
		i = i + 1

	until i = (lines)

RETURN lines + 1