Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Object-Pascal / Delphi-Language (https://www.delphipraxis.net/35-library-object-pascal-delphi-language/)
-   -   Delphi WaitCursor (https://www.delphipraxis.net/6622-waitcursor.html)

negaH 17. Jul 2003 03:49


WaitCursor
 
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]

Luckie 17. Jul 2003 04:31

Re: WaitCursor
 
Ich weiß ja nicht, also den try-finaly-Block habe ich schneller getippt. :mrgreen:

Ich habe mir das nicht lange angekuckt, nur mal eben überflogen, aber nur um ein Stundenglas anzuzeigen ist das etwas overkill - meiner Meinung nach. Was kann man den noch nützliches damit machen? Also irgendwas, wo es etwas mehr Sinn macht.

negaH 17. Jul 2003 12:58

Re: WaitCursor
 
Hi Luckie,

naja das ist Geschmackssache. Bei großen Projekten mit z.b. 20-50 Eingabemasken und vielen Berechnungen hat es mehrere Vorteile.
1.) wird der Source lesbarer
2.) muß man nicht auf Verschachtelungen achten
3.) kann man keine Fehler mehr machen, wie zB. vergessen den Wert zu restaurieren.

Es gibt aber noch viele andere Anwendungen dieses Tricks. Allerdings an Hand des WaitCursors wollte ich ja demonstrieren wie man solche forged Interfaces erzeugen kann. Ich dachte das die Code Library dazu da ist um Wissen in kompakter Form weiter zu reichen.

Bei einem größeren Projekt von mir habe ich die besagten try finally's durch obigen Assembler Code ersetzt. Dabei habe ich mir die Mühe gemacht zu zählen wie viele mal das vorkam. Es waren 357 Stellen, bei denen 11 Programmierfehler enthielten. Obiger ASM Source benötigt 36 Sourcezeilen, pro try finally kommen wir auf 8 Zeilen. 8 * 357 = 2856 Sourcecodezeile zu 36 + 357 = 393 Zeilen. Also schon einiges gespart :)
Jemand der Erfahrungen mit großen Projekten hat wird wissen das jede Bereinigung eines Sources die Entwicklung beschleunigt und den Wartungs-/Einarbeitungsaufwand veringert.




Gruß Hagen

Luckie 17. Jul 2003 14:27

Re: WaitCursor
 
Zitat:

Zitat von negaH
Hi Luckie,

naja das ist Geschmackssache. Bei großen Projekten mit z.b. 20-50 Eingabemasken und vielen Berechnungen hat es mehrere Vorteile.
1.) wird der Source lesbarer
2.) muß man nicht auf Verschachtelungen achten
3.) kann man keine Fehler mehr machen, wie zB. vergessen den Wert zu restaurieren.

OK überzeugt.
Zitat:

Ich dachte das die Code Library dazu da ist um Wissen in kompakter Form weiter zu reichen.
Richtig gedacht. Ist ja auch in Ordnung. War ja auch keine Kritok meiner Seits, ich wollte da nur etwas nachhaken, weil ich den Sinn nicht gleich gesehen habe.
Zitat:

Bei einem größeren Projekt von mir habe ich die besagten try finally's durch obigen Assembler Code ersetzt. Dabei habe ich mir die Mühe gemacht zu zählen wie viele mal das vorkam. Es waren 357 Stellen, bei denen 11 Programmierfehler enthielten. Obiger ASM Source benötigt 36 Sourcezeilen, pro try finally kommen wir auf 8 Zeilen. 8 * 357 = 2856 Sourcecodezeile zu 36 + 357 = 393 Zeilen. Also schon einiges gespart :)
Jemand der Erfahrungen mit großen Projekten hat wird wissen das jede Bereinigung eines Sources die Entwicklung beschleunigt und den Wartungs-/Einarbeitungsaufwand veringert.
So riesen Monster hatte ich noch nie.




Gruß Hagen[/quote]

negaH 17. Jul 2003 17:29

Re: WaitCursor
 
Zitat:

So riesen Monster hatte ich noch nie.
Kannste echt froh sein. Ich habe in den letzten 8 Jahren vier solcher Monster entwickelt und gewartet und bei zweien das Projekt noch zusätzlich geleitet. Wenn dann noch die Anbindungen an z.b. Zeiterfassungsysteme oder Handhelds wie Palm's dazu kommen, ist man froh wenn man einen absolut einfach gestrickten, modularen und übersichtlichen Source hat.

Gruß Hagen


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:37 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz