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]