Am 20.09.2013 16:48 schrieb "Graeme Geldenhuys" <[email protected]>:
>
> 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
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus

Reply via email to