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

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; 

 

完整程序:

UmtReaper:单元

unit UmtReaper;

interface

type
  ImtReaper = interface
    ['{5CFB91BE-6314-43FA-AF0C-293303083EAC}']
  end;

  TmtReaper = class(TInterfacedObject, 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.

USnapshot单元:

unit USnapshot;

interface

uses
  SysUtils, UmtReaper, system.classes,Vcl.Graphics;

type
  ISnapshot = interface
    ['{0828C81E-FE01-456D-81B5-42F7EA526A55}']
  end;

  TSnapshot = class(TInterfacedObject, ISnapshot)
  private
    FOriginalFont: TFont;
    FOriginal: TPersistent; //原件
    FTarget: TPersistent;   //目标
    FReaper: ImtReaper;     //收割
  public
    constructor create(Target: TPersistent);
    destructor Destroy; override;
    procedure Restore;
  end;

implementation

uses
  Vcl.Dialogs;

{ TSnapshot }

constructor TSnapshot.create(Target: TPersistent);
var
  Font:TFont;
begin
  Font := TFont.Create;
//  ShowMessage(Target.ClassName);
//  ShowMessage(Target.ClassParent.ClassParent.ClassName);
  FOriginal := TPersistent(Font);
  ShowMessage(TFont(FOriginal).Name);
  ShowMessage(TFont(Target).Name);
  ShowMessage(Format('%p,%p',[FOriginal.ClassInfo,target.ClassInfo]));
  FReaper := TmtReaper.create(FOriginal);
  //ShowMessage(Format('%p',[TPersistent.Create.ClassInfo]));
  FTarget := Target;
  //FOriginalFont := TFont.Create;
  //FOriginalFont.Assign(Target);
  //ShowMessage(TPersistent(target).ClassName);
  FOriginal.Assign(Target);

end;

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

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

end.

Unit2单元

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, UmtReaper, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    dlgFont1: TFontDialog;
    btn1: TButton;
    mmo1: TMemo;
    procedure btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure WaitAWhile;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses
  USnapshot;

{$R *.dfm}

procedure TForm2.btn1Click(Sender: TObject);
var
  FontSnapshot: Isnapshot;
begin
  //ShowMessage(mmo1.Font.Name);
  FontSnapshot := TSnapshot.create(mmo1.Font);
  if dlgFont1.Execute then
    mmo1.Font := dlgFont1.Font;
  mmo1.Update;
  WaitAWhile;

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  mmo1.Lines.Add('一个模拟对象状态改变后自动恢复的例子');
end;

procedure TForm2.WaitAWhile;
var
  i: Integer;
begin
  for i := 0 to 5000 do
  begin
    Caption := '状态恢复倒计时' + (5000 - i).ToString;
  end;
end;

end.

窗体代码:

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 291
  ClientWidth = 633
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 120
  TextHeight = 16
  object btn1: TButton
    Left = 0
    Top = 258
    Width = 75
    Height = 25
    Caption = 'Set'
    TabOrder = 0
    OnClick = btn1Click
  end
  object mmo1: TMemo
    Left = 0
    Top = 0
    Width = 633
    Height = 252
    Font.Charset = GB2312_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = #21326#25991#24425#20113
    Font.Style = [fsBold, fsItalic]
    ParentFont = False
    TabOrder = 1
  end
  object dlgFont1: TFontDialog
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    Left = 80
    Top = 256
  end
end

 

转载于:https://www.cnblogs.com/YiShen/p/9866204.html