Example52: Folding - Container (Advanced)

Category: Controls - Scintilla

Date: 03-28-2012

Return to Index


 
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:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#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 typeOr _
            Left$(txt,7) = "end subOr _
            Left$(txt,12)= "end functionOr _
            Left$(txt,9) = "end classOr _
            Left$(txt,13)= "end interfaceOr _
            Left$(txt,10)= "end methodOr _
            Left$(txt,12)= "end propertyThen
         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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm