The Wiert Corner – irregular stream of stuff

Following up on yesterdays Delphi: using IInterface to restore cursor at end of mehod (prelude to a memento that executes any code at end of method) here is the memento I meant.

They are based on anonymous methods, which in Delphi are closures: they capture location.

The location is kept just as long as needed, based on a well known Delphi reference counting mechanism: interfaces. The same one I used for the TTemporaryCursor class (and one of the reasons the TTemporaryCursor will keep functioning).

My goal was to simplify code like this:

procedure TTemporaryCursorMainForm.TemporaryCursorClassicButtonClick(Sender: TObject);
var
  Button: TButton;
  SavedCursor: TCursor;
  SavedEnabled: Boolean;
begin
  Button := Sender as TButton;
  SavedEnabled := Button.Enabled;
  try
    Button.Enabled := False;
    SavedCursor := Screen.Cursor;
    try
      Screen.Cursor := crHourGlass;
      Sleep(3000);
    finally
      Screen.Cursor := SavedCursor;
    end;
  finally
    Button.Enabled := SavedEnabled;
  end;
end;

Into this:

procedure TTemporaryCursorMainForm.TemporaryCursorMementoButtonClick(Sender: TObject);
var
  Button: TButton;
  SavedEnabled: Boolean;
begin
  TTemporaryCursor.SetTemporaryCursor();
  Button := Sender as TButton;
  SavedEnabled := Button.Enabled;
  TAnonymousMethodMemento.CreateMemento(procedure begin Button.Enabled := SavedEnabled; end);
  Button.Enabled := False;
  Sleep(3000); // sleep 3 seconds with the button disabled crHourGlass cursor
  // Delphi will automatically restore the cursor
end;

We’ve already seen one of the try…finally…end blocks vanish by using TTemporaryCursor. Now lets look at TAnonymousMethodMemento:

unit AnonymousMethodMementoUnit;

interface

uses
  System.SysUtils;

type
  IAnonymousMethodMemento = interface(IInterface)
  ['{29690E1E-24C8-43A5-8FDF-5F21BB32CEC2}']
  end;

  TAnonymousMethodMemento = class(TInterfacedObject, IAnonymousMethodMemento)
  strict private
    FFinallyProc: TProc;
  public
    constructor Create(const AFinallyProc: TProc);
    destructor Destroy; override;
    procedure Restore(const AFinallyProc: TProc); virtual;
    class function CreateMemento(const AFinallyProc: TProc): IAnonymousMethodMemento;
  end;

implementation

{ TAnonymousMethodMemento }
constructor TAnonymousMethodMemento.Create(const AFinallyProc: TProc);
begin
  inherited Create();
  FFinallyProc := AFinallyProc;
end;

destructor TAnonymousMethodMemento.Destroy;
begin
  Restore(FFinallyProc);
  inherited Destroy();
end;

class function TAnonymousMethodMemento.CreateMemento(const AFinallyProc: TProc): IAnonymousMethodMemento;
begin
  Result := TAnonymousMethodMemento.Create(AFinallyProc);
end;

procedure TAnonymousMethodMemento.Restore(const AFinallyProc: TProc);
begin
  AFinallyProc();
end;

end.

Like TTemporaryCursor, I’ve kept it self-contained.

It uses a TProc parameter – a parameterless anonymous method – called AFinallyProc that needs to be executed right before the memento goes out of scope.

It can be called like any method, as to the compiler it is a method.

–jeroen