Date: 02-16-2022
Return to Index
created by gbSnippets
a Line with no Children is considered Expanded
to Get fold level, you have to AND the results with a mask
'This snippet builds on the "Folding - Container (Simple)" snippet by
'adding a more complete capability to assign fold levels to the content
'of a Scintilla code.
'In particular, the following PowerBASIC constructs are detected and the
'first lines of the constructs are flagged as fold points and given a
'plus or minus sign are a symbol, depending on their expanded state.
'The end line of the constructs are given a SC_MarkNum_FolderTail symbol
'(curvvd line to indicate the end of the construct. Then all other lines
'of the constructs are give a SC_MarkNum_FolderSub symbol (vertical line).
Type ... End Type
Sub ... End Sub
Function ... End Function
CallBack ... End Function
Class ... End Class
Interface ... End Interface
Property ... End Property
Method ... End Method
'The SCN_MarginClick notification, sent when user clicks on one of the
'folding symbols, is used to set the margin symbol to indicate the
'expanded/not-expanded state of the first line of each construct.
'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 : %ID_BtnA = 1001 : %ID_BtnB = 1002 : %ID_BtnC = 1003 : %ID_BtnD = 1004
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, "Toggle Function", 5,10,115,20, %WS_Child Or %WS_Visible
Control Add Button, hDlg, %ID_BtnB, "Toggle Sub", 5,40,115,20, %WS_Child Or %WS_Visible
Control Add Button, hDlg, %ID_BtnC, "Fold All", 5,70,115,20, %WS_Child Or %WS_Visible
Control Add Button, hDlg, %ID_BtnD, "Expand All", 5,100,115,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, iExpanded As Long
Select Case CB.Msg
Case %WM_InitDialog
InitializeSci
InitializeFolding
SetFoldLevels
PostMessage hSci, %SCI_SetSel, 0,0 'unselect initially
Case %WM_Command
Select Case CB.Ctl
Case %ID_BtnA : TestA
Case %ID_BtnB : TestB
Case %ID_BtnC : FoldAll
Case %ID_BtnD : ExpandAll
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
iExpanded = SendMessage(hSci, %SCI_GetFoldExpanded, iLine, 0)
If iExpanded Then
SendMessage hSci, %SCI_MarkerDelete, iLine, %SC_MarkNum_Folder
SendMessage hSci, %SCI_MarkerAdd, iLine, %SC_MarkNum_FolderOpen
Else
SendMessage hSci, %SCI_MarkerDelete, iLine, %SC_MarkNum_FolderOpen
SendMessage hSci, %SCI_MarkerAdd, iLine, %SC_MarkNum_Folder
End If
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
KeyWords = "case end function select sub"
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_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
SendMessage hSci, %SCI_SetKeywords, 0, ByVal StrPTR(KeyWords) 'define PB keywords
SendMessage(hSci, %SCI_SetText, 0, StrPTR(txt)) 'set text
SendMessage hSci, %SCI_SetMarginWidthN, 0, 20 'display line numbers
SendMessage hSci, %SCI_SetMarginWidthN, 1, 20 'display line numbers
SendMessage hSci, %SCI_SetMarginWidthN, 2, 20 'display line numbers
SendMessage hSci, %SCI_SetMarginMaskN, 2, %SC_Mask_Folders
SendMessage hSci, %SCI_SetMarginSensitiveN, 2, 1 'sensitive to clicks
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
'colors
SendMessage hSci, %SCI_MarkerSetFore, %SC_MarkNum_Folder, %White
SendMessage hSci, %SCI_MarkerSetBack, %SC_MarkNum_Folder, %Black
SendMessage hSci, %SCI_MarkerSetFore, %SC_MarkNum_FolderOpen, %White
SendMessage hSci, %SCI_MarkerSetback, %SC_MarkNum_FolderOpen, %Black
SendMessage hSci, %SCI_MarkerSetBack, %SC_MarkNum_FolderSub, %Black
SendMessage hSci, %SCI_MarkerSetBack, %SC_MarkNum_FolderTail, %Black
End Sub
Sub SetFoldLevels
Local i, iLine, iLineCount, iLineLength, iLevel As Long
Local txt As String
'remove all folder symbols from all ines
SendMessage hSci, %SCI_MarkerDelete, %SC_MarkNum_Folder, 0
SendMessage hSci, %SCI_MarkerDelete, %SC_MarkNum_FolderOpen, 0
SendMessage hSci, %SCI_MarkerDelete, %SC_MarkNum_FolderTail, 0
SendMessage hSci, %SCI_MarkerDelete, %SC_MarkNum_FolderSub, 0
'rebuild folder levels and symbol assignment
iLineCount = SendMessage( hSci, %SCI_GetLineCount, 0, 0) 'number of lines
For iLine = 0 To iLineCount - 1
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 = LCase$(txt) 'lower case for comparison
If Left$(txt,5) = "type " Or _
Left$(txt,4) = "sub " Or _
Left$(txt,9) = "callback " Or _
(Left$(txt,9)= "function " AND LCase$(Left$(txt,10)) <> "function =") Or _
Left$(txt,6) = "class " Or _
Left$(txt,10)= "interface " Or _
Left$(txt,7) = "method " Or _
Left$(txt,9) = "property " Then
iLevel = 1
ElseIf Left$(txt,8) = "end type" Or _
Left$(txt,7) = "end sub" Or _
Left$(txt,12)= "end function" Or _
Left$(txt,9) = "end class" Or _
Left$(txt,13)= "end interface" Or _
Left$(txt,10)= "end method" Or _
Left$(txt,12)= "end property" Then
iLevel = 2
Else
iLevel = 3
End If
Select Case iLevel
Case 1
SendMessage hSci, %SCI_SetFoldLevel, iLine, iLevel Or %SC_FoldLevelHeaderFlag
SendMessage hSci, %SCI_MarkerAdd, iLine, %SC_MarkNum_FolderOpen
Case 2
SendMessage hSci, %SCI_SetFoldLevel, iLine, iLevel
SendMessage hSci, %SCI_MarkerAdd, iLine, %SC_MarkNum_FolderTail
Case Else
SendMessage hSci, %SCI_SetFoldLevel, iLine, iLevel
SendMessage hSci, %SCI_MarkerAdd, iLine, %SC_MarkNum_FolderSub
End Select
Next iLine
End Sub
Sub TestA
SendMessage hSci, %SCI_ToggleFold, 0, 0
End Sub
Sub TestB
SendMessage hSci, %SCI_ToggleFold, 6, 0
End Sub
Sub FoldAll
Local iExpanded, iLine, iLineCount As Long
iLineCount = SendMessage( hSci, %SCI_GetLineCount, 0, 0) 'number of lines
For iLine = 0 To iLineCount - 1
iExpanded = SendMessage( hSci, %SCI_GetFoldExpanded, iLine, 0)
If iExpanded Then SendMessage (hSci, %SCI_ToggleFold, iLine, 0)
Next i
End Sub
Sub ExpandAll
Local iExpanded, iLine, iLineCount As Long
iLineCount = SendMessage( hSci, %SCI_GetLineCount, 0, 0) 'number of lines
For iLine = 0 To iLineCount - 1
iExpanded = SendMessage( hSci, %SCI_GetFoldExpanded, iLine, 0)
If iExpanded = 1 Then SendMessage (hSci, %SCI_ToggleFold, iLine, 0)
Next i
End Sub
'gbs_00670
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm