[Lazarus] Changing the cursor to hourglass then to default

[Sven Barth]

Am 20.09.2013 16:48 schrieb "Graeme Geldenhuys" <graeme at geldenhuys.co.uk>:
>
> On 2013-09-20 15:03, Antonio Fortuny wrote:
> > *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;

Weren't you the one who asked some years ago why FPC behaves differently on
that case? Because the time when an interface's reference count is
decreased is an implementation detail...

Regards,
Sven
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20130921/b3147c65/attachment-0003.html>