Date: 02-16-2022
Return to Index
created by gbSnippets
'This snippet builds on the "Lexer - Container(Simple)" snippet by
'adding a more complete lexing capability to the custom lexer function.
'In the previous snippet, the lexer styled an entire line at at time.
'The lexer discussed here breaks up the text and applies styling at
'a lower level (keywords, punctuation, operators, ...)
'Primary Code
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "scintilla_gb.inc"
%ID_Sci = 1000
%SCE_Style_Numbers = 1 : %SCE_Style_Strings = 2 : %SCE_Style_Keywords = 3
%SCE_Style_Comments = 4 : %SCE_Style_Default = 5 : %SCE_Style_Operators = 6
Global hDlg, hSci, hLib As DWord
Global LWords() As String, UWords() As String, MWords() As String
Global CodeCase As Long
Function PBMain() As Long
hLib = LoadLibrary("SCILEXER.DLL")
Dialog New Pixels, 0, "Scintilla: Container Lexer",300,300,300,200, %WS_OverlappedWindow To hDlg
Control Add "Scintilla", hDlg, %ID_Sci, "", 10,10,180,130, %WS_Child Or %WS_Visible
Control Handle hDlg, %ID_Sci To hSci 'get handle to Scintilla window
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local pNSC As SCNotification Ptr ' // Scintilla notification messages
Select Case CB.Msg
Case %WM_InitDialog
CodeCase = 3
InitializeSci
InitializeKeyWords
PostMessage hSci, %SCI_SetSel, 0,0 'unselect initially
Case %WM_Notify
Select Case CB.NmID
Case %ID_Sci
pNSC = CB.lParam
Select Case @pNSC.hdr.Code
Case %SCN_StyleNeeded
CustomPBLexer @pNSC.position
End Select
End Select
Case %WM_Size
Control Set Size hDlg, %ID_Sci, Lo(Word, CB.lParam)-20, Hi(Word, CB.lParam)-20
Case %WM_Destroy
If hLib Then FreeLibrary hLib ' Free the Scintilla library
End Select
End Function
Sub InitializeSci
Local txt As String
txt = "Select Case" + $CrLf
txt = txt + "' Case " + Chr$(34) + "cat" + Chr$(34) + $CrLf
txt = txt + "' Case " + Chr$(34) + "dog" + Chr$(34) + $CrLf
txt = txt + "End Select" + Chr$(0)
SendMessage(hSci, %SCI_SetText, 0, StrPTR(txt)) 'set example text
SendMessage hSci, %SCI_SetMarginWidthN, 0, 20 'display line numbers
SendMessage hSci, %SCI_SetLexer, %SCLEX_Container, 0 'container does lexing
SetLexerStyles
End Sub
Sub SetLexerstyles
SendMessage hSci, %SCI_StyleSetFore, %SCE_Style_Comments, %Green
SendMessage hSci, %SCI_StyleSetFore, %SCE_Style_Keywords, %Blue
SendMessage hSci, %SCI_StyleSetFore, %SCE_Style_Strings, %Red
SendMessage hSci, %SCI_StyleSetFore, %SCE_Style_Numbers, %Gray
SendMessage hSci, %SCI_StyleSetFore, %SCE_Style_Default, %Black
SendMessage hSci, %SCI_StyleSetFore, %SCE_Style_Operators, %Green
End Sub
Sub InitializeKeyWords
Local temp$, i As Long
ReDim UWords(1000), LWords(1000), MWords(1000)
Open Exe.Path$ + "keywords.txt" For Input As #1
While IsFalse Eof(1)
Line Input #1, temp$
If Len(Trim$(temp$)) Then
MWords(i) = temp$
UWords(i) = UCase$(MWords(i))
LWords(i) = LCase$(MWords(i))
Incr i
End If
Wend
Close #1
ReDim Preserve UWords(i-1), LWords(i-1), MWords(i-1)
End Sub
Sub CustomPBLexer (ByVal iEndPos As Long)
Local iLine, iStartPos, iStartLine, iEndLine As Long, c As String
'lines from position returned by GetEndStyle to line containing SCNotification.position
iStartPos = SendMessage(hSci, %SCI_GetEndStyled,0,0)
iStartLine = SendMessage(hSci, %SCI_LineFromPosition,iStartPos,0) 'start line
iEndLine = SendMessage(hSci, %SCI_LineFromPosition,iEndPos,0) 'end line
For iLine = iStartLine To iEndLine
LexOneLine iLine
Next iLine
End Sub
Sub LexOneLine(iLine As Long)
Local I, iStart, iEnd, iLineLength, wFlag, StopPos, iResult As Long
Local txt, xWord As String
Local Letter As Byte Ptr
iStart = SendMessage( hSci, %SCI_PositionFromLine, iLine, 0) 'position of 1st char in line
iEnd = SendMessage( hSci, %SCI_GetLineEndPosition, iLine, 0) 'postion of last char in line
iLineLength = SendMessage( hSci, %SCI_LineLength , iLine, 0) 'get line width
txt = String$(iLineLength," ") + $Nul 'set buffer length
SendMessage hSci, %SCI_GetLine , iLine, StrPTR(txt) 'get line text
txt = UCase$(txt) 'CharUpperBuff(ByVal StrPTR(Buf), iLineLength) 'Make UCASE
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Loop through each character in the line, using a pointer for better speed
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Letter = StrPTR(txt) : wFlag = 0
For I = 1 To Len(txt)
Select Case @Letter 'The characters we need to inlude in a word
Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255, 35 To 38, 48 To 57, 63, 95
If wFlag = 0 Then
wFlag = 1 : stopPos = I
End If
Case 34 ' string quotes -> "
stopPos = Instr(I + 1, txt, Chr$(34)) 'Find match
If StopPos Then
SendMessage(hSci, %SCI_StartStyling,iStart + I,31)
SendMessage(hSci, %SCI_SetStyling, StopPos - 1 - I, %SCE_Style_Strings) 'style iLineLength characters
StopPos = (StopPos - I + 1)
I = I + StopPos
Letter = Letter + StopPos
wFlag = 0
End If
Case 39 ' comment character -> '
SendMessage(hSci, %SCI_StartStyling,iStart + I - 1,31)
SendMessage(hSci, %SCI_SetStyling, iLineLength - I + 1, %SCE_Style_Comments)
wFlag = 0
Exit For
Case Else 'word is ready
If wFlag = 1 Then
xWord = Mid$(txt, stopPos, I - stopPos) 'Get word
If xWord = "REM" Then 'extra for the uncomment word, REM
SendMessage(hSci, %SCI_StartStyling,iStart + I - Len(xWord) - 1,31)
SendMessage(hSci, %SCI_SetStyling, iLineLength - I + Len(xWord) + 1, %SCE_Style_Comments)
wFlag = 0
Exit For
End If
Array Scan UWords(0), = xWord, To iResult 'Is it in the array?
'---------------------------------upper/lower/mixed handled here-----------
'If iResult AND CodeCase& Then
' xWord = Choose$(CodeCase&, UWords(iResult-1), LWords(iResult-1), MWords(iResult-1))
' SendMessage hSci, %SCI_SetTargetStart, iStart + I - Len(xWord) - 1, 0
' SendMessage hSci, %SCI_SetTargetEnd, iStart + I, 0
' SendMessage hSci, %SCI_ReplaceTarget, Len(xWord), StrPTR(xWord)
' SendMessage hSci, %SCI_GoToPos, iStart + I, 0
'End If
'----------------------------------------------------------------------
SendMessage(hSci, %SCI_StartStyling,iStart + StopPos - 1,31)
SendMessage(hSci, %SCI_SetStyling, I - StopPos, IIF(iResult, %SCE_Style_Keywords,%SCE_Style_Default))
wFlag = 0
End If
End Select
Incr Letter
Next I
End Sub
'gbs_00665
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm