Display colored bar for table size and row count columns in ListTables, and for process time column in ListProcesses. Also, extend the preferences dialog so this color can be customized and/or disabled.

2026-03-13 09:24:25 +08:00 · 2010-03-09 23:30:44 +00:00
parent b2b84ba47a
commit f7ee77561b
5 changed files with 113 additions and 14 deletions
--- a/source/const.inc
+++ b/source/const.inc
@@ -196,6 +196,10 @@ const
  REGNAME_DO_STATISTICS = 'DoUsageStatistics';
  DEFAULT_DO_STATISTICS = False;
  REGNAME_LAST_STATSCALL = 'LastUsageStatisticCall';
+  REGNAME_DISPLAYBARS = 'DisplayBars';
+  DEFAULT_DISPLAYBARS = true;
+  REGNAME_BARCOLOR = 'BarColor';
+  DEFAULT_BARCOLOR = $00BBFFDD;
  REGNAME_FILTERACTIVE = 'FilterPanel';
  DEFAULT_FILTERACTIVE = False;
  REGNAME_MULTI_INSTANCES = 'AllowMultipleInstances';
--- a/source/main.dfm
+++ b/source/main.dfm
@@ -660,6 +660,7 @@ object MainForm: TMainForm
                TreeOptions.PaintOptions = [toHotTrack, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme]
                TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect, toMultiSelect, toRightClickSelect]
                OnAfterPaint = vstAfterPaint
+                OnBeforeCellPaint = ListProcessesBeforeCellPaint
                OnBeforePaint = ListProcessesBeforePaint
                OnCompareNodes = vstCompareNodes
                OnFocusChanged = ListProcessesFocusChanged
@@ -876,6 +877,7 @@ object MainForm: TMainForm
            TreeOptions.PaintOptions = [toHotTrack, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme]
            TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect, toRightClickSelect]
            OnAfterPaint = vstAfterPaint
+            OnBeforeCellPaint = ListTablesBeforeCellPaint
            OnBeforePaint = ListTablesBeforePaint
            OnChange = ListTablesChange
            OnCompareNodes = vstCompareNodes
--- a/source/main.pas
+++ b/source/main.pas
@@ -647,6 +647,12 @@ type
    procedure ListCommandStatsBeforeCellPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
+    procedure ListTablesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+      Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect;
+      var ContentRect: TRect);
+    procedure ListProcessesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+      Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect;
+      var ContentRect: TRect);
    procedure ListProcessesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
    procedure editFilterVTChange(Sender: TObject);
    procedure ListVariablesDblClick(Sender: TObject);
@@ -783,6 +789,7 @@ type
    function GetBlobContent(Results: TMySQLQuery; Column: Integer): String;
    procedure DoSearchReplace;
    procedure UpdateLineCharPanel;
+    procedure PaintColorBar(Value, Max: Extended; TargetCanvas: TCanvas; CellRect: TRect);
  public
    Connection: TMySQLConnection;
    SessionName: String;
@@ -791,6 +798,9 @@ type
    Databases: TStringList;
    btnAddTab: TSpeedButton;
    QueryTabs: TObjectList<TQueryTab>;
+    DBObjectsMaxSize: Int64;
+    DBObjectsMaxRows: Int64;
+    ProcessListMaxTime: Int64;

    // Cached forms
    TableToolsDialog: TfrmTableTools;
@@ -841,6 +851,8 @@ type
    prefExportLocaleNumbers: Boolean;
    prefNullColorDefault: TColor;
    prefNullBG: TColor;
+    prefDisplayBars: Boolean;
+    prefBarColor: TColor;

    // Data grid related stuff
    DataGridHiddenColumns: TStringList;
@@ -1315,6 +1327,8 @@ begin
  prefLogSQL := GetRegValue(REGNAME_LOG_SQL, DEFAULT_LOG_SQL);
  prefLogInfos := GetRegValue(REGNAME_LOG_INFOS, DEFAULT_LOG_INFOS);
  prefLogDebug := GetRegValue(REGNAME_LOG_DEBUG, DEFAULT_LOG_DEBUG);
+  prefDisplayBars := GetRegValue(REGNAME_DISPLAYBARS, DEFAULT_DISPLAYBARS);
+  prefBarColor := GetRegValue(REGNAME_BARCOLOR, DEFAULT_BARCOLOR);

  // Data-Font:
  datafontname := GetRegValue(REGNAME_DATAFONTNAME, DEFAULT_DATAFONTNAME);
@@ -3713,11 +3727,15 @@ begin
  vt.Tag := VTREE_LOADED;

  NumObjects := TStringList.Create;
+  DBObjectsMaxSize := 1;
+  DBObjectsMaxRows := 1;
  for i:=0 to Objects.Count-1 do begin
    Obj := Objects[i];
    NumObj := StrToIntDef(NumObjects.Values[Obj.ObjType], 0);
    Inc(NumObj);
    NumObjects.Values[Obj.ObjType] := IntToStr(NumObj);
+    DBObjectsMaxSize := Max(DBObjectsMaxSize, Obj.Size);
+    DBObjectsMaxRows := Max(DBObjectsMaxRows, Obj.Rows);
  end;
  Msg := ActiveDatabase + ': ' + FormatNumber(Objects.Count) + ' ';
  if NumObjects.Count = 1 then
@@ -5947,28 +5965,62 @@ procedure TMainForm.ListCommandStatsBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
 var
-  percent : Extended;
-  barwidth, cellwidth: Integer;
  NodeData: PVTreeData;
 begin
  // Only paint bar in percentage column
-  if Column <> 4 then
+  if Column = 4 then begin
+    NodeData := Sender.GetNodeData(Node);
+    PaintColorBar(MakeFloat(NodeData.Captions[Column]), 100, TargetCanvas, CellRect);
+  end;
+end;
+
+
+procedure TMainForm.ListTablesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+  Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect;
+  var ContentRect: TRect);
+var
+  Obj: PDBObject;
+begin
+  // Only paint bar in rows + size column
+  if Column in [1, 2] then begin
+    Obj := Sender.GetNodeData(Node);
+    case Column of
+      1: PaintColorBar(Obj.Rows, DBObjectsMaxRows, TargetCanvas, CellRect);
+      2: PaintColorBar(Obj.Size, DBObjectsMaxSize, TargetCanvas, CellRect);
+    end;
+  end;
+end;
+
+procedure TMainForm.ListProcessesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+  Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect;
+  var ContentRect: TRect);
+var
+  NodeData: PVTreeData;
+begin
+  if Column = 5 then begin
+    NodeData := Sender.GetNodeData(Node);
+    PaintColorBar(MakeFloat(NodeData.Captions[Column]), ProcessListMaxTime, TargetCanvas, CellRect);
+  end;
+end;
+
+
+procedure TMainForm.PaintColorBar(Value, Max: Extended; TargetCanvas: TCanvas; CellRect: TRect);
+var
+  BarWidth, CellWidth: Integer;
+begin
+  if not prefDisplayBars then
    Exit;

  // Add minimal margin to cell edges
  InflateRect(CellRect, -1, -1);
-  cellwidth := CellRect.Right - CellRect.Left;
+  CellWidth := CellRect.Right - CellRect.Left;
+  BarWidth := Round(CellWidth*1 / Max * Value);

-  // Calculate value to display
-  NodeData := Sender.GetNodeData(Node);
-  percent := MakeFloat(NodeData.Captions[Column]);
-  barwidth := Round(cellwidth / 100 * percent);
-
-  // Adjust width of rect and paint the bar
-  CellRect.Right := CellRect.Right - cellwidth + barwidth;
-  TargetCanvas.Pen.Color := clGray;
-  TargetCanvas.Brush.Color := clInfoBk;
-  TargetCanvas.Rectangle(CellRect);
+  if BarWidth > 0 then begin
+    TargetCanvas.Brush.Color := prefBarColor;
+    TargetCanvas.Pen.Color := ColorAdjustBrightness(TargetCanvas.Brush.Color, -40);
+    TargetCanvas.RoundRect(CellRect.Left, CellRect.Top, CellRect.Left+BarWidth, CellRect.Bottom, 2, 2);
+  end;
 end;


@@ -7810,6 +7862,7 @@ begin
      Results := Connection.GetResults('SHOW FULL PROCESSLIST');
    end;
    SetLength(VTRowDataListProcesses, Results.RecordCount);
+    ProcessListMaxTime := 1;
    for i:=0 to Results.RecordCount-1 do begin
      if AnsiCompareText(Results.Col(4), 'Killed') = 0 then
        VTRowDataListProcesses[i].ImageIndex := 26  // killed
@@ -7826,6 +7879,7 @@ begin
          Text := sstr(Text, InfoLen);
        VTRowDataListProcesses[i].Captions.Add(Text);
      end;
+      ProcessListMaxTime := Max(ProcessListMaxTime, MakeInt(Results.Col(5)));
      Results.Next;
    end;
    FreeAndNil(Results);
--- a/source/options.dfm
+++ b/source/options.dfm
@@ -127,6 +127,25 @@ object optionsform: Toptionsform
        State = cbChecked
        TabOrder = 0
      end
+      object chkColorBars: TCheckBox
+        Left = 16
+        Top = 189
+        Width = 201
+        Height = 17
+        Caption = 'Display bars in various list columns'
+        TabOrder = 8
+        OnClick = chkColorBarsClick
+      end
+      object cboxColorBars: TColorBox
+        Left = 249
+        Top = 187
+        Width = 145
+        Height = 22
+        Style = [cbStandardColors, cbExtendedColors, cbCustomColor, cbPrettyNames, cbCustomColors]
+        Anchors = [akTop, akRight]
+        TabOrder = 9
+        OnClick = Modified
+      end
    end
    object tabLogging: TTabSheet
      Caption = 'Logging'
--- a/source/options.pas
+++ b/source/options.pas
@@ -132,6 +132,8 @@ type
    lblGridRowsLinecount: TLabel;
    editGridRowsLineCount: TEdit;
    updownGridRowsLineCount: TUpDown;
+    chkColorBars: TCheckBox;
+    cboxColorBars: TColorBox;
    procedure FormShow(Sender: TObject);
    procedure Modified(Sender: TObject);
    procedure Apply(Sender: TObject);
@@ -163,6 +165,7 @@ type
    procedure Shortcut2Change(Sender: TObject);
    procedure ShortcutEnter(Sender: TObject);
    procedure ShortcutExit(Sender: TObject);
+    procedure chkColorBarsClick(Sender: TObject);
  private
    { Private declarations }
    FWasModified: Boolean;
@@ -257,6 +260,8 @@ begin
  MainReg.WriteBool(REGNAME_DO_UPDATECHECK_BUILDS, chkUpdatecheckBuilds.Checked);
  MainReg.WriteInteger(REGNAME_UPDATECHECK_INTERVAL, updownUpdatecheckInterval.Position);
  MainReg.WriteBool(REGNAME_DO_STATISTICS, chkDoStatistics.Checked);
+  MainReg.WriteBool(REGNAME_DISPLAYBARS, chkColorBars.Checked);
+  MainReg.WriteInteger(REGNAME_BARCOLOR, cboxColorBars.Selected);
  // Save color settings
  MainReg.WriteInteger(REGNAME_FIELDCOLOR_NUMERIC, cboxNumeric.Selected);
  MainReg.WriteInteger(REGNAME_FIELDCOLOR_TEXT, cboxText.Selected);
@@ -344,6 +349,11 @@ begin
  Mainform.prefEnableEnumEditor := chkEditorEnum.Checked;
  Mainform.prefEnableSetEditor := chkEditorSet.Checked;
  Mainform.prefEnableNullBG := chkNullBg.Checked;
+  Mainform.prefDisplayBars := chkColorBars.Checked;
+  Mainform.prefBarColor := cboxColorBars.Selected;
+  Mainform.ListTables.Invalidate;
+  Mainform.ListProcesses.Invalidate;
+  Mainform.ListCommandStats.Invalidate;

  // Settings have been applied, send a signal to the user
  btnApply.Enabled := False;
@@ -404,6 +414,8 @@ begin
  updownUpdatecheckInterval.Position := GetRegValue(REGNAME_UPDATECHECK_INTERVAL, DEFAULT_UPDATECHECK_INTERVAL);
  chkUpdatecheckClick(Sender);
  chkDoStatistics.Checked := GetRegValue(REGNAME_DO_STATISTICS, DEFAULT_DO_STATISTICS);
+  chkColorBars.Checked := GetRegValue(REGNAME_DISPLAYBARS, DEFAULT_DISPLAYBARS);
+  cboxColorBars.Selected := GetRegValue(REGNAME_BARCOLOR, DEFAULT_BARCOLOR);

  // Logging
  updownLogLines.Position := GetRegValue(REGNAME_LOGSQLNUM, DEFAULT_LOGSQLNUM);
@@ -524,6 +536,14 @@ begin
  Modified(Sender);
 end;

+
+procedure Toptionsform.chkColorBarsClick(Sender: TObject);
+begin
+  cboxColorBars.Enabled := (Sender as TCheckbox).Checked;
+  Modified(Sender);
+end;
+
+
 procedure Toptionsform.chkNullBGClick(Sender: TObject);
 begin
  cboxNullBG.Enabled := (Sender as TCheckbox).Checked;