Home page > Delphi, tips bulk > Tips for beginners > WaitCursor: managing cursors

WaitCursor: managing cursors

Saturday 17 September 2011, by CapJack

This example shows how to change the cursor to wait cursor (sometimes also called "Hourglass"), then return to the previous cursor after treatment ended.

It uses a class TList with a "cast" TCursor / Pointer, to keep the change history of the cursor. You can so nest as many calls as you wish, the only rule is that any call to DTWaitCursorOn must correspond to a following DTWaitCursorOff.

For Delphi or Lazarus, all platforms.

  1. (*********************************************************)
  2. (***)                                                 (***)
  3. (***)               UNIT WaitCursor;                  (***)
  4. (***)                                                 (***)
  5. (*********************************************************)
  6.  
  7. (*********************************************************)
  8. (* Feel free to use it, but at your own risk!            *)
  9. (* À utiliser librement, mais à vos risques et périls !  *)
  10. (* CapJack.                                              *)
  11. (*********************************************************)
  12.  
  13.  
  14. (*********************************************************)
  15. (***)                                                 (***)
  16. (***)                  INTERFACE                      (***)
  17. (***)                                                 (***)
  18. (*********************************************************)
  19.  
  20.  
  21. (*********************************************************)
  22. (* DTWaitCursorOn                                        *)
  23. (* ----------------------------------------------------- *)
  24. (* Stores the current cursor in a list, then             *)
  25. (* changes the cursor to wait cursor.                    *)
  26. (* ----------------------------------------------------- *)
  27. (* Mémorise le curseur courant dans une liste, puis      *)
  28. (* Change le curseur en curseur d'attente.               *)
  29. (*********************************************************)
  30.  
  31. Procedure DTWaitCursorOn;
  32.  
  33.  
  34. (*********************************************************)
  35. (* DTWaitCursorOff                                       *)
  36. (* ----------------------------------------------------- *)
  37. (* Restores the cursor to the last saved cursor,         *)
  38. (* or the default cursor if the list is empty.           *)
  39. (* ----------------------------------------------------- *)
  40. (* Rétablit le curseur au dernier curseur mémorisé,      *)
  41. (* ou au curseur par défaut si la liste est vide.        *)
  42. (*********************************************************)
  43.  
  44. Procedure DTWaitCursorOff;
  45.  
  46.  
  47. (*********************************************************)
  48. (***)                                                 (***)
  49. (***)                 IMPLEMENTATION                  (***)
  50. (***)                                                 (***)
  51. (*********************************************************)
  52.  
  53. uses
  54.   Classes, Controls, Forms;
  55.  
  56. {---------------------------------------------------------}
  57.  
  58. var DTCursorHistory : TList;
  59.  
  60. {---------------------------------------------------------}
  61.  
  62. Procedure DTWaitCursorOn;
  63.  begin
  64.   DTCursorHistory.Add(Pointer(Screen.Cursor));
  65.   Screen.Cursor := crHourGlass;
  66.   Application.ProcessMessages;
  67.  end;
  68.  
  69. {---------------------------------------------------------}
  70.  
  71. Procedure DTWaitCursorOff;
  72.  var C : Integer;
  73.  begin
  74.   if not Assigned(DTCursorHistory) then exit;
  75.   C := DTCursorHistory.Count - 1; // last element...
  76.   if C >= 0
  77.    then begin
  78.          Screen.Cursor := TCursor(DTCursorHistory[C]);
  79.          DTCursorHistory.Count := C;
  80.         end
  81.    else Screen.Cursor := crDefault;
  82.   Application.ProcessMessages;
  83.  end;
  84.  
  85. {---------------------------------------------------------}
  86.  
  87. INITIALIZATION
  88.  
  89.  DTCursorHistory := TList.Create;
  90.  
  91. FINALIZATION
  92.  
  93.  if assigned(DTCursorHistory)
  94.     then DTCursorHistory.Free;
  95.  
  96. END.