pure constant finder

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

pure constant finder

Post by Zebuddi123 »

Hi to all I have adapted some of my old code to work with pb constants, you can now find a set of constants via value or partial name etc its threaded and quite quick.

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.

Image Image

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
;
;}
Last edited by Zebuddi123 on Mon Dec 04, 2017 11:50 am, edited 10 times in total.
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: pure constant finder

Post by Zebuddi123 »

Updated: Incorporated and hacked Danilo`s GetPBInfo constant code part.

1. Constants.txt will be created in the executable`s folder if not found.

see 1st post

Zebuddi :)
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
gurj
Enthusiast
Enthusiast
Posts: 658
Joined: Thu Jan 22, 2009 3:48 am
Location: china
Contact:

Re: pure constant finder

Post by gurj »

thanks
lnk is:
GetPBInfo - get constants structures procedures interfaces
http://www.purebasic.fr/english/viewtop ... 12&t=53701
my pb for chinese:
http://ataorj.ys168.com
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: pure constant finder

Post by Kwai chang caine »

Cool this tools, can be usefull :D
Super idea to can search part of name of constant, it perhaps can be better, if we can search several words, like this "wm move" :idea:
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: pure constant finder

Post by Zebuddi123 »

Updated: Multi Parameter Search added: See 1st Post.

Hi as you requested GrassHopper. :) You can use multiple parameters (no limit, except common sense) separated by a single space.

Zebuddi. :)
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: pure constant finder

Post by Kwai chang caine »

You are an angel Zebuddi123, thanks a lot 8)
ImageThe happiness is a road...
Not a destination
oO0XX0Oo
User
User
Posts: 78
Joined: Thu Aug 10, 2017 7:35 am

Re: pure constant finder

Post by oO0XX0Oo »

@Zebuddi123

It would be a nice feature if double clicking on an item in the list gadget
would copy the constant name into the clipboard...
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: pure constant finder

Post by Zebuddi123 »

Update: Left double mouse click to copy constant name and value to clipboard, now case insensitive search as default for better search results.

@oO0XX0Oo Done

Zebuddi. :)
malleo, caput, bang. Ego, comprehendunt in tempore
oO0XX0Oo
User
User
Posts: 78
Joined: Thu Aug 10, 2017 7:35 am

Re: pure constant finder

Post by oO0XX0Oo »

Thanks a lot for adding the requested feature, Zebuddi123!
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: pure constant finder

Post by Michael Vogel »

Fine tool, quite quick compared to the internal IDE code.

Some more ideas:
* an additional column with hex values (or a possibility to swap between decimal/hex display)
* a possibility to sort by column titles

What I saw here:
* memory error when closing the window by Alt+F4
* maybe FindString(LCase(nslist()\name + nslist()\value), LCase(a_SearchParams(iIndex)), 1) could be optimized by using a shadowed variables initialized at the beginning: searchlist()=LCase(nslist()\name + #Tab$+ nslist()\value), lc_SearchParams(index)=LCase(a_SearchParams(iIndex))
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: pure constant finder

Post by Zebuddi123 »

Updated to V1.2 4/12/2017

Link to Ico File: https://www.freepik.com/free-icon/numbe ... 745086.htm

1. PopupMenu for selected item to Clipboard:
2. Hexidecimal, Binary Values: (Michael Vogel) :) Sorting When more Spare Time.
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

Code updated in first Post

Zebuddi. @:) Its a Hat I`m Cold.
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: pure constant finder

Post by Michael Vogel »

Oh no, just started one hour ago to tune your code a little bit :evil: - now I stop that nonsense :wink:

Anyhow, here's the code, I made the following changes:
* constants are in a string array, so nothing needed to prepare them for the list box - eventually a duplicate list with lower case characters could be speedier
* while entering a text the search will be restarted
* the listbox won't be updated while it is filled up... (windows only)

Code: Select all

EnableExplicit
CompilerIf #PB_Compiler_Thread = 0
	MessageRequester("Compiler Options", "Please CheckMark (Create Thread Safe) in the Compiler Options")
	End
CompilerEndIf

; /!\ ersetzen durch dynamischen bzw. relativen Pfad?
Global ToolCompiler.s=#PB_Compiler_Home + "compilers\pbcompiler.exe"
Global CacheFile.s = GetPathPart(ProgramFilename()) + "Constants.txt"

; DeleteFile(CacheFile)
; Debug CacheFile

Global Dim Consts.s(0)
Global Count.i

#Q=#DOUBLEQUOTE$

Procedure.s FormatNumber(number.d,decimals.i=0)

	ProcedureReturn StrD(number,decimals)

EndProcedure

;{- Enumerations / DataSections
	;{ Windows
		Enumeration
			#Window_0
		EndEnumeration
	;}
	;{ Gadgets
		Enumeration
			#Editor_0
			#String_Search
			#StatusBar_Window_0
			#ListIcon_0

		EndEnumeration

	;}
	Define.l Event, EventWindow, EventGadget, EventType, EventMenu, sSearchParam.s = "#PB_"
;}




Global NewList OUT.s()

Global title$ = "Pure Constant Finder", bTheadEnd.b = #False, out.s, iItems.s, iCompiler.i


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 SendCompilerCommand(pb,command$)
	If ProgramRunning(pb)
		WriteProgramStringN(pb, command$, #PB_Ascii)
	EndIf
EndProcedure


Procedure Insert_markers(List 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 out()
		If UCase(Mid(out(),i,1)) <> car
			temp = out()                  ; mémoriser la ligne courante
			car  = UCase(Mid(temp,i,1))
			out() = ";- " + car           ; insérer la lettre à utiliser dans l'IDE
			AddElement(out())           ; nouvelle ligne...
			out() = temp              ; et ré-insérer la ligne remplacée
		EndIf
	Next
EndProcedure

Procedure Save_outList(iItems.s, how_many)
	Shared out()
	If CreateFile(0, CacheFile)
		WriteStringN(0,";- "+Str(how_many) + " " + iItems)
		ForEach out()
			WriteStringN(0,out())
		Next
		CloseFile(0)
	EndIf
EndProcedure

Procedure.s ReadCompilerOutput(pb)

	If AvailableProgramOutput(pb)
		ProcedureReturn ReadProgramString(pb,#PB_Ascii)
	Else
		ProcedureReturn ""
	EndIf

EndProcedure
Procedure RetrieveConstants(pb,List OUT.s(),space=0)

	Protected out$
	Protected space$=Space(space)

	If ProgramRunning(pb)
		SendCompilerCommand(pb,"CONSTANTLIST")


		While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
			out$=ReadCompilerOutput(pb)
			; Debug out$
			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)
					ReplaceString(out$,#TAB$,"=",#PB_String_InPlace)
					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(out())
					out() = space$ + out$
				EndIf
			EndIf
		Wend

	EndIf

	ProcedureReturn ListSize(out())

EndProcedure
Procedure ReadConstants()

	If FileSize(CacheFile) = -1
		iCompiler=RunProgram(ToolCompiler, "/STANDBY", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
		If iCompiler = 0
			FreeList(OUT())
			MessageRequester("Compiler Error", "Unable to Start the Compiler" + #CRLF$ + GetLastErrorAsText())
			End
		EndIf

		Protected out$
		While out$<>"READY" And Left(out$,5)<>"ERROR"
			out$ = ReadCompilerOutput(iCompiler)
		Wend

		SortList(out(),#PB_Sort_Ascending|#PB_Sort_NoCase)
		Insert_markers(out(),2)
		Save_outList("constants",RetrieveConstants(iCompiler,out()))

		WriteProgramStringN(iCompiler, "END", #PB_Ascii)
		WaitProgram(iCompiler,5000)
		CloseProgram(iCompiler)

		FreeList(out())
	EndIf

EndProcedure


Procedure  do_list() ;  parse file names.txt and fill nslist structured linkedlist

	Protected  a$, p.i

	If Not ReadFile(0,CacheFile)
		FreeList(OUT())
		MessageRequester("Constant Data File Error", "Unable to create Constant Data File" + #CRLF$ + GetLastErrorAsText())
		End
	Else
		With nslist()
			While Eof(0)=0
				a$=ReadString(0,ReadStringFormat(0))
				p=FindString(a$,"=")
				ReDim Consts(Count)
				Consts(Count)=Left(a$,p-1)+#LF$
				a$=Trim(Mid(a$,p+1))
				If PeekA(@a$)='"'
					Consts(Count)+Trim(a$,#Q)+#LF$+"-"
				Else
					Consts(Count)+a$+#LF$+"0x"+Hex(Val(a$))
				EndIf
				Count+1
			Wend
		EndWith
		CloseFile(0)
	EndIf

EndProcedure

Procedure sSetConstantClipBoardData()
	StatusBarText(#StatusBar_Window_0, 1, "Copying......")
	If GetGadgetState(#ListIcon_0) <> -1
		SetClipboardText(GetGadgetItemText(#ListIcon_0, GetGadgetState(#ListIcon_0), 1) + Chr(32) +
		GetGadgetItemText(#ListIcon_0, GetGadgetState(#ListIcon_0), 2))
		Delay(360)
		StatusBarText(#StatusBar_Window_0, 1, "Copied To Clipboard")
	EndIf
EndProcedure

Procedure.b IsNumeric(string.s)
	If Val(String) > 0
		ProcedureReturn #True
	Else
		ProcedureReturn #False
	EndIf
EndProcedure

Procedure check(aaa) ; threaded auto update routine

	Protected i
	Protected text.s,check.s
	Protected match_counter.i, initgadget=0, oldcheck$, bFirstRun.b
	Protected iCount.i, iIndex.i, iNbr.i, iRegExSearchParams.i = CreateRegularExpression(#PB_Any, "(?<=\s).+?(?=\s)", #PB_RegularExpression_NoCase)

	Repeat
		If bTheadEnd = #True
			ProcedureReturn
		EndIf

		If bFirstRun = 0
			oldcheck$ = PeekS(@aaa, #PB_Unicode)
			bFirstRun = 1
		Else
			oldcheck$=text
		EndIf

		Delay(100)

		If oldcheck$<>GetGadgetText(#String_Search)  ;If changed
			Repeat
				text=GetGadgetText(#String_Search)
				check=Trim(text)
				Delay(200)
			Until text=GetGadgetText(#String_Search)

			SendMessage_(GadgetID(#ListIcon_0),#WM_SETREDRAW,#False,0)
			ClearGadgetItems(#ListIcon_0)
			If check

				StatusBarText(#StatusBar_Window_0,0,"Searching for '"+check+"'...")
				StatusBarText(#StatusBar_Window_0,1, "Please wait...")

				If Right(check, 1) <> Chr(32)
					check + Chr(32)
				EndIf

				If Left(check, 1) <> Chr(32)
					check = InsertString(check, Chr(32), 1)
				EndIf

				If MatchRegularExpression(iRegExSearchParams,check)
					Dim a_SearchParams.s(0)
					iNbr = ExtractRegularExpression(iRegExSearchParams,check,a_SearchParams())
				Else
					iNbr=0
					Debug "NO EXPRESSION"
				EndIf

				For i=0 To Count-1
					For iIndex = 0 To iNbr-1
						If FindString(LCase(Consts(i)), LCase(a_SearchParams(iIndex)), 1)
							iCount + 1
						EndIf
					Next

					If iCount = iNbr
						match_counter+1
						AddGadgetItem(#ListIcon_0,-1, Str(match_counter) +#LF$+Consts(i))
					EndIf
					iCount = 0
					If text<>GetGadgetText(#String_Search)
						;check=""
						Debug "Abort..."
						Break
					EndIf
				Next

				FreeArray(a_SearchParams())
				If i=Count
					StatusBarText(#StatusBar_Window_0,0,"Found " + FormatNumber(match_counter,0 ) + " Matches for '"+check+"'")
				Else
					StatusBarText(#StatusBar_Window_0,0,"Search aborted")
				EndIf

				If GetGadgetText(#String_Search) = "" ; search term is empty clear listview
					match_counter=0
					ClearGadgetItems(#ListIcon_0)
					StatusBarText(#StatusBar_Window_0,1,"No Search Term")
				Else
					StatusBarText(#StatusBar_Window_0,1,"ok.")
				EndIf
			EndIf
			SendMessage_(GadgetID(#ListIcon_0),#WM_SETREDRAW,#True,#True)
			Debug "."

		EndIf
		match_counter=0
		SetActiveGadget(#String_Search)
	ForEver
	FreeRegularExpression(iRegExSearchParams)

EndProcedure

Procedure OpenWindowMain()

	If OpenWindow(#Window_0, 450, 32, 497, 573, title$, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
		If CreateStatusBar(#StatusBar_Window_0, WindowID(#Window_0))
			AddStatusBarField(350)
			AddStatusBarField(147)
		EndIf
		ListIconGadget(#ListIcon_0, 0, 0, 497, 505, "Nb", 30, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
		AddGadgetColumn(#ListIcon_0,2,"Constant",300)
		AddGadgetColumn(#ListIcon_0,3,"value",80)
		AddGadgetColumn(#ListIcon_0,4,"hex",80)
		StringGadget(#String_Search, 0, 525, 497, 25, "")
		SetGadgetColor(#ListIcon_0,#PB_Gadget_BackColor,$80FFFF)
		SetGadgetColor(#String_Search,#PB_Gadget_BackColor, $1FF6F5)
		SetActiveGadget(#String_Search)
		SetGadgetText(#String_Search, "#PB_")
	EndIf
EndProcedure

;--------------------- MAIN ------------------

ReadConstants()

do_list()

OpenWindowMain()

SetWindowTitle(#Window_0,title$ +  " " + FormatNumber(Count) + " Constants Found ")

Define mythread=CreateThread(@check(),@sSearchParam)

BindGadgetEvent(#ListIcon_0, @sSetConstantClipBoardData(), #PB_EventType_LeftDoubleClick)

Repeat
	Event = WaitWindowEvent()
	Select Event
	Case #PB_Event_CloseWindow
		EventWindow = EventWindow()
		If EventWindow = #Window_0
			If mythread
				bTheadEnd =#True
			EndIf
			Count=0
			CloseWindow(#Window_0)
			Break
		EndIf
	EndSelect
ForEver
End
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: pure constant finder

Post by Zebuddi123 »

Hi Micheal Yes the search is better than mine :) so I will look at your code to see how your implementation is set out something to learn from :) Thanks

Change it, post it, make it better :mrgreen: :lol:

Zebuddi. :)
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: pure constant finder

Post by Michael Vogel »

Simplified the code a little bit (does not handle combined searching for names and values), hopefully it is okay for most of you...

Anyhow there's a nasty problem when closing the window - sometimes the program crashes because the thread has not closed before the gadgets have been pushed from memory...
...there's something going on with ThreadWait() which seems to wait only some milliseconds even when the thread is still active ?

Code: Select all

; Define

	EnableExplicit
	CompilerIf #PB_Compiler_Thread = 0
		MessageRequester(":(", "Enable 'Thread Safe' in the compiler options.")
		End
	CompilerEndIf

	#Q=#DOUBLEQUOTE$

	Enumeration
		#Win
		#Search
		#Status
		#List
	EndEnumeration

	Enumeration
		#SearchName
		#SearchValue
		#SearchHex
	EndEnumeration

	Global Dim Consts.s(0)
	Global Dim Search.s(#SearchHex,0)
	Global Count.i

	Global ThreadActive
	Global ThreadId

	; /!\ ersetzen durch dynamischen bzw. relativen Pfad?
	Global ToolCompiler.s=#PB_Compiler_Home+"compilers\pbcompiler.exe"
	Global CacheFile.s=GetPathPart(ProgramFilename())+"Constants.lst"

	; DeleteFile(CacheFile)
	; Debug CacheFile

; EndDefine

Procedure.s GetLastErrorAsText()

	Protected message.s

	CompilerIf #PB_Compiler_OS = #PB_OS_Windows
		Protected LastError=GetLastError_(), *ErrorBuffer
		If LastError=#ERROR_NO_IMPERSONATION_TOKEN
			LastError=0
		ElseIf 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 = "OSX :("
	CompilerEndIf

	ProcedureReturn message

EndProcedure
Procedure RetrieveConstants(handle,List o.s())

	Protected s.s,t.s,c.s
	Protected i,z
	Protected len
	Protected *c.ascii

	If ProgramRunning(handle)
		WriteProgramStringN(handle,"CONSTANTLIST",#PB_Ascii)

		While s<>"OUTPUT"+#TAB$+"COMPLETE" And Left(s,5)<>"ERROR"
			If AvailableProgramOutput(handle)
				s=ReadProgramString(handle,#PB_Ascii)
				If s<>"" And s<>"OUTPUT"+#TAB$+"COMPLETE" And Left(s,5)<>"ERROR" And FindString("0123456789",Mid(s,2,1))=0

					If FindString("01",Mid(s,1,1))
						s = "#"+Mid(s,2,Len(s)-1)
						ReplaceString(s,#TAB$,"=",#PB_String_InPlace)
						s = ReplaceString(s,"#=","#")

					ElseIf FindString("2",Mid(s,1,1))
						t=s
						s="#"+StringField(t,2,#TAB$)

						z=#True
						Select FindString(s,"$")
						Case 4
							If s="#HT$"
								z=#False : s+" = Chr(9)"
							ElseIf s="#LF$"
								z=#False : s+" = Chr(10)"
							ElseIf s="#CR$"
								z=#False : s+" = Chr(13)"
							EndIf

						Case 5
							If s="#TAB$"
								z=#False : s+" = Chr(9)"
							EndIf

						Case 6
							If s="#CRLF$"
								z=#False : s+" = Chr(13) + Chr(10)"
							ElseIf s="#LFCR$"
								z=#False : s+" = Chr(10) + Chr(13)"
							EndIf

						Case 8
							If s="#DQUOTE$"
								z=#False : s+" = Chr(34)"
							EndIf

						Case 13
							If s="#DOUBLEQUOTE$"
								z=#False : s+" = Chr(34)"
							EndIf

						EndSelect

						If z
							c=StringField(t,3,Chr(9))
							*c=@c
							len=Len(c)
							While len
								If *c\a<' ' Or *c\a>'~'
									z=#False
									len=0
								Else
									len-1
									*c+1;	Ascii
								EndIf
							Wend

							If z
								s + " = " + #DQUOTE$ + StringField(t,3,#TAB$) + #DQUOTE$
							Else
								s + " ="
								Protected temp$ = StringField(t,3,#TAB$)
								For i = 0 To Len(c)-1
									s + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
								Next
							EndIf
							s = RTrim(s,"+")
						EndIf
					EndIf

					s=Trim(s)
					If s
						AddElement(o())
						o()=s
					EndIf

				EndIf
			EndIf

		Wend

	EndIf

	ProcedureReturn ListSize(o())

EndProcedure
Procedure ReadConstants()

	Protected s.s
	Protected handle.i
	Protected NewList o.s()

	If FileSize(CacheFile) = -1
		handle=RunProgram(ToolCompiler,"/STANDBY","",#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)

		If handle
			While s<>"READY" And Left(s,5)<>"ERROR"
				If AvailableProgramOutput(handle)
					s=ReadProgramString(handle,#PB_Ascii)
				EndIf
			Wend

			SortList(o(),#PB_Sort_Ascending|#PB_Sort_NoCase)
			Debug RetrieveConstants(handle,o())
			If CreateFile(0, CacheFile)
				ForEach o()
					WriteStringN(0,o())
				Next
				CloseFile(0)
			EndIf

			WriteProgramStringN(handle,"END",#PB_Ascii)
			WaitProgram(handle,5000)
			CloseProgram(handle)
			FreeList(o())

		Else
			MessageRequester(":(", "Could not create 'constant.lst'..." +#CR$+GetLastErrorAsText())
			End

		EndIf
	EndIf


	Protected p.i
	Protected Name.s
	Protected Value.s
	Protected Hex.s
	; Protected max,min

	If ReadFile(0,CacheFile)
		While Eof(0)=0
			s=ReadString(0,ReadStringFormat(0))
			p=FindString(s,"=")
			ReDim Consts(Count)
			ReDim Search(#SearchHex,Count)
			Name=Left(s,p-1)
			s=Trim(Mid(s,p+1))
			If PeekA(@s)='"'
				Value=Trim(s,#Q)
				Hex="-"
			Else
				Value=s
				; p=Val(s) : If p>max : max=p : EndIf : If p<min : min=p : EndIf
				Hex=Hex(Val(s),#PB_Long)
			EndIf
			Consts(Count)=Name+#LF$+Value+#LF$+"0x"+Hex
			Search(#SearchName,Count)=LCase(Name)
			Search(#SearchValue,Count)=Value
			Search(#SearchHex,Count)=Hex
			Count+1
		Wend
		CloseFile(0)
		; Debug max
		; Debug min

	Else
		MessageRequester(":(", "Constant list file not available..."+#CR$+GetLastErrorAsText())
		End

	EndIf

EndProcedure

Procedure SetConstantClipBoardData()

	Protected n

	n=GetGadgetState(#List)

	If n<>-1
		StatusBarText(#Status,1,"Copying...")
		SetClipboardText(GetGadgetItemText(#List,n,1)+" = "+GetGadgetItemText(#List,n,2))
		Delay(200)
		StatusBarText(#Status,1,"Copied to Clipboard")
	EndIf

EndProcedure
Procedure Eliza(nil)

	Protected i
	Protected match_counter.i, initgadget=0, bFirstRun.b
	Protected ExSearch.s

	Protected s.s
	Protected SearchText.s
	Protected SearchValue.s
	Protected LastSearch.s
	Protected SearchMode
	Protected SearchResult

	ThreadActive=#True

	LastSearch="*"

	While ThreadActive

		Delay(100)
		If LastSearch<>GetGadgetText(#Search)

			Repeat
				s=GetGadgetText(#Search);					Killing Thread Crash /!\
				If ThreadActive
					SearchText=Trim(s)
					Delay(250)
				EndIf
			Until s=GetGadgetText(#Search)

			LastSearch=s

			SearchMode=#SearchName
			If SearchText="0" Or Val(SearchText)
				SearchMode=#SearchValue
			ElseIf Left(SearchText,1)="$" Or LCase(Left(SearchText,1))="x"
				s=Mid(SearchText,2)
				SearchMode=#SearchHex
			ElseIf LCase(Left(SearchText,2))="0x"
				s=Mid(SearchText,3)
				SearchMode=#SearchHex
			EndIf

			If SearchMode=#SearchHex
				If s="0" Or Val("$"+s)
					SearchText=s
				Else
					SearchMode=#SearchName
				EndIf
			EndIf

			SendMessage_(GadgetID(#List),#WM_SETREDRAW,#False,0)
			ClearGadgetItems(#List)

			If SearchText
				StatusBarText(#Status,0,"Searching for '"+SearchText+"'...")
				StatusBarText(#Status,1, "Please wait...")

				Debug "'"+SearchText+"'"

				If SearchText
					ExSearch=LCase(SearchText)

					For i=0 To Count-1

						If SearchMode
							SearchResult=Bool(Search(SearchMode,i)=ExSearch)
						Else
							SearchResult=FindString(Search(SearchMode,i),ExSearch,1)
						EndIf

						If SearchResult
							match_counter+1
							AddGadgetItem(#List,-1,Str(match_counter)+#LF$+Consts(i))
						EndIf

						If i&255=0 And (ThreadActive=#Null Or LastSearch<>GetGadgetText(#Search))
							Debug "Abort..."
							Break
						EndIf
					Next

				Else
					Debug "NO EXPRESSION"
				EndIf


				If i=Count
					StatusBarText(#Status,0,"Found " + Str(match_counter) + " Matches for '"+SearchText+"'")
				Else
					StatusBarText(#Status,0,"Search aborted")
				EndIf

				If GetGadgetText(#Search) = "" ; search term is empty clear listview
					match_counter=0
					ClearGadgetItems(#List)
					StatusBarText(#Status,1,"No Search Term")
				Else
					StatusBarText(#Status,1,"ok.")
				EndIf
			EndIf
			SendMessage_(GadgetID(#List),#WM_SETREDRAW,#True,#True)
			; Debug "."

		EndIf
		match_counter=0
		SetActiveGadget(#Search)
	Wend

EndProcedure

Procedure Main()

	ReadConstants()
	OpenWindow(#Win,200,100,540,555,"Purebasic Constants",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
	If CreateStatusBar(#Status,WindowID(#Win))
		AddStatusBarField(360)
		AddStatusBarField(180)
	EndIf
	ListIconGadget(#List,0,0,540,500,"#",30,#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
	AddGadgetColumn(#List,2,"Constant Name",260)
	AddGadgetColumn(#List,3,"Value",120)
	AddGadgetColumn(#List,4,"Hex",100)
	StringGadget(#Search,1,503,538,25,"")
	SetGadgetColor(#List,#PB_Gadget_BackColor,#White)
	;SetGadgetColor(#Search,#PB_Gadget_BackColor,#white)
	SetActiveGadget(#Search)
	SetGadgetText(#Search, "#PB_")

	ThreadId=CreateThread(@Eliza(),#Null)
	BindGadgetEvent(#List,@SetConstantClipBoardData(),#PB_EventType_LeftDoubleClick)

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				If EventType()=#PB_EventType_Focus
					SendMessage_(GadgetID(#Search),#EM_SETSEL,0,-1)
				EndIf
				
		Case #PB_Event_CloseWindow
			If ThreadId
				ThreadActive=#Null
				WaitThread(ThreadId,500)
			EndIf
			Break
		EndSelect

	ForEver

EndProcedure
Main()

Post Reply