Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg as Dword
Function PBMain() As Long
Local style&
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
Dialog New Pixels, 0, "Test Code",300,300,400,400, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Push", 50,10,100,20
Control Add TextBox, hDlg, 150, SampleCode, 20,30,350,350, style&
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local temp$
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
Control Get Text hDlg, 150 To temp$
? "Procedure List:" + $crlf + BuildProcedureList(temp$)
End If
End Function
Function BuildProcedureList(ProcListBuf As String) As String
Local i As Long, tmp$, w1$, w2$, w3$, w4$, r$
Dim BufArray(ParseCount(ProcListBuf,$CrLf)-1) As String 'break input string into an array
Parse ProcListBuf$, BufArray(), $CrLf
For i = 0 To UBound(BufArray)
tmp$ = Retain$(BufArray(i), Any Chr$(65 To 90, 95, 97 To 122, 48 To 57, $Spc, "()="))
Replace Any "()" With " " In tmp$
While InStr(tmp$, " ") : Replace " " With " " In tmp$ : Wend 'remove all pairs of spaces
w1$ = Parse$(tmp$," ",1) : w2$ = Parse$(tmp$," ",2) : w3$ = Parse$(tmp$," ",3) : w4$ = Parse$(tmp$," ",4)
If LCase$(w1$+" "+w2$+" "+w3$) = "override property get" Then r$=r$+$CrLf+w4$ : Iterate For
If LCase$(w1$+" "+w2$+" "+w3$) = "override property set" Then r$=r$+$CrLf+w4$ : Iterate For
If LCase$(w1$+" "+w2$) = "macro function" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$+" "+w2$) = "callback function" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$+" "+w2$) = "thread function" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$+" "+w2$) = "class method" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$+" "+w2$) = "override method" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$+" "+w2$) = "property get" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$+" "+w2$) = "property set" Then r$=r$+$CrLf+w3$ : Iterate For
If LCase$(w1$) = "union" Then r$=r$+$CrLf+w2$ : Iterate For
If LCase$(w1$) = "macro" Then r$=r$+$CrLf+w2$ : Iterate For
If LCase$(w1$) = "sub" Then r$=r$+$CrLf+w2$ : Iterate For
If LCase$(w1$) = "function" And w2$ <> "=" Then r$=r$+$CrLf+w2$ : Iterate For
If LCase$(w1$) = "class" Then r$=r$+$CrLf+w2$ : Iterate For
If LCase$(w1$) = "method" And w2$ <> "=" Then r$=r$+$CrLf+w2$ : Iterate For
If LCase$(w1$) = "interface" Then r$=r$+$CrLf+w2$ : Iterate For
Next i
Function = Trim$(r$,$CrLf)
End Function
Function SampleCode() As String
Local temp$
'4 word possibilities
temp$ = temp$ + $crlf + "Override Property Get myOPG"
temp$ = temp$ + $crlf + "Override Property Set myOPS"
'3 word possibilities
temp$ = temp$ + $crlf + "Macro Function myMacroFunction"
temp$ = temp$ + $crlf + "CallBack Function myCallbackFunction"
temp$ = temp$ + $crlf + "Thread Function myThreadFunction"
temp$ = temp$ + $crlf + "Class Method myClassMethod"
temp$ = temp$ + $crlf + "Override Method myOverrideMethod"
temp$ = temp$ + $crlf + "Property Get myPropertyGet"
temp$ = temp$ + $crlf + "Property Set myPropertySGet"
'2 word possibilities
temp$ = temp$ + $crlf + "Union myUnion"
temp$ = temp$ + $crlf + "Macro myMacro"
temp$ = temp$ + $crlf + "Sub mySub"
temp$ = temp$ + $crlf + "Function myFunction"
temp$ = temp$ + $crlf + "Thread myThread" 'invalid
temp$ = temp$ + $crlf + "Callback myCallback" 'invalid
temp$ = temp$ + $crlf + "Class myClass"
temp$ = temp$ + $crlf + "Method myMethod"
temp$ = temp$ + $crlf + "Interface myInterface"
temp$ = temp$ + $crlf + "Override myOverride" 'invalid
temp$ = temp$ + $crlf + "Property myProperty" 'invalid
temp$ = temp$ + $crlf + "Function=50" 'code should ignore
temp$ = temp$ + $crlf + " Function = 10" 'code should ignore
temp$ = temp$ + $crlf + "Method=50" 'code should ignore
temp$ = temp$ + $crlf + " Method = 10" 'code should ignore
Function = Trim$(temp$,$crlf)
End Function
'gbs_01078
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm