Date: 02-16-2022
Return to Index
created by gbSnippets
'Folding is simply the hiding (not deleting) of lines from view, as well as restoring
'the lines to view. Typically this is used to hide the content of procedures, making
'it easier to scroll through a document looking for a particular procedure. When found,
'the procedure is then unfolded for viewing.
'Scintilla's approach is straight-forward.
'1. Each line of code is assigned a fold level. The larger the fold level
' the lower a line is in the hierarchy.
'2. A line may be designated as "fold points", where the visibility of lines of code
' below a fold point can be toggled on/off.
'3. Clickable margin symbols can be displayed to visually indicate fold status of lines
'Folding is usually implemented in a lexer, but can also be implemented within the
'container.
'In this snippet, an internal lexer is used - the VB lexer in this case because the
'PB lexer does not handle folding all that well.
'Primary Code:
'turn on folding
Local key, Value As String
key = "fold" + Chr$(0)
value = "1" + Chr$(0)
SendMessage hSci, %SCI_SetProperty, StrPTR(key), StrPTR(Value)
'To toggle the a fold point, use this message
SendMessage hSci, %SCI_ToggleFold, iLine, 0
'If iLine has its flag set, then the visibility of any line beneath it, down to
'the next line that has a folding level less than or equal to the fold level of
'the selected line, will be toggled.
'Primary Code:
'Lexers typically have folding off by default. To turn it on, use this code:
Local key, Value As String
key = "fold" + Chr$(0)
value = "1" + Chr$(0)
SendMessage hSci, %SCI_SetProperty, StrPTR(key), StrPTR(Value)
'At that point, the lexer handles all of the
SendMessage hSci, %SCI_ToggleFold, 1, 0
'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 : %ID_BtnA = 1001 : %ID_BtnB = 1002
Global hDlg, hSci, hLib As DWord
Function PBMain() As Long
hLib = LoadLibrary("SCILEXER.DLL")
Dialog New Pixels, 0, "Scintilla Example",300,300,400,250, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %ID_BtnA, "Fold ON", 10,10,90,20, %WS_Child Or %WS_Visible
Control Add Button, hDlg, %ID_BtnB, "Fold OFF", 10,40,90,20, %WS_Child Or %WS_Visible
Control Add "Scintilla", hDlg, %ID_Sci, "", 120,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
Local iLine As Long
Select Case CB.Msg
Case %WM_InitDialog
InitializeSci
PostMessage hSci, %SCI_SetSel, 0,0 'unselect initially
Case %WM_Command
Select Case CB.Ctl
Case %ID_BtnA : TestA
Case %ID_BtnB : TestB
End Select
Case %WM_NOTIFY
Select Case CB.NmID
Case %ID_Sci
pNSC = CB.lParam
Select Case @pNSC.hdr.Code
Case %SCN_MarginClick
iLine = SendMessage( hSci, %SCI_LineFromPosition, @pNSC.position, 0)
SendMessage hSci, %SCI_ToggleFold, iLine, 0
End Select
End Select
Case %WM_Size
Control Set Size hDlg, %ID_Sci, Lo(Word, CB.lParam)-130, 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, KeyWords As String, iResult As Long
'set margins
SendMessage hSci, %SCI_SetMarginWidthN, 0, 20 'display Line numbers
SendMessage hSci, %SCI_SetMarginWidthN, 1, 20 'defaults to non-folding symbols
SendMessage hSci, %SCI_SetMarginWidthN, 2, 20 'no default
SendMessage hSci, %SCI_SetMarginMaskN, 2, %SC_Mask_Folders
SendMessage hSci, %SCI_SetMarginSensitiveN, 2, 1 'sensitive to clicks
InitializeFolding
'set lexer to PB
SendMessage hSci, %SCI_SETLEXER, %SCLEX_VB, 0 'built-in PB lexer has bugs, so this snippet uses VB
SendMessage hSci, %SCI_Colourise, 0, -1 'colourize from 0 to end-of-doc
'set syntax highlighting colors and load keywords
SendMessage hSci, %SCI_STYLESETFORE, %SCE_B_KEYWORD, Rgb(0, 0, 255) 'keyword FGcolor
SendMessage hSci, %SCI_STYLESETFORE, %SCE_B_STRING, Rgb(255, 0, 255) 'string color
SendMessage hSci, %SCI_STYLESETFORE, %SCE_B_NUMBER, Rgb(192,100,0) 'number colors
KeyWords = "case end function select"
SendMessage hSci, %SCI_SETKEYWORDS, 0, ByVal StrPTR(KeyWords) 'define PB keywords
'turn on folding
Local key, Value As String
key = "fold" + Chr$(0)
value = "1" + Chr$(0)
SendMessage hSci, %SCI_SetProperty, StrPTR(key), StrPTR(Value)
'load sample text into the control
txt = "Function Test(x as Long) As Long"
txt = txt + $CrLf + " Select Case x"
txt = txt + $CrLf + " Case 1 : y = 3"
txt = txt + $CrLf + " Case 2 : y = 4"
txt = txt + $CrLf + " End Select"
txt = txt + $CrLf + "End Function"
txt = txt + $crlf + "Sub TestB(x as Long)"
txt = txt + $CrLf + " Select Case x"
txt = txt + $CrLf + " Case 1 : y = 3"
txt = txt + $CrLf + " Case 2 : y = 4"
txt = txt + $CrLf + " End Select"
txt = txt + $CrLf + "End Sub" + Chr$(0)
SendMessage(hSci, %SCI_SetText, 0, StrPTR(txt)) 'set text
End Sub
Sub InitializeFolding
'markers/symbols
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDEROPEN, %SC_MARK_CIRCLEMINUS
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDER, %SC_MARK_CIRCLEPLUS
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDERSUB, %SC_MARK_VLINE
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDERTAIL, %SC_MARK_LCORNERCURVE
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDEREND, %SC_MARK_CIRCLEPLUSCONNECTED
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDEROPENMID, %SC_MARK_CIRCLEMINUSCONNECTED
SendMessage hSci, %SCI_MARKERDEFINE, %SC_MARKNUM_FOLDERMIDTAIL, %SC_MARK_TCORNERCURVE
'colors
SendMessage hSci, %SCI_MARKERSETFORE, %SC_MARKNUM_FOLDER, %red
SendMessage hSci, %SCI_MARKERSETBACK, %SC_MARKNUM_FOLDER, 0
SendMessage hSci, %SCI_MARKERSETFORE, %SC_MARKNUM_FOLDEROPEN, %red
SendMessage hSci, %SCI_MARKERSETBACK, %SC_MARKNUM_FOLDEROPEN, 0
SendMessage hSci, %SCI_MARKERSETBACK, %SC_MARKNUM_FOLDEROPENMID, 0
SendMessage hSci, %SCI_MARKERSETBACK, %SC_MARKNUM_FOLDERSUB, 0
SendMessage hSci, %SCI_MARKERSETBACK, %SC_MARKNUM_FOLDERTAIL, 0
SendMessage hSci, %SCI_MARKERSETBACK, %SC_MARKNUM_FOLDERMIDTAIL, 0
End Sub
Sub TestA
SendMessage hSci, %SCI_ToggleFold, 0, 0
End Sub
Sub TestB
SendMessage hSci, %SCI_ToggleFold, 1, 0
End Sub
'gbs_00668
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm