DELPHI自定义事件（本质就是构建自定义类）、运行时标准化事件调用TNotifyEvent及普通的标准化事件传递TObjectClick(Sender)

DELPHI自定义事件（本质就是构建自定义类）、运行时标准化事件调用TNotifyEvent及普通的标准化事件传递TObjectClick(Sender)

一、自定义事件（本质就是构建自定义类）

参考：

http://docwiki.embarcadero.com/RADStudio/Rio/en/Creating_Events_-_Overview

http://docwiki.embarcadero.com/RADStudio/Rio/en/Defining_Your_Own_Events

http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types_(Delphi)

：定义自己的事件：

 

转到创建事件索引

定义全新的事件是相对不寻常的。但是，有时候某个组件引入的行为与任何其他组件完全不同，因此您需要为其定义一个事件。

以下是定义事件时需要考虑的问题：

• 触发事件
• 定义处理程序类型
• 宣布事件
• 调用事件

概念：

    任何1个控件，都有自身的N个事件属性，有些事件是按标准化事件定义的（即TNotifyEvent）
 { 标准事件Standard events ： uses System.Classes;}
type
  TNotifyEvent = procedure(Sender: TObject) of object; //:1、通知 类的事件原型
  TGetStrProc = procedure(const S: string) of object;     //:2、通知并传递 类的事件原型

     不管哪种事件原型，它们都有1个共同特点，就是它们的程序类型，都是of object，即默认都传递了1个“不让你显式的看见的”TObject。

     事件本质：就是1个类。

     但是，并非所有的事件属性都是按标准化事件TNotifyEvent定义的，而是非标准化事件，当你要将这些非标准化事件和其它组件的属性和方法进行相互调用时，此时是比较困难的，解决方法，就是为它做1个自定义的事件。自定义事件并非要改写组件本身，而是要改变它的事件的触发和响应的行为，什么时候触发、怎样触发，响应成怎样的结果。

先看代码：(备忘查询目录:D:\PulledupO2O\WinPro\WinUtilsTests)

//type
  //TaEventFunc<T> = reference to function: T;
  //TaEventProc<T> = reference to procedure(
    //const AResult:T );

type
  TaEvent = procedure(ArrayT: TArray<string>;AProc:TProc) of object;
   //:1、如果你的程序类型参数中含有TObject(匿名过程TProc或匿名函数本身也是TObject)
     //:那么,程序类型后面就必须要加上of object
     //:然而任何事件本身就是1个带有默认TObject参数的程序类型,
       //:不管你是否传递带有TObject类型的参数
   //:2、上述代码是定义1个标准化事件的格式:后面必须加of object
     //:这里你定义为需要传两个参数的格式

  TMyEvent = class(TObject)
  private
    //:定义私有属性和方法:只能在TMyEvent类内部调用
    FMyEventProc:TProc;//:定义事件的响应匿名过程//TaEventProc<string>;//TProc;
    //FMyEventFunc:TFunc<TResult> //:你还可以定义事件的泛型参数的匿名函数
    FMyEventResult:TArray<string>;//:定义事件的响应结果变量:字符串动态数组等变量
    FMyEventFunc:TFunc<TArray<string>>;//:定义事件的响应结果变量:字符串动态数组参数的函数//TaEventFunc<TArray<string>>;
    FOnMyEvent:TaEvent;//:定义事件类变量本身
    procedure setOnMyEventResult(EventParamsIn:TArray<string>);
      //:返回事件响应结果的私有过程:用字符串动态数组等变量
    procedure setOnMyEventProc(EventProc:TProc);
      //:返回事件响应结果的私有过程:用匿名过程变量
  protected
  public
    //:定义对外调用公开的属性和方法:
    constructor Create(
      ArrayT: TArray<string>;
      AProc:TProc//:定义构造方法
      );
    destructor Destroy; override;//:定义解构方法
    property MyEventProc:TProc
      read FMyEventProc write setOnMyEventProc;
      //:我的事件的匿名过程变量
    //property MyEventFunc:TFunc<TResult>
      //read FMyEventFunc write setOnMyEventFunc;
      //:你还可以定义事件的泛型函数,泛型<TResult>需要具体化类型
    property MyEventResult:TArray<string>
      read FMyEventResult       //:read响应事件
      write setOnMyEventResult; //:write定义和触发事件
      //:我的事件的字符还动态数组变量
    property OnMyEvent: TaEvent
      read FOnMyEvent           //:read响应事件
      write FOnMyEvent;         //:write定义和触发事件
      //:定义一个公开的事件,在其它的对象里面
      //:可以通过FTMyEvent.OnMyEvent=你要赋的触发事件的方法 这样调用:
        //:其读写是通过私有的FOnMyEvent在setOnMyEventResult
          //:或setOnMyEventProc中去实现的
  published
  end;

  IMyEventStandAndExtended = interface
    ['{10BAC933-0000-E800-BC81-FFFFC38D4000}']
    //...... 你还可以预留接口:让用户扩展你的自定义事件类
  end;
 

二、调用运行时来自标准化事件TNotifyEvent的属性值TValue来进行事件的通知与传递

本质是TNotifyEvent，因为其事件模型定义一致，均为：

TNotifyEvent = procedure(Sender: TObject) of object;

特殊在于：它是运行时，通过泛型值TValue来进行事件的通知和传递的：

案例代码：$(BDS)\Samples\Object Pascal\Multi-Device Samples\User Interface\CustomListBox

                   D:\开发测试\Samples\Object Pascal\Multi-Device Samples\User Interface\CustomListBox

代码分析：

procedure TfrmCustomList.Button2Click(Sender: TObject);
var Item: TListBoxItem;
begin
  // create custom item
  Item := TListBoxItem.Create(nil);
  Item.Parent := ListBox1;
  Item.StyleLookup := 'CustomItem';
  Item.Text := 'item ' + IntToStr(Item.Index); // set filename
  if Odd(Item.Index) then
    Item.ItemData.Bitmap := Image1.Bitmap // set thumbnail
  else
    Item.ItemData.Bitmap := Image2.Bitmap; // set thumbnail
  Item.StylesData['resolution'] := '1024x768 px'; // set size
  Item.StylesData['depth'] := '32 bit';
  Item.StylesData['visible'] := true; // set Checkbox value
  Item.StylesData['visible.OnChange'] //:Checkbox复选框的值改变的点选事件OnChange
    //:=frmCustomList.DoVisibleChange(sender);
      //:这样写错误:就无法赋值,因为:
      //:E2010 Incompatible types: 'TClass' and 'procedure, untyped pointer or untyped parameter'
      //:左侧是TListBoxItem类的属性值System.Rtti.TValue,右侧却是1个过程方法(非TListBoxItem类的自定义事件)
    := TValue.From<TNotifyEvent>(DoVisibleChange); //正确的赋值方法：用运行时来自标准化通知事件的值来引用该过程： set OnChange value
  Item.StylesData['info.OnClick'] //:意思是说TListBoxItem类的样式文件中StylesData样式中的info组件的点击事件属性值就是你写的DoInfoClick(Sender: TObject)的标准化点击事件在运行时刻的属性值:
    := TValue.From<TNotifyEvent>(DoInfoClick); // set OnClick value

end;

procedure TfrmCustomList.DoInfoClick(Sender: TObject);
var
  Item : TListBoxItem;
begin
  Item := TListBoxItem(FindItemParent(Sender as TFmxObject,TListBoxItem));
  if Assigned(Item) then
    InfoLabel.Text := 'Info Button click on '
    + IntToStr(Item.Index) + ' listbox item';
end;

procedure TfrmCustomList.DoVisibleChange(Sender: TObject);
var
  Item : TListBoxItem;
begin
  Item := TListBoxItem(
    FindItemParent(Sender as TFmxObject,TListBoxItem) );
  if Assigned(Item) then
    InfoLabel.Text := 'Checkbox changed '
    + IntToStr(Item.Index) + ' listbox item to '
    + BoolToStr(Item.StylesData['visible'].AsBoolean, true);
end;
 

三、标准化事件调用TObjectClick(Sender :TObject)

即普通的点击事件的传递，本质是TNotifyEvent，因为其事件模型定义一致，均为：

TNotifyEvent = procedure(Sender: TObject) of object;

参见：http://docwiki.embarcadero.com/Libraries/Rio/en/System.Classes.TNotifyEvent

http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types_(Delphi)

C++Builder原型案例：http://docwiki.embarcadero.com/CodeExamples/Rio/en/TNotifyEvent_(C%2B%2B)

TNotifyEvent用于不需要特定参数的事件。
该TNotifyEvent类型是没有事件特定参数的事件类型。这些事件只是通知组件发生了特定事件。例如，类型为TNotifyEvent的 OnClick 通知控件该控件上发生了单击事件。
该Sender参数是它的事件处理程序被调用的对象。例如，对于按钮的OnClick事件，Sender参数是被单击的按钮组件。

案例1：D:\PulledupO2O\PublicApp\DataDictionary\

procedure TfmxDictionary.ListViewMainItemClickEx(
  const Sender: TObject;
  ItemIndex: Integer; const LocalClickPos: TPointF;
  const ItemObject: TListItemDrawable);
begin
  AListViewItemClickEx(
    Sender,ItemIndex,LocalClickPos,
    ItemObject,ListViewMain);
end;

：Sender之间传递标准的TObject事件：

procedure TfmxDictionary.AListViewItemClickEx(
  const Sender: TObject;
  ItemIndex: Integer; const LocalClickPos: TPointF;
  const ItemObject: TListItemDrawable ;
  aCurrentListView:TListView  );
//各ListViewItem.View.FindDrawable点击事件的
  //:公共接口,变量：aCurrentListView
begin
  if aCurrentListView<>nil then
  begin
    if ItemObject<>nil then //很重要否则会报错，意思是：如果有TListItemDrawable的ItemObject
    begin
      if  ( ItemObject.Name=aImage1_name )
        then
      begin
        //aCurrentListView.Items[ItemIndex].Checked:=true;
          //:此索引行被选中
        TDialogService.MessageDialog('点了第'+IntToStr(ItemIndex)+'行头像'+ItemObject.Name,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
        //调用头像展示及更新窗体:...(补公共接口代码)...:
          //...............
      end;

      if  ( ItemObject.Name=aText01_name )
        then
      begin
          //ItemObject.Data.ToString等价于:(aCurrentListView.Items[ItemIndex].Objects.FindDrawable(aText01_name) as TListItemText).Data.ToString;
        TDialogService.MessageDialog('点了第'+IntToStr(ItemIndex)+'行文本'+ItemObject.Data.ToString.Trim,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
      end;

      if  ( ItemObject.Name=aImage3_name )
        then
      begin
        if ItemObject.Opacity=1 then
        begin
          ItemObject.Opacity:=0.5;//0.5敏感,其它不敏感
          aCurrentListView.Items[ItemIndex].Checked:=true;//:此索引行被选中
          //设置被选中行的颜色: as TCustomListView
          (aCurrentListView as TCustomListView).Canvas.Fill.Color:=TAlphaColor($008000);//TAlphaColorRec.Green
          TDialogService.MessageDialog('第'+IntToStr(ItemIndex)+'行被选定'+ItemObject.Name,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
        end else
        if ItemObject.Opacity=0.5 then //0.5敏感,其它不敏感
        begin
          ItemObject.Opacity:=1;
          aCurrentListView.Items[ItemIndex].Checked:=false;//:此索引行取消选中
          (aCurrentListView as TCustomListView).Canvas.Fill.Color:=TAlphaColorRec.White;
          TDialogService.MessageDialog('第'+IntToStr(ItemIndex)+'行取消选定'+ItemObject.Name,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
        end;
      end;

      if  ( ItemObject.Name=aImage4_name )
        then
      begin
          //:此索引行被选中
        TDialogService.MessageDialog('第'+IntToStr(ItemIndex)+'行编辑按钮点啦'+ItemObject.Name,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
      end;

      if  ( ItemObject.Name=aText02_name )
        then
      begin
        TDialogService.MessageDialog('点了第'+IntToStr(ItemIndex)+'行文本'+ItemObject.Data.ToString.Trim,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
      end;
      if  ( ItemObject.Name=aText03_name )
        then
      begin
        TDialogService.MessageDialog('点了第'+IntToStr(ItemIndex)+'行文本'+ItemObject.Data.ToString.Trim,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
      end;
      if  ( ItemObject.Name=aText04_name )
        then
      begin
        TDialogService.MessageDialog('点了第'+IntToStr(ItemIndex)+'行文本'+ItemObject.Data.ToString.Trim,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK],TMsgDlgBtn.mbOK,-1,nil );
      end;

    end else
    begin
      //屏蔽TListView自动行点选时的背景颜色,改用客制化的颜色:
      if (aCurrentListView.Items[ItemIndex].Objects.FindDrawable(aImage3_name) as TListItemImage).Opacity=0.5 then
      begin
        aCurrentListView.Items[ItemIndex].Checked:=true;//:此索引行被选中
        (aCurrentListView as TCustomListView).Canvas.Fill.Color:=TAlphaColor($008000);//TAlphaColorRec.Green
      end else
      begin
        aCurrentListView.Items[ItemIndex].Checked:=false;//:此索引行取消选中
        (aCurrentListView as TCustomListView).Canvas.Fill.Color:=TAlphaColorRec.White;
      end;

    end;
  end;
end;

又如案例2：TreeView父Item和子Item勾选互动

  TTreeView = class(TCustomTreeView)
  published
       property OnChangeCheck;  //.....(还有很多发布属性)
           //:该属性的父类为受保护属性:  protected TCustomTreeView.OnChangeCheck
   end;

  TMyTreeView =Class(TTreeView)
  private
  protected
  public
  published
       // 我要改写并将其发布出来供调用者和RttiType使用:
       procedure OnChangeCheck( AItem :TObject );//:protected TCustomTreeView.OnChangeCheck
  end;
  // 实现代码如下:

implementation

{$R *.fmx}
{TMyTreeView}
procedure TMyTreeView.OnChangeCheck( AItem :TObject );
var LLoop,
    LCountAllCheckedOfAParentItem,
    LCountAllUnCheckedOfAParentItem :Integer;
    LItem,
    LParentItem: TTreeViewItem;
begin
  inherited DoChangeCheck( AItem as TTreeViewItem );
      {
      procedure TCustomTreeView.DoChangeCheck( const Item: TTreeViewItem );
      begin
        if Assigned(FOnChangeCheck) then
          FOnChangeCheck(Item);
      end;
      }  

  LItem := TTreeViewItem(AItem as TTreeViewItem);
  for LLoop:=0 to LItem.Count - 1 do
     LItem.Items[LLoop].IsChecked := LItem.IsChecked;
  if TTreeViewItem(LItem).ParentItem<>nil then
  begin
    LParentItem :=TTreeViewItem(LItem).ParentItem;
    LCountAllCheckedOfAParentItem:=0;
    for LLoop:=0 to LParentItem.Count - 1 do
      if LParentItem.Items[LLoop].IsChecked=true then
        LCountAllCheckedOfAParentItem
          :=LCountAllCheckedOfAParentItem+1;
    if LCountAllCheckedOfAParentItem=LParentItem.Count then
    begin
      LParentItem.IsChecked:=true;
    end;
    LCountAllUnCheckedOfAParentItem:=LParentItem.Count;
    for LLoop:=0 to LParentItem.Count - 1 do
      if LParentItem.Items[LLoop].IsChecked=false then
        LCountAllUnCheckedOfAParentItem
          :=LCountAllUnCheckedOfAParentItem-1;
    if LCountAllUnCheckedOfAParentItem=0 then
    begin
      LParentItem.IsChecked:=false;
    end;
  end;
end;

//  调用代码:
procedure TForm1.FormCreate(Sender: TObject);
var LTreeView :TMyTreeView;
begin
    LTreeView :=TMyTreeView.Create(TreeView1);  // :TreeView1 :UI中的TreeView组件
    TreeView1.OnChangeCheck :=LTreeView.OnChangeCheck;
end; 

四、参见：

https://mp.csdn.net/console/editor/html/105065671