The Wiert Corner - irregular stream of stuff: jpluimers

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