Delphi 组件开发 - 在组件内部传播事件

Question

我正在尝试开发一个新的 TEdit 组件。

TDBFilterEdit = class(TEdit)

该组件旨在根据在其编辑字段中输入的字符串过滤关联的数据集。

这是我的组件的样子：

type
TDBFilterEdit = class(TEdit)
  private
    { Private-Deklarationen }
    fFilter:String;
    fDataSource:TDataSource;
    fDataSet:TDataSet;
    fText:string;
  protected
    { Protected-Deklarationen }
    procedure SetFilter(value:String);
    procedure SetDS(value:TDataSource);
    procedure FilterRecords(DataSet:TDataSet; var Accept:Boolean);
    procedure Change(Sender:TObject);
    procedure SetText(value:String);
  public
    { Public-Deklarationen }
    constructor Create(AOwner:TComponent);
  published
    { Published-Deklarationen }
    property Text:String read fText write SetText;
    property Filter:String read fFilter write SetFilter;
    property DataSource:TDataSource read fDataSource write SetDS;
  end;

现在，在组件开发方面，我还算新手。我的第一个想法是在数据源分配给我的组件后立即覆盖数据集的 OnFilterRecord 方法，并在我的编辑组件的文本更改时触发它。

procedure TDBFilterEdit.SetDS(value:TDataSource);
var
  myaccept:Boolean;
begin
  fDataSource:=value;
  fDataSet:=fDataSource.DataSet;
  if fDataSet=nil then Exit;

  fDataSet.OnFilterRecord:=FilterRecords;
  if Filter<>'' then fDataSet.OnFilterRecord(fDataSet,myaccept);
end;

我的问题是，我不知道如何让组件知道它的 Text-属性已更新。我尝试使用以下代码

覆盖 OnChange-Method

procedure TDBFilterEdit.Change(Sender:TObject);
begin
  Filter:=Text;
  inherited Change();
end;

然而，至今无果。

Answer 1

My Problem is, I don't know how to make the component aware that its Text-property got updated.

Text属性继承自TControl。当属性值更改时，TControl 会向自己发出 CM_TEXTCHANGED 通知消息。后代类可以通过以下任一方式处理该消息：

使用 message 处理程序：

type
  TDBFilterEdit = class(TEdit)
    ...
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    ...
  published
    ...
    // DO NOT redeclare the Text property here!
    // It is already published by TEdit...
  end;

procedure TDBFilterEdit.CMTextChanged(var Message: TMessage);
begin
  inherited;
  // use new Text value as needed...
  Filter := Text;
end;

覆盖虚拟 WndProc() 方法。

type
  TDBFilterEdit = class(TEdit)
    ...
  protected
    ...
    procedure WndProc(var Message: TMessage); override;
    ...
  end;

procedure TDBFilterEdit.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = CM_TEXTCHANGED then
  begin
    // use new Text value as needed...
    Filter := Text;
  end;
end;

至于组件的其余部分，它应该看起来更像这样：

type
  TDBFilterEdit = class(TEdit)
  private
    { Private-Deklarationen }
    fDataSource: TDataSource;
    fDataSet: TDataSet;
    fFilter: String;
    procedure FilterRecords(DataSet: TDataSet; var Accept: Boolean);
    procedure SetDataSource(Value: TDataSource);
    procedure SetDataSet(Value: TDataSet);
    procedure SetFilter(const Value: String);
    procedure StateChanged(Sender: TObject);
    procedure UpdateDataSetFilter;
  protected
    { Protected-Deklarationen }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WndProc(var Message: TMessage); override;
  public
    { Public-Deklarationen }
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    property DataSource: TDataSource read fDataSource write SetDataSource;
    property Filter: String read fFilter write SetFilter;
  end;

...

destructor TDBFilterEdit.Destroy;
begin
  SetDataSource(nil);
  inherited;
end;

procedure TDBFilterEdit.FilterRecords(DataSet: TDataSet; var Accept: Boolean);
begin
  // ...
end;

procedure TDBFilterEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = fDataSource then
    begin
      SetDataSet(nil);
      fDataSource := nil;
    end
    else if AComponent = fDataSet then
    begin
      fDataSet := nil;
    end;
  end;
end;

procedure TDBFilterEdit.SetFilter(const Value: String);
begin
  if fFilter <> Value then
  begin
    fFilter := Value;
    UpdateDataSetFilter;
  end;
end;

procedure TDBFilterEdit.SetDataSource(Value: TDataSource);
begin
  if fDataSource <> Value then
  begin
    SetDataSet(nil);

    if fDataSource <> nil then
    begin
      fDataSource.RemoveFreeNotification(Self);
      fDataSource.OnStateChange := nil;
    end;

    fDataSource := Value;    

    if fDataSource <> nil then
    begin
      fDataSource.FreeNotification(Self);
      fDataSource.OnStateChange := StateChanged;
      SetDataSet(fDataSource.DataSet);
    end;
  end;
end;

procedure TDBFilterEdit.SetDataSet(Value: TDataSet);
begin
  if fDataSet <> Value then
  begin
    if fDataSet <> nil then
    begin
      fDataSet.RemoveFreeNotification(Self);
      fDataSet.OnFilterRecord := nil;
    end;

    fDataSet := Value;

    if fDataSet <> nil then
    begin
      fDataSet.FreeNotification(Self);
      fDataSet.OnFilterRecord := FilterRecords;
      UpdateDataSetFilter;
    end;
  end;
end;

procedure TDBFilterEdit.StateChanged(Sender: TObject);
begin
  if fDataSource.DataSet <> fDataSet then
    SetDataSet(fDataSource.DataSet);
end;

procedure TDBFilterEdit.UpdateDataSetFilter;
begin
  if fDataSet <> nil then
  begin
    fDataSet.Filter := fFilter;
    fDataSet.Filtered := fFilter <> '';
  end;
end;

procedure TDBFilterEdit.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = CM_TEXTCHANGED then
    Filter := Text;
end;

更新：对不起，我的错。 CM_TEXTCHANGED 消息仅在 Text 属性在代码中以编程方式更新时才发送。要检测用户何时更改了文本，您需要改为处理 Win32 EN_CHANGE 通知：

使用 message 处理程序：

type
  TDBFilterEdit = class(TEdit)
    ...
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    ...
  published
    ...
    // DO NOT redeclare the Text property here!
    // It is already published by TEdit...
  end;

procedure TDBFilterEdit.CMTextChanged(var Message: TMessage);
begin
  inherited;
  // use new Text value as needed...
  Filter := Text;
end;

procedure TDBFilterEdit.CNCommand(var Message: TWMCommand);
begin
  inherited;
  if Message.NotifyCode = EN_CHANGE then
  begin
    // use new Text value as needed...
    Filter := Text;
  end;
end;

覆盖虚拟 WndProc() 方法。

type
  TDBFilterEdit = class(TEdit)
    ...
  protected
    ...
    procedure WndProc(var Message: TMessage); override;
    ...
  end;

procedure TDBFilterEdit.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    CM_TEXTCHANGED: begin
      // use new Text value as needed...
      Filter := Text;
    end;
    CN_COMMAND: begin
      if TWMCommand(Message).NotifyCode = EN_CHANGE then
      begin
        // use new Text value as needed...
        Filter := Text;
      end;
    end;
  end;
end;

事实上，TCustomEdit 已经为您处理了 EN_CHANGE，并将调用其虚拟 Change() 方法（以触发其 OnChange 事件），您可以覆盖该方法:

    type
      TDBFilterEdit = class(TEdit)
        ...
      protected
        ...
        procedure Change; override;
        ...
      end;

    procedure TDBFilterEdit.Change;
    begin
      inherited;
      // use new Text value as needed...
      Filter := Text;
    end;

Delphi 组件开发 - 在组件内部传播事件

Delphi Component Development - Propagate Events inside component

delphi

event-handling

custom-component