Convert ListProcesses from TSortListView to VirtualTree.

- Don't replace "ListProcessesSelectItem" by "ListProcessesClick". Do the menuitem stuff in popupHost.popup()
- Avoid potential AV when exceeding the captions-list of a node in GetNodeText.

source/childwin.dfm

@@ -157,59 +157,83 @@ object MDIChild: TMDIChild
             object tabProcessList: TTabSheet
               Caption = 'Process-List'
               ImageIndex = 1
-              object ListProcesses: TSortListView
+              object ListProcesses: TVirtualStringTree
-                Tag = -1
                 Left = 0
                 Top = 0
                 Width = 488
                 Height = 175
                 Align = alClient
+                Header.AutoSizeIndex = 7
+                Header.Font.Charset = DEFAULT_CHARSET
+                Header.Font.Color = clWindowText
+                Header.Font.Height = -11
+                Header.Font.Name = 'Tahoma'
+                Header.Font.Style = []
+                Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoShowSortGlyphs, hoVisible]
+                Header.SortColumn = 0
+                Header.SortDirection = sdDescending
+                Images = MainForm.ImageList1
+                IncrementalSearch = isInitializedOnly
+                PopupMenu = popupHost
+                TabOrder = 0
+                TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
+                TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
+                TreeOptions.PaintOptions = [toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages]
+                TreeOptions.SelectionOptions = [toFullRowSelect, toRightClickSelect]
+                OnCompareNodes = vstCompareNodes
+                OnFreeNode = vstFreeNode
+                OnGetText = vstGetText
+                OnGetImageIndex = vstGetImageIndex
+                OnGetNodeDataSize = vstGetNodeDataSize
+                OnHeaderClick = vstHeaderClick
+                OnInitNode = vstInitNode
                 Columns = <
                   item
-                    Caption = 'id'
+                    Alignment = taRightJustify
-                    Width = -1
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
-                    WidthType = (
+                    Position = 0
-                      -1)
+                    WideText = 'id'
                   end
                   item
-                    Caption = 'User'
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+                    Position = 1
                     Width = 80
+                    WideText = 'User'
                   end
                   item
-                    Caption = 'Host'
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
-                    Tag = -1
+                    Position = 2
                     Width = 80
+                    WideText = 'Host'
                   end
                   item
-                    Caption = 'DB'
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
-                    Width = -1
+                    Position = 3
-                    WidthType = (
-                      -1)
-                  end
-                  item
-                    Caption = 'Command'
                     Width = 80
+                    WideText = 'DB'
                   end
                   item
-                    Caption = 'Time'
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+                    Position = 4
+                    Width = 80
+                    WideText = 'Command'
                   end
                   item
-                    Caption = 'State'
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+                    Position = 5
+                    WideText = 'Time'
                   end
                   item
-                    Caption = 'Info'
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
-                    Width = 126
+                    Position = 6
+                    WideText = 'State'
+                  end
+                  item
+                    Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible]
+                    Position = 7
+                    Width = 14
+                    WideText = 'Info'
                   end>
-                GridLines = True
-                ReadOnly = True
-                RowSelect = True
-                PopupMenu = popupHost
-                SmallImages = MainForm.ImageList1
-                TabOrder = 0
-                ViewStyle = vsReport
-                OnSelectItem = ListProcessesSelectItem
-                ImageIndexSortAsc = 95
-                ImageIndexSortDesc = 94
               end
             end
             object tabCommandStats: TTabSheet

source/childwin.pas

@@ -61,7 +61,7 @@ type
     tabVariables: TTabSheet;
     tabProcessList: TTabSheet;
     ListVariables: TVirtualStringTree;
-    ListProcesses: TSortListView;
+    ListProcesses: TVirtualStringTree;
     popupHost: TPopupMenu;
     Kill1: TMenuItem;
     NewDatabase1: TMenuItem;
@@ -329,8 +329,6 @@ type
       Selected: Boolean);
     procedure ListColumnsSelectItem(Sender: TObject; Item: TListItem;
       Selected: Boolean);
-    procedure ListProcessesSelectItem(Sender: TObject; Item: TListItem;
-      Selected: Boolean);
     procedure DBMemo1Exit(Sender: TObject);
     procedure btnUnsafeEditClick(Sender: TObject);
     procedure gridMouseDown(Sender: TObject; Button: TMouseButton;
@@ -538,6 +536,7 @@ type
       CachedTableLists           : TStringList;
       QueryHelpersSelectedItems  : Array[0..3] of Integer;
       VTRowDataListVariables,
+      VTRowDataListProcesses,
       VTRowDataListCommandStats  : Array of TVTreeData;
 
       function GetQueryRunning: Boolean;
@@ -1852,7 +1851,7 @@ begin
   ValidateControls;
 
   // Show processlist if it's visible now but empty yet
-  if ListProcesses.Items.Count = 0 then
+  if ListProcesses.RootNodeCount = 0 then
     ShowProcessList( self );
 end;
 
@@ -2669,7 +2668,6 @@ end;
 procedure TMDIChild.ShowProcessList(sender: TObject);
 var
   i,j : Integer;
-  n   : TListItem;
   ds  : TDataSet;
 begin
   // No need to update if it's not visible.
@@ -2677,57 +2675,49 @@ begin
   if PageControlHost.ActivePage <> tabProcesslist then exit;
   Screen.Cursor := crSQLWait;
   try
-    ListProcesses.Items.BeginUpdate;
+    ListProcesses.BeginUpdate;
-    ListProcesses.Items.Clear;
+    ListProcesses.Clear;
     debug('ShowProcessList()');
     ds := GetResults('SHOW FULL PROCESSLIST', false, false);
+    SetLength(VTRowDataListProcesses, ds.RecordCount);
     for i:=1 to ds.RecordCount do
     begin
-      n := ListProcesses.Items.Add;
+      VTRowDataListProcesses[i-1].Captions := TStringList.Create;
-      n.Caption := ds.Fields[0].AsString;
+      VTRowDataListProcesses[i-1].Captions.Add( ds.Fields[0].AsString );
       if CompareText( ds.Fields[4].AsString, 'Killed') = 0 then
-        n.ImageIndex := 83  // killed
+        VTRowDataListProcesses[i-1].ImageIndex := 83  // killed
       else
-        n.ImageIndex := 82; // running
+        VTRowDataListProcesses[i-1].ImageIndex := 82; // running
       for j := 1 to 7 do
-        n.Subitems.Add(ds.Fields[j].AsString);
+        VTRowDataListProcesses[i-1].Captions.Add(ds.Fields[j].AsString);
       ds.Next;
     end;
     ds.Close;
-    ListProcesses.Items.EndUpdate;
+    tabProcessList.Caption := 'Process-List (' + IntToStr(Length(VTRowDataListProcesses)) + ')';
-    // Remove existing column-sort-images
-    // (TODO: auomatically invoke this method in TSortListView itself)
-    ListProcesses.ClearSortColumnImages;
-    tabProcessList.Caption := 'Process-List (' + IntToStr(ListProcesses.Items.Count) + ')';
   except
     on E: Exception do begin
       LogSQL('Error loading process list (automatic refresh disabled): ' + e.Message);
       TimerProcesslist.Enabled := false;
     end;
   end;
-  ListProcesses.Items.EndUpdate;
+  ListProcesses.RootNodeCount := Length(VTRowDataListProcesses);
+  ListProcesses.EndUpdate;
   Screen.Cursor := crDefault;
 end;
 
-
-procedure TMDIChild.ListProcessesSelectItem(Sender: TObject; Item: TListItem;
-  Selected: Boolean);
-begin
-  Kill1.Enabled := (ListProcesses.Selected <> nil) and (PageControlHost.ActivePage = tabProcessList);
-end;
-
-
 procedure TMDIChild.KillProcess(Sender: TObject);
 var t : Boolean;
+  NodeData : PVTreeData;
 begin
-  if ListProcesses.Selected.Caption = IntToStr( MySQLConn.Connection.GetThreadId ) then
+  NodeData := ListProcesses.GetNodeData(ListProcesses.FocusedNode);
+  if NodeData.Captions[0] = IntToStr( MySQLConn.Connection.GetThreadId ) then
     MessageDlg('Fatal: Better not kill my own Process...', mtError, [mbok], 0)
   else begin
     t := TimerProcessList.Enabled;
     TimerProcessList.Enabled := false; // prevent av (ListProcesses.selected...)
-    if MessageDlg('Kill Process '+ListProcesses.Selected.Caption+'?', mtConfirmation, [mbok,mbcancel], 0) = mrok then
+    if MessageDlg('Kill Process '+NodeData.Captions[0]+'?', mtConfirmation, [mbok,mbcancel], 0) = mrok then
     begin
-      ExecUpdateQuery( 'KILL '+ListProcesses.Selected.Caption );
+      ExecUpdateQuery( 'KILL '+NodeData.Captions[0] );
       ShowVariablesAndProcesses(self);
     end;
     TimerProcessList.Enabled := t; // re-enable autorefresh timer
@@ -2738,9 +2728,8 @@ end;
 procedure TMDIChild.PageControlHostChange(Sender: TObject);
 begin
   // Show processlist if it's visible now but empty yet
-  if ListProcesses.Items.Count = 0 then
+  if ListProcesses.RootNodeCount = 0 then
     ShowProcessList( self );
-  ListProcessesSelectItem(self, nil, False);
 end;
 
 
@@ -4450,6 +4439,7 @@ end;
 procedure TMDIChild.popupHostPopup(Sender: TObject);
 begin
   MenuAutoupdate.Enabled := PageControlHost.ActivePage = tabProcessList;
+  Kill1.Enabled := (PageControlHost.ActivePage = tabProcessList) and Assigned(ListProcesses.FocusedNode);
 end;
 
 procedure TMDIChild.ListTablesEditing(Sender: TObject; Item: TListItem;
@@ -5989,6 +5979,11 @@ begin
   begin
     NodeData.Captions := VTRowDataListCommandStats[Node.Index].Captions;
     NodeData.ImageIndex := VTRowDataListCommandStats[Node.Index].ImageIndex;
+  end
+  else if Sender = ListProcesses then
+  begin
+    NodeData.Captions := VTRowDataListProcesses[Node.Index].Captions;
+    NodeData.ImageIndex := VTRowDataListProcesses[Node.Index].ImageIndex;
   end;
 end;
 
@@ -6017,13 +6012,20 @@ procedure TMDIChild.vstGetText(Sender: TBaseVirtualTree; Node:
     WideString);
 var
   NodeData : PVTreeData;
+  i : Integer;
 begin
   // Get pointer to node which gets displayed
   NodeData := Sender.GetNodeData(Node);
-  case Column of
+  // Column is -1 if no column headers are defined
-    -1: CellText := NodeData.Captions[0]; // Column is -1 if no column headers are defined
+  if Column = -1 then
-    else CellText := NodeData.Captions[Column];
+    i := 0
-  end;
+  else
+    i := Column;
+  // Avoid AV, don't exceed Captions content
+  if NodeData.Captions.Count > i then
+    CellText := NodeData.Captions[i]
+  else
+    CellText := '';
 end;
 
 

source/printlist.pas

@@ -73,11 +73,11 @@ begin
 
   // which ListView to print?
   case cwin.PageControlMain.ActivePageIndex of
-    0 : case cwin.PageControlHost.ActivePageIndex of
+//    0 : case cwin.PageControlHost.ActivePageIndex of
 //      0 : begin list := cwin.ListVariables; title := 'Server-Variables for ' + cwin.Conn.MysqlParams.Host; end;
-      1 : begin list := cwin.ListProcesses; title := 'Processlist for ' + cwin.Conn.MysqlParams.Host; end;
+//      1 : begin list := cwin.ListProcesses; title := 'Processlist for ' + cwin.Conn.MysqlParams.Host; end;
 //      2 : begin list := cwin.ListCommandStats; title := 'Command-statistics for ' + cwin.Conn.MysqlParams.Host; end;
-      end;
+//      end;
     1 : begin list := cwin.ListTables; title := 'Tables-List for Database ' + cwin.ActualDatabase; end;
     2 : begin list := cwin.ListColumns; title := 'Field-List for ' + cwin.ActualDatabase + '/' + cwin.ActualTable; end;
   end;