It presents as in the image above with each button representing a file. On clicking a button a popup menu is displayed with the public procedure.
Selecting a menu item fills the string gadgets with the Include, UseModule, Procedure. From here Clicking paste write directly to the PBIDE where ever the text cursor is placed.
Compile and use as a tool. Tool Arguments:
1. %DirectoryPathToYourFiles
2. %Module*.pbi ie : YourNamingconvention could be *.pbi | myInclude****.pbi
3. %FILE
4. %FILENAME
if the current tab has not been saved %FILE wont pass an argument so then %TEMPFILE is used ie: new tab
Zebuddi.
Code: Select all
EnableExplicit
Structure SUBMENUDATA
sSubProcName.s
sSubFileAndPath.s
sSubModName.s
iSubMenuButtonID.i
EndStructure
Structure MODULEDATA
sFileAndPath.s
sModName.s
iMenuButtonID.i
iPopUpMenuID.i
List _as_ProcName.SUBMENUDATA()
EndStructure
Global giLastGadgetY.i, giWinHeight.i, giWinWidth.i, giMenuWidth.i , giMenuHeight.i, giLastGadgetY.i, giProcCount.i
Global giStringGadgetSetProc.i, giStringGadgetUserMod.i, giStringGadgetInclude.i, giButtonPasteInclude.i, giButtonPasteSetProc.i, giButtonPasteUserMod.i
Define iMenuItemCount.i, sMenusNeeded.s, iEv.i, iThisButtonGadgetID.i, bHasFileBeenIncluded.i
Define sModulePath.s = Mid(ProgramParameter(0),2)
Define sModulePrefix.s = Mid(ProgramParameter(1), 2)
Define sCurrentFile.s = ProgramParameter(2)
Define sTempFile.s = ProgramParameter(3)
If sCurrentFile = ""
sCurrentFile = sTempFile
EndIf
NewList _llMyModuleData.MODULEDATA()
Procedure.i iGetFiles(StartDirectory$, List _llMyModuleData.MODULEDATA(), Pattern$="*.*"); get the modules from the directory
Protected Result.i, Dir.i
Dir = ExamineDirectory(#PB_Any, StartDirectory$, Pattern$)
If Dir
While NextDirectoryEntry(Dir)
If DirectoryEntryType(Dir) = #PB_DirectoryEntry_File
AddElement(_llMyModuleData())
_llMyModuleData() \sFileAndPath = DirectoryEntryName(Dir)
EndIf
Wend
FinishDirectory(Dir)
EndIf
SortStructuredList(_llMyModuleData(), #PB_Sort_Ascending, OffsetOf(MODULEDATA\sModName), TypeOf(MODULEDATA\sModName))
ProcedureReturn ListSize(_llMyModuleData())
EndProcedure
Procedure.i GetModuleProcedures(sModulePath.s, List _llMyModuleData.MODULEDATA())
Protected sFile.s, nbr.i, iSringFormat.i, iNbrBytes.i, sModData.s, *buffer, iDNbr.i, iPNbr.i, iIndex.i
Protected iRegexDeclareModule.i = CreateRegularExpression(#PB_Any, "DeclareModule.+EndDeclareModule", #PB_RegularExpression_MultiLine|#PB_RegularExpression_DotAll)
Protected iRegexDeclareProcedures.i = CreateRegularExpression(#PB_Any, "Declare *\w+ *\(.*\)|Declare\.. *\w+ *\(.*\)|Prototype *\w+ *\(.*\)|Prototype\.. *\w+ *\(.*\)|PrototypeC *\w+ *\(.*\)|PrototypeC\.. *\w+ *\(.*\)", #PB_RegularExpression_MultiLine)
Protected iRegexModName.i = CreateRegularExpression(#PB_Any, "(?<=DeclareModule\s)\w+")
Protected iRegexRemovePrefix.i = CreateRegularExpression(#PB_Any, "\..\s")
ForEach _llMyModuleData()
sFile = sModulePath + "\" +_llMyModuleData()\sFileAndPath
If ReadFile(0, sFile)
iSringFormat.i = ReadStringFormat(0)
*buffer = AllocateMemory(Lof(0))
iNbrBytes = ReadData(0, *buffer, Lof(0))
sModData.s = PeekS(*buffer,Lof(0), iSringFormat)
;{ get module name
If MatchRegularExpression(iRegexModName, sModData)
Dim asModName.s(0)
ExtractRegularExpression(iRegexModName, sModData, asModName())
_llMyModuleData()\sModName = Trim(RemoveString(asModName(0), Chr(13))) + "::"
;}
;{ -- Extract the module procedure from the declaremodule section; public procedures
If MatchRegularExpression(iRegexDeclareModule,sModData )
Dim asDeclares.s(0)
iDNbr =ExtractRegularExpression(iRegexDeclareModule, sModData, asDeclares())
If iDNbr
If MatchRegularExpression(iRegexDeclareProcedures, asDeclares(0))
Dim _asProc.s(0)
iPNbr = ExtractRegularExpression(iRegexDeclareProcedures, asDeclares(0), _asProc())
For iIndex = 0 To iPNbr-1
_asProc(iIndex) = Mid(_asProc(iIndex), FindString(_asProc(iIndex), Chr(32) ,1) + 1)
AddElement(_llMyModuleData()\_as_ProcName())
_llMyModuleData()\_as_ProcName()\sSubProcName = Trim(_asProc(iIndex))
Next
EndIf
EndIf
EndIf
EndIf
;}
iNbrBytes = 0 : sModData = ""
CloseFile(0)
Debug ""
EndIf
Next
;{-- clean up
FreeMemory(*buffer)
FreeArray(asDeclares())
FreeArray(asModName())
FreeArray(_asProc())
FreeRegularExpression(iRegexDeclareModule)
FreeRegularExpression(iRegexDeclareProcedures)
FreeRegularExpression(iRegexModName)
FreeRegularExpression(iRegexRemovePrefix)
;}
ProcedureReturn ListSize(_llMyModuleData()\_as_ProcName())
EndProcedure
Procedure.s sReturnMenusNeeded(iItemCount.i)
Protected iRemainder.i, iIndex.i, iEvenCount. i
If Mod(iItemCount,2) =1
iEvenCount = iItemCount -1
Else
iEvenCount = iItemCount
EndIf
For iIndex = 1 To iItemCount/2
If ((iIndex * iIndex) = iEvenCount) Or ((iIndex * iIndex) > iEvenCount) ; get max square root
If ((iIndex * iIndex) > iEvenCount) ; max reached
ProcedureReturn Str(iIndex - 1) + "," + Str(iIndex - 1) + "," + Str(iItemCount - ((iIndex - 1)*(iIndex - 1))) + Chr(44)
Else
ProcedureReturn Str(iIndex)+","+Str(iIndex) + Chr(44)
EndIf
EndIf
Next
EndProcedure
Procedure.b DrawMenuButtons(iWinID.i, sMenuItemCount.s, iMenuWidth.i, iMenuHeight.i, List _llMyModuleData.MODULEDATA())
Protected iXcount.i, iYcount.i, iRemainderCount, iWinWidth.i, iWinHeight.i, iButtonX.i, iButtonY.i , iCounter.i
;{-- calculate windowwidth/height for respective menu`s
iXcount = Val(StringField(sMenuItemCount, 1, Chr(44))) : iYcount = Val(StringField(sMenuItemCount, 2, Chr(44))) : iRemainderCount = Val(StringField(sMenuItemCount, 3, Chr(44)))
iWinWidth = ((iXcount * (iMenuWidth + 5) )+ 10) : giWinWidth = iWinWidth
iWinHeight = (((iYcount * (iMenuHeight + 5)) + 10)+ (90) ) : giWinHeight = iWinHeight
;}
;-- --main window opening and button drawing
If OpenWindow(0, 10,10, iWinWidth, iWinHeight, "Pure Module Procedure`s",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget)
StickyWindow(0, #True)
With _llMyModuleData()
iButtonX = 5: iButtonY = 5
ForEach _llMyModuleData()
If ListSize(\_as_ProcName()) > 0
giMenuWidth = iMenuWidth : giMenuHeight = iMenuHeight
\iMenuButtonID = ButtonGadget(#PB_Any, iButtonX, iButtonY, iMenuWidth , iMenuHeight, \sModName, #PB_Button_MultiLine|#PB_Button_Default) : giLastGadgetY = ((GadgetY(\iMenuButtonID) + 5) + iMenuHeight)
iCounter + 1 : iButtonX + (iMenuWidth + 5)
If iCounter = iXcount
iButtonX = 5 : iButtonY + (iMenuHeight + 5) : iCounter = 0
EndIf
EndIf
Next
giStringGadgetInclude = StringGadget(#PB_Any, 5, giLastGadgetY, giWinWidth - 80, 25 ,"")
giStringGadgetUserMod = StringGadget(#PB_Any, 5, giLastGadgetY+ 30 , giWinWidth - 80, 25 ,"")
giStringGadgetSetProc = StringGadget(#PB_Any, 5, giLastGadgetY + 60, giWinWidth - 80, 25 ,"")
giButtonPasteInclude = ButtonGadget(#PB_Any, giWinWidth - 75, giLastGadgetY , 70, 25, "Paste")
giButtonPasteUserMod = ButtonGadget(#PB_Any, giWinWidth - 75, giLastGadgetY + 30, 70, 25, "Paste")
giButtonPasteSetProc = ButtonGadget(#PB_Any, giWinWidth - 75, giLastGadgetY + 60, 70, 25 , "Paste")
EndWith
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure CreateSubPopUpMenu( iThisMenuButtonID.i, List _llMyModuleData.MODULEDATA())
ForEach _llMyModuleData()
If ListSize(_llMyModuleData()\_as_ProcName()) > 0
With _llMyModuleData()
\iPopUpMenuID = CreatePopupMenu(#PB_Any)
If \iMenuButtonID = iThisMenuButtonID
ForEach _llMyModuleData()\_as_ProcName()
MenuItem(ListIndex(\_as_ProcName()), \_as_ProcName()\sSubProcName)
_llMyModuleData()\_as_ProcName()\iSubMenuButtonID = ListIndex(\_as_ProcName())
\_as_ProcName()\sSubModName = \sModName
\_as_ProcName()\sSubFileAndPath = \sFileAndPath
Next
Break
EndIf
EndWith
EndIf
Next
EndProcedure
Procedure WriteToPBIDE(sText.s, iHuman.i = 0, iDelay.i = 1)
Protected iScintilla.i = Val(GetEnvironmentVariable("PB_Tool_Scintilla"))
Protected iIndex.i, iPos.i, sChar.s, IHumanMax.i, IHumanMin.i
If iHuman = 1
IHumanMax = Random(500, 250)
IHumanMin = Random(100, 1)
EndIf
For iIndex=1 To Len(sText)
If iDelay = 0 And iHuman = 1
Delay(Random(IHumanMax, IHumanMin))
Else
Delay(iDelay)
EndIf
sChar = Mid(sText, iIndex, 1)
SendMessage_(iScintilla, #EM_REPLACESEL, iDelay, @sChar)
Next
EndProcedure
;======================== MAIN====================
CallDebugger
iMenuItemCount = iGetFiles(sModulePath, _llMyModuleData(), sModulePrefix)
If iMenuItemCount
sMenusNeeded = sReturnMenusNeeded(iMenuItemCount)
giProcCount = GetModuleProcedures(sModulePath, _llMyModuleData())
If giProcCount
If DrawMenuButtons(0, sMenusNeeded, 150, 25, _llMyModuleData())
Repeat
iEv =WaitWindowEvent()
Select iEv
Case #PB_Event_CloseWindow
FreeList(_llMyModuleData())
CloseWindow(0)
End
Case #PB_Event_Gadget
Select EventGadget()
Case giButtonPasteInclude
WriteToPBIDE(GetGadgetText(giStringGadgetInclude) + #CRLF$, 0, 0)
Case giButtonPasteUserMod
WriteToPBIDE(GetGadgetText(giStringGadgetUserMod) + #CRLF$, 0, 0)
Case giButtonPasteSetProc
WriteToPBIDE(GetGadgetText(giStringGadgetSetProc) + #CRLF$, 0, 0)
EndSelect
iThisButtonGadgetID = EventGadget()
ForEach _llMyModuleData()
If _llMyModuleData()\iMenuButtonID = iThisButtonGadgetID
CreateSubPopUpMenu(iThisButtonGadgetID, _llMyModuleData())
DisplayPopupMenu(_llMyModuleData()\iPopUpMenuID, WindowID(0), DesktopMouseX(), DesktopMouseY())
Break 1
EndIf
Next
Case #PB_Event_Menu
ForEach _llMyModuleData()
If _llMyModuleData()\iMenuButtonID= iThisButtonGadgetID
ForEach _llMyModuleData()\_as_ProcName()
Debug Str(_llMyModuleData()\_as_ProcName()\iSubMenuButtonID) + " --- " + Str(EventMenu())
If _llMyModuleData()\_as_ProcName()\iSubMenuButtonID = EventMenu()
SetGadgetText( giStringGadgetInclude, "IncludeFile " + Chr(34) +sModulePath + _llMyModuleData()\sFileAndPath + Chr(34) )
SetGadgetText(giStringGadgetUserMod, "UseModule " + Left(_llMyModuleData()\sModName, Len(_llMyModuleData()\sModName)-2))
SetGadgetText(giStringGadgetSetProc, _llMyModuleData()\sModName +_llMyModuleData()\_as_ProcName()\sSubProcName)
Break 2
EndIf
Next
EndIf
Next
EndSelect
ForEver
EndIf
Else
MessageRequester("PureModProc. Program Error" , Str(giProcCount) + " Module Procedure`s Found" + #CRLF$+ #CRLF$ + "Module Path = " + Chr(34) + sModulePath + Chr(34) +
#CRLF$ + "PBIDE Tool Arguments:" + #CRLF$ + #CRLF$ +"%PathToYourModulesDirectory %Module*.pbi% FILES %FILENAME " )
EndIf
Else
MessageRequester("PureModProc. Program Error" , Str(iMenuItemCount) + " Module `s Found" + #CRLF$+ "Module Path = " + sModulePath )
EndIf
End