feat: reverse foreign keys on "Foreign keys" tab in table editor, including an option to toggle the new listing

Refs #1825
2026-03-13 09:24:25 +08:00 · 2026-02-28 15:47:50 +01:00
parent d6742913d4
commit 844d9c3640
5 changed files with 169 additions and 35 deletions
--- a/source/apphelpers.pas
+++ b/source/apphelpers.pas
@@ -235,7 +235,7 @@ type
    asThemePreviewWidth, asThemePreviewHeight, asThemePreviewTop, asThemePreviewLeft,
    asCreateDbCollation, asRealTrailingZeros,
    asSequalSuggestWindowWidth, asSequalSuggestWindowHeight, asSequalSuggestPrompt, asSequalSuggestRecentPrompts,
-    asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter,
+    asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, asDisplayReverseForeignKeys,
    asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, asDisplayLogPanel, asDisplayTreeFilters,
    asUnused);
  TAppSetting = record
@@ -4053,6 +4053,7 @@ begin
  InitSetting(asReformatter,                      'Reformatter',                           0);
  InitSetting(asReformatterNoDialog,              'ReformatterNoDialog',                   0);
  InitSetting(asAlwaysGenerateFilter,             'AlwaysGenerateFilter',                  0, False);
+  InitSetting(asDisplayReverseForeignKeys,        'DisplayReverseForeignKeys',             0, False);
  InitSetting(asGenerateDataNumRows,              'GenerateDataNumRows',                   1000);
  InitSetting(asGenerateDataNullAmount,           'GenerateDataNullAmount',                10);

--- a/source/dbstructures.mysql.pas
+++ b/source/dbstructures.mysql.pas
@@ -3334,6 +3334,12 @@ begin
      'SHOW TABLE STATUS LIKE :EscapedName',
      ''
      );
+    qGetReverseForeignKeys: Result := 'SELECT DISTINCT'+
+      ' k.TABLE_SCHEMA, k.TABLE_NAME'+
+      ' FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE k'+
+      ' WHERE'+
+      '   REFERENCED_TABLE_SCHEMA = :EscapedDatabase AND'+
+      '   REFERENCED_TABLE_NAME = :EscapedName';
    else Result := inherited;
  end;
 end;
--- a/source/dbstructures.pas
+++ b/source/dbstructures.pas
@@ -47,7 +47,8 @@ type
    qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber,
    qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks,
    qOrderAsc, qOrderDesc, qGetRowCountExact, qGetRowCountApprox,
-    qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets);
+    qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets,
+    qGetReverseForeignKeys);
  TSqlProvider = class
    strict protected
      FNetType: TNetType;
--- a/source/table_editor.dfm
+++ b/source/table_editor.dfm
@@ -37,7 +37,7 @@ object frmTableEditor: TfrmTableEditor
      ImageName = 'icons8-data-sheet-100'
      DesignSize = (
        686
-        121)
+        120)
      object lblName: TLabel
        Left = 4
        Top = 6
@@ -235,10 +235,10 @@ object frmTableEditor: TfrmTableEditor
      ImageName = 'icons8-lightning-bolt-100'
      object treeIndexes: TVirtualStringTree
        AlignWithMargins = True
-        Left = 69
+        Left = 73
        Top = 0
-        Width = 614
-        Height = 121
+        Width = 610
+        Height = 120
        Margins.Top = 0
        Margins.Bottom = 0
        Align = alClient
@@ -275,7 +275,7 @@ object frmTableEditor: TfrmTableEditor
            Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
            Position = 0
            Text = 'Name'
-            Width = 214
+            Width = 226
          end
          item
            Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
@@ -302,11 +302,11 @@ object frmTableEditor: TfrmTableEditor
      object tlbIndexes: TToolBar
        Left = 0
        Top = 0
-        Width = 66
-        Height = 121
+        Width = 70
+        Height = 120
        Align = alLeft
        AutoSize = True
-        ButtonWidth = 66
+        ButtonWidth = 70
        Caption = 'tlbIndexes'
        Images = MainForm.VirtualImageListMain
        List = True
@@ -367,14 +367,23 @@ object frmTableEditor: TfrmTableEditor
      Caption = 'Foreign keys'
      ImageIndex = 136
      ImageName = 'icons8-data-grid-relation'
+      object spltForeignKeyListings: TSplitter
+        Left = 573
+        Top = 0
+        Height = 120
+        Align = alRight
+        Visible = False
+        ExplicitLeft = 494
+        ExplicitTop = -3
+      end
      object tlbForeignKeys: TToolBar
        Left = 0
        Top = 0
-        Width = 66
-        Height = 121
+        Width = 70
+        Height = 120
        Align = alLeft
        AutoSize = True
-        ButtonWidth = 66
+        ButtonWidth = 70
        Caption = 'tlbForeignKeys'
        Images = MainForm.VirtualImageListMain
        List = True
@@ -406,14 +415,24 @@ object frmTableEditor: TfrmTableEditor
          Enabled = False
          ImageIndex = 26
          ImageName = 'icons8-close-button'
+          Wrap = True
          OnClick = btnClearForeignKeysClick
        end
+        object btnShowReverseForeignKeys: TToolButton
+          Left = 0
+          Top = 66
+          Hint = 'Show reverse foreign keys'
+          Caption = 'Reverse'
+          ImageIndex = 40
+          Style = tbsCheck
+          OnClick = btnShowReverseForeignKeysClick
+        end
      end
      object listForeignKeys: TVirtualStringTree
-        Left = 66
+        Left = 70
        Top = 0
-        Width = 620
-        Height = 121
+        Width = 503
+        Height = 120
        Margins.Top = 0
        Margins.Bottom = 0
        Align = alClient
@@ -474,9 +493,32 @@ object frmTableEditor: TfrmTableEditor
            Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
            Position = 5
            Text = 'On DELETE'
-            Width = 80
+            Width = 10
          end>
      end
+      object ListViewReverseForeignKeys: TListView
+        Left = 576
+        Top = 0
+        Width = 110
+        Height = 120
+        Align = alRight
+        Columns = <
+          item
+            AutoSize = True
+            Caption = 'Database'
+          end
+          item
+            AutoSize = True
+            Caption = 'Table'
+          end>
+        ColumnClick = False
+        ReadOnly = True
+        RowSelect = True
+        TabOrder = 2
+        ViewStyle = vsReport
+        Visible = False
+        OnDblClick = ListViewReverseForeignKeysDblClick
+      end
    end
    object tabCheckConstraints: TTabSheet
      Caption = 'Check constraints'
@@ -484,11 +526,11 @@ object frmTableEditor: TfrmTableEditor
      object tlbCheckConstraints: TToolBar
        Left = 0
        Top = 0
-        Width = 66
-        Height = 121
+        Width = 70
+        Height = 120
        Align = alLeft
        AutoSize = True
-        ButtonWidth = 66
+        ButtonWidth = 70
        Caption = 'tlbCheckConstraints'
        Images = MainForm.VirtualImageListMain
        List = True
@@ -521,10 +563,10 @@ object frmTableEditor: TfrmTableEditor
        end
      end
      object listCheckConstraints: TVirtualStringTree
-        Left = 66
+        Left = 70
        Top = 0
-        Width = 620
-        Height = 121
+        Width = 616
+        Height = 120
        Align = alClient
        DefaultNodeHeight = 19
        EditDelay = 0
@@ -558,7 +600,7 @@ object frmTableEditor: TfrmTableEditor
            Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coEditable, coStyleColor]
            Position = 1
            Text = 'Check clause'
-            Width = 416
+            Width = 412
          end>
      end
    end
@@ -569,8 +611,8 @@ object frmTableEditor: TfrmTableEditor
      object SynMemoPartitions: TSynMemo
        Left = 0
        Top = 0
-        Width = 593
-        Height = 121
+        Width = 686
+        Height = 120
        SingleLineMode = False
        Align = alClient
        Font.Charset = DEFAULT_CHARSET
@@ -611,8 +653,8 @@ object frmTableEditor: TfrmTableEditor
      object SynMemoCREATEcode: TSynMemo
        Left = 0
        Top = 0
-        Width = 593
-        Height = 121
+        Width = 686
+        Height = 120
        SingleLineMode = False
        Align = alClient
        Font.Charset = DEFAULT_CHARSET
@@ -653,8 +695,8 @@ object frmTableEditor: TfrmTableEditor
      object SynMemoALTERcode: TSynMemo
        Left = 0
        Top = 0
-        Width = 593
-        Height = 121
+        Width = 686
+        Height = 120
        SingleLineMode = False
        Align = alClient
        Font.Charset = DEFAULT_CHARSET
@@ -714,7 +756,7 @@ object frmTableEditor: TfrmTableEditor
      Margins.Bottom = 0
      Align = alClient
      AutoSize = True
-      ButtonWidth = 66
+      ButtonWidth = 70
      Caption = 'Columns:'
      Images = MainForm.VirtualImageListMain
      List = True
@@ -730,7 +772,7 @@ object frmTableEditor: TfrmTableEditor
        OnClick = btnAddColumnClick
      end
      object btnRemoveColumn: TToolButton
-        Left = 66
+        Left = 70
        Top = 0
        Hint = 'Remove column'
        Caption = 'Remove'
@@ -739,7 +781,7 @@ object frmTableEditor: TfrmTableEditor
        OnClick = btnRemoveColumnClick
      end
      object btnMoveUpColumn: TToolButton
-        Left = 132
+        Left = 140
        Top = 0
        Hint = 'Move up'
        Caption = 'Up'
@@ -748,7 +790,7 @@ object frmTableEditor: TfrmTableEditor
        OnClick = btnMoveUpColumnClick
      end
      object btnMoveDownColumn: TToolButton
-        Left = 198
+        Left = 210
        Top = 0
        Hint = 'Move down'
        Caption = 'Down'
--- a/source/table_editor.pas
+++ b/source/table_editor.pas
@@ -16,7 +16,9 @@ type
    btnDiscard: TButton;
    btnHelp: TButton;
    listColumns: TVirtualStringTree;
+    ListViewReverseForeignKeys: TListView;
    PageControlMain: TPageControl;
+    spltForeignKeyListings: TSplitter;
    tabBasic: TTabSheet;
    tabIndexes: TTabSheet;
    tabOptions: TTabSheet;
@@ -41,6 +43,7 @@ type
    comboCollation: TComboBox;
    lblEngine: TLabel;
    comboEngine: TComboBox;
+    btnShowReverseForeignKeys: TToolButton;
    treeIndexes: TVirtualStringTree;
    tlbIndexes: TToolBar;
    btnAddIndex: TToolButton;
@@ -94,6 +97,8 @@ type
    btnClearCheckConstraints: TToolButton;
    listCheckConstraints: TVirtualStringTree;
    Copy1: TMenuItem;
+    procedure btnShowReverseForeignKeysClick(Sender: TObject);
+    procedure ListViewReverseForeignKeysDblClick(Sender: TObject);
    procedure Modification(Sender: TObject);
    procedure btnAddColumnClick(Sender: TObject);
    procedure btnRemoveColumnClick(Sender: TObject);
@@ -207,6 +212,7 @@ type
    { Private declarations }
    FLoaded: Boolean;
    CreateCodeValid, AlterCodeValid: Boolean;
+    FReverseForeignKeysLoaded: Boolean;
    FColumns: TTableColumnList;
    FKeys, FDeletedKeys: TTableKeyList;
    FForeignKeys: TForeignKeyList;
@@ -242,6 +248,7 @@ type
    procedure CalcMinColWidth;
    procedure UpdateTabCaptions;
    function MoveNodeAllowed(Sender: TVirtualStringTree): Boolean;
+    procedure LoadReverseForeignKeys(Sender: TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
@@ -284,6 +291,7 @@ begin
  for i in ColNumsCheckboxes do begin
    listColumns.Header.Columns[i].Alignment := taCenter;
  end;
+  btnShowReverseForeignKeys.Down := AppSettings.ReadBool(asDisplayReverseForeignKeys);
  FixVT(listColumns);
  FixVT(treeIndexes);
  FixVT(listForeignKeys);
@@ -442,6 +450,8 @@ begin
  ResetModificationFlags;
  CreateCodeValid := False;
  AlterCodeValid := False;
+  FReverseForeignKeysLoaded := False;
+  btnShowReverseForeignKeysClick(Self);
  PageControlMainChange(Self); // Foreign key editor needs a hit
  // Buttons are randomly moved, since VirtualTree update, see #440
  btnSave.Top := Height - btnSave.Height - 3;
@@ -1042,6 +1052,43 @@ begin
  end;
 end;

+procedure TfrmTableEditor.ListViewReverseForeignKeysDblClick(Sender: TObject);
+var
+  ClickItem: TListItem;
+  Obj: TDBObject;
+begin
+  // Create virtual object and let mainform search for it in the tree
+  ClickItem := ListViewReverseForeignKeys.Selected;
+  if not Assigned(ClickItem) then
+    Exit;
+  Obj := TDBObject.Create(DBObject.Connection);
+  Obj.NodeType := lntTable;
+  Obj.Database := ClickItem.Caption;
+  Obj.Name := ClickItem.SubItems[0];
+  MainForm.ActiveDbObj := Obj;
+end;
+
+procedure TfrmTableEditor.btnShowReverseForeignKeysClick(Sender: TObject);
+var
+  DoShow: Boolean;
+begin
+  DoShow := btnShowReverseForeignKeys.Down;
+  if DoShow then begin
+    spltForeignKeyListings.Visible := True;
+    ListViewReverseForeignKeys.Visible := True;
+    spltForeignKeyListings.BringToFront;
+    spltForeignKeyListings.Left := ListViewReverseForeignKeys.Left - spltForeignKeyListings.Width;
+    ListViewReverseForeignKeys.BringToFront;
+    LoadReverseForeignKeys(Sender);
+  end
+  else begin
+    ListViewReverseForeignKeys.Visible := False;
+    spltForeignKeyListings.Visible := False;
+    listForeignKeys.Width := listForeignKeys.Parent.Width - tlbForeignKeys.Width;
+  end;
+  AppSettings.WriteBool(asDisplayReverseForeignKeys, DoShow);
+end;
+

 procedure TfrmTableEditor.btnAddColumnClick(Sender: TObject);
 var
@@ -2554,7 +2601,10 @@ begin
  listForeignKeys.EndEditNode;
  listCheckConstraints.EndEditNode;
  // Ensure SynMemo's have focus, otherwise Select-All and Copy actions may fail
-  if PageControlMain.ActivePage = tabCREATEcode then begin
+  if PageControlMain.ActivePage = tabForeignKeys then begin
+    LoadReverseForeignKeys(Sender);
+  end
+  else if PageControlMain.ActivePage = tabCREATEcode then begin
    SynMemoCreateCode.TrySetFocus;
  end
  else if PageControlMain.ActivePage = tabALTERcode then begin
@@ -3068,6 +3118,40 @@ begin
  end;
 end;

+procedure TfrmTableEditor.LoadReverseForeignKeys(Sender: TObject);
+var
+  SqlGet: String;
+  Results: TDBQuery;
+  ListItem: TListItem;
+begin
+  if FReverseForeignKeysLoaded then
+    Exit;
+  if not ListViewReverseForeignKeys.Visible then
+    Exit;
+  if not ObjectExists then // Jump out early when creating a new table
+    Exit;
+  SqlGet := DBObject.Connection.SqlProvider.GetSql(qGetReverseForeignKeys, DBObject.AsStringMap);
+  if SqlGet.IsEmpty then begin
+    MainForm.LogSQL(_('Database does not provide reverse foreign key listing'));
+    Exit;
+  end;
+  ListViewReverseForeignKeys.Items.BeginUpdate;
+  ListViewReverseForeignKeys.Clear;
+  try
+    Results := DBObject.Connection.GetResults(SqlGet);
+    while not Results.Eof do begin
+      ListItem := ListViewReverseForeignKeys.Items.Add;
+      ListItem.ImageIndex := ICONINDEX_TABLE;
+      ListItem.Caption := Results.Col(0);
+      ListItem.SubItems.Add(Results.Col(1));
+      Results.Next;
+    end;
+  except
+    on EDbError do;
+  end;
+  ListViewReverseForeignKeys.Items.EndUpdate;
+  FReverseForeignKeysLoaded := True;
+end;

 procedure TfrmTableEditor.btnHelpClick(Sender: TObject);
 begin