Using HourGlass cursor and autorestore it to default application cursor



{*****************************************************************************
Name : WaitForTask
Author : Perevoznyk Serhiy
Description :
History :

Date By Description
---- -- -----------
08-07-2005 Perevoznyk Serhiy Initial creation of the Unit.
*****************************************************************************}

unit WaitForTask;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms;

type
TCursorRestorer = class(TInterfacedObject)
private
FCursor : TCursor;
FWindowHandle: HWND;
FWaitTime : integer;
protected
procedure WndProc(var Msg: TMessage);
public
constructor Create(WaitTime : integer =0); virtual;
destructor Destroy; override;
procedure Restore;
end;

function Busy(WaitTime : integer = 0) : IUnknown;
procedure WaitSleep(MS : Longint);

implementation


{ TCursorRestorer }

constructor TCursorRestorer.Create;
begin
inherited Create;
FCursor := Screen.Cursor;
Restore;
FWaitTime := WaitTime;
if FWaitTime > 0 then
begin
FWindowHandle := AllocateHWnd(WndProc);
SetTimer(FWindowHandle, 1, WaitTime, nil);
end;
end;

destructor TCursorRestorer.Destroy;
begin
if FWaitTime > 0 then
begin
KillTimer(FWindowHandle, 1);
DeallocateHWnd(FWindowHandle);
end;
Screen.Cursor := FCursor;
inherited;
end;

procedure TCursorRestorer.Restore;
begin
Screen.Cursor := crHourGlass;
end;

procedure TCursorRestorer.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_TIMER then
try
KillTimer(FWindowHandle, 1);
if RefCount = 0 then
Free;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

function Busy(WaitTime : integer = 0) : IUnknown;
begin
if WaitTime > 0 then
TCursorRestorer.Create(WaitTime)
else
Result := TCursorRestorer.Create;
end;


procedure WaitSleep(MS : Longint);
const
_SECOND = 10000;
var
lBusy : LongInt;
hTimer : LongInt;
liDueTime : LARGE_INTEGER;

begin
hTimer := CreateWaitableTimer(nil, True, 'WaitableTimer');
if hTimer = 0 then
Exit;
liDueTime.QuadPart := -_Second * MS;
SetWaitableTimer(hTimer, TLargeInteger(liDueTime), 0, nil, nil, False);

repeat
lBusy := MsgWaitForMultipleObjects(1, hTimer, False,
INFINITE, QS_ALLINPUT);
Application.ProcessMessages;
Until lBusy = WAIT_OBJECT_0;

// Close the handles when you are done with them.
CloseHandle(hTimer);

End;

end.

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s