Delphi中的“委托”

2022-09-16 14:54:57

.NET中有委托（Delegate）的概念，其声明形式如下所示：

 
  public delegate void MyDelegate(int aIntParam, string aStringParam);
 
　　依个人所见，委托实际上就是规定一种接口，提供一种规范，任何符合该委托签名的函数/过程都属于同一类。
 
　　在Delphi中，也有类似于“委托”的概念（不过可没有C#的功能丰富，不过两者从根本上说都应该是函数指针），如下所示：
 
  type
    TMyDelegateFunc = function (AIntParam: integer; AStringParam: string): Boolean;
    TMyDelegateProc = procedure (AIntParam: integer; AStringParam: string);
 
　　在以上的声明中，还可以用of object关键字来规定所定义的“委托”是应用于对象的函数/过程，还是应用于非对象的函数/过程，例：
 
  type
    TMyObjectDelegate = procedure (AIntParam: integer; AStringParam: string) of object; //对象的
函数/过程
    TMyRegularDelegate = procedure (AIntParam: integer; AStringParam: string); //非对象的（一般的）函数/过程
 
　　以下举个简单的例子来说明一下Delphi中“委托”的应用。附件为完整程序。
　　
  1. {type
  2. TMyDelegateFunc = function (AIntParam: integer; AStringParam: string): Boolean;
  3. TMyDelegateProc = procedure (AIntParam: integer; AStringParam: string);
  4. 　　//在以上的声明中，还可以用of object关键字来规定所定义的“委托”是应用于对象的函数/过程，还是应用于非对象的函数/过程，例：
  5. type
  6. TMyObjectDelegate = procedure (AIntParam: integer; AStringParam: string) of object; //对象的函数/过程
  7. TMyRegularDelegate = procedure (AIntParam: integer; AStringParam: string); //非对象的（一般的）函数/过程
  8. 　　//以下举个简单的例子来说明一下Delphi中“委托”的应用。附件为完整程序。    }
  9. 　　
  10. unit UnitFrmTest;
  11. interface
  12. uses
  13. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  14. Dialogs, StdCtrls;
  15. type
  16. TDelegateType = (dtObject, dtRegular);
  17. //对象的函数委托
  18. TObjectNumFuncs = function (const ANumOne: Double;
  19. const ANumTwo: Double): Double of object;
  20. //非对象（一般）的函数委托
  21. TRegularNumFuncs = function (const ANumOne: Double;
  22. const ANumTwo: Double): Double;
  23. type
  24. TfrmTest = class(TForm)
  25. edtNumOne: TEdit;
  26. edtNumTwo: TEdit;
  27. btnAdd: TButton;
  28. btnSub: TButton;
  29. btnMultiply: TButton;
  30. btnDivide: TButton;
  31. lblResult: TLabel;
  32. rbObjectDelegate: TRadioButton;
  33. rbRegularDelegate: TRadioButton;
  34. procedure rbRegularDelegateClick(Sender: TObject);
  35. procedure rbObjectDelegateClick(Sender: TObject);
  36. procedure MyButtonClick(Sender: TObject);
  37. private
  38. { Private declarations }
  39. //指示当前是使用对象的函数，还是非对象的函数
  40. FDelegateType: TDelegateType;
  41. { 对象的函数列表 }
  42. function Add(const ANumOne: Double;
  43. const ANumTwo: Double): Double;
  44. function Sub(const ANumOne: Double;
  45. const ANumTwo: Double): Double;
  46. function Multiply(const ANumOne: Double;
  47. const ANumTwo: Double): Double;
  48. function Divide(const ANumOne: Double;
  49. const ANumTwo: Double): Double;
  50. { 对象的函数列表　结束 }
  51. function DoObjectCalc(const ANumOne: Double;
  52. const ANumTwo: Double; AMethod: TObjectNumFuncs): Double;
  53. public
  54. { Public declarations }
  55. end;
  56. { 非对象（一般）的函数列表 }
  57. function Add(const ANumOne: Double; const ANumTwo: Double): Double;
  58. function Sub(const ANumOne: Double; const ANumTwo: Double): Double;
  59. function Multiply(const ANumOne: Double; const ANumTwo: Double): Double;
  60. function Divide(const ANumOne: Double; const ANumTwo: Double): Double;
  61. function DoRegularCalc(const ANumOne: Double; const ANumTwo: Double;
  62. AMethod: TRegularNumFuncs): Double;
  63. { 非对象（一般）的函数列表　结束 }
  64. var
  65. frmTest: TfrmTest;
  66. implementation
  67. {$R *.dfm}
  68. { 非对象（一般）的函数列表 }
  69. function Add(const ANumOne: Double; const ANumTwo: Double): Double;
  70. begin
  71. Result := ANumOne + ANumTwo;
  72. end;
  73. function Sub(const ANumOne: Double; const ANumTwo: Double): Double;
  74. begin
  75. Result := ANumOne - ANumTwo;
  76. end;
  77. function Multiply(const ANumOne: Double; const ANumTwo: Double): Double;
  78. begin
  79. Result := ANumOne * ANumTwo;
  80. end;
  81. function Divide(const ANumOne: Double; const ANumTwo: Double): Double;
  82. begin
  83. try
  84. Result := ANumOne / ANumTwo;
  85. except
  86. on E: EZeroDivide do
  87. begin
  88. frmTest.edtNumTwo.SetFocus();
  89. frmTest.lblResult.Caption := '除数不能为零';
  90. Abort();
  91. end;
  92. end;
  93. end;
  94. function DoRegularCalc(const ANumOne: Double; const ANumTwo: Double;
  95. AMethod: TRegularNumFuncs): Double;
  96. begin
  97. Result := AMethod(ANumOne, ANumTwo);
  98. end;
  99. { 非对象（一般）的函数列表　结束 }
  100. { TfrmTest }
  101. { 对象的函数列表 }
  102. function TfrmTest.Add(const ANumOne, ANumTwo: Double): Double;
  103. begin
  104. Result := ANumOne + ANumTwo;
  105. end;
  106. function TfrmTest.Divide(const ANumOne, ANumTwo: Double): Double;
  107. begin
  108. try
  109. Result := ANumOne / ANumTwo;
  110. except
  111. on E: EZeroDivide do
  112. begin
  113. edtNumTwo.SetFocus();
  114. lblResult.Caption := '除数不能为零';
  115. Abort;
  116. end;
  117. end;
  118. end;
  119. function TfrmTest.DoObjectCalc(const ANumOne, ANumTwo: Double;
  120. AMethod: TObjectNumFuncs): Double;
  121. begin
  122. Result := AMethod(ANumOne, ANumTwo);
  123. end;
  124. function TfrmTest.Multiply(const ANumOne, ANumTwo: Double): Double;
  125. begin
  126. Result := ANumOne * ANumTwo;
  127. end;
  128. procedure TfrmTest.MyButtonClick(Sender: TObject);
  129. var
  130. dblNumOne, dblNumTwo, dblResult: Double;
  131. begin
  132. if not (Sender is TButton) then Exit;
  133. dblNumOne := StrToFloatDef(Trim(edtNumOne.Text), 0.0);
  134. dblNumTwo := StrToFloatDef(Trim(edtNumTwo.Text), 0.0);
  135. case (Sender as TButton).Tag of
  136. 0: //加
  137. begin
  138. case Self.FDelegateType of
  139. dtObject:
  140. begin
  141. dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Add);
  142. //若为
  143. //dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, UnitFrmTest.Add);
  144. //则会提示以下错误：
  145. //E2009 Incompatible types: 'regular procedure and method pointer'
  146. end;
  147. dtRegular:
  148. begin
  149. dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Add);
  150. //若为
  151. //dblResult := DoRegularCalc(dblNumOne, dblNumTwo, Self.Add);
  152. //则会提示以下错误：
  153. //E2009 Incompatible types: 'regular procedure and method pointer'
  154. end;
  155. end;
  156. end;
  157. 1: //减
  158. begin
  159. case Self.FDelegateType of
  160. dtObject:
  161. begin
  162. dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Sub);
  163. end;
  164. dtRegular:
  165. begin
  166. dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Sub);
  167. end;
  168. end;
  169. end;
  170. 2: //乘
  171. begin
  172. case Self.FDelegateType of
  173. dtObject:
  174. begin
  175. dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Multiply);
  176. end;
  177. dtRegular:
  178. begin
  179. dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Multiply);
  180. end;
  181. end;
  182. end;
  183. 3: //除
  184. begin
  185. case Self.FDelegateType of
  186. dtObject:
  187. begin
  188. dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Divide);
  189. end;
  190. dtRegular:
  191. begin
  192. dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Divide);
  193. end;
  194. end;
  195. end;
  196. end;
  197. lblResult.Caption := '结果：' + FloatToStr(dblResult);
  198. end;
  199. procedure TfrmTest.rbObjectDelegateClick(Sender: TObject);
  200. begin
  201. Self.FDelegateType := dtObject;
  202. end;
  203. procedure TfrmTest.rbRegularDelegateClick(Sender: TObject);
  204. begin
  205. Self.FDelegateType := dtRegular;
  206. end;
  207. function TfrmTest.Sub(const ANumOne, ANumTwo: Double): Double;
  208. begin
  209. Result := ANumOne - ANumTwo;
  210. end;
  211. { 对象的函数列表　结束 }
  212. end.

http://blog.csdn.net/procedure1984/article/details/3897028

上一篇：delphi中接口的委托和聚合


下一篇：应用Druid监控SQL语句的执行情况