viewtopic.php?t=80739
I found the program from Mesa is very useful. AZJIO, Axolotl has helped to make it better. Many thanks to them.
As I would like to also know the procedure where the varible locates, I attempt to add this feature. Since I do not know Regular expression, I use pointer/string function to write the code.
Attached is the code. hope someone would found it useful. It will support Procedure/Macro/Enumeration/Structure/with. It does not support one line Macro defination. Any suggestion/idea for improvement are welcome.
Code: Select all
;-Top---------------------
;{ File : FindAllReferences[Win].pb
; ----------------------------------------------------------------------------
;
; Description: Find all references of a variable
; OS: Windows
; English-Forum:
; French-Forum:
; German-Forum: http://www.purebasic.fr/german/viewtopic.php?f=8&t=28292
; ----------------------------------------------------------------------------
; MIT License
;
; Copyright (c) 2015 Kiffi
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;
; ----------------------------------------------------------------------------
; Change Log :
; 2023-02-12 : New Additions from Mesa, AZJIO, Axolotl
;
; English-Forum: https://www.purebasic.fr/english/viewtopic.php?t=80739
;
; Change Details by Axolotl
; - Integrated ColorListIconGadget.pb from AZJIO and modified
; - Add a #PB_Compiler_Debugger mode (for development)
; - New Structure of the entire application
; - harmonize the different coding styles (still something to do)
; - Changing the coloring of the selected Names
; - counting all appearances of the SelectedWord (quick and dirty)
;
; ----------------------------------------------------------------------------
; Change Details by Allen
; Basically keep Input and Output procedures
; Rewrite prase method use pointer/String function instead of Regular expressions
; Include information of Procedure/Macro/Enumeration/Structure/With where the SELECTED WORD is found
;}
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
CompilerError "Windows Only!"
CompilerEndIf
EnableExplicit
;-Constant
CompilerIf #PB_Compiler_Debugger
#SelectedWordMarker$ = "|"
#SelectedWordMarker=124 ;
CompilerElse
#SelectedWordMarker$ = Chr(1) ; not used in source codes
#SelectedWordMarker=1
CompilerEndIf
;-Enumeration
Enumeration KeyWordGroup 1
#Procedure ; must be first position
#Macro
#Enumeration
#Structure
#With
#LastKeyWord ; must be last position
EndEnumeration
Enumeration ; Windows
#frmMain
EndEnumeration
Enumeration ; Gadgets
#frmMain_References
EndEnumeration
Enumeration ; Menu-/Toolbaritems
#frmMain_Shortcut_Escape_Event
EndEnumeration
;-Structure
Structure SelectWords
SelWord$
LenSelWord.i
Array LCase.i(1)
Array UCase.i(1)
EndStructure
Structure ProgramLines
Line$
Array MatchLine.i(#LastKeyWord-1)
Show.b
Type.b
EndStructure
;-Global Variables
Global.i MaxLines=5000 ; max lines in the PB files
Global.i CountSelectedWords ; new, because we want to know all references (not only the lines)
Global.i CountSelectedLines
Global.i CountLines
Global Dim Lines.ProgramLines(MaxLines); content start form 1
Global Dim CharType.b(65535)
Global SelectWord.SelectWords
Global.s Word$=Space(100)
Global Dim Colors(1)
Procedure InitCharType()
Enumeration CharType 1 ;
#Digit
#SmallLetter
#CapticalLetter
#UnderScore
EndEnumeration
Protected.i i
For i=Asc("0") To Asc("9")
CharType(i)=#Digit
Next
For i=Asc("A") To Asc("Z")
CharType(i)=#CapticalLetter
Next
For i=Asc("a") To Asc("z")
CharType(i)=#SmallLetter
Next
CharType(Asc("_"))=#UnderScore
CharType(Asc("#"))=#UnderScore
EndProcedure
Procedure InitKeyWord()
Protected.i i
Global.i TotalKeyQty=13
Global Dim KeyWord$(TotalKeyQty), Dim KeyType.b(TotalKeyQty)
Protected.s KeyNames$="Procedure/Macro/Enumeration/Structure/With/ProcedureC/ProcedureCDLL/ProcedureDLL/"+
"EndProcedure/EndMacro/EndEnumeration/EndStructure/EndWith/"
For i=1 To TotalKeyQty
KeyWord$(i)=StringField(KeyNames$,i,"/")
Next
; KeyType must match with KeyWord$
KeyType(1)=#Procedure
KeyType(2)=#Macro
KeyType(3)=#Enumeration
KeyType(4)=#Structure
KeyType(5)=#With
KeyType(6)=#Procedure
KeyType(7)=#Procedure
KeyType(8)=#Procedure
KeyType(9)=#Procedure
KeyType(10)=#Macro
KeyType(11)=#Enumeration
KeyType(12)=#Structure
KeyType(13)=#With
EndProcedure
Procedure.i Find1stName(*Start.unicode)
Protected.unicode *Dest
*Dest=@Word$
Repeat
If *Start\u=0 Or CharType(*Start\u)=0
*Dest\u=0
ProcedureReturn #True
Else
*Dest\u=*Start\u
*Start+2
*Dest+2
EndIf
ForEver
EndProcedure
Procedure GetScintillaInfo()
Global PbIdeHandle, ScintillaHandle ,CursorLine
PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
If PbIdeHandle = 0 : End : EndIf
ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
If ScintillaHandle = 0 : End : EndIf
EndProcedure
Procedure.s GetWordUnderCursor()
Protected.s WordUnderCursor, ClipBoardContent
Protected.i Cursor,Start,Stop
SendMessage_(ScintillaHandle,#SCI_BEGINUNDOACTION,#Null,#Null)
If SendMessage_(ScintillaHandle,#SCI_GETSELECTIONEMPTY,#Null,#Null)
Cursor.i = SendMessage_(ScintillaHandle,#SCI_GETCURRENTPOS,#Null,#Null)
Start.i = SendMessage_(ScintillaHandle,#SCI_WORDSTARTPOSITION, Cursor, #True)
Stop.i = SendMessage_(ScintillaHandle,#SCI_WORDENDPOSITION, Cursor, #True)
SendMessage_(ScintillaHandle,#SCI_SETSEL, Start, Stop)
EndIf
ClipBoardContent= GetClipboardText()
SendMessage_(ScintillaHandle,#SCI_COPY,#Null,#Null)
WordUnderCursor=GetClipboardText()
SetClipboardText(ClipBoardContent)
SendMessage_(ScintillaHandle,#SCI_ENDUNDOACTION,#Null,#Null)
ProcedureReturn WordUnderCursor
EndProcedure
Procedure.s GetScintillaText()
Protected ReturnValue.s
Protected length
Protected buffer
Protected processId
Protected hProcess
Protected result
length = SendMessage_(ScintillaHandle, #SCI_GETLENGTH, 0, 0)
If length
length + 2
buffer = AllocateMemory(length)
If buffer
SendMessageTimeout_(ScintillaHandle, #SCI_GETCHARACTERPOINTER, 0, 0, #SMTO_ABORTIFHUNG, 2000, @result)
If result
GetWindowThreadProcessId_(ScintillaHandle, @processId)
hProcess = OpenProcess_(#PROCESS_ALL_ACCESS, #False, processId)
If hProcess
ReadProcessMemory_(hProcess, result, buffer, length, 0)
ReturnValue = PeekS(buffer, -1, #PB_UTF8)
CloseHandle_(hProcess) ; <-- Axolotl, added acc. to MSDN
EndIf
EndIf
EndIf
FreeMemory(buffer)
EndIf
ProcedureReturn ReturnValue
EndProcedure
Procedure ScintillaText2Lines(*ScintillaText)
Protected.s Line$=Space(5000)
Protected.i i
Protected.unicode *Start,*Dest,*CurPos
CountLines=0
*CurPos=*ScintillaText
Repeat
Repeat ; skip space or Tap at begin of line
If *CurPos\u<>$20 And *CurPos\u<>#TAB And *CurPos\u<>#FF And *CurPos\u<>#VT
Break
EndIf
*CurPos+2
ForEver
*Dest=@Line$
Repeat
If *CurPos\u=0
*Dest\u=0
Break
EndIf
If *CurPos\u=#CR
*CurPos+4
*Dest\u=0
Break
EndIf
*Dest\u=*CurPos\u
*CurPos+2
*Dest+2
ForEver
CountLines+1
If CountLines>MaxLines
MaxLines+1000
ReDim Lines.ProgramLines(MaxLines)
EndIf
Lines(CountLines)\Line$=Line$
If *CurPos\u=0
Break
EndIf
ForEver
CompilerIf #PB_Compiler_Debugger
For i=0 To CountLines
Debug Str(i)+":"+Lines(i)\Line$
Next
CompilerEndIf
ProcedureReturn CountLines-1
EndProcedure
Procedure ConvSelWord(SelWord$, *SelWord.SelectWords)
Protected.i i
*SelWord\SelWord$=SelWord$
*SelWord\LenSelWord=Len(SelWord$)
ReDim *SelWord\LCase(*SelWord\LenSelWord)
ReDim *SelWord\UCase(*SelWord\LenSelWord)
For i=1 To *SelWord\LenSelWord
*SelWord\UCase(i)=Asc(UCase(Mid(SelWord$,i,1)))
*SelWord\LCase(i)=Asc(LCase(Mid(SelWord$,i,1)))
Next
EndProcedure
Procedure.s SearchRplc(*Start.unicode,*SelWord.SelectWords)
Protected.unicode *Dest,*Tmp
Protected.s Result$=Space(1000)
Protected.i i,B4Char,AFChar,Found
Found=#False
*Dest=@Result$
*Start-2
Repeat
*Start+2
Select *Start\u
Case 0
*Dest\u=0
If Found
ProcedureReturn Result$
Else
ProcedureReturn ""
EndIf
Case 34
Repeat
*Dest\u=*Start\u
*Start+2
*Dest+2
Until *Start\u=34 Or *Start\u=0
*Dest\u=*Start\u
If *Start\u=0
If Found
ProcedureReturn Result$
Else
ProcedureReturn ""
EndIf
EndIf
*Dest+2
Continue
Case Asc(";")
If Found
Repeat
*Dest\u=*Start\u
*Start+2
*Dest+2
Until *Start\u=0
*Dest\u=0
ProcedureReturn Result$
Else
ProcedureReturn ""
EndIf
Case *SelWord\UCase(1)
*Tmp=*Start+2
For i=2 To *SelWord\LenSelWord
If *Tmp\u=*SelWord\UCase(i) Or *Tmp\u=*SelWord\LCase(i)
*Tmp+2
Else
Break
EndIf
Next
If i>*SelWord\LenSelWord ; found
AFChar=*Tmp\u
If AFChar<>Asc("$") And CharType(AFChar)=0
*Tmp=*Start-2
B4Char=*Tmp\u
If B4Char<>Asc("*") And CharType(B4Char)=0
Found=#True
*Dest\u=#SelectedWordMarker
*Dest+2
For i=1 To *SelWord\LenSelWord
*Dest\u=*Start\u
*Dest+2
*Start+2
Next
*Dest\u=#SelectedWordMarker
*Dest+2
*Start-2
CountSelectedWords+1
Continue
EndIf
EndIf
EndIf
*Dest\u=*Start\u
*Dest+2
Continue
Case *SelWord\LCase(1)
*Tmp=*Start+2
For i=2 To *SelWord\LenSelWord
If *Tmp\u=*SelWord\UCase(i) Or *Tmp\u=*SelWord\LCase(i)
*Tmp+2
Else
Break
EndIf
Next
If i>*SelWord\LenSelWord ; found
AFChar=*Tmp\u
If AFChar<>Asc("$") And CharType(AFChar)=0
*Tmp=*Start-2
B4Char=*Tmp\u
If B4Char<>Asc("*") And CharType(B4Char)=0
Found=#True
*Dest\u=#SelectedWordMarker
*Dest+2
For i=1 To *SelWord\LenSelWord
*Dest\u=*Start\u
*Dest+2
*Start+2
Next
*Dest\u=#SelectedWordMarker
*Dest+2
*Start-2
CountSelectedWords+1
Continue
EndIf
EndIf
EndIf
*Dest\u=*Start\u
*Dest+2
Continue
Default
*Dest\u=*Start\u
*Dest+2
EndSelect
ForEver
EndProcedure
Procedure Prase4Proc()
#IdentNo=4 ; no of space idented inside Procddure/Macro
Protected.i i,J,K
;Protected.i CurrentProcL,CurrentMacroL,MaxProc=100, MaxMacro=20, TotalMacro=0,TotalProc=0
Protected.i Status=%11,TmpStatus
Protected.i KeyType, Dim KeyTypeTotal(#LastKeyWord-1)
Protected.s Ident$,IdentSpace$=Space(#IdentNo)
Protected.i Dim CurrentKeyWordLine(#LastKeyWord)
Protected.i GroupStartLine,GroupEndLine
Protected.b GroupLineType
Ident$=""
For i=1 To CountLines
For J=1 To TotalKeyQty
If Find1stName(@Lines(i)\Line$)
If Word$=KeyWord$(j)
Break
EndIf
EndIf
Next
If J>TotalKeyQty ; no match. line w/o key name
For K=1 To #LastKeyWord-1
Lines(i)\MatchLine(K)=CurrentKeyWordLine(K) ; KeyName group start line of current line
Next
Lines(i)\Type=0
Lines(i)\Line$=Ident$+Lines(i)\Line$
Continue
EndIf
KeyType=KeyType(j)
Select J
Case 1, 6 To 8 ; Procedure
For k=#Procedure To #LastKeyWord-1; check if any keyword group is opened, it is an error
If CurrentKeyWordLine(K)<>0 ; <>0 means group is opened
If MessageRequester("ERROR"+Str(K),KeyWord$(K)+" not yet closed. "+#CRLF$+" Line "+ Str(i)+" will be ignored."+
#CRLF$+Lines(i)\Line$,#PB_MessageRequester_Error |#PB_MessageRequester_YesNo)<>#PB_MessageRequester_Yes
End
EndIf
EndIf
Next
Lines(i)\Line$=Ident$+Lines(i)\Line$
Lines(i)\Type=KeyType
Ident$+IdentSpace$
CurrentKeyWordLine(KeyType)=i
KeyTypeTotal(KeyType)+1
Case 2 To 5 ; Macro to With
For k=#Procedure+1 To #LastKeyWord-1
If CurrentKeyWordLine(K)<>0
;Error, ignore current line
If MessageRequester("ERROR"+Str(K),KeyWord$(K)+" opened and not yet closed. "+#CRLF$+" Line "+ Str(i)+" will be ignored."+
#CRLF$+Lines(i)\Line$,#PB_MessageRequester_Error |#PB_MessageRequester_YesNo)<>#PB_MessageRequester_Yes
End
EndIf
EndIf
Next
Lines(i)\Line$=Ident$+Lines(i)\Line$
Lines(i)\Type=KeyType
Ident$+IdentSpace$
CurrentKeyWordLine(KeyType)=i
KeyTypeTotal(KeyType)+1
Case 9 ; EndProcedure
If CurrentKeyWordLine(KeyType)<>0; procedure opened
For K=#Procedure+1 To #LastKeyWord-1
If CurrentKeyWordLine(K)<>0
Break
EndIf
Next
If K=#LastKeyWord ; all other groups closed
Ident$=Left(Ident$,Len(Ident$)-#IdentNo)
Lines(i)\Type=0
Lines(CurrentKeyWordLine(KeyType))\MatchLine(KeyType)=i
Lines(i)\MatchLine(KeyType)=CurrentKeyWordLine(KeyType) ; Group start Line
CurrentKeyWordLine(KeyType)=0
Lines(i)\Line$=Ident$+Lines(i)\Line$
Continue
Else
If MessageRequester("ERROR"+Str(K),KeyWord$(K)+" opened and not yet closed. "+#CRLF$+" Line "+ Str(i)+" will be ignored."+
#CRLF$+Lines(i)\Line$,#PB_MessageRequester_Error |#PB_MessageRequester_YesNo)<>#PB_MessageRequester_Yes
End
EndIf
EndIf
Else
If MessageRequester("ERROR"+Str(#Procedure),KeyWord$(KeyType)+" not yet opened. "+#CRLF$+" Line "+ Str(i)+" will be ignored."+
#CRLF$+Lines(i)\Line$,#PB_MessageRequester_Error |#PB_MessageRequester_YesNo)<>#PB_MessageRequester_Yes
End
EndIf
EndIf
For K=1 To #LastKeyWord-1; treat as normal line
Lines(i)\MatchLine(J)=CurrentKeyWordLine(K)
Next
Lines(i)\Type=0
Lines(i)\Line$=Ident$+Lines(i)\Line$
Continue
Case 10 To 13 ; EndMacro - EndWith
If CurrentKeyWordLine(KeyType)<>0
For K=#Procedure+1 To #LastKeyWord-1 ; check if other group is opened (Procedure group can be open or clossed)
If CurrentKeyWordLine(K)<>0
If K=KeyType
Continue
Else
Break
EndIf
EndIf
Next
If K=#LastKeyWord
Ident$=Left(Ident$,Len(Ident$)-#IdentNo)
Lines(i)\Type=0
Lines(i)\MatchLine(KeyType)=CurrentKeyWordLine(KeyType) ; Group start Line
Lines(CurrentKeyWordLine(KeyType))\MatchLine(KeyType)=i
CurrentKeyWordLine(KeyType)=0
Lines(i)\Line$=Ident$+Lines(i)\Line$
Continue
EndIf
Else
K=KeyType
EndIf
If MessageRequester("ERROR"+Str(K),KeyWord$(K)+" Not yet opened. "+#CRLF$+" Line "+ Str(i)+" will be ignored."+
#CRLF$+Lines(i)\Line$,#PB_MessageRequester_Error |#PB_MessageRequester_YesNo)<>#PB_MessageRequester_Yes
End
EndIf
For K=1 To #LastKeyWord-1
Lines(i)\MatchLine(J)=CurrentKeyWordLine(K) ; KeyWord start line current line belong to
Next
Lines(i)\Type=0
Lines(i)\Line$=Ident$+Lines(i)\Line$
Continue
EndSelect
Next
CompilerIf #PB_Compiler_Debugger
OpenConsole()
For i=#Procedure To #LastKeyWord-1
PrintN("Total "+Str(KeyTypeTotal(i))+#TAB$+KeyWord$(i))
Next
PrintN("")
PrintN("Line"+#TAB$+"Type"+#TAB$+"1"+#TAB$+"2"+#TAB$+"3"+#TAB$+"4"+#TAB$+"5")
PrintN("------------------------------------------------------------------------------------------")
For i=1 To CountLines
Print(Str(i)+#TAB$+Str(Lines(i)\Type)+#TAB$)
For j=#Procedure To #LastKeyWord-1
Print(Str(Lines(i)\MatchLine(J))+#TAB$)
Next
PrintN(Lines(i)\Line$)
Next
CompilerEndIf
EndProcedure
Procedure LookForWordUnderCursor(SelectedWord.s)
Protected.i i,j,TotalProc,CurrentProcL,ProcClosed
Protected.s selWord,Line$
Protected.i GroupStartLine,GroupEndLine
Protected.b GroupLineType
;Find SelWord
ProcClosed=#True
CurrentProcL=0 ; start form 1
CountSelectedWords = 0 ; init for new search
CountSelectedLines=0
For i =1 To CountLines
CompilerIf #PB_Compiler_Debugger
Debug "Original ("+Str(i)+"):"+Lines(i)\Line$
CompilerEndIf
Line$=SearchRplc(@Lines(i)\Line$,@SelectWord)
If Line$<>""
CompilerIf #PB_Compiler_Debugger
Debug "Found and Converted ("+Str(i)+"):"+Line$
CompilerEndIf
CountSelectedLines+1
;MessageRequester("Info",Str(CountSelectedLines))
Lines(i)\Line$=Line$
Lines(i)\Show=#True
For j=#Procedure To #LastKeyWord-1
GroupStartLine=Lines(i)\MatchLine(J)
Lines(GroupStartLine)\Show=#True
GroupLineType= Lines(GroupStartLine)\Type
GroupEndLine=Lines(GroupStartLine)\MatchLine(GroupLineType)
Lines(GroupEndLine)\Show=#True
Next
EndIf
Next
If CountSelectedWords=0
End
EndIf
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
; XIncludeFile "ColorListIconGadget.pbi" ; I prefer .pbi (instead of .pb)
; ---------------------------------------------------------------------------------------------------------------------
;... Create brushes for painting item background
Structure MYBRUSHES
brushDefault.l
brushSelected.l
EndStructure
Global brush.MYBRUSHES
; brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
brush\brushDefault = GetStockObject_(#WHITE_BRUSH)
Procedure GetCharWidth(gad, c$)
ProcedureReturn SendMessage_(gad, #LVM_GETSTRINGWIDTH, 0, @c$)
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
;Here we add some text to the underlying cell text to store the color info.
; Procedure SetColor(gad, row, column, startp, endp, color)
; Protected text$
; If column
; text$ = GetGadgetItemText(gad, row, column)
; ;Now add the new text.
; text$+#coloredChars_Delimeter+Str(startp)+"\"+Str(endp)+"\"+Str(color)
; SetGadgetItemText(gad,row,text$,column)
; EndIf
; EndProcedure
; ---== MainWindow Procedures ==---------------------------------------------------------------------------------------
Procedure frmMain_SizeWindow_Event()
ResizeGadget(#frmMain_References, #PB_Ignore, #PB_Ignore, WindowWidth(#frmMain) - 16, WindowHeight(#frmMain) - 16)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER) ; last column -> fill the remaining rest
EndProcedure
Procedure frmMain_References_Event()
Protected SelectedLine
SelectedLine = Val(GetGadgetItemText(#frmMain_References, GetGadgetState(#frmMain_References), 0))
If SelectedLine > 0
SendMessage_(ScintillaHandle, #SCI_GOTOLINE, SelectedLine - 1, 0)
SendMessage_(ScintillaHandle, #SCI_ENSUREVISIBLE, SelectedLine - 1, 0)
SetForegroundWindow_(PbIdeHandle)
SetActiveWindow_(PbIdeHandle)
EndIf
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure myWindowCallback(hwnd, msg, wParam, lParam)
Protected Result, *nmhdr.NMHDR, *lvCD.NMLVCUSTOMDRAW, subItemRect.RECT
Protected thisRow, thisCol, idx
Protected t$, text$
; ; ; ; ; ; ; Protected subItemText$, pos, color, c$, nextColor, thisColor
Result = #PB_ProcessPureBasicEvents
;;Dim LVColor(0)
Select msg
Case #WM_NOTIFY
*nmhdr.NMHDR = lParam
*lvCD.NMLVCUSTOMDRAW = lParam
If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#frmMain_References) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
Select *lvCD\nmcd\dwDrawStage
Case #CDDS_PREPAINT
Result = #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
Result = #CDRF_NOTIFYSUBITEMDRAW;
Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
thisRow = *lvCD\nmcd\dwItemSpec
thisCol = *lvCD\iSubItem
If thisCol
;... Define rect for text
subItemRect.RECT\left = #LVIR_LABEL
subItemRect.RECT\top = *lvCD\iSubItem
;... Get the subitem rect
SendMessage_(GadgetID(#frmMain_References), #LVM_GETSUBITEMRECT, thisRow, @subItemRect)
text$ = GetGadgetItemText(#frmMain_References, thisRow, thisCol)
If GetGadgetState(#frmMain_References) = thisRow
;... If item is selected
FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushSelected)
; Colors(1) = GetSysColor_(#COLOR_HIGHLIGHTTEXT) ; the default text
Else
;... If item is not selected
FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushDefault)
; Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT) ; the default text
EndIf
InflateRect_(subItemRect, -2, 0)
For idx = 1 To CountString(text$, #SelectedWordMarker$) + 1
t$ = StringField(text$, idx, #SelectedWordMarker$)
If t$
SetTextColor_(*lvCD\nmcd\hdc, colors(idx & 1))
DrawText_(*lvCD\nmcd\hdc, t$, -1, subItemRect, #DT_END_ELLIPSIS|#DT_VCENTER|#DT_SINGLELINE|#DT_NOPREFIX)
subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, t$)
EndIf
Next idx
Result = #CDRF_SKIPDEFAULT
Else
Result = #CDRF_DODEFAULT
EndIf
EndSelect
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure SetGadgetBorderless(Gadget)
Protected hGad = GadgetID(Gadget)
SetWindowLongPtr_(hGad, #GWL_EXSTYLE, GetWindowLongPtr_(hGad, #GWL_EXSTYLE) & (~#WS_EX_CLIENTEDGE))
ProcedureReturn SetWindowPos_(hGad, 0, 0, 0, 0, 0, #SWP_SHOWWINDOW | #SWP_NOZORDER | #SWP_NOSIZE | #SWP_NOMOVE | #SWP_FRAMECHANGED)
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure main()
Protected WWE ;, idx, pos, le
Protected SelectedWord.s, ScintillaText.s
Protected.i CursorLine,i,j
Protected Dim TotalKeyNameNeeded(#LastKeyWord-1)
Protected.s KeyNameQty$
CompilerIf #PB_Compiler_Debugger
Protected.i Encode
ScintillaText="Procedure Test()"+#CRLF$+
"Protected.i Test1"+#CRLF$+
"#Test =12"+#CRLF$+
"EndProcedure"
SelectedWord="#Test"
If ScintillaText=""
ReadFile(0,"Your Test file name")
SelectedWord="TestWord"
Encode = ReadStringFormat(0)
ScintillaText=ReadString(0,Encode|#PB_File_IgnoreEOL)
CloseFile(0)
EndIf
Debug "Text : "+ScintillaText
CompilerElse
GetScintillaInfo() ;
SelectedWord.s=Trim(GetWordUnderCursor())
If SelectedWord = "" : End : EndIf
ScintillaText.s = GetScintillaText()
If ScintillaText = "" : End : EndIf
CompilerEndIf
InitKeyWord()
InitCharType()
ScintillaText2Lines(@ScintillaText)
Prase4Proc()
ConvSelWord(SelectedWord,SelectWord)
LookForWordUnderCursor(SelectedWord)
For i=1 To CountLines
If Lines(i)\Show
TotalKeyNameNeeded(Lines(i)\Type)+1
EndIf
Next
KeyNameQty$="Display all: '" + SelectedWord + "', Total "+Str(CountSelectedWords)+" found in "+Str(CountSelectedLines)+" lines from "
For i=#Procedure To #LastKeyWord-1
If TotalKeyNameNeeded(i)>0
KeyNameQty$+Str(TotalKeyNameNeeded(i))+" "+KeyWord$(i)+" "
EndIf
Next
;-User Perference
; Listicon Font
Protected.i ListFont
ListFont=LoadFont(#PB_Any, "Microsoft YaHei UI", 11)
; Output Window Size and position
Protected.i OriginX=400,OriginY=120,Width=750,Height=450
; Listicon Text Color
Colors(0) = $FF901E ; the SelectedWord
Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT) ; the default text
; end of user preference
If OpenWindow(#frmMain, OriginX, OriginY, Width, Height, KeyNameQty$,
#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget)
StickyWindow(#frmMain, #True)
SetWindowCallback(@myWindowCallback())
ListIconGadget(#frmMain_References, 8, 8, WindowWidth(#frmMain) - 16, WindowHeight(#frmMain) - 16, "Line ", 96, #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection)
SetGadgetFont(#frmMain_References, FontID(ListFont))
AddGadgetColumn(#frmMain_References, 1, "Reference ", 400)
SetGadgetBorderless(#frmMain_References) ;
For i=1 To CountLines
If Lines(i)\Show
AddGadgetItem(#frmMain_References, -1, Str(i) + #LF$ + Lines(i)\Line$)
EndIf
Next
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER) ; last column -> fill the remaining rest
AddKeyboardShortcut(#frmMain, #PB_Shortcut_Escape, #frmMain_Shortcut_Escape_Event)
BindEvent(#PB_Event_SizeWindow, @frmMain_SizeWindow_Event(), #frmMain)
BindGadgetEvent(#frmMain_References, @frmMain_References_Event())
SetActiveGadget(#frmMain_References)
; Free some memory
ScintillaText.s =""
FreeArray(Lines())
FreeArray(CharType())
Repeat
WWE = WaitWindowEvent()
If (WWE = #PB_Event_Menu And EventMenu() = #frmMain_Shortcut_Escape_Event) Or (WWE = #PB_Event_CloseWindow)
Break ; bye
EndIf
ForEver
DeleteObject_(brush\brushSelected) ; objects created by CreateSolidBrush_() needs this!
EndIf
ProcedureReturn 0 ; not necessary, but looks good/better
EndProcedure
Main()
;----== Bottom of File ==----------------------------------------------------------------------------------------------
Allen