Antonio Fortuny wrote 6 lines
*Screen.*Cursor := crHourGlass;
try
...
finally
*Screen.*Cursor := crDefault;
end;
Another trick - slightly better that yours [I think] - is to use interfaces instead. That way you can nest cursor changes, and know the interfaces will unwind the correct previous cursor for you, be it clHourGlass, clSQLWait, clDefault etc.
----8<-------------8<-------------8<-------------8<-------------8<----
unit CodeToolbox;
interface
function tiAutoCursor(ACursor: TCursor = crHourglass): IUnknown;
function tiAutoWaitCursor: IUnknown;
implementation
type
TtiAutoCursor = class(TInterfacedObject)
private
public
constructor Create(ANewCursor: TCursor);
destructor Destroy; override;
end;
var
uCursorStack: TList;
function tiCursorStack: TList;
begin
if not Assigned(uCursorStack) then
uCursorStack := TList.Create;
Result := uCursorStack;
end;
constructor TtiAutoCursor.Create(ANewCursor: TCursor);
begin
inherited Create;
// push
tiCursorStack.Add(@(Screen.Cursor));
Screen.Cursor := ANewCursor;
end;
destructor TtiAutoCursor.Destroy;
begin
// pop
Screen.Cursor := TCursor(tiCursorStack.Last);
tiCursorStack.Delete(uCursorStack.Count-1);
inherited;
end;
function tiAutoCursor(ACursor: TCursor = crHourglass): IUnknown;
begin
if GetCurrentThreadId = MainThreadId then
Result := TtiAutoCursor.Create(ACursor);
end;
function tiAutoWaitCursor: IUnknown;
begin
if GetCurrentThreadId = MainThreadId then
Result := TtiAutoCursor.Create(crHourglass)
else
Result := nil;
end;
initialization
finalization
FreeAndNil(uCursorStack);
----8<-------------8<-------------8<-------------8<-------------8<----
You can now use the above code as follows.
procedure Foo;
var
ms: IUnknown; // FPC requires this, Delphi doesn't.
begin
ms := tiAutoCursor;
// do something long
// Note: No need to reset the cursor. The Interface will do
// that automatically when it goes out of scope.
end;
Regards,
- Graeme -
