[Lazarus] Changing the cursor to hourglass then to default

[Graeme Geldenhuys]

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;



Regards,
  - Graeme -

-- 
fpGUI Toolkit - a cross-platform GUI toolkit using Free Pascal
http://fpgui.sourceforge.net/