Ein Zwischenspeicher für fast alles

Es ist ziemilch nervend, wenn man verschiedenen Sequencen immer und immer wieder schreiben muss:

procedure TForm1.Original;
var
  OldCursor: TCursor;
  OldCaption: TCaption;
begin
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  OldCaption := Caption;
  Caption := 'Working..';
  try
    .. irgend etwas sinnvolles tun
  finally
    Screen.Cursor := OldCursor;
    Caption := OldCaption;
  end;
end;

Es wäre schön, wenn man eine Funktion hätte, um solche temporär geänderten Eigenschaften zwischenspeichern zu können:

var
  OldCursor: TCursor;
  OldCaption: TCaption;

procedure StoreCursor(Cursor: TCursor);
begin
  OldCursor := Cursor;
end;

function RestoreCursor: TCursor;
begin
  Result := OldCursor;
end;

procedure StoreCaption(Caption: TCaption);
begin
  OldCaption := Caption;
end;

function RestoreCaption: TCaption;
begin
  Result := OldCaption;
end;

Jetzt können wir die procedure Original abkürzen:

procedure TForm1.ErsterVersuch;
begin
  StoreCursor(Screen.Cursor);
  Screen.Cursor := crHourGlass;
  StoreCaption(Caption);
  Caption := 'Working..';
  try
    .. irgend etwas sinnvolles tun
  finally
    Screen.Cursor := RestoreCursor;
    Caption := RestoreCaption;
  end;
end;

Mit etwas Nachdenken lässt sich diese Variante noch kürzer schreiben:

var
  OldCursor: TCursor;
  OldCaption: TCaption;

function StoreCursor(Cursor: TCursor; NewCursor: TCursor): TCursor;
begin
  OldCursor := Cursor;
  Result := NewCursor;
end;

function RestoreCursor: TCursor;
begin
  Result := OldCursor;
end;

function StoreCaption(Caption: TCaption; NewCaption: TCaption): TCaption;
begin
  OldCaption := Caption;
  Caption := NewCaption;
end;

function RestoreCaption: TCaption;
begin
  Result := OldCaption;
end;

Die neue Variante sieht schon bedeutend besser aus:

procedure TForm1.ZweiterVersuch;
begin
  Screen.Cursor := StoreCursor(Screen.Cursor, crHourGlass);
  Caption := StoreCaption(Caption, 'Working..');
  try
    .. irgend etwas sinnvolles tun
  finally
    Screen.Cursor := RestoreCursor;
    Caption := RestoreCaption;
  end;
end;

Übrigens ist es oftmals nicht möglich, eine Prozedur mit variablen Parametern zu verwenden:

procedure StoreCaption(var Caption: TCaption; NewCaption: TCaption);

Caption und ebenso Cursor sind Eigenschaften (property) und können nicht über ihre Referenz (pass by reference) übergeben werden.

Allerdings scheint es, als würden wir uns mit dem gewählten Lösungsansatz ein anderes Problem einhandeln:

procedure TForm1.ZweiterVersuchMitFehler;
begin
  Screen.Cursor := StoreCursor(Screen.Cursor, crHourGlass);
  Caption := StoreCaption(Caption, 'Working..');
  try
    .. irgend etwas sinnvolles tun
    Caption := StoreCaption(Caption, 'Thinking..');
    try
      .. noch etwas sinnvolles tun
    finally
      Caption := RestoreCaption;
    end
  finally
    Screen.Cursor := RestoreCursor;
    Caption := RestoreCaption;
  end;
end;

Die erste ‘caption’ ist leider verloren gegangen!

Um das Problem generell zu lösen, sollten wir so etwas wie einen Stack verwenden. Ein Stack zeichnet sich durch das LiFo-Prinzip aus.
LiFo heißt ‘last in, first out’ - was zuletzt gespeichert wurde, wird zuerst wieder ausgelesen. Wir können soviele Werte wie notwendig in diesen Stack ‘hineinwerfen’ und müssen diese anschließend nur in der umgekehrten Reihenfolge wieder auslesen.

Zum Glück bietet Delphi schon von sich aus ein Objekt TStack an! Verbessern können wir den Lösungsansatz noch, indem wir uns beim Speichern der Variable nicht auf einen Datentyp festlegen und als Typ Variant verwenden:

var
  Stack: TStack;

function Push(Value: Variant; NewValue: Variant): Variant;
var
  tmp: PVariant;
begin
  GetMem(tmp, SizeOf(Variant));
  tmp^ := Value;
  Stack.Push(tmp);
  Result := NewValue;
end;

function Pop: Variant;
var
  tmp: PVariant;
begin
  if Stack.Count > 0 then begin
    tmp := Stack.Pop;
    Result := tmp^;
    tmp^ := Null;
    FreeMem(tmp, SizeOf(Variant));
  end
  else
    Result := Null;
end;

Die Zeile

tmp^ := Null;

ist notwendig, um Memory leaks zu verhindern. Wenn der Stack z.B. einen String speichert, würde

FreeMem(tmp, SizeOf(Variant));

nur den Pointer zum String freigeben, nicht den String selber.

Das Stack-Objekt lässt sich zweckmäßigerweise gleich im initialization-Abschnitt der Unit anlegen und im finalization- Abschnitt wieder freigeben:

initialization
  Stack := TStack.Create;
finalization
  Stack.Free;
end.

Auf diese Art und Weise gibt es keine Schwierigkeiten mit diesem Objekt, es steht bei Programmbeginn bereits zur Verfügung.

Unsere Prozedur lässt sich jetzt umschreiben wie folgt:

procedure TForm1.DritterVersuch;
begin
  Screen.Cursor := Push(Screen.Cursor, crHourGlass);
  Caption := Push(Caption, 'Working..');
  try
    .. irgend etwas sinnvolles tun
  finally
    Caption := Pop;
    Screen.Cursor := Pop;
  end;
end;

Wir sollten unbedingt immer das LiFo-Prinzip im Hinterkopf behalten: zuletzt ‘rein, zuerst wieder ‘raus!

Jetzt können wir uns nochmal an das Original heranwagen;

procedure TForm1.VierterVersuch;
begin
  Screen.Cursor := Push(Screen.Cursor, crHourGlass);
  Caption := Push(Caption, 'Working..');
  try
    .. irgend etwas sinnvolles tun
    Caption := Push(Caption, 'Thinking..');
    try
      .. noch etwas sinnvolles tun
    finally
      Caption := Pop;
    end
  finally
    Caption := Pop;
    Screen.Cursor := Pop;
  end;
end;

Es bleibt noch ein Problem:

1. Es ist möglich, dass zwei oder mehrere Formulare das Objekt zur gleichen Zeit nutzen.
2. Bei diesem Scenario kann man nicht sicher sein, dass alle 'pop's in der richtigen Reihenfolge stattfinden

Ich habe das Problem mit einer Liste von Stack-Objekten gelöst, jedes Formular bekommt seinen eigenen Stack. Der Source steht unter dem Link zur freien Verfügung.

LStack.pas