WaitCursor

[negaH]

Wir kennen das alle. Bei längerdauernden Operationen möchte man das Stundenglas als Waitcursor anzeigen. Dazu wird normalerweise immer folgender Weg beschritten:

Delphi-Quellcode:

procedure MacheWasWasLangeDauert;
var
  Cursor: TCursor;
begin
  Cursor := Screen.Cursor;
  try
    Screen.Cursor := crHourGlass;
    Delay(10000);
  finally
    Screen.Cursor := Cursor;
  end;
end;

Was dabei stört ist die ständige Tiparbeit mit den try finally Blocks und der lokalen Variable Cursor. Es geht auch eleganter wenn man den Compiler für uns arbeiten lässt.

Wie wir wissen gibt es in Delphi Typen die ein Referencecounter besitzen und die durch den Compiler automatisch und transparent per try finally Blöcken verwaltet werden. Ich spreche damit natürlich die Interfaces an, also IUnknown.

Der Compiler schützt den Lebenszyklus solcher Interfaces per try finally Blöcke und verwaltet transparent den Referenzzähler für uns.
Aber was die wenigsten wissen ist das
1.) wir kein TInterfacedObject benötigen um Interfaces zu benutzen
2.) wir keine Speicher allozieren müssen um Interfaces verwenden zu können

Als erstes ein PASCAL Source.

Delphi-Quellcode:

unit Miscs;

interface

function WaitCursor: IUnknown;

implementation 

uses
  Forms, Controls;

var
  WaitCount: Integer = 0;  // unser Zähler der Verschachtelungstiefe

function Wait_QueryInterface(Self: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
// Wir können unser Interface nicht in andere Interfaces Typcasten, also geben wir einen Fehler zurück
const
  E_NOINTERFACE = HResult($80004002);
begin
  Result := E_NOINTERFACE;
end;

function Wait_AddRef(Self: Pointer): Integer; stdcall;
// Der Referencecounter des Interface soll erhöht werden.
// Da wir ja global unseren WaitCursor verwalten erhöhen wir unseren Zähler.
// Falls der Zähler Null ist aktualisieren wir TScreen mit unserem Cursor
begin
  if WaitCount = 0 then
    Screen.Cursor := crHourGlass;
  Inc(WaitCount);
  Result := 1;
end;

function Wait_Release(Self: Pointer): Integer; stdcall;
// Das Interface soll freigegeben werden, also alles zurück und eventl. den Standardcursor
// wieder einblenden.
begin
  if WaitCount > 0 then
  begin
    Dec(WaitCount);
    if WaitCount = 0 then Screen.Cursor := crDefault;
  end;
  Result := 1;
end;

// so sieht die VTable = Virtuelle Methoden Tabelle eines Interfaces aus, hier IUnknown
type
  PIntfVTable = ^TIntfVTable;
  TIntfVTable = packed record
    QueryInterface: Pointer;
    _AddRef: Pointer;
    _Release: Pointer;
  end;

// so sieht dann ein alloziertes minimal Interface aus
// es enthält ähnlich wie ein TObject als erstes Feld einen Zeiger auf die VMT
  TIntf = packed record
    VTable: PIntfVTable;
 // Field1: Integer;      // hier würden die Datenfelder eines allozierten Interfaces gespeichert
  end;

// Wir wollen kein Interface allozieren da wir nur eine Kopie im Speicher benötigen.
// Also deklarieren wir es einfach als globale Konstante
const
// erstmal die VTable
  Wait_VTable: TIntfVTable =
    ( QueryInterface: @Wait_QueryInterface;
     _AddRef: @Wait_AddRef;
     _Release: @Wait_Release);
// nun unser Interface Object
  Wait_Intf: TIntf = (VTable: @Wait_VTable);


function WaitCursor: IUnknown;
// das ist unsere eigentliche Funktion
begin
  Result := IUnknown(@Wait_Intf);
end;

end.

Der Aufruf ist echt simpel:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  WaitCursor;
  Delay(1000);
end;

Wie wir sehen, keine try finally Blöcke mehr da dies der Compiler für uns erledigt. Auch keine Variable mehr da wir ja über WaitCount Verschachtelungen berücksichtigen.

Nun noch eine kleinere Version die in Assembler geschrieben ist. Natürlich ist sie in diesem Falle viel kürzer und kompakter.

Delphi-Quellcode:

function WaitCursor: IUnknown;
const
  WaitCount: Integer = -1;

  procedure SetCursor(Cursor: TCursor);
  begin
    Screen.Cursor := Cursor;
  end;

  procedure WaitIntf;
  asm
           DD    @VTable                 // Zeiger auf die Interface Virtuelle Methoden Tabelle
  @VTable: DD    @QueryInterface         // hier unsere 3 wichtigsten Methodenzeiger von IUnknown
           DD    @_AddRef
           DD    @_Release

  @QueryInterface:                       // QueryInterface gibt E_NOINTERFACE zurück
           MOV   EAX,080004002h
           RET   12                      // natürlich die 3 Parameter bei stdcall vom Stack holen

  @_AddRef:
           INC   WaitCount               // Zähler hochsetzen, und eventuell das Stundenglass
           JNZ   @Exit                   // sichtbar machen
           MOV   EAX,crHourglass
           PUSH  OFFSET @Exit
           JMP   SetCursor

  @_Release:                             // Zähler runter, und bei -1 Stundenglass unsichtbar
           DEC   WaitCount
           JNS   @Exit
           MOV   EAX,crDefault
           CALL  SetCursor

  @Exit:
           MOV   EAX,1                   // Resultat von  ._AddRef und ._Release immer 1
           RET   4
  end;

begin
  Result := IUnknown(@WaitIntf);
end;

Gruß Hagen

PS: das nächste mal beschreibe ich wie wir mit der gleichen Methode sehr schnell Speicher allozieren können ohne den Borland Speicher Manager zu nutzen.

[edit=sakura] uses eingefügt Mfg, sakura[/edit]