Updated: Should now be cross platform
Zebuddi.
Windows Constants acquired with Danilo`s GetPBInfo http://www.forums.purebasic.com/english ... 2b07fc6f74
Windows Constants zip https://www.dropbox.com/s/seg2v2439vea7 ... s.zip?dl=0
Path for Constants.txt is the base dir of the exe.
Code: Select all
; Title : Pure Constant finder
; Created: 19/10/2017,
; Author : Zebuddi.
; Credits: original work by Danilo - 2013 for the PBGetInfo Code Thanks
; Info: Checks and Exports current PB Constant list to Constants.txt if not exist() else program ends if fails to create file.
; Shows MessageRequester on failier with system error message in CheckConstants()
; v1.2: Added LMB double click to copy selected constant name + value to clipboard. 25/11/2017
; Added: ---- 4/12/2017---------------------
; 1. PopupMenu for selected item to Clipboard:
; 2. Hexidecimal, Binary Values:
; 3. AutoResize Listicon Columns to fit values:
; 4. Window Sizing:
; 5. Programmable Key Check() delay 50ms Ideal via ProgramParameter(0) if used an an Ide tool else defaults to 50ms for stand alone
;---------------------------------------------
EnableExplicit
CompilerIf #PB_Compiler_Thread = 0
MessageRequester("Compiler Options", "Please CheckMark (Create Thread Safe) in the Compiler Options")
End
CompilerEndIf
;{- Enumerations / DataSections
;{ Windows
Enumeration
#HndWinMain
EndEnumeration
;}
;{ Gadgets
Enumeration
#Editor_0
#String_Search
#StatusBarWin0
#ListIcon
#PopUpMenu
EndEnumeration
;}
Define iListSize.i, sSearchParam.s = "#PB_"
;}
#Compiler$ = #PB_Compiler_Home + "compilers\pbcompiler.exe"
Structure CONSTANTS
sName.s
iNameRow.i
sDecimal.s
iDecimalRow.i
sHex.s
iHexRow.i
sBin.s
iBinRow.i
EndStructure : Global NewList sll_Constants.CONSTANTS()
NewList sll_Out.s()
NewList ill_CloumnWidths.i()
Global sWindowTitle.s = "Pure Constant Finder", bTheadEnd.b = #False, out.s, iItems.s, iCompiler.i
Global gsConstantsFile.s = GetPathPart(ProgramFilename()) + "Constants.txt"
Procedure LIG_SetColumnWidth(gadget,index,new_width)
; by Danilo, 15.12.2003 - english chat (for 'Karbon')
;
; change column header width
;
SendMessage_(GadgetID(gadget),#LVM_SETCOLUMNWIDTH,index,new_width)
EndProcedure
Procedure.s GetLastErrorAsText() ; Used to get Last Win32 API Error
Protected message.s
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Protected LastError=GetLastError_(), *ErrorBuffer
If LastError=1309 : LastError=0 : EndIf
If LastError
*ErrorBuffer = AllocateMemory(1024)
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0)
message.s=PeekS(*ErrorBuffer)
FreeMemory(*ErrorBuffer)
EndIf
CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux
message = errono()
CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
message = "MacOSX Not Implemented Yet"
CompilerEndIf
ProcedureReturn message
EndProcedure
Procedure StartCompiler()
ProcedureReturn RunProgram(#Compiler$, "/STANDBY", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
EndProcedure
Procedure StopCompiler(pb)
WriteProgramStringN(pb, "END", #PB_Ascii)
WaitProgram(pb,5000)
CloseProgram(pb)
EndProcedure
Procedure SendCompilerCommand(pb,command$)
If ProgramRunning(pb)
WriteProgramStringN(pb, command$, #PB_Ascii)
EndIf
EndProcedure
Procedure.s GetCompilerOutput(pb)
If AvailableProgramOutput(pb)
ProcedureReturn ReadProgramString(pb, #PB_Ascii)
EndIf
EndProcedure
Procedure WaitCompilerReady(pb)
Protected out$
While out$<>"READY" And Left(out$,5)<>"ERROR"
out$ = GetCompilerOutput(pb)
Wend
EndProcedure
Procedure FillList(pb,List sll_Out.s(),marge=0)
Protected out$
Protected marge$=Space(marge)
While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
out$=GetCompilerOutput(pb)
If out$ And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,1,1))=0
AddElement(sll_Out())
sll_Out()= marge$ + out$
EndIf
Wend
EndProcedure
Procedure Insert_markers(List sll_Out.s(),i=1)
; in a sorted listed, it's possible and useful
; to add indexed markers for quick browsing in PB IDE
Protected.s temp, car
ForEach sll_Out()
If UCase(Mid(sll_Out(),i,1)) <> car
temp = sll_Out() ; mémoriser la ligne courante
car = UCase(Mid(temp,i,1))
sll_Out() = ";- " + car ; insérer la lettre à utiliser dans l'IDE
AddElement(sll_Out()) ; nouvelle ligne...
sll_Out() = temp ; et ré-insérer la ligne remplacée
EndIf
Next
EndProcedure
Procedure Save_outList(iItems.s, how_many)
Shared sll_Out()
If CreateFile(0, gsConstantsFile)
WriteStringN(0,";- "+Str(how_many) + " " + iItems)
ForEach sll_Out()
WriteStringN(0,sll_Out())
Next
CloseFile(0)
EndIf
EndProcedure
Procedure FillConstantList(pb,List sll_Out.s(),space=0)
Protected out$
Protected space$=Space(space)
While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
out$=GetCompilerOutput(pb)
If out$<>"" And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,2,1))=0
If FindString("01",Mid(out$,1,1))
out$ = "#"+Mid(out$,2,Len(out$)-1)
out$ = ReplaceString(out$,#TAB$," = ")
out$ = ReplaceString(out$,"# = ","#")
ElseIf FindString("2",Mid(out$,1,1))
Protected i, found_non_printable = #False
Protected oldout$ = out$
Protected sconst_value$ = StringField(oldout$,3,Chr(9))
out$ = "#"+StringField(oldout$,2,#TAB$)
For i = 1 To Len(sconst_value$)
If Asc(Mid(sconst_value$,i)) < 32 Or Asc(Mid(sconst_value$,i)) > 126
found_non_printable = #True
EndIf
Next i
If out$ = "#TAB$" : out$ + " = Chr(9)"
ElseIf out$ = "#HT$" : out$ + " = Chr(9)"
ElseIf out$ = "#CRLF$" : out$ + " = Chr(13) + Chr(10)"
ElseIf out$ = "#LFCR$" : out$ + " = Chr(10) + Chr(13)"
ElseIf out$ = "#LF$" : out$ + " = Chr(10)"
ElseIf out$ = "#CR$" : out$ + " = Chr(13)"
ElseIf out$ = "#DOUBLEQUOTE$" : out$ + " = Chr(34)"
ElseIf out$ = "#DQUOTE$" : out$ + " = Chr(34)"
ElseIf found_non_printable = #False
out$ + " = " + #DQUOTE$ + StringField(oldout$,3,#TAB$) + #DQUOTE$
Else
out$ + " ="
Protected temp$ = StringField(oldout$,3,#TAB$)
For i = 0 To Len(sconst_value$)-1
out$ + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
Next
EndIf
out$ = RTrim(out$,"+")
EndIf
out$ = Trim(out$)
If out$
AddElement(sll_Out())
sll_Out() = space$ + out$
EndIf
EndIf
Wend
EndProcedure
Procedure.i GetConstantsList(pb,List sll_Out.s())
If ProgramRunning(pb)
SendCompilerCommand(pb,"CONSTANTLIST")
FillConstantList(pb,sll_Out())
EndIf
ProcedureReturn ListSize(sll_Out())
EndProcedure
Procedure CheckConstants(List sll_Out.s())
If FileSize(gsConstantsFile) = -1
iCompiler = StartCompiler()
If iCompiler = 0
FreeList(sll_Out())
MessageRequester("Compiler Error", "Unable to Start the Compiler" + #CRLF$ + GetLastErrorAsText())
End
EndIf
WaitCompilerReady(iCompiler)
SortList(sll_Out(),#PB_Sort_Ascending|#PB_Sort_NoCase)
Insert_markers(sll_Out(),2)
Save_outList("constants",GetConstantsList(iCompiler,sll_Out()))
StopCompiler(iCompiler)
FreeList(sll_Out())
EndIf
EndProcedure
Procedure.i do_list(List sll_Out.s())
Protected sString.s, iPos.i
If Not ReadFile(0, gsConstantsFile)
FreeList(sll_Out())
MessageRequester("Constant Data File Error", "Unable to create Constant Data File" + #CRLF$ + GetLastErrorAsText())
End
Else
With sll_Constants()
While Not Eof(0)
sString=ReadString(0,ReadStringFormat(0))
iPos=FindString(sString," = ")
AddElement(sll_Constants())
\sName = Left(sString,iPos-1)
\sDecimal = Right(sString,(Len(sString)-(iPos+2)))
\sHex = Hex(Val(\sDecimal))
\sBin = Bin(Val(\sDecimal))
Wend
EndWith
CloseFile(0)
ProcedureReturn ListSize(sll_Constants())
EndIf
EndProcedure
Procedure sSetConstantClipBoardData()
StatusBarText(#StatusBarWin0, 1, "Copying......")
If GetGadgetState(#ListIcon) <> -1
SetClipboardText(GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), 1) + Chr(32) +
GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), 2))
Delay(360)
StatusBarText(#StatusBarWin0, 1, "Copied To Clipboard")
EndIf
EndProcedure
; Procedure.b IsNumeric(string.s)
; If Val(String) > 0
; ProcedureReturn #True
; Else
; ProcedureReturn #False
; EndIf
; EndProcedure
Procedure AutoResizeListGadgetColumn(iGadID.l, iRowID.l, iColumnID.l, sText.s)
SetGadgetItemText(iGadID, iRowID, sText,iColumnID)
SendMessage_(GadgetID(iGadID), #LVM_SETCOLUMNWIDTH,iColumnID,#LVSCW_AUTOSIZE)
EndProcedure
Procedure check(iDummy.i) ; threaded auto update routine
Protected sSearchString.s, iMatchCounter.i, iInitGadget.i = 0, sPreviousSearchString.s, iPreviousSearchStringLength.i, bFirstRun.b
Protected iCount.i, iIndex.i, iNbr.i, iRegExSearchParams.i = CreateRegularExpression(#PB_Any, "(?<=\s).+?(?=\s)", #PB_RegularExpression_NoCase)
Protected iFlag.i, iDelayValue.i
With sll_Constants()
Repeat
If Len(GetGadgetText(#String_Search)) <> iPreviousSearchStringLength
iPreviousSearchStringLength = Len(GetGadgetText(#String_Search))
iFlag = 0
EndIf
If bTheadEnd = #True
ProcedureReturn
EndIf
If bFirstRun = 0
sPreviousSearchString = PeekS(@iDummy, #PB_Unicode)
bFirstRun = 1
Else
sPreviousSearchString=GetGadgetText(#String_Search)
EndIf
If Bool(Val(ProgramParameter(0)) = 0)
iDelayValue = 50 ; ms
Else
iDelayValue = Val(ProgramParameter(0))
EndIf
Delay(iDelayValue)
If sPreviousSearchString<>GetGadgetText(#String_Search) ;If changed
ClearGadgetItems(#ListIcon)
sSearchString=GetGadgetText(#String_Search)
If sSearchString > ""
If Right(sSearchString, 1) <> Chr(32)
sSearchString + Chr(32)
EndIf
If Left(sSearchString, 1) <> Chr(32)
sSearchString = InsertString(sSearchString, Chr(32), 1)
EndIf
If sSearchString
StatusBarText(#StatusBarWin0, 1, "")
If MatchRegularExpression(iRegExSearchParams, sSearchString)
Dim a_SearchParams.s(0)
iNbr = ExtractRegularExpression(iRegExSearchParams, sSearchString, a_SearchParams())
EndIf
EndIf
SendMessage_(GadgetID(#ListIcon),#WM_SETREDRAW, #False, 0)
ForEach sll_Constants()
For iIndex = 0 To iNbr-1
If FindString(LCase(\sName + \sDecimal), LCase(a_SearchParams(iIndex)), 1)
iCount + 1
EndIf
Next
If iCount = iNbr
iMatchCounter+1
If Len(\sName) < \iNameRow : \iNameRow = iMatchCounter : EndIf
If Len(\sDecimal) < \iDecimalRow : \iDecimalRow = iMatchCounter : EndIf
If Len(\sHex) < \iHexRow : \iHexRow = iMatchCounter : EndIf
If Len(\sBin) < \iBinRow : \iBinRow = iMatchCounter : EndIf
AddGadgetItem(#ListIcon,-1, Str(iMatchCounter) + ". " + Chr(10) + \sName + Chr(10) + \sDecimal + Chr(10) + \sHex + Chr(10) + \sBin)
EndIf
iCount = 0
Next
SendMessage_(GadgetID(#ListIcon),#WM_SETREDRAW, #True, 0)
FreeArray(a_SearchParams())
StatusBarText(#StatusBarWin0,0,"Found " + FormatNumber(iMatchCounter,0 ) + " Matches")
If GetGadgetText(#String_Search) = "" ; search term is empty clear listview
iMatchCounter=0
ClearGadgetItems(#ListIcon)
StatusBarText(#StatusBarWin0,0,"No Search Term")
EndIf
EndIf
EndIf
iMatchCounter=0
SetActiveGadget(#String_Search)
If Bool((Len(GetGadgetText(#String_Search)) = iPreviousSearchStringLength) And iFlag = 0)
AutoResizeListGadgetColumn(#ListIcon, \iNameRow, 1, GetGadgetItemText(#ListIcon, \iNameRow, 1))
AutoResizeListGadgetColumn(#ListIcon, \iDecimalRow, 2, GetGadgetItemText(#ListIcon, \iDecimalRow, 2))
AutoResizeListGadgetColumn(#ListIcon, \iHexRow, 3, GetGadgetItemText(#ListIcon, \iHexRow, 3))
AutoResizeListGadgetColumn(#ListIcon, \iBinRow, 4, GetGadgetItemText(#ListIcon, \iBinRow, 4))
iFlag = 1
EndIf
ForEver
FreeRegularExpression(iRegExSearchParams)
EndWith
EndProcedure
Procedure Resize()
ResizeGadget(#ListIcon, #PB_Ignore, #PB_Ignore, WindowWidth(#HndWinMain),
(WindowHeight(#HndWinMain) - (StatusBarHeight(#StatusBarWin0) +
GadgetHeight(#String_Search))))
ResizeGadget(#String_Search, #PB_Ignore, ( GadgetHeight(#ListIcon)), WindowWidth(#HndWinMain), #PB_Ignore)
EndProcedure
Procedure OpenWindowMain()
If OpenWindow(#HndWinMain, 450, 32, 497, 573, sWindowTitle, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|
#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
If CreateStatusBar(#StatusBarWin0, WindowID(#HndWinMain))
AddStatusBarField(350)
AddStatusBarField(147)
EndIf
If CreatePopupMenu(#PopUpMenu)
MenuItem(0, "Constant Name ")
MenuItem(1, "Decimal")
MenuItem(2, "Hexidecinal")
MenuItem(3, "Binary")
EndIf
StringGadget(#String_Search, 0, 525, 497, 25, "")
SetGadgetText(#String_Search, "#PB_")
SetActiveGadget(#String_Search)
ListIconGadget(#ListIcon, 0, 0, 497, 573 - (StatusBarHeight(#StatusBarWin0) + GadgetHeight(#String_Search)), "Nb", 30, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListIcon, 2, "Name", 0)
AddGadgetColumn(#ListIcon, 3, "Dec", 0)
AddGadgetColumn(#ListIcon, 4, "Hex", 0)
AddGadgetColumn(#ListIcon, 5, "Bin", 0)
SetGadgetColor(#ListIcon,#PB_Gadget_BackColor,$80FFFF)
SetGadgetColor(#String_Search,#PB_Gadget_BackColor, $1FF6F5)
EndIf
EndProcedure
Procedure ShowMenu()
Protected iIndex.i, sTitles.s
Restore Titles
For iIndex = 0 To 3
Read.s sTitles
SetMenuItemText(#PopUpMenu, iIndex, sTitles + GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), iIndex + 1) + " ]")
Next
DataSection
Titles:
Data.s "Name --- [ ", "Dec --- [ ", "Hex --- [ $", "bin --- [ %"
EndDataSection
DisplayPopupMenu(#PopUpMenu, WindowID(#HndWinMain))
EndProcedure
;--------------------- MAIN ------------------
CheckConstants(sll_Out())
iListSize = do_list(sll_Out())
OpenWindowMain()
SetWindowTitle(#HndWinMain,sWindowTitle + " " + FormatNumber(iListSize) + " Constants Found ")
BindGadgetEvent(#ListIcon, @sSetConstantClipBoardData(), #PB_EventType_LeftDoubleClick)
BindEvent(#PB_Event_SizeWindow, @Resize(), GetActiveWindow())
BindGadgetEvent(#ListIcon, @ShowMenu(), #PB_EventType_RightClick)
Define iThread=CreateThread(@check(),@sSearchParam)
If Bool(iThread And iListSize)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
If EventWindow() = #HndWinMain
If iThread
bTheadEnd =#True
EndIf
FreeList(sll_Constants())
CloseWindow(#HndWinMain)
Break
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 0
SetClipboardText(GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), 1))
Case 1
SetClipboardText(GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), 2))
Case 2
SetClipboardText("$" + GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), 3))
Case 3
SetClipboardText("%" + GetGadgetItemText(#ListIcon, GetGadgetState(#ListIcon), 4))
EndSelect
EndSelect
ForEver
End
Else
MessageRequester("Program Error", "Unable to CreateThread() Terminating...")
End
EndIf
;
;}