delphi - 如何找出哪些 DB-Aware 控件链接到 TDataSource？

Question

我有 DataSource1 (TDataSource)，并且有一些链接到它的 DB-Aware 控件(通过 SomeDBControl.DataSource=DataSource1)

如何在代码中找出(枚举)哪些控件链接到给定的 TDataSource？

Answer 1

下面的代码使用 RTTI，在 D7 中为我工作，通过递归搜索容器对象(即表单及其组件)来列出具有 DataSource 或 MasterSource 属性的组件。

(显然，您可以对您感兴趣的任何其他表单/数据模块执行类似的操作)

更新#1:此答案的原始版本生成了表单上每个组件的列表及其 DataSource/MasterSource 的名称(如果有)。我对其进行了更改，以便与您在 q 正文中提出的要求更好地匹配。

更新 #2: 这修复了更新 #1 版本中的一些错误，并重新实现了 HasDataSource 函数，以避免在检查没有数据源的组件时生成异常。 DataSource/MasterSource 属性。

function HasDataSource(AComponent : TComponent; var ADataSource : TDataSource) : Boolean;

  function GetDataSource(APropName : String) : TDataSource;
  var
    AObject : TObject;
    PInfo : PPropInfo;
  begin
    Result :=  Nil;
    PInfo := GetPropInfo(AComponent, APropName);
    if PInfo = Nil then
      exit;
    AObject := GetObjectProp(AComponent, PInfo);
    Result := TDataSource(AObject);
  end;

begin
  Result :=  False;
  ADataSource := GetDataSource('DataSource');
  if ADataSource <> Nil then
    Result := True;
  if Result then exit;

  ADataSource := GetDataSource('MasterSource');
  if ADataSource <> Nil then
    Result := True;
end;


procedure TForm1.Log(Msg: String);
begin
  Memo1.Lines.Add(Msg);
end;

procedure TForm1.FindDataSourceObjects(AContainer : TComponent);
var
  i : Integer;
  ADataSource : TDataSource;

  procedure LogDataSourceName(AContainer : TComponent);
  begin
    Log(AContainer.Name + ' Datasource: ' + ADataSource.Name);
  end;

begin
  if HasDataSource(AContainer, ADataSource) then
    LogDataSourceName(AContainer);

  for i := 0 to AContainer.ComponentCount - 1 do begin
    FindDataSourceObjects(AContainer.Components[i]);
  end;
end;

procedure TForm1.btnFindClick(Sender: TObject);
begin
  FindDataSourceObjects(Self);
end;

我的表单的 DFM 是

object Form1: TForm1
  Left = 195
  Top = 124
  Width = 623
  Height = 303
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object DBText1: TDBText
    Left = 307
    Top = 56
    Width = 65
    Height = 17
    DataSource = DataSource1
  end
  object Panel1: TPanel
    Left = 307
    Top = 80
    Width = 281
    Height = 161
    Caption = 'Panel1'
    TabOrder = 0
    object DBText2: TDBText
      Left = 24
      Top = 64
      Width = 65
      Height = 17
      DataSource = DataSource2
    end
  end
  object Memo1: TMemo
    Left = 8
    Top = 16
    Width = 281
    Height = 225
    TabOrder = 1
  end
  object btnFind: TButton
    Left = 307
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Find'
    TabOrder = 2
    OnClick = btnFindClick
  end
  object DataSource1: TDataSource
    DataSet = ClientDataSet1
    Left = 448
    Top = 16
  end
  object DataSource2: TDataSource
    DataSet = ClientDataSet2
    Left = 544
    Top = 16
  end
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    Params = <>
    Left = 408
    Top = 16
  end
  object ClientDataSet2: TClientDataSet
    Aggregates = <>
    MasterSource = DataSource1
    PacketRecords = 0
    Params = <>
    Left = 496
    Top = 16
  end
end