zoukankan      html  css  js  c++  java
  • delphi 函数过程类型 委托...?

    算是一种减少单元之间的引用的方法

    类似委托

    View Code
     1 unit Unit5;
     2 
     3 interface
     4 
     5 uses System.Classes, System.SysUtils, Vcl.Dialogs;
     6 
     7 type
     8   // 声明过程类型
     9   TObjFuns = procedure(const str1, str2: string) of object;
    10 
    11   IFormattedNumber = interface
    12     ['{19AE4E57-A022-45B1-AA42-43FF5142D685}']
    13     function FormattedString: string;
    14     function GetName: string;
    15   end;
    16 
    17   TFormattedInteger = class(TInterfacedObject, IFormattedNumber)
    18   private
    19     FValue: Integer;
    20   public
    21     // 声明过程变量
    22     FPro: TObjFuns;
    23     constructor Create(AValue: Integer);
    24     destructor Destroy; override;
    25     function FormattedString: string;
    26     function GetName: string;
    27     procedure DoDelegate(str1, str2: string);
    28   end;
    29 
    30   TFormattedHexInteger = class(TFormattedInteger, IFormattedNumber)
    31     destructor Destroy; override;
    32     function FormattedString: string;
    33     function GetName: string;
    34   end;
    35 
    36 implementation
    37 
    38 { TFormattedInteger }
    39 
    40 constructor TFormattedInteger.Create(AValue: Integer);
    41 begin
    42   inherited Create;
    43   DoDelegate('TFormattedInteger', 'Destroy');
    44   FValue := AValue;
    45 end;
    46 
    47 destructor TFormattedInteger.Destroy;
    48 begin
    49   DoDelegate('TFormattedInteger', 'Destroy');
    50   inherited Destroy;
    51 end;
    52 
    53 procedure TFormattedInteger.DoDelegate(str1, str2: string);
    54 begin
    55   // 使用过程变量
    56   if Assigned(FPro) then
    57     FPro(str1, str2);
    58 end;
    59 
    60 function TFormattedInteger.FormattedString: string;
    61 begin
    62   Result := 'This integer is' + IntToStr(FValue);
    63 end;
    64 
    65 function TFormattedInteger.GetName: string;
    66 begin
    67   Result := 'TFormattedInteger.GetName';
    68 end;
    69 
    70 { TFormattedHexInteger }
    71 
    72 destructor TFormattedHexInteger.Destroy;
    73 begin
    74   DoDelegate('TFormattedHexInteger', 'Destroy');
    75   inherited Destroy;
    76 end;
    77 
    78 function TFormattedHexInteger.FormattedString: string;
    79 begin
    80   Result := 'The hex integer is $' + IntToHex(FValue, 4);
    81 end;
    82 
    83 function TFormattedHexInteger.GetName: string;
    84 begin
    85   Result := 'TFormattedHexInteger.GetName';
    86 end;
    87 
    88 end.
    View Code
     1 unit Unit4;
     2 
     3 interface
     4 
     5 uses
     6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
     7   System.Classes, Vcl.Graphics,
     8   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
     9   Unit5;
    10 
    11 type
    12   TForm4 = class(TForm)
    13     btn1: TButton;
    14     mmo1: TMemo;
    15     procedure btn1Click(Sender: TObject);
    16   private
    17     procedure PrintfStr(const str1, str2: string);
    18     { Private declarations }
    19   public
    20     { Public declarations }
    21   end;
    22 
    23 var
    24   Form4: TForm4;
    25 
    26 implementation
    27 
    28 {$R *.dfm}
    29 
    30 procedure TForm4.btn1Click(Sender: TObject);
    31 var
    32   MyInt: TFormattedInteger;
    33 begin
    34   MyInt := TFormattedInteger.Create(123);
    35   // 给过程变量赋值
    36   MyInt.FPro := PrintfStr;
    37   mmo1.Lines.Add(MyInt.FormattedString);
    38   MyInt.Free;
    39   mmo1.Lines.Add('End of Procedure  ' + #13);
    40 
    41 end;
    42 
    43 procedure TForm4.PrintfStr(const str1, str2: string);
    44 begin
    45   mmo1.Lines.Add(str1 + '->' + str2);
    46 end;
    47 
    48 end.

     ps:最近学习接口,接口代码来自:delphi COM深入编程p22

  • 相关阅读:
    Go语言new( )函数
    Go语言讲解深拷贝与浅拷贝
    (转)使用kubectl访问Kubernetes集群时的身份验证和授权
    执行kubectl命令时报错 error: You must be logged in to the server (Unauthorized)
    报错 cannot allocate memory 或者 no space left on device ,修复K8S内存泄露问题
    linux之apt-get命令(转)
    GSensor 碰撞检测方法与实现
    uboot流程(转)
    linux 环境搭建
    333开发记录
  • 原文地址:https://www.cnblogs.com/xspace/p/2503896.html
Copyright © 2011-2022 走看看