Delphi 接口(10)-接口的其他用法

Posted 2021-01-15 yishen

unit mtReaper;

interface
ImtReaper = interface
    [‘|0000-0000-0000-0000|‘]
end;

TmtReaper = class(TInterfaceObject,ImtReaper)
private
    FObject: TObject;
public
    constructor create(AObject: TObject);
    destructor Destroy; override;
end;

implementation

uses SysUtils;

constructor TmtReaper.create(AObject: TObject);
begin
  FObject := AObject;
end;

destructor TmtReaper:Destroy;
begin
    FreeAndNil(FObject);
    inherited;
end;

end.

unit FormMain;

interface

uses
    //...

type 
TNoisyDeath = class(TObject)
public
    destructor Destroy; override;
end;

TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    procedure WaitAWhile();
public
    //...
end;

var
    Form1: TForm1;

implementation

uses mtReaper;

destructor TNoisyDeath.Destroy;
begin
    ShowMessage(‘对象被销毁了!‘);
    inherited;
end;

procedure TForm1.WaitAWhile;
var 
    i: integer;
begin
    for i := 0 to 5000 do
    begin
        caption := inttostr(i); //修改窗口标题
    end;
end;

procedure TForm1.Button1Click(Sender: TObject)
var
    NoisyDeath: TNoisyDeath;
begin
    NoisyDeath := TNoisyDeath.create;
    try
      WaitAWhile;
    finally
      NoisyDeath.Free;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var 
    NoisyDeath: TNoisyDeath;
    girm: ImtReaper;
begin
    NoisyDeath := TNoisyDeath.create;
    girm := TmtReaper.create(NoisyDeath);
    WaitAWhile;
end;

end.

 

unit USnapshot

interface

type
ISnapshot = interface
[‘|0000-0000-0000-0000|‘]
end;

//persistent [p??s?st?nt]持续的;持久的;坚持不懈的;坚持不渝
//Original 原件
//Target 目标
//Reaper 收割
TSnapshot = class(TInterfaceObject,ISnapshot)
private
    FOriginal: TPersistent; //原件
    FTarget: TPresistent;   //目标
    FReaper: ImtReaper;     //收割
public
    constructor create(Target: TPersistent);
    destructor Destory; ovrride;
    procedure Restore;
end;

implementation

constructor TSnapshot.create(Target: tpresistent)
begin
    FOriginal := TPersistent(Target.classType.create);
    FReaper := TmtReaper.create(FOriginal);
    FTarget := Target;
    FOriginal.Assign(Target);
end;

destructor TSnapshot.Destory;
begin   
    Restore;
    inherited;
end;

procedure TSnapshot.Restore;
begin
    if FTarget <> nil then
        FTarget.Assign(FOriginal);
end;

unit Unit1;

interface

uses
    //...

type
TForm1 = class(TForm)
    FontDialog1: TFontDialog;
    btnSet: TButton;
    Memo1: TMemo;
    procedure btnSetClick(Sender: TObject);
    procedure FormCreate(sendre: TObject);
    procedure WaitAWhile;
private
public
    //...
end;

var
    Form1: TForm1;

implementation

uses USnapshot;

procedure TForm1.btnSetClick(Sender: TObject);
var
    FontSnapshot: ISnapshot;
begin
    FontSnapshot := TSnapshot.create(Memo1.Font);
    //这里可以填写可能会改变TFont状态的任何代码
    if FontDialog1.Execute then
        Memo1.Font := FontDialog1.Font;
    Memo1.Update;
    WaitAWhile;
end;

procedure TForm1.FormCreate(sendre: TObject);
begin
    Memo1.Lines.Add(‘一个模拟对象状态改变后自动恢复的例子‘);
end;

procedure TForm1.WaitAWhile;
var
    i: integer;
begin
    for i := 0 to 5000 do
    begin
        capton := ‘状态恢复倒计时: ‘ + inttostr(5000-i);
    end;
end;