Add a filter editor above ListVariables, ListStatus and ListProcesses. Should make the lists more suitable to look for specific values when they're very long.

(Plus: Move some TPopupMenus around so they don't overlap other controls at design time)
2026-03-13 09:24:25 +08:00 · 2008-01-23 20:24:35 +00:00
parent c51ea356a1
commit f53ea37647
2 changed files with 176 additions and 23 deletions
--- a/source/childwin.dfm
+++ b/source/childwin.dfm
@@ -111,9 +111,9 @@ object MDIChild: TMDIChild
              Caption = 'Variables'
              object ListVariables: TVirtualStringTree
                Left = 0
-                Top = 0
+                Top = 25
                Width = 488
-                Height = 175
+                Height = 150
                Align = alClient
                DragOperations = []
                Header.AutoSizeIndex = 1
@@ -153,18 +153,42 @@ object MDIChild: TMDIChild
                  end
                  item
                    Position = 1
-                    Width = 328
+                    Width = 324
                    WideText = 'Value'
                  end>
              end
+              object pnlFilterVariables: TPanel
+                Left = 0
+                Top = 0
+                Width = 488
+                Height = 25
+                Align = alTop
+                BevelOuter = bvNone
+                TabOrder = 1
+                object lblFilterVariables: TLabel
+                  Left = 1
+                  Top = 4
+                  Width = 28
+                  Height = 13
+                  Caption = 'Filter:'
+                end
+                object editFilterVariables: TEdit
+                  Left = 34
+                  Top = 1
+                  Width = 154
+                  Height = 21
+                  TabOrder = 0
+                  OnChange = editFilterVTChange
+                end
+              end
            end
            object tabStatus: TTabSheet
              Caption = 'Status'
              object ListStatus: TVirtualStringTree
                Left = 0
-                Top = 0
+                Top = 25
                Width = 488
-                Height = 175
+                Height = 150
                Align = alClient
                DragOperations = []
                Header.AutoSizeIndex = 1
@@ -204,10 +228,34 @@ object MDIChild: TMDIChild
                  end
                  item
                    Position = 1
-                    Width = 328
+                    Width = 324
                    WideText = 'Value'
                  end>
              end
+              object pnlFilterStatus: TPanel
+                Left = 0
+                Top = 0
+                Width = 488
+                Height = 25
+                Align = alTop
+                BevelOuter = bvNone
+                TabOrder = 1
+                object lblFilterStatus: TLabel
+                  Left = 1
+                  Top = 4
+                  Width = 28
+                  Height = 13
+                  Caption = 'Filter:'
+                end
+                object editFilterStatus: TEdit
+                  Left = 34
+                  Top = 1
+                  Width = 154
+                  Height = 21
+                  TabOrder = 0
+                  OnChange = editFilterVTChange
+                end
+              end
            end
            object tabProcessList: TTabSheet
              Caption = 'Process-List'
@@ -223,9 +271,9 @@ object MDIChild: TMDIChild
              end
              object ListProcesses: TVirtualStringTree
                Left = 0
-                Top = 0
+                Top = 25
                Width = 488
-                Height = 102
+                Height = 77
                Align = alClient
                Header.AutoSizeIndex = 7
                Header.Font.Charset = DEFAULT_CHARSET
@@ -343,6 +391,30 @@ object MDIChild: TMDIChild
                  ReadOnly = True
                end
              end
+              object pnlFilterProcesses: TPanel
+                Left = 0
+                Top = 0
+                Width = 488
+                Height = 25
+                Align = alTop
+                BevelOuter = bvNone
+                TabOrder = 2
+                object lblFilterProcesses: TLabel
+                  Left = 1
+                  Top = 4
+                  Width = 28
+                  Height = 13
+                  Caption = 'Filter:'
+                end
+                object editFilterProcesses: TEdit
+                  Left = 34
+                  Top = 1
+                  Width = 154
+                  Height = 21
+                  TabOrder = 0
+                  OnChange = editFilterVTChange
+                end
+              end
            end
            object tabCommandStats: TTabSheet
              Caption = 'Command-Statistics'
@@ -410,7 +482,7 @@ object MDIChild: TMDIChild
                  end
                  item
                    Position = 4
-                    Width = 68
+                    Width = 64
                    WideText = 'Percentage'
                  end>
              end
@@ -1695,7 +1767,7 @@ object MDIChild: TMDIChild
    Images = MainForm.ImageList1
    OnPopup = popupTreeViewPopup
    Left = 8
-    Top = 48
+    Top = 16
    object NewDatabase1: TMenuItem
      Caption = 'Create database...'
      ImageIndex = 73
@@ -1744,7 +1816,7 @@ object MDIChild: TMDIChild
    AutoHotkeys = maManual
    Images = MainForm.ImageList1
    Left = 72
-    Top = 48
+    Top = 16
    object menuproperties: TMenuItem
      Caption = 'Properties'
      Default = True
@@ -1850,7 +1922,7 @@ object MDIChild: TMDIChild
    Images = MainForm.ImageList1
    OnPopup = popupHostPopup
    Left = 41
-    Top = 48
+    Top = 16
    object Kill1: TMenuItem
      Caption = 'Kill Process(es)...'
      Enabled = False
@@ -1921,7 +1993,7 @@ object MDIChild: TMDIChild
  object popupTableGrid: TPopupMenu
    Images = MainForm.ImageList1
    Left = 104
-    Top = 48
+    Top = 16
    object MenuEditField: TMenuItem
      Caption = 'Properties'
      Default = True
@@ -1976,7 +2048,7 @@ object MDIChild: TMDIChild
    AutoHotkeys = maManual
    Images = MainForm.ImageList1
    OnPopup = popupDataGridPopup
-    Left = 136
+    Left = 8
    Top = 48
    object Copy3: TMenuItem
      Action = MainForm.EditCopy1
@@ -2191,8 +2263,8 @@ object MDIChild: TMDIChild
  object popupResultGrid: TPopupMenu
    Images = MainForm.ImageList1
    OnPopup = popupResultGridPopup
-    Left = 8
-    Top = 80
+    Left = 40
+    Top = 48
    object Copy4: TMenuItem
      Action = MainForm.EditCopy1
    end
@@ -2225,8 +2297,8 @@ object MDIChild: TMDIChild
  end
  object popupSqlLog: TPopupMenu
    Images = MainForm.ImageList1
-    Left = 40
-    Top = 80
+    Left = 72
+    Top = 48
    object Copy1: TMenuItem
      Action = MainForm.EditCopy1
    end
@@ -2317,8 +2389,8 @@ object MDIChild: TMDIChild
  object popupDbGridHeader: TPopupMenu
    AutoHotkeys = maManual
    AutoLineReduction = maManual
-    Left = 72
-    Top = 80
+    Left = 104
+    Top = 48
  end
  object SynCompletionProposal1: TSynCompletionProposal
    Options = [scoLimitToMatchedText, scoUseInsertList, scoUsePrettyText, scoUseBuiltInTimer, scoEndCharCompletion, scoCompleteWithTab, scoCompleteWithEnter]
@@ -2360,7 +2432,7 @@ object MDIChild: TMDIChild
    TriggerCharsW = '.'
  end
  object popupQueryLoad: TPopupMenu
-    Left = 104
+    Left = 8
    Top = 80
  end
  object OpenDialogSQLFile: TOpenDialog
@@ -2394,7 +2466,7 @@ object MDIChild: TMDIChild
  object popupQuery: TPopupMenu
    Images = MainForm.ImageList1
    OnPopup = popupQueryPopup
-    Left = 136
+    Left = 40
    Top = 80
    object MenuRun: TMenuItem
      Action = MainForm.ExecuteQuery
@@ -2489,7 +2561,7 @@ object MDIChild: TMDIChild
  end
  object popupQueryHelpers: TPopupMenu
    Images = MainForm.ImageList1
-    Left = 168
+    Left = 72
    Top = 80
    object menuInsertSnippetAtCursor: TMenuItem
      Caption = 'Insert at cursor'
--- a/source/childwin.pas
+++ b/source/childwin.pas
@@ -321,6 +321,15 @@ type
    pnlProcessViewBox: TPanel;
    pnlProcessView: TPanel;
    SynMemoProcessView: TSynMemo;
+    pnlFilterVariables: TPanel;
+    lblFilterVariables: TLabel;
+    editFilterVariables: TEdit;
+    pnlFilterStatus: TPanel;
+    lblFilterStatus: TLabel;
+    editFilterStatus: TEdit;
+    pnlFilterProcesses: TPanel;
+    lblFilterProcesses: TLabel;
+    editFilterProcesses: TEdit;
    procedure DBtreeContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure DBtreeChanging(Sender: TObject; Node: TTreeNode;
@@ -532,6 +541,7 @@ type
        TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect:
        TRect);
    procedure ListProcessesChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
+    procedure editFilterVTChange(Sender: TObject);

    private
      methodStack                : TStack;
@@ -2749,6 +2759,9 @@ begin
  // Tell VirtualTree the number of nodes it will display
  ListVariables.RootNodeCount := Length(VTRowDataListVariables);
  ListVariables.EndUpdate;
+  // Apply filter
+  if editFilterVariables.Text <> '' then
+    editFilterVTChange(editFilterVariables);
  // Display number of listed values on tab
  tabVariables.Caption := 'Variables (' + IntToStr(ListVariables.RootNodeCount) + ')';

@@ -2774,6 +2787,9 @@ begin
  // Tell VirtualTree the number of nodes it will display
  ListStatus.RootNodeCount := Length(VTRowDataListStatus);
  ListStatus.EndUpdate;
+  // Apply filter
+  if editFilterStatus.Text <> '' then
+    editFilterVTChange(editFilterStatus);
  // Display number of listed values on tab
  tabStatus.Caption := 'Status (' + IntToStr(ListStatus.RootNodeCount) + ')';

@@ -2847,6 +2863,9 @@ begin
  end;
  ListProcesses.RootNodeCount := Length(VTRowDataListProcesses);
  ListProcesses.EndUpdate;
+  // Apply filter
+  if editFilterProcesses.Text <> '' then
+    editFilterVTChange(editFilterProcesses);
  Screen.Cursor := crDefault;
 end;

@@ -6923,4 +6942,66 @@ begin
  else SynMemoProcessView.Clear;
 end;

+
+{***
+  Apply a filter to a Virtual Tree.
+  Currently used for ListVariables, ListStatus and ListProcesses
+}
+procedure TMDIChild.editFilterVTChange(Sender: TObject);
+var
+  Node : PVirtualNode;
+  NodeData : PVTreeData;
+  VT : TVirtualStringTree;
+  Edit : TEdit;
+  i : Integer;
+  match : Boolean;
+  search : String;
+  somefiltered : Boolean;
+begin
+  // Find the correct VirtualTree that shall be filtered
+  if Sender = editFilterVariables then
+    VT := ListVariables
+  else if Sender = editFilterStatus then
+    VT := ListStatus
+  else if Sender = editFilterProcesses then
+    VT := ListProcesses
+  else
+    Raise Exception.Create('editFilterVTKeyUp() called with wrong sender control ('+(Sender as TControl).Name+')' );
+  Edit := Sender as TEdit;
+  // Loop through all nodes to adjust their vsVisible state
+  Node := VT.GetFirst;
+  search := LowerCase( Edit.Text );
+  somefiltered := False;
+  while Assigned(Node) do begin
+    NodeData := VT.GetNodeData(Node);
+    // Don't filter anything if the filter text is empty
+    match := search = '';
+    // Search for given text in node's captions
+    if not match then for i := 0 to NodeData.Captions.Count - 1 do begin
+      if Pos( search, LowerCase(NodeData.Captions[i]) ) > 0 then begin
+        match := True;
+        break;
+      end;
+    end;
+    if match then
+      Node.States := Node.States + [vsVisible]
+    else
+      Node.States := Node.States - [vsVisible];
+    if (not somefiltered) and (not match) then
+      somefiltered := True;
+    Node := VT.GetNext(Node);
+  end;
+  // Colorize TEdit with filter string to signalize that some nodes are hidden now
+  if somefiltered then begin
+    Edit.Font.Color := clRed;
+    Edit.Color := clYellow;
+  end else begin
+    Edit.Font.Color := clWindowText;
+    Edit.Color := clWindow;
+  end;
+  // Needs a refresh to apply visible states
+  VT.Refresh;
+end;
+
+
 end.