Jump to content
Mike Torrettinni

Rules for changing cursor to HourGlass and back

Recommended Posts

My projects sometimes work with large files, read, parse, write, export to csv, process... sometimes action can take a few seconds, so I like to change the cursor to crHourGlass at the beginning and then back to crDefault.

While refactoring, I had occasions when I created common methods that had the change of cursor while processing. The problem is when I use button to call this method, and I already change cursor in buttons' OnClick. So, a mess.

 

Now I have a rule only to change cursor in control handlers, not in any methods, anymore. This is working good, so far.

I have 2 methods that I use instead of remembering exact syntax:

 

procedure SetCursorBegin(Cursor: TCursor = crHourGlass);
begin
  Screen.Cursor := Cursor;
end;

procedure SetCursorEnd;
begin
  Screen.Cursor := crDefault;
end;

I only develop for Windows.

 

I was just wondering if anybody has different experience and has any good tips on how to deal with cursor changing, or maybe sees a ticking time bomb in my approach to this.

 

Thank you!

Share this post


Link to post

These days, I avoid changing the cursor at all, but provide feedback in other ways. If it's a long running process, it'll be performed in a background thread.

 

If you really must change the cursor, be sure to save its current value, and wrap it all in a try..finally, e.g.

SaveTheCurrentCursorAndChangeToHourGlass;
try
  DoSomeLongProcess;
finally
  RestoreCursorToWhatItWas;
end;

 

  • Like 5
  • Thanks 1

Share this post


Link to post

Consider if DoSomeLongProcess causes an exception.. what will happen to the cursor if there was no try..finally?

 

Consider also if the cursor was something other than the default before you changed it to an HourGlass? Should you restore it to default, or to what it was before you changed it?

  • Like 1

Share this post


Link to post
unit uTempCursor;

interface

uses
  Vcl.Controls;

type
  ITempCursor = interface(IInterface)
  ['{495ADE0F-EFBE-4A0E-BF37-F1ACCACCE03D}']
  end;

  TTempCursor = class(TInterfacedObject, ITempCursor)
  strict private
    FCursor: TCursor;
  public
    constructor Create(const ACursor: TCursor);
    destructor Destroy; override;
    class function SetTempCursor(const ACursor: TCursor = crHourGlass): ITempCursor;
  end;

implementation

uses
  Vcl.Forms;

{ TTempCursor }
constructor TTempCursor.Create(const ACursor: TCursor);
begin
  inherited Create();
  FCursor := Screen.Cursor;
  Screen.Cursor := ACursor;
end;

destructor TTempCursor.Destroy;
begin
  if Assigned(Screen) then
    Screen.Cursor := FCursor;
  inherited Destroy();
end;

class function TTempCursor.SetTempCursor(const ACursor: TCursor = crHourGlass): ITempCursor;
begin
  Result := TTempCursor.Create(ACursor);
end;

end.

...using somthing like this for years (the original idea is from Jeroen Pluimer's i think). Use the SetTempCursor-Function in your code, and when the interface get out of scope, the corsur changes back to the old cursor.

 

uses uTempCursor;

procedure LongRun;
begin
 SetTempCursor;                         // the default is crHourGlass
 // do the long running stuff
end;

 

  • Thanks 2

Share this post


Link to post

I would use something like a CursorManager that would handle the application cursor state like

unit Utils.Vcl.CursorManager;

interface

uses
  System.Generics.Collections,
  System.SysUtils,
  Vcl.Controls,
  Vcl.Forms;

type
  ICursorToken = interface
    ['{7ECD8CB7-FF5C-4A5C-9C6C-D1B221432534}']
  end;

  TCursorManager = class
  private type
    TCursorRegistration = class(TInterfacedObject, ICursorToken)
    private
      FCursor: TCursor;
    public
      constructor Create(const ACursor: TCursor);
      destructor Destroy; override;

      property Cursor: TCursor read FCursor;
    end;
  private
    class var FRegistrations: TList<TCursorRegistration>;
  private
    class constructor Create;
    class destructor Destroy;
    class procedure AddRegistration(ARegistration: TCursorRegistration);
    class procedure RemoveRegistration(ARegistration: TCursorRegistration);
  public
    class function SetCursor(const ACursor: TCursor): ICursorToken;
  end;

implementation

{ TCursorManager }

class procedure TCursorManager.AddRegistration(ARegistration: TCursorRegistration);
begin
  FRegistrations.Add(ARegistration);
  Screen.Cursor := ARegistration.Cursor;
end;

class constructor TCursorManager.Create;
begin
  TCursorManager.FRegistrations := TList<TCursorRegistration>.Create();
end;

class destructor TCursorManager.Destroy;
begin
  FreeAndNil(TCursorManager.FRegistrations);
end;

class procedure TCursorManager.RemoveRegistration(ARegistration: TCursorRegistration);
begin
  if not Assigned(FRegistrations) then
    Exit;

  FRegistrations.Remove(ARegistration);
  if FRegistrations.Count > 0 then
    Screen.Cursor := FRegistrations.Last.Cursor
  else
    Screen.Cursor := crDefault;
end;

class function TCursorManager.SetCursor(const ACursor: TCursor): ICursorToken;
var
  lCursorRegistration: TCursorRegistration;
begin
  lCursorRegistration := TCursorRegistration.Create(ACursor);
  AddRegistration(lCursorRegistration);
  Result := lCursorRegistration;
end;

{ TCursorManager.TCursorRegistration }

constructor TCursorManager.TCursorRegistration.Create(const ACursor: TCursor);
begin
  inherited Create;
  FCursor := ACursor;
end;

destructor TCursorManager.TCursorRegistration.Destroy;
begin
  TCursorManager.RemoveRegistration(Self);
  inherited;
end;

end.

Now it does not matter if you have code running in fore- or background or how much time you will change the cursor. It will ensure that the last active cursor state is set.

 

Example for foreground running code

uses Utils.Vcl.CursorManager;

procedure LongRun;
begin
 TCursorManager.SetCursor(crHourGlass);                         // the default is crHourGlass
 // do the long running stuff
end;

and for background running code

uses Utils.Vcl.CursorManager;

procedure TForm1.Button1Click(Sender: TObject);
var
  cur: ICursorRegistration;
begin
  Button1.Enabled := False;
  cur := TCursorManager.SetCursor(crHourGlass);
  TTask.Run(procedure
  begin
    try
      // do the long running stuff
    finally
      TThread.Synchronize(nil, procedure
      begin
        Button1.Enabled := True;
        cur := nil; // only to keep alive until this method ends
      end);
    end;
  end);
end;

 

  • Like 1
  • Thanks 1

Share this post


Link to post
4 hours ago, Mike Torrettinni said:

Interesting, although I only change cursor to HourGlass and back. That Try.. finally looks odd, being used just for the cursor.

Why would that be odd? That's pretty much a canonical use of try finally. 

  • Like 3

Share this post


Link to post

I usually use a simple class with a counter and two methods, like BeginWait and EndWait. The first one increments the counter and sets the cursor to crHourglass if the counter was 0, the second one decrements the counter if it is positive and reverts the cursor back to crDefault when the counter is 0. Of course, with the obligatory try..finally to make sure that each BeginWait has a matching EndWait and with critical sections if multithreaded.

  • Like 3

Share this post


Link to post
6 minutes ago, Fr0sT.Brutal said:

IMO nowadays it's better to show modal progress window (or even make the process async)

Async, sure - but the user has to wait anyway and you can indicate that with the HourGlass cursor. It is not limited to sync operations.

 

Sync long operations are indicated by the modern OS itself, showing the HourGlass and adding Not Responding to the forms caption, so no work to do at all.

Edited by Schokohase

Share this post


Link to post
54 minutes ago, Schokohase said:

Sync long operations are indicated by the modern OS itself, showing the HourGlass and adding Not Responding to the forms caption, so no work to do at all.

IMHO, if you allow windows to do that, something is a bit off. It is not good UI/UX, users interpret this in different ways depending on what other software they are using. Some get an almost extreme adrenaline-surge. Be kind to users. Granted, running an app on so many different OS versions, hardware, networks it is almost impossible to achieve,but we should try to avoid it.

Share this post


Link to post
1 minute ago, Dany Marmur said:

IMHO, if you allow windows to do that, something is a bit off. It is not good UI/UX, users interpret this in different ways depending on what other software they are using. Some get an almost extreme adrenaline-surge. Be kind to users. Granted, running an app on so many different OS versions, hardware, networks it is almost impossible to achieve,but we should try to avoid it.

Yes, of course. 

 

But I understand @Fr0sT.Brutal comment that he would not set the cursor because he would use a modal progress window or an async process.

 

And my point is, you do not need to set the cursor if you have synchron long running code (because the OS will do for you) - so it only make sense to set the cursor when having code running async. 

Share this post


Link to post
3 hours ago, Schokohase said:

And my point is, you do not need to set the cursor if you have synchron long running code (because the OS will do for you) - so it only make sense to set the cursor when having code running async. 

This approach is what you take when you hate your users. They can't tell whether or not your program is stuck in a non terminating loop, and the OS asks if you want to terminate the program. So only do this if you want to make your users suffer. 

  • Like 1
  • Thanks 2

Share this post


Link to post

Wow, some complex implementation of cursor... when I changed to my simple 2 methods, I thought it is overkill 🙂

 

12 hours ago, David Heffernan said:

Why would that be odd? That's pretty much a canonical use of try finally. 

I'm not used to using try in my control handlers, usually 1 or 2 calls to methods and ShowMessage when needed. But it makes sense, of course using it for this case.

 

 

Share this post


Link to post
10 hours ago, Mike Torrettinni said:

Wow, some complex implementation of cursor... when I changed to my simple 2 methods, I thought it is overkill 🙂

Today one cannot write two simple methods and be happy. There must be classes, interfaces, factories, patterns etc - that's the serious approach :classic_smile:. Have you seen the FizzBuzz Enterprise Edition ? :classic_cool:

  • Haha 4

Share this post


Link to post
On 9/10/2019 at 12:29 AM, ConstantGardener said:

Use the SetTempCursor-Function in your code, and when the interface get out of scope, the corsur changes back to the old cursor.

 


uses uTempCursor;

procedure LongRun;
begin
 SetTempCursor;                         // the default is crHourGlass
 // do the long running stuff
end;

 

I don't have experience with interfaces, but does this actually mean what it says: you just call SetTempCursor that creates Interface and when LongRun procedure is done, it will destroy interface automatically and re-set cursor?

No need for local variable, no need for Interface=nil or something similar at the end of LongRun procedure that will trigger Destroy method?

Share this post


Link to post

I have also been using a variant of code from Jeroen W. Pluimers website.  I have incorporated it into the hcOPF project and added support for FMX.  The code credit contains the original blog post.

hcTemporaryCursor.pas

  • Thanks 1

Share this post


Link to post
3 hours ago, Mike Torrettinni said:

I don't have experience with interfaces, but does this actually mean what it says: you just call SetTempCursor that creates Interface and when LongRun procedure is done, it will destroy interface automatically and re-set cursor?

No need for local variable, no need for Interface=nil or something similar at the end of LongRun procedure that will trigger Destroy method?

exactly!

  • Thanks 1

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×