Hi,
As i need to add some syntaxis highlight for my CodeLibrary tool, im developing from scratch a syntaxis highlighter code.
I know that the PB Ide has some code to do that, but i preffer to do it by myself since i want to code a lot on PB to forget about VB.
I need a code that just highlight the complete code, so im not puting any option to highlight when the user types since my app its not an editor, its just a code keeper.
This code is working now, maybe some bugs and it dosent colorize any commands at the moment (i will add that feature tonight).
Give me feedback if you think that i could do something in a easir or better way, mainly in my code.
Problems: its a little slow.
Code: Select all
;The header of RTF with the 4 colors needed
Start$ = "{\rtf1\ansi\ansicpg1252\deff0\deflang2067{\fonttbl{\f0\fswiss\fcharset0 Arial;}{\f1\fnil\fcharset0 Courier;}}{\colortbl ;\red0\green102\blue102;\red0\green0\blue0;\red0\green170\blue170;\red146\green75\blue114;}{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\ "
;The end of the RTF file.
Final$ = "\f0\par}"
Global RichEditHandle.l, CFlag.l, QFlag.l
Procedure.s GetRichText()
Shared RichEditHandle
OldText$ = GetClipboardText() ; Get old clipboard content
ClearClipboard()
SetFocus_(RichEditHandle)
SendMessage_(RichEditHandle, #EM_SETSEL, 100000 , 0)
Result = SendMessage_(RichEditHandle, #EM_GetSel, @From, @To)
SendMessage_(RichEditHandle, #EM_SETSEL, From, To)
SendMessage_ (RichEditHandle, #EM_HIDESELECTION , 1, 0)
SendMessage_(RichEditHandle, #WM_COPY, 0, 0)
SendMessage_(RichEditHandle, #EM_SETSEL, 0, 0)
SendMessage_ (RichEditHandle, #EM_HIDESELECTION , 0, 0)
Text$ = GetClipboardText() ;Need to find how to get the text from Ruchedit
SetClipboardText(OldText$);Restore
ProcedureReturn Text$
EndProcedure
Procedure.s SetTextColor(Word.s)
Shared CFlag.l, QFlag.l
Word = ReplaceString(Word,Chr(141)," ")
Basic$ = " IF FOR TO STEP NEXT GOSUB RETURN FAKERETURN ELSEIF ELSE ENDIF REPEAT UNTIL FOREVER SELECT CASE "
Basic$ = Basic$ + " DEFAULT ENDSELECT FAKEENDSELECT WHILE WEND GOTO DEFTYPE DIM NEWLIST STRUCTURE STRUCTUREUNION "
Basic$ = Basic$ + " ENDSTRUCTUREUNION ENDSTRUCTURE GLOBAL PROCEDURE ENDPROCEDURE PROCEDURERETURN DECLARE "
Basic$ = Basic$ + " PROCEDUREDLL SHARED PROTECTED DATASECTION ENDDATASECTION DATA RESTORE READ CALLDEBUGGER "
Basic$ = Basic$ + " DEBUG DEBUGLEVEL DISABLEDEBUGGER ENABLEDEBUGGER INCLUDEFILE XINCLUDEFILE INCLUDEBINARY INCLUDEPATH "
Basic$ = Basic$ + " COMPILERIF COMPILERELSE COMPILERENDIF COMPILERSELECT COMPILERCASE COMPILERDEFAULT COMPILERENDSELECT "
Word1$ = ReplaceString(Word,"\line","")
Word1$ = LTrim(RTrim(Word1$))
If FindString(Word,Chr(34),0) 0 And QFlag = 0 And CFlag = 0
Pos = FindString(Word,Chr(34),0)
Pos1 = FindString(Word," ",Pos)
If Pos1 0
Word = Left(Word,Len(Word) - 1)
EndIf
Result$ = ReplaceString(Word,Chr(34),"\cf1 " + Chr(34),0)
QFlag = 1
ElseIf FindString(Word,Chr(34),0) 0 And QFlag = 1 And CFlag = 0
Pos = FindString(Word,Chr(34),0)
Pos1 = FindString(Word," ",Pos)
If Pos1 0
Word = Left(Word,Len(Word) - 1)
EndIf
Result$ = ReplaceString(Word,Chr(34),Chr(34) + "\cf2 ",0)
QFlag = 0
ElseIf QFlag = 1 And CFlag = 0
Result$ = Word
ElseIf CFlag = 1 And FindString(Word,"\line",0) = 0
If FindString(Word,"\line",0) 0
Result$ = Word + "\cf2 "
CFlag = 0
Else
Result$ = "\cf3 " + Word
EndIf
ElseIf CFlag = 2
If FindString(Word,"\line",0) = 0 And FindString(Word,",",0) = 0 And FindString(Word,")",0) = 0 And FindString(Word,"(",0) = 0 And FindString(Word,"=",0) = 0 And FindString(Word,"",0) = 0 And FindString(Word,"*",0) = 0 And FindString(Word,"-",0) = 0
Result$ = Word + "\cf2 "
CFlag = 0
Else
Restore MyData
For i = 0 To 9
Read Key$
Pos.l = FindString(Word, Key$,0)
If Pos 0
Word = ReplaceString(Word,Key$,"\cf2 " + Key$,0)
CFlag = 0
EndIf
Next i
Result$ = Word
EndIf
Else
CFlag = 0
If FindString(LCase(Basic$),LCase(" " + Word1$ + " "),1) 0 And Word1$ " " And Word1$ ""
;-BASIC
Result$ = "\cf1\b " + Word + "\cf2\b0 "
ElseIf FindString(Word1$,";",0) 0
;-Conpuntoycoma
If FindString(Word,"\line",0) = 0
Word = ReplaceString(Word,";","\cf3 ;",0)+ "\cf2 "
CFlag = 1
Else
Word = ReplaceString(Word,";","\cf3 ;",0)+ "\cf2 "
EndIf
Result$ = Word
ElseIf FindString(Word1$,"#",0) 0
Word = ReplaceString(Word,"#","\cf4 #",0)
CFlag = 2
Restore MyData
For i = 0 To 9
Read Key$
Pos.l = FindString(Word, Key$,0)
If Pos 0
Word = ReplaceString(Word,Key$,"\cf2 " + Key$,0)
CFlag = 0
EndIf
Next i
Result$ = Word
Else
Result$ = Word + "\cf2 "
EndIf
EndIf
Out:
ProcedureReturn Result$
EndProcedure
Procedure.s Parse(Text.s)
Shared CFlag.l, QFlag.l
CFlag = 0
QFlag = 0
Text = ReplaceString(Text,Chr(13) + Chr(10),"\line" + Chr(143))
Text = ReplaceString(Text,Chr(34),Chr(34) + Chr(143))
Repeat
Indice = Indice + 1
Texto$ = StringField(Text, Indice, Chr(143)) + " "
Texto$ = ReplaceString(Texto$,Chr(32),Chr(141) + Chr(142),1)
If Left(Texto$,1) ";" And FindString(Texto$,Chr(141) + Chr(142) + ";",0) = 0
Texto$ = ReplaceString(Texto$,";", Chr(142) + ";",1)
EndIf
Index = 0
Repeat
Index = Index + 1
Word$ = StringField(Texto$, Index, Chr(142))
Rtf$ = Rtf$ + SetTextColor(Word$)
Until Word$ = ""
Texto$ = LTrim(RTrim(Texto$))
Until Texto$ = Chr(141) + Chr(142)
ProcedureReturn Rtf$
EndProcedure
If OpenWindow(1, 0, 100, 700, 400 ,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget,"Syntaxis Highlight")
LoadLibrary_("RICHED32.DLL")
RichEditHandle = CreateWindowEx_(#WS_EX_CLIENTEDGE, "RichEdit20A", 0, #WS_CHILD | #WS_VISIBLE | #ES_MULTILINE | #ES_AUTOHSCROLL | #ES_AUTOVSCROLL | #ES_WANTRETURN | #WS_HSCROLL | #WS_VSCROLL, 10, 10, 600, 380, WindowID(), 0, GetModuleHandle_(0), 0)
If CreateGadgetList(WindowID())
ButtonGadget(2,620, 15, 70, 25, "Open")
;ButtonGadget(3,620, 40, 70, 25, "HighLight")
While WindowEvent() : Wend
SendMessage_(RichEditHandle, #WM_SETTEXT,0,@Prueba$)
Repeat
EventID= WaitWindowEvent()
If EventID = #PB_EventGadget
Select EventGadgetID()
Case 2
FileName$ = OpenFileRequester("Select a PB File", "", "*.pb|*.pb", 0)
If FileName$
If ReadFile(0,FileName$)
FileContent$ = Space(Lof())
ReadData(@FileContent$, Len(FileContent$))
CloseFile(0)
EnableWindow_ (RichEditHandle, 0)
SendMessage_(RichEditHandle, #WM_SETTEXT,0, FileContent$)
Cursor = LoadCursor_(0, #IDC_WAIT)
SetClassLong_(WindowID(),#GCL_HCURSOR,Cursor)
WindowEvent()
RichText$ = Start$ + Parse(GetRichText()) + Final$
SendMessage_(RichEditHandle, #WM_SETTEXT,0,RichText$ )
SendMessage_(RichEditHandle, #EM_SETSEL, 0, 0)
Beep_(444,30)
EnableWindow_ (RichEditHandle, 1)
Cursor = LoadCursor_(0, #IDC_ARROW)
SetClassLong_(WindowID(),#GCL_HCURSOR,Cursor)
EndIf
EndIf
EndSelect
EndIf
Until EventID=#PB_Event_CloseWindow
EndIf
EndIf
;
End
DataSection
MyData:
Data$ "\line",",","(",")","=",">","<","*","+","-"
EndDataSection
Ricardo
Dont cry for me Argentina...