'Sintax color in window

def filename,ln,printer,filter:string
def file1:FILE
def buffer[32766]:ISTRING
filter = "CBasic files|*.cba|All Files|*.*||"
declare applyColorLine(w1:window,ctl:INT)
declare colorize(w1:window,ctl:INT,linenum:INT)
'create a list with keywords
CONST kewordCount = 29
DEF keyword[kewordCount]:STRING
keyword[0] = " IF "
keyword[1] = " THEN "
keyword[2] = " ELSE "
keyword[3] = " ENDIF "
keyword[4] = " WHILE "
keyword[5] = " ENDWHILE "
keyword[6] = " TO "
keyword[7] = " FOR "
keyword[8] = " NEXT "
keyword[9] = " PRINT "
keyword[10] = "RETURN"
keyword[11] = "SUB"
keyword[12] = "WINDOW "
keyword[13] = ":WINDOW"
keyword[14] = "DEF "
keyword[15] = "idclosewindow"
keyword[16] = "@"
keyword[17] = "WINDOW "
keyword[18] = "CLOSEWINDOW "
keyword[19] = "CLASS"
keyword[20] = "CASE"
keyword[21] = "SELECT"
keyword[22] = "COLOR"
keyword[23] = "SINTAX"
keyword[24] = "ENDSELECT"
keyword[25] = "minbox"
keyword[26] = "WAITUNTIL"
keyword[27] = "END"
keyword[28] = "#"

DEF w1:window
Window w1,0,0,600,400,@minbox,0,"Color code in window",main
Setwindowcolor w1,rgb(231,222,231)
'--------------------------------------------
CONTROL w1,"B,Open,11,9,70,20,0x50000001,2"
SETFONT w1, "Courier New", 10, 400,0,2
CONTROL w1,"B,Save,101,9,70,20,0x50000001,3"
SETFONT w1, "Courier New", 10, 400,0,3
CONTROL w1,"B,Copy,180,9,70,20,0x50000001,4"
SETFONT w1, "Courier New", 10, 400,0,4
CONTROL w1,"B,Paste,260,9,70,20,0x50000001,5"
SETFONT w1, "Courier New", 10, 400,0,5

'--------------------------------
run=1
Waituntil run =0
Closewindow w1
END

SUB main
	SELECT @CLASS
		case @idclosewindow
			run=0
		case @idcreate			
			Centerwindow w1
			CONTROL w1,"RE,,7,35,570,294,0x50B010C4,1"
			SETFONT w1, "Courier New", 10, 400,0,1
			mask = CONTROLCMD(w1,1,@RTGETEVENTMASK)
			CONTROLCMD w1, 1, @RTSETEVENTMASK, mask | @ENMKEYEVENTS |@ENMCHANGE
			' put text in control
			SETCONTROLTEXT w1, 1, "'>>>start<<<#Sintax Color"

		CASE @IDCONTROL
			SELECT @CONTROLID
				CASE 1:'richedit
					SELECT @NOTIFYCODE
						CASE @ENCHANGE
							applyColorLine(w1,1)
					ENDSELECT

				CASE 2:'open file
					doopen()
				CASE 3:'save file
					dosave()
				CASE 4:'copy
					CONTROLCMD w1,1,@RTCOPY
				CASE 5:'paste
					CONTROLCMD w1,1,@RTPASTE
			ENDSELECT	
	ENDSELECT
RETURN

'This function adjusts the colors of the current line
SUB applyColorLine(w1,ctl)
	def char_start, char_end:int
	def linenum:int

	CONTROLCMD w1, 1, @RTHIDESEL, 1
	CONTROLCMD w1, 1, @RTGETSELECTION, char_start, char_end

	linenum = CONTROLCMD (w1, 1, @RTLINEFROMCHAR, char_start)
	colorize(w1, 1, linenum)
	CONTROLCMD w1, 1, @RTSETSELECTION, char_start, char_end
	CONTROLCMD w1, 1, @RTHIDESEL, 0
RETURN

'This function adjusts the colors of the keywords on the given linenum
SUB colorize(w1,ctl,linenum)
	def lineStart, lineLength:int
	def i,char_start:int
	def p, pLine:int
	def ln$,ln2:string

	lineStart =SendMessage( w1, 0xbb, linenum,0,  1)
	lineLength = CONTROLCMD (w1, 1, @RTGETLINELENGTH, linenum)
	'uncolor the whole line, set black color
	CONTROLCMD w1, 1, @RTSETSELECTION, lineStart, lineStart + lineLength
	CONTROLCMD w1, 1, @RTSETSELCOLOR, RGB(0, 0, 0)

	'check the keywords one by one, if they occur on this line
	FOR i=0 TO kewordCount-1
		p = lineStart-1
		DO
			p = CONTROLCMD (w1, 1, @RTFINDTEXT,keyword[i] , p+1,lineStart + lineLength )
			IF p >0
				pline = CONTROLCMD (w1,1, @RTLINEFROMCHAR, p)
				ln$=	CONTROLCMD (w1, 1, @RTGETLINE, pline)
				ln2 = ltrim$(ln$)
				if i < 28
					if instr(ln2,keyword[i])=1
						CONTROLCMD w1, 1, @RTSETSELECTION, p,p+len(keyword[i])
						CONTROLCMD w1, 1, @RTSETSELCOLOR, RGB(0, 0, 255)
					endif
				else
					pos =instr(ln$,keyword[28])
					if pos
						tlen=len(ln$)-pos
						CONTROLCMD w1, 1, @RTSETSELECTION, p,p+tlen
						CONTROLCMD w1, 1, @RTSETSELCOLOR, RGB(0, 255,0)
					endif
				endif
			ENDIF
		UNTIL p < 0
		CONTROLCMD w1, 1, @RTSETSELECTION, p, p-LEN(keyword[i])
		CONTROLCMD w1, 1, @RTSETSELCOLOR, RGB(0, 0, 0)
	NEXT i
RETURN

'open file------------------------------------------
SUB doopen
	filename = filerequest("Load File",w1,1)
	if(len(filename) > 0)
		buffer = ""
		if( openfile(file1,filename,"R") = 0)
			do
	 			if(read(file1,ln) = 0)
					if len(buffer) < (32766-257)
 	 					buffer = buffer + ln + chr$(13) + chr$(10)
					endif
	 	 		endif
			until eof(file1)
			closefile file1
			setcontroltext w1,1,buffer
		endif
	endif
RETURN
'save file-------------------------------------
SUB dosave
	filename = filerequest("Save File",w1,0,filter,"cba")
	if(len(filename) > 0)
		if(openfile(file1,filename,"W") = 0)
			buffer = getcontroltext(w1,1)
					GOSUB RemoveCR
			write file1,buffer
			closefile file1
		endif
	endif
RETURN
'-------------
SUB RemoveCR
def pos:INT
def buffer2[32766]:ISTRING
	pos = INSTR(buffer,CHR$(13))
	while(pos)
		if(mid$(buffer,pos,1) = CHR$(13))
			buffer2 = left$(buffer,pos-1)
			buffer2 = buffer2 + mid$(buffer,pos+1)
			buffer = buffer2
		endif
		pos = INSTR(pos+1,buffer,chr$(13))
	endwhile
return