Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Include "Win32API.inc"
%ID_RichEditA = 500
%ID_RichEditB = 501
%ID_Button = 502
Global hDlg,hRichEditA,hRichEditB As Dword
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,600,300, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %ID_Button,"Sort Procedures", 10,10,150,20
LoadLibrary("riched32.dll") : InitCommonControls
CreateRichEditControls
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If Cb.Msg = %WM_Command And Cb.Ctl = %ID_Button And Cb.CtlMsg = %BN_Clicked Then
Local SourceCode$
Control Get Text hDlg, %ID_RichEditA To SourceCode$
Control Set Text hDlg, %ID_RichEditB, SortedProcedures(SourceCode$)
End If
End Function
Sub CreateRichEditControls
Local style&, buf$
buf$ = "Sub H" + $CrLf + "End Sub" + $CrLf + $CrLf + "Callback Function A" + $CrLf + "End Function" + $CrLf + $CrLf + "Function G" + $CrLf + "End Function"
style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
Control Add "RichEdit", hDlg, %ID_RichEditA, buf$, 10, 40, 280, 250, style&, %WS_Ex_ClientEdge
Control Handle hDlg, %ID_RichEditA To hRichEditA
SendMessage hRichEditA, %EM_SETLIMITTEXT, &H100000&, 0
Control Add "RichEdit", hDlg, %ID_RichEditB, "results", 310, 40, 280, 250, style&, %WS_Ex_ClientEdge
Control Handle hDlg, %ID_RichEditB To hRichEditB
SendMessage hRichEditB, %EM_SETLIMITTEXT, &H100000&, 0
End Sub
Function SortedProcedures(SourceCode$) As String
Local i,iCount,Flag As Long, tmp$
Dim Titles(1 To 1) As String
Dim Procedures(1 To 1) As String
Dim CodeLines(ParseCount(SourceCode$,$CrLf)-1) As String
SourceCode$ = Trim$(SourceCode$, Any $CrLf + $Spc) 'remove blanks in front and behind of procedures
Parse SourceCode$,CodeLines(),$CrLf 'split source code into array CodeLines()
For i = 0 To UBound(CodeLines) 'split procedures into Procedures() and procedure titles into Titles()
Flag = 0
tmp$ = LCase$(Shrink$(CodeLines(i))) 'eliminate two-space character strings
If Left$(tmp$,4) = "sub " Then Flag = 2
If Left$(tmp$,9) = "callback " Then Flag = 3
If Left$(tmp$,9) = "function " Then Flag = 2
If Flag Then
Incr iCount
ReDim Preserve Procedures(1 To iCount)
ReDim Preserve Titles(1 To iCount)
Procedures(iCount) += CodeLines(i)
Titles(iCount) = Parse$(CodeLines(i),$Spc,Flag)
Else
Procedures(iCount) += $CrLf + CodeLines(i)
End If
Next i
If Right$(Procedures(iCount),2) <> $CrLf Then Procedures(iCount) += $CrLf 'ensure a new line after last procedure
Array Sort Titles(), Collate UCase, TagArray Procedures(), Ascend 'sort Title() but with Procedures() as a tag-along array
Function = Trim$(Join$(Procedures(), $CrLf), $CrLf) 'return Procedures() as a string
End Function
'gbs_01451
'Date: 10-17-2014
http://www.garybeene.com/sw/gbsnippets.htm