2. Removed Header in ListIconGadget
3. Added the suggested copy option
4. Added regular expressions
Code: Select all
; ----------------------------------------------------------------------------
; 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, Dadlick, ChrisR
;
; English-Forum: https://www.purebasic.fr/english/viewtopic.php?t=80739
;
; History
; - Mesa added search for constants and renewed interest in the tool
; - AZJIO embedded highlight using ColorListIconGadget.pb by srod
; - Axolotl qualitatively rewrote the functionality, making many changes
; - Axolotl added the ability to test without compiling
; - AZJIO added regular expressions
; - ChrisR added a black theme
; - Dadlick started his own tool fork
; - AZJIO added a jump test to a string without compiling
; - AZJIO added a black theme for Header and button
;
; ----------------------------------------------------------------------------
; FindAllReferences
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
CompilerError "Windows Only!"
CompilerEndIf
EnableExplicit
;- Structure
Structure sFoundReference
LineNo.i
Reference.s
Selregexp.s
EndStructure
Structure xywhm
x.i
y.i
w.i
h.i
m.i
EndStructure
;- Enumeration
Enumeration ; Windows
#frmMain
EndEnumeration
Enumeration ; Gadgets
#cmbRex
#btnRex
; #btnClose
#frmMain_References
EndEnumeration
Enumeration ; Menu-/Toolbaritems
#frmMain_Shortcut_Escape_Event
#Shortcut_Ctrl_Shift_C
#Shortcut_Enter
EndEnumeration
;- Constants
CompilerIf #PB_Compiler_Debugger
#SelectedWordMarker$ = "|"
CompilerElse
#SelectedWordMarker$ = Chr(1) ; not used in source codes
CompilerEndIf
; " Line = Trim(Line)"
; " |Line| = Trim(|Line|)"
; --> ReplaceString(text$, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$)
;/-----------------------------------------------------------------------------
;| RGB() as HEX() --> BB GG RR .. i.e. RGB (1, 2, 3) --> 03 02 01
;| RGB() as HEX() --> AA BB GG RR .. i.e. RGBA(1, 2, 3, 4) --> 04 03 02 01
;\
#coloredChars_Delimeter = "{***\"
;- Global
Global ini$ = LSet(ProgramFilename(), Len(ProgramFilename()) - 3) + "ini"
Global centered
Global xywh.xywhm
Global xywh2.xywhm
Global xywh\w = 600
Global xywh\h = 300
Global hHeader
Global frmMain_References
Global CursorLine
Global flgRead
Global PbIdeHandle, ScintillaHandle
Global SelectedWord.s, ScintillaText.s
Global CountSelectedWords ; new, because we want to know all references (not only the lines)
Global NewList FoundReference.sFoundReference()
Global Dim Lines.s(0)
Global BackColor = $3f3f3f
Global ForeColor = $cccccc
Global BackColorHeader = $222222
Global ForeColorHeader = $72ADC0
Global BorderColor = $888888
Global HightLightBrush = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
; Global HightLightBrush = CreateSolidBrush_($423926)
Global BackColorBrush = CreateSolidBrush_(BackColor)
Global BackColorBrushHeader = CreateSolidBrush_(BackColorHeader)
; ; ; Global PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
; ; ; If PbIdeHandle = 0 : End : EndIf
; ; ;
; ; ; Global ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
; ; ; If ScintillaHandle = 0 : End : EndIf
; ---== Procedures ==--------------------------------------------------------------------------------------------------
; AZJIO
Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Protected *memChar, *c.Character, *jc.Character
If Not Asc(String$)
ProcedureReturn ""
EndIf
*c.Character = @String$
*memChar = @TrimChar$
While *c\c
*jc.Character = *memChar
While *jc\c
If *c\c = *jc\c
*c\c = 0
Break
EndIf
*jc + SizeOf(Character)
Wend
If *c\c
String$ = PeekS(*c)
Break
EndIf
*c + SizeOf(Character)
Wend
ProcedureReturn String$
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
; ---------------------------------------------------------------------------------------------------------------------
; For test only
Global classText.s = Space(256)
; Finding a PureBasic Window
Procedure.l enumChildren0(hwnd.l)
If hwnd
GetClassName_(hwnd, @classText, 256)
If classText = "WindowClass_2"
GetWindowText_(hwnd, @classText, 256)
If Left(classText, 9) = "PureBasic"
PbIdeHandle = hwnd
ProcedureReturn 0
EndIf
EndIf
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
; Finding the Scintilla
Procedure.l enumChildren1(hwnd.l)
If hwnd
GetClassName_(hwnd, @classText, 256)
If classText = "Scintilla"
ScintillaHandle = hwnd
ProcedureReturn 0
EndIf
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
; End: For test only
Procedure Initialization()
PbIdeHandle = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
CompilerIf Not #PB_Compiler_Debugger
If PbIdeHandle = 0 : End : EndIf
CompilerEndIf
ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
CompilerIf Not #PB_Compiler_Debugger
If ScintillaHandle = 0 : End : EndIf
CompilerEndIf
; For test only
CompilerIf #PB_Compiler_Debugger
EnumChildWindows_(0, @enumChildren0(), 0)
EnumChildWindows_(PbIdeHandle, @enumChildren1(), 0)
CompilerEndIf
; End: For test only
SelectedWord.s = GetEnvironmentVariable("PB_TOOL_Word")
CompilerIf Not #PB_Compiler_Debugger
If SelectedWord = "" : End : EndIf
CompilerEndIf
ScintillaText.s = GetScintillaText()
CompilerIf Not #PB_Compiler_Debugger
If ScintillaText = "" : End : EndIf
CompilerEndIf
CursorLine = Int(Val(StringField(GetEnvironmentVariable("PB_TOOL_Cursor"), 1, "x")))
; For test only
CompilerIf #PB_Compiler_Debugger
If SelectedWord = ""
; SelectedWord = "Line" ; try one of these
; SelectedWord = "#Line" ; -"- #Line could be in a comment also
SelectedWord = "ScintillaText" ; -"-
EndIf
If ScintillaText = ""
#File = 0
If ReadFile(#File, #PB_Compiler_File)
ScintillaText = ReadString(#File, #PB_UTF8 | #PB_File_IgnoreEOL)
CloseFile(#File)
EndIf
; RunProgram("explorer.exe", "/Select," + #PB_Compiler_File, "")
; ScintillaText = "" + #CRLF$ +
; "#Line = #LF ; #Line could be in a comment also " + #CRLF$ +
; "Procedure Test(*Line) ; pointer *Line " + #CRLF$ +
; "" + #CRLF$ +
; "If SelectedWord = LCase(Tokens(TokenCounter))" + #CRLF$ +
; " AddElement(FoundReference())" + #CRLF$ +
; " FoundReference()\LineNo = LineCounter + 1" + #CRLF$ +
; " Line = Trim(Line)" + #CRLF$ +
; " Line = Mid(Line, 1, Len(Line)-2)" + #CRLF$ +
; " FoundReference()\Reference = Line" + #CRLF$ +
; "EndIf" + #CRLF$ +
; "" ; End of Text
EndIf
CompilerEndIf
; End: For test only
ProcedureReturn 0 ; default (ZERO is returned by default, even if there is no ProcedureReturn)
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
; ChrisR
Procedure CopyClipboard()
Protected text$
PushListPosition(FoundReference())
ForEach FoundReference()
If text$ : text$ + #CRLF$ : EndIf
If Right(FoundReference()\Reference, 2) = #CRLF$
text$ + Left(FoundReference()\Reference, Len(FoundReference()\Reference) - 2)
Else
text$ + FoundReference()\Reference
EndIf
Next
PopListPosition(FoundReference())
If text$
text$ = ReplaceString(text$, #SelectedWordMarker$, "")
SetClipboardText(text$)
Protected Title$ = GetWindowTitle(#frmMain)
SetWindowTitle(#frmMain, Title$ + " (Reference copied To the clipboard)")
Delay(500)
SetWindowTitle(#frmMain, Title$)
EndIf
EndProcedure
; AZJIO
Procedure GoRegExp()
; LINK : https://www.purebasic.fr/english/viewtopic.php?p=595832#p595832
Protected rex, LSize, Pos = 0, i, tmp$
Protected Dim Tokens.s(0)
Protected timer
timer = ElapsedMilliseconds()
ClearGadgetItems(#frmMain_References)
ClearList(FoundReference())
tmp$ = GetGadgetText(#cmbRex)
If Not Asc(tmp$)
ProcedureReturn
EndIf
rex = CreateRegularExpression(#PB_Any, tmp$)
; CountTokens = ExtractRegularExpression(rex, ScintillaText, Tokens()) ; tokenize the line
; Debug ArraySize(Lines())
If rex
If ExamineRegularExpression(rex, ScintillaText)
While NextRegularExpressionMatch(rex)
If Not FindString(RegularExpressionMatchString(rex), #LF$)
AddElement(FoundReference())
FoundReference()\Selregexp = RegularExpressionMatchString(rex)
FoundReference()\LineNo = RegularExpressionMatchPosition(rex)
; Debug FoundReference()\LineNo
EndIf
Wend
EndIf
Else
MessageRequester("Regular expression error", RegularExpressionError())
ProcedureReturn
EndIf
LSize = ListSize(FoundReference())
If LSize > 0
; If LSize > 5000 And MessageRequester("Continue?", "Found" + Str(LSize) + " rows, Continue?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
; ProcedureReturn
; EndIf
Pos = 0
i = 0
SendMessage_(GadgetID(#frmMain_References), #WM_SETREDRAW, 0, 0)
ForEach FoundReference()
While Pos < FoundReference()\LineNo
Pos = FindString(ScintillaText, #LF$, Pos + 1)
If Pos
i + 1
Else
Break
EndIf
; Debug Str(FoundReference()\LineNo) + " " + Str(Pos)
Wend
If i < 1 Or i > ArraySize(Lines())
Continue
EndIf
FoundReference()\LineNo = i
FoundReference()\Reference = Lines(i - 1)
FoundReference()\Reference = LTrimChar(FoundReference()\Reference, " " + #TAB$)
; >> first attempt to mark the selected word in the string
FoundReference()\Reference = ReplaceString(FoundReference()\Reference, FoundReference()\Selregexp, #SelectedWordMarker$ + FoundReference()\Selregexp + #SelectedWordMarker$, #PB_String_NoCase)
AddGadgetItem(#frmMain_References, -1, Str(FoundReference()\LineNo) + #LF$ + FoundReference()\Reference)
Next
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE)
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
SendMessage_(GadgetID(#frmMain_References), #WM_SETREDRAW, 1, 0)
SelectedWord = "regexp"
SetWindowTitle(#frmMain, Str(ElapsedMilliseconds() - timer) + " ms, '" + SelectedWord + "', Found " + " in " + Str(ListSize(FoundReference())) + " Lines")
EndIf
EndProcedure
Procedure LookForWordUnderCursor()
; LINK : http://www.purebasic.fr/english/viewtopic.php?f=12&t=37823
Protected RegexLines, PbRegexTokens
Protected CountLines, LineCounter, CountTokens, TokenCounter
Protected Line.s, selWord.s, stx.s
Protected Dim Tokens.s(0)
RegexLines = CreateRegularExpression(#PB_Any , ".*\r\n")
PbRegexTokens = CreateRegularExpression(#PB_Any, #DOUBLEQUOTE$ + "[^" + #DOUBLEQUOTE$ + "]*" + #DOUBLEQUOTE$ + "|[\*]?[a-zA-Z_]+[\w]*[\x24]?|#[a-zA-Z_]+[\w]*[\x24]?|[\[\]\(\)\{\}]|[-+]?[0-9]*\.?[0-9]+|;.*|\.|\+|-|[&@!\\\/\*,\|]|::|:|\|<>|>>|<<|=>{1}|>={1}|<={1}|=<{1}|={1}|<{1}|>{1}|\x24+[0-9a-fA-F]+|\%[0-1]*|%|'")
CountLines = CountString(ScintillaText, #CRLF$)
CountLines = ExtractRegularExpression(RegexLines, ScintillaText, Lines())
selWord = LCase(SelectedWord) ; keep the original writing
CountSelectedWords = 0 ; init for new search
For LineCounter = 0 To CountLines - 1
Line = Lines(LineCounter)
;Debug "tokenize Line '" + Line + "'"
CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens()) ; tokenize the line
For TokenCounter = 0 To CountTokens - 1
;Debug " check Token '" + Tokens(TokenCounter) + "'"
If selWord = LCase(Tokens(TokenCounter))
AddElement(FoundReference())
FoundReference()\LineNo = LineCounter + 1
Line = Trim(Line)
Line = Mid(Line, 1, Len(Line) - 2) ; remove the #CRLF$
CountSelectedWords + CountString(LCase(Line), selWord) ; <-- count SelectedWord in the codeline
FoundReference()\Reference = Line
Break ; only one line (evenn if there are more than one SelectedWord )
EndIf
Next TokenCounter
Next LineCounter
; because of #Constant or *Pointer
If ListSize(FoundReference()) = 0
For LineCounter = 0 To CountLines - 1
Line = Lines(LineCounter)
CountTokens = ExtractRegularExpression(PbRegexTokens, Line, Tokens())
For TokenCounter = 0 To CountTokens - 1
stx = LCase(Tokens(TokenCounter))
If stx = "#" + selWord Or stx = "*" + selWord
AddElement(FoundReference())
FoundReference()\LineNo = LineCounter + 1
Line = Trim(Line)
Line = Mid(Line, 1, Len(Line) - 2)
CountSelectedWords + CountString(LCase(Line), stx) ; <-- count SelectedWord in the codeline
FoundReference()\Reference = Line
Break
EndIf
Next
Next
CompilerIf Not #PB_Compiler_Debugger
If ListSize(FoundReference()) = 0 : End : EndIf
CompilerEndIf
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
Global Dim Colors(1)
; brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
; brush\brushSelected = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
; brush\brushDefault = GetStockObject_(#WHITE_BRUSH)
; brush\brushSelected = ForeColor
; brush\brushDefault = BackColor
; ---== Color for Default Text and Selected Word ==--------------------------------------------------------------------
; Colors(0) = #Red ; the SelectedWord
Colors(0) = $8080FF ; the SelectedWord
; Colors(1) = GetSysColor_(#COLOR_HIGHLIGHTTEXT) ; the default text
; Colors(1) = GetSysColor_(#COLOR_WINDOWTEXT); the default text
Colors(1) = ForeColor ; the default text
; ---------------------------------------------------------------------------------------------------------------------
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 Resize_Event()
Protected wlv
xywh\w = WindowWidth(#frmMain)
xywh\h = WindowHeight(#frmMain)
ResizeGadget(#cmbRex, #PB_Ignore, #PB_Ignore, xywh\w - 34, 24)
ResizeGadget(#btnRex, xywh\w - 28, #PB_Ignore, #PB_Ignore, #PB_Ignore)
ResizeGadget(#frmMain_References, #PB_Ignore, #PB_Ignore, xywh\w - 6, xywh\h - 33)
; wlv = GetGadgetItemAttribute(#frmMain_References, 0 , #PB_ListIcon_ColumnWidth, 0)
; SetGadgetItemAttribute(#frmMain_References, 0, #PB_ListIcon_ColumnWidth, xywh\w - 6 - wlv, 1)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER) ; last column -> fill the remaining rest
EndProcedure
Procedure JumpToLine(SelectedLine)
Protected Count
; Debug SelectedLine
SendMessage_(ScintillaHandle, #SCI_GOTOLINE, SelectedLine - 1, 0)
Count = SendMessage_(ScintillaHandle, #SCI_LINESONSCREEN, 0, 0) / 2
SendMessage_(ScintillaHandle, #SCI_SETFIRSTVISIBLELINE, SelectedLine - Count - 1, 0)
; Debug Count
; MessageRequester("", Str(Count))
; SendMessage_(ScintillaHandle, #SCI_ENSUREVISIBLE, SelectedLine - 1, 0)
SetForegroundWindow_(PbIdeHandle)
SetActiveWindow_(PbIdeHandle)
EndProcedure
Procedure Event_ListView()
Protected SelectedLine
; Static SelLineOld = -1
; If SelLineOld = SelectedLine
; ProcedureReturn
; EndIf
SelectedLine = Val(GetGadgetItemText(#frmMain_References, GetGadgetState(#frmMain_References), 0))
If SelectedLine > 0
JumpToLine(SelectedLine)
; SelLineOld = SelectedLine
EndIf
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure Callback_Win(hwnd, msg, wParam, lParam)
Protected Result, *nmhdr.NMHDR, *lvCD.NMLVCUSTOMDRAW, subItemRect.RECT, *DrawItem.DRAWITEMSTRUCT, Buffer.s
Protected *pnmcd.NMCUSTOMDRAW, hdi.hd_item
Protected thisRow, thisCol, idx
Protected t$, text$
Protected nNotifyCode
Protected *NMITEM.NMITEMACTIVATE
Protected SelectedLine
Result = #PB_ProcessPureBasicEvents
;;Dim LVColor(0)
Select msg
Case #WM_COMMAND
If lParam = GadgetID(#cmbRex)
nNotifyCode = wParam >> 16 ; HiWord
; If nNotifyCode = #CBN_SELCHANGE
If nNotifyCode = #CBN_SELENDCANCEL
flgRead = 0
EndIf
If nNotifyCode = #CBN_DROPDOWN
flgRead = 1
; GoRegExp()
EndIf
EndIf
Case #WM_NCDESTROY
DeleteObject_(HightLightBrush)
DeleteObject_(BackColorBrush)
DeleteObject_(BackColorBrushHeader)
Case #WM_NOTIFY
*nmhdr.NMHDR = lParam
*lvCD.NMLVCUSTOMDRAW = lParam
*NMITEM.NMITEMACTIVATE = lParam
If *nmhdr\code = #NM_CLICK
If *NMITEM\iItem <> -1
SelectedLine = Val(GetGadgetItemText(#frmMain_References, *NMITEM\iItem, 0))
If SelectedLine > 0
JumpToLine(SelectedLine)
EndIf
EndIf
EndIf
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, -8, 0)
For idx = 1 To CountString(text$, #SelectedWordMarker$) + 1
t$ = StringField(text$, idx, #SelectedWordMarker$)
If t$
SetTextColor_(*lvCD\nmcd\hdc, colors(idx & 1))
SetBkColor_(*lvCD\nmcd\hdc, BackColor)
DrawText_(*lvCD\nmcd\hdc, t$, -1, subItemRect, #DT_END_ELLIPSIS | #DT_VCENTER | #DT_SINGLELINE)
subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, t$)
EndIf
Next idx
Result = #CDRF_SKIPDEFAULT
Else
Result = #CDRF_DODEFAULT
EndIf
EndSelect
EndIf
Case #WM_CTLCOLOREDIT
Buffer = Space(64)
If GetClassName_(GetParent_(lParam), @Buffer, 64)
If Buffer = "ComboBox"
SetTextColor_(wParam, #White)
SetBkMode_(wParam, #TRANSPARENT)
ProcedureReturn BackColorBrush
EndIf
EndIf
Case #WM_DRAWITEM
*DrawItem.DRAWITEMSTRUCT = lParam
If *DrawItem\CtlType = #ODT_COMBOBOX
If IsGadget(wParam)
If *DrawItem\itemID <> -1
If *DrawItem\itemstate & #ODS_SELECTED
FillRect_(*DrawItem\hDC, *DrawItem\rcitem, HightLightBrush)
Else
FillRect_(*DrawItem\hDC, *DrawItem\rcitem, BackColorBrush)
EndIf
SetBkMode_(*DrawItem\hDC, #TRANSPARENT)
SetTextColor_(*DrawItem\hDC, ForeColor)
Text$ = GetGadgetItemText(*DrawItem\CtlID, *DrawItem\itemID)
*DrawItem\rcItem\left + DesktopScaledX(4)
DrawText_(*DrawItem\hDC, Text$, Len(Text$), *DrawItem\rcItem, #DT_LEFT | #DT_SINGLELINE | #DT_VCENTER)
EndIf
EndIf
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure Callback_Header(hWnd, Message, wParam, lParam)
Protected *Header.HD_NOTIFY, SelectedLine, *lvCD.NMLVCUSTOMDRAW
Protected *nmhdr.NMHDR, text$, *pnmcd.NMCUSTOMDRAW, hdi.hd_item
Protected rc2.RECT, hDC
Protected Result = CallWindowProc_(frmMain_References, hWnd, Message, wParam, lParam)
*Header = lParam
*nmhdr = lParam
*lvCD = lParam
Select Message
Case #WM_NOTIFY
Select *Header\hdr\code
Case #HDN_ITEMCLICK
If *Header\hdr\code = #HDN_ITEMCLICK
;ColumnClicked=*Header\iItem
SelectedLine = Val(GetGadgetItemText(#frmMain_References, -1, 0))
If SelectedLine > 0
JumpToLine(SelectedLine)
EndIf
EndIf
Case #NM_CUSTOMDRAW
If *nmhdr\hwndFrom = hHeader
*pnmcd.NMCUSTOMDRAW = lParam
Select *pnmcd\dwDrawStage
Case #CDDS_PREPAINT
result = #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
text$ = GetGadgetItemText(GetDlgCtrlID_(hWnd), -1, *pnmcd\dwItemSpec)
hdi\mask = #HDI_TEXT
hdi\psztext = @text$
hdi\cchtextmax = Len(text$)
SetBkMode_(*pnmcd\hdc, #TRANSPARENT)
FillRect_(*pnmcd\hdc, *pnmcd\rc, BackColorBrushHeader)
; сдвигаем текст после закрашивания прямоуголников
If *lvCD\nmcd\dwItemSpec
InflateRect_(*pnmcd\rc, -8, 0)
text$ = LTrimChar(text$)
Else
InflateRect_(*pnmcd\rc, -4, 0)
EndIf
SetTextColor_(*pnmcd\hdc, ForeColorHeader)
DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_VCENTER | #DT_END_ELLIPSIS)
result = #CDRF_SKIPDEFAULT
EndSelect
EndIf
EndSelect
EndSelect
ProcedureReturn Result
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
; ChrisR
Procedure SetWindowTheme()
Protected Theme.s, cmbRexID, ChildGadget, Buffer.s
If OSVersion() >= #PB_OS_Windows_10
Theme = "DarkMode_Explorer"
Else
Theme = "Explorer"
EndIf
SetWindowTheme_(GadgetID(#frmMain_References), @Theme, 0)
cmbRexID = GadgetID(#cmbRex)
Buffer = Space(64)
If GetClassName_(cmbRexID, @Buffer, 64)
If Buffer = "ComboBox"
If OSVersion() >= #PB_OS_Windows_10 And Theme = "DarkMode_Explorer"
SetWindowTheme_(cmbRexID, "DarkMode_CFD", "Combobox")
Else
SetWindowTheme_(cmbRexID, @Theme, 0)
EndIf
EndIf
EndIf
ChildGadget = GetWindow_(cmbRexID, #GW_CHILD)
If ChildGadget
Buffer = Space(64)
If GetClassName_(ChildGadget, @Buffer, 64)
If Buffer = "ComboBox"
If OSVersion() >= #PB_OS_Windows_10 And Theme = "DarkMode_Explorer"
SetWindowTheme_(ChildGadget, "DarkMode_CFD", "Combobox")
Else
SetWindowTheme_(ChildGadget, @Theme, 0)
EndIf
EndIf
EndIf
EndIf
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 timer
timer = ElapsedMilliseconds()
Initialization() ;
LookForWordUnderCursor()
;--> ini
If OpenPreferences(ini$) ; открываем ini
If PreferenceGroup("set")
xywh\x = ReadPreferenceInteger("x", xywh\x)
xywh\y = ReadPreferenceInteger("y", xywh\y)
xywh\w = ReadPreferenceInteger("w", xywh\w)
xywh\h = ReadPreferenceInteger("h", xywh\h)
EndIf
ClosePreferences()
EndIf
If xywh\x = 0 And xywh\y = 0
centered = #PB_Window_ScreenCentered
EndIf
CopyStructure(@xywh, @xywh2, xywhm)
;- GUI
If OpenWindow(#frmMain, xywh\x, xywh\y, xywh\w, xywh\h,
Str(ElapsedMilliseconds() - timer) + " ms, '" + SelectedWord + "', Found " + CountSelectedWords + " in " + Str(ListSize(FoundReference())) + " Lines",
#PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | centered)
SetWindowColor(#frmMain, BackColor)
StickyWindow(#frmMain, #True)
SetWindowCallback(@Callback_Win())
ComboBoxGadget(#cmbRex, 3, 3, WindowWidth(#frmMain) - 34, 24, #PB_ComboBox_Editable | #CBS_HASSTRINGS | #CBS_OWNERDRAWFIXED)
;ComboBoxGadget(#cmbRex, 3, 3, WindowWidth(#frmMain) - 60, 24, #PB_ComboBox_Editable)
AddGadgetItem(#cmbRex, -1, "(?# Debug, All )\bDebug\b")
AddGadgetItem(#cmbRex, -1, "(?# Debug, real )(?m)^\h*\KDebug\b")
AddGadgetItem(#cmbRex, -1, "(?# WinAPI )(?mi)[a-z][\da-z]*_(?=\h*\()")
AddGadgetItem(#cmbRex, -1, "(?# Link )https?://[\w.:]+/?(?:[\w/?&=.~;\+!*_#%-]+)")
AddGadgetItem(#cmbRex, -1, "(?# Procedure )(?mi)^\h*(?:Procedure[CDL$]{0,5}?(?:\h*\.[abcdfilqsuw])?\h+\K)[A-Za-z_]\w*\h*(?=\()")
AddGadgetItem(#cmbRex, -1, "(?# Macro )(?mi)^\h*Macro\h+\K[A-Za-z_]\w*\h*(?=\()")
AddGadgetItem(#cmbRex, -1, "(?# Var$ )(?<![#@\w])\w+\$")
AddGadgetItem(#cmbRex, -1, "(?# @*Point, whole )[@*]{1,2}\w+\b\$?(?![\\.(])")
AddGadgetItem(#cmbRex, -1, "(?# @*Point, var)[@*]{1,2}\w+(?!\()")
AddGadgetItem(#cmbRex, -1, "(?# @Point, Procedure)@\w+\(\)")
AddGadgetItem(#cmbRex, -1, "(?# Hex num )(?i)\$[\da-f]+")
AddGadgetItem(#cmbRex, -1, "(?# Comments )(?m)^\h*\K;.*?(?=\r?$)")
#q$ = Chr(34)
AddGadgetItem(#cmbRex, -1, "(?# Comments, All )(?m)^(?:[^" + #q$ + ";]*" + #q$ + "[^" + #q$ + "]*?" + #q$ + ")*[^" + #q$ + ";]*(;.*?)(?=\r?$)")
AddGadgetItem(#cmbRex, -1, "(?# Structures, Declare )(?i)(?<![=\w" + #q$ + "\\./-])[a-z]\w*\.[a-z]\w+(?![\w" + #q$ + "\\./-])")
AddGadgetItem(#cmbRex, -1, "(?# Structures, item )(?<![\w.:" + #q$ + "\\])\*?\w+(?:(?:\(\))?\\[\d_a-zA-Z]+)+(?![\w" + #q$ + "\\])")
AddGadgetItem(#cmbRex, -1, "(?# Structures, Content )(?m)^\h*Structure\h*\K\w+")
; AddGadgetItem(#cmbRex, -1, ~"(?# Comments )(?m)^(?:[^\";]*\"[^\"]*?\")*[^\";]*(;.*?)(?=\r?$)")
; AddGadgetItem(#cmbRex, -1, ~"(?# Structures, Declare )(?i)(?<![=\\w\"\\./-])[a-z]\\w*\\.[a-z]\\w+(?![\\w\"\\\\./-])")
; AddGadgetItem(#cmbRex, -1, ~"(?# Structures, item )(?<![\\w.:\"\\\\])\\*?\\w+(?:(?:\\(\\))?\\\\[\\d_a-zA-Z]+)+(?![\\w\"\\\\])")
AddGadgetItem(#cmbRex, -1, "(?# Types )\b\w+\.[sfdqbliwcapu]\b")
AddGadgetItem(#cmbRex, -1, "(?# Constants, Declare )(?m)^\h*\K#\w+\$?(?=\h*(?:=|\r?$))")
AddGadgetItem(#cmbRex, -1, "(?# Constants, All )#\w+\b\$?")
AddGadgetItem(#cmbRex, -1, "(?# CONSTANTS, DECLARE )(?m)^\h*\K#[A-Z\d_]+(?=\h*(?:=|\r?$))")
AddGadgetItem(#cmbRex, -1, "(?# CONSTANTS, ALL )#[A-Z\d_]+\b")
AddGadgetItem(#cmbRex, -1, "(?# CONSTANTS, X_X )#[A-Z\d]+_[A-Z\d]+\b")
AddGadgetItem(#cmbRex, -1, "(?# Constants, #PB_ )#PB_\w+\b\$?")
AddGadgetItem(#cmbRex, -1, "(?# Constants, Str )#\w+\$")
AddGadgetItem(#cmbRex, -1, "(?# If )(?mi)^\h*\KIf(?=\h)")
AddGadgetItem(#cmbRex, -1, "(?# Loop )(?mi)^\h*\K(For(Each)?|Repeat|While)(?=\h)")
AddGadgetItem(#cmbRex, -1, "(?# Select )(?mi)^\h*\KSelect(?=\h)")
AddGadgetItem(#cmbRex, -1, "(?# Include )(?mi)^\h*\KX?Include[a-z]{4,6}\b(?=\h)")
; ButtonGadget(#btnRex, WindowWidth(#frmMain) - 28, 3, 24, 24, ">")
; ButtonImageGadget(#btnRex, WindowWidth(#frmMain) - 28, 3, 24, 24, GetClassLongPtr_(WindowID(#frmMain), #GCL_HICONSM))
#img = 0
; Protected tmp = GadgetHeight(#cmbRex)
Protected tmp = 24
If CreateImage(#img, tmp, tmp, 32, RGB(255, 255, 255))
StartDrawing(ImageOutput(#img))
Box(0, 0, tmp, tmp, BorderColor)
Box(1, 1, tmp - 2, tmp - 2, BackColorHeader)
DrawText((tmp - TextWidth(">")) / 2, (tmp - TextHeight(">")) / 2, ">", ForeColor, BackColorHeader)
StopDrawing()
EndIf
ImageGadget(#btnRex, WindowWidth(#frmMain) - 28, 3, tmp, tmp, ImageID(0))
; ButtonImageGadget(#btnRex, WindowWidth(#frmMain) - 28, 3, 24, 24, ImageID(0))
; CatchImage(0, GetClassLongPtr_(WindowID(#frmMain), #GCL_HICONSM))
; ButtonImageGadget(#btnRex, WindowWidth(#frmMain) - 28, 3, 24, 24, ImageID(0))
; ButtonGadget(#btnClose, WindowWidth(#frmMain) - 27, 3, 24, 24, "x") ; to make a black theme
If CursorLine < 1 Or CursorLine > ArraySize(Lines())
CursorLine = 1
EndIf
ListIconGadget(#frmMain_References, 3, 30, WindowWidth(#frmMain) - 6, WindowHeight(#frmMain) - 33, Str(CursorLine), 96, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection)
; SetWindowLongPtr_(GadgetID(#frmMain_References),#GWL_STYLE,GetWindowLongPtr_(GadgetID(#frmMain_References),#GWL_STYLE) | #LVS_NOCOLUMNHEADER)
frmMain_References = SetWindowLongPtr_(GadgetID(#frmMain_References), #GWL_WNDPROC, @Callback_Header())
hHeader = SendMessage_(GadgetID(#frmMain_References), #LVM_GETHEADER, 0, 0)
AddGadgetColumn(#frmMain_References, 1, Lines(CursorLine - 1), 400)
SetGadgetColor(#frmMain_References, #PB_Gadget_BackColor, BackColor)
SetGadgetColor(#frmMain_References, #PB_Gadget_FrontColor, ForeColor)
SetGadgetBorderless(#frmMain_References) ; by me
; Optional DarkMode_Explorer theme if OSVersion >= Windows_10 Else Explorer Theme
SetWindowTheme()
ForEach FoundReference()
FoundReference()\Reference = LTrimChar(FoundReference()\Reference, " " + #TAB$)
; >> first attempt to mark the selected word in the string
FoundReference()\Reference = ReplaceString(FoundReference()\Reference, SelectedWord, #SelectedWordMarker$ + SelectedWord + #SelectedWordMarker$, #PB_String_NoCase)
AddGadgetItem(#frmMain_References, -1, Str(FoundReference()\LineNo) + #LF$ + FoundReference()\Reference)
Next
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE)
SendMessage_(GadgetID(#frmMain_References), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE)
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, @Resize_Event(), #frmMain)
; BindGadgetEvent(#frmMain_References, @Event_ListView())
SetActiveGadget(#frmMain_References)
AddKeyboardShortcut(#frmMain, #PB_Shortcut_Control | #PB_Shortcut_Shift | #PB_Shortcut_C, #Shortcut_Ctrl_Shift_C)
AddKeyboardShortcut(#frmMain, #PB_Shortcut_Return, #Shortcut_Enter)
;- Loop
Repeat
Select WaitWindowEvent()
Case #PB_Event_MoveWindow
xywh\x = WindowX(#frmMain)
xywh\y = WindowY(#frmMain)
Case #PB_Event_CloseWindow
; Если размеры окна изменились, то сохраняем.
If Not CompareMemory(@xywh, @xywh2, SizeOf(xywhm))
If OpenPreferences(ini$) Or CreatePreferences(ini$)
PreferenceGroup("set")
WritePreferenceInteger("x", xywh\x)
WritePreferenceInteger("y", xywh\y)
WritePreferenceInteger("w", xywh\w)
WritePreferenceInteger("h", xywh\h)
ClosePreferences()
EndIf
EndIf
Break
Case #PB_Event_Menu
Select EventMenu()
Case #Shortcut_Enter
If GetActiveGadget() = #cmbRex
flgRead = 0
GoRegExp()
EndIf
If GetActiveGadget() = #frmMain_References
Event_ListView()
EndIf
Case #Shortcut_Ctrl_Shift_C
CopyClipboard()
Case #frmMain_Shortcut_Escape_Event
Break
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #cmbRex
If EventType() = #PB_EventType_Change And flgRead = 1
flgRead = 0
GoRegExp()
EndIf
Case #btnRex
GoRegExp()
EndSelect
EndSelect
ForEver
EndIf
ProcedureReturn 0 ; not necessary, but looks good/better
EndProcedure
End main()
;- Bottom of File