加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

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

发布时间:2020-12-15 09:51:18 所属栏目:大数据 来源:网络整理
导读:我有DataSource1(TDataSource),并且有一些链接到它的DB-Aware控件(通过SomeDBControl.DataSource = DataSource1) 如何在代码中找出(枚举)哪些控件链接到给定的TDataSource? 解决方法 下面的代码使用RTTI,在D7中为我工作,通过递归搜索容器对象(即表单及其组
我有DataSource1(TDataSource),并且有一些链接到它的DB-Aware控件(通过SomeDBControl.DataSource = DataSource1)

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

解决方法

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

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

更新#1:此答案的原始版本生成了表单上每个组件的列表以及其DataSource / MasterSource的名称(如果有).我已经改变它以提供与你在q的身体中所要求的更好的匹配.

更新#2:这修复了Update#1版本中的一些漏洞,并以一种避免在检查没有DataSource / MasterSource属性的组件时生成异常的方式重新实现HasDataSource函数.

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

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读