Recent

Author Topic: [SOLVED by ASerge] Block all other actions while the current action is running  (Read 4248 times)

totya

  • Hero Member
  • *****
  • Posts: 720
Hi!

If I want to block all other actions (TActionList) while the current action is running, what is the recommended (simplest) way to do this?

Thanks!

Edit1: Thanks to: ASerge
Edit2: My actual code v1.4
« Last Edit: March 26, 2018, 06:39:57 pm by totya »

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: Block all other actions while the current action is running
« Reply #1 on: March 23, 2018, 10:54:42 pm »
This isn't recommended, because I've never tried it. But I suppose, given an actionlist named ActionList1 which contains actions including an action named ExclusiveAction which you want to temporarily block all the other actions, you could write an OnExecute handler for ExclusiveAction like this:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.ExclusiveActionExecute(Sender: TObject);
  2. var
  3.   ca: TContainedAction;
  4. begin
  5.   for ca in ActionList1 do
  6.     if ca.Equals(Sender) then
  7.       Continue
  8.     else TCustomAction(ca).Enabled := False;
  9.  
  10.   // your code to Execute the action of ExclusiveAction goes here
  11.  
  12.   for ca in ActionList1 do
  13.     TCustomAction(ca).Enabled := True;
  14. end;

ASerge

  • Hero Member
  • *****
  • Posts: 2212
Re: Block all other actions while the current action is running
« Reply #2 on: March 23, 2018, 10:58:59 pm »
If I want to block all other actions (TActionList) while the current action is running, what is the recommended (simplest) way to do this?
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Action1Execute(Sender: TObject);
  2. var
  3.   ActionList: TCustomActionList;
  4. begin
  5.   ActionList := (Sender as TAction).ActionList;
  6.   ActionList.State := asSuspended;
  7.   try
  8.     // Do work
  9.   finally
  10.     ActionList.State := asNormal;
  11.   end;
  12. end;

totya

  • Hero Member
  • *****
  • Posts: 720
Re: Block all other actions while the current action is running
« Reply #3 on: March 24, 2018, 11:43:13 am »
Thanks to you, it's working!

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Action1Execute(Sender: TObject);
  2. begin
  3.   with (Sender as TAction) do
  4.   begin
  5.     ActionList.State := asSuspended;
  6.     try
  7.       // Do work
  8.     finally
  9.       ActionList.State := asNormal;
  10.     end;
  11.   end;
  12. end;
  13.  
« Last Edit: March 24, 2018, 03:41:41 pm by totya »

totya

  • Hero Member
  • *****
  • Posts: 720
Re: Block all other actions while the current action is running
« Reply #4 on: March 24, 2018, 11:48:43 am »
This isn't recommended, because I've never tried it. But I suppose, given an actionlist named ActionList1 which contains actions including an action named ExclusiveAction which you want to temporarily block all the other actions, you could write an OnExecute handler for ExclusiveAction like this

Hi!

Thanks for the answer, but I need this: when I running any action, the all other actions be blocked.

totya

  • Hero Member
  • *****
  • Posts: 720
v1.4 - Simplified usage in Action.OnExecute, see example 2.

v1.3 - Abort hot key (full support)
       - Simplified FormKeyDown code

v1.2 - Abort Hotkey (partial support only)

v1.1 - Disabled action state now visible on attached menu items.
       - AbortAction.

Code: Pascal  [Select][+][-]
  1. unit unit_action_kez;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. {
  6.   v1.4 by Totya
  7.  
  8.   see: http://forum.lazarus.freepascal.org/index.php/topic,40606.0.html
  9. }
  10.  
  11. interface
  12.  
  13. uses
  14.   Classes, SysUtils,
  15.  
  16.   Forms, Controls,
  17.  
  18.   ActnList;
  19.  
  20. type
  21.   TProcedureOfObject = procedure of object;
  22.  
  23. type TActionKez = class
  24.      public
  25.        constructor Create (const ActionList: TActionList;
  26.                            const Screen: TScreen);
  27.  
  28.      private
  29.        FActionList: TActionList;
  30.        FScreen: TScreen;
  31.  
  32.      public
  33.        procedure ExecuteOnly (const Method: TProcedureOfObject);
  34.  
  35.      private
  36.        FAbortAction: TAction;
  37.      protected
  38.        procedure SetAbortAction(const Action: TAction);
  39.      published
  40.        property AbortAction: TAction
  41.                   read FAbortAction write SetAbortAction default nil;
  42.  
  43.      private
  44.        FActionsEnabled: boolean;
  45.      protected
  46.        procedure SetActionsEnabled (const Value: boolean);
  47.      published
  48.        property ActionsEnabled: boolean
  49.                  read FActionsEnabled write SetActionsEnabled default false;
  50.  
  51.      public
  52.        FAbortShortCut: TShortCut;
  53.      published
  54.        property AbortShortCut : TShortCut
  55.                   read FAbortShortCut default 0;
  56.  
  57.      public
  58.        FAbortKey: word;
  59.      published
  60.        property AbortKey : word
  61.                   read FAbortKey default 0;
  62.  
  63.      public
  64.        FAbortKeyShift: TShiftState;
  65.      published
  66.        property AbortKeyShift : TShiftState
  67.                   read FAbortKeyShift default [];
  68.  
  69.      protected
  70.        function KeyFromShortCut (const ShortCut: TShortCut): word;
  71.        function ShiftFromShortCut (const ShortCut: TShortCut): TShiftState;
  72.  
  73.      public
  74.        function OnKeyDownAbortKeyFilter (var Key: word; const Shift: TShiftState): boolean;
  75.      end;
  76.  
  77. var
  78.   ActionKez: TActionKez;
  79.  
  80. implementation
  81.  
  82. constructor TActionKez.Create (const ActionList: TActionList;
  83.                                const Screen: TScreen);
  84. begin
  85.   Inherited Create;
  86.  
  87.   FActionList:= ActionList;
  88.   FScreen:= Screen;
  89.  
  90.   FActionsEnabled:= true;
  91.  
  92.   AbortAction:= nil;
  93.   FAbortShortCut:= 0;
  94.   FAbortKey:= 0;
  95.   FAbortKeyShift:= [];
  96. end;
  97.  
  98. procedure TActionKez.SetActionsEnabled(const Value: boolean);
  99. var
  100.   i: integer;
  101. begin
  102.   with FActionList do
  103.     case Value of
  104.  
  105.       false:
  106.         begin
  107.           for i:= 0 to ActionCount -1 do
  108.             (Actions[i] as TAction).Enabled:= false;
  109.  
  110.             if Assigned(AbortAction)
  111.               then AbortAction.Enabled:= true;
  112.  
  113.             if Assigned(FScreen)
  114.               then FScreen.Cursor:= crHourGlass;
  115.  
  116.             FActionsEnabled:= false;
  117.         end;
  118.  
  119.       true:
  120.         begin
  121.           for i:= 0 to ActionCount -1 do
  122.            (Actions[i] as TAction).Enabled:= true;
  123.  
  124.           if Assigned(AbortAction)
  125.             then AbortAction.Enabled:= false;
  126.  
  127.           if Assigned(FScreen)
  128.             then FScreen.Cursor:= crDefault;
  129.  
  130.           FActionsEnabled:= true;
  131.         end;
  132.     end;
  133. end;
  134.  
  135. procedure TActionKez.ExecuteOnly (const Method: TProcedureOfObject);
  136. begin
  137.     ActionsEnabled:= false;
  138.  
  139.     try
  140.       if Assigned(Method)
  141.         then Method;
  142.  
  143.     finally
  144.       ActionsEnabled:= true;
  145.     end;
  146. end;
  147.  
  148. procedure TActionKez.SetAbortAction(const Action: TAction);
  149. begin
  150.   FAbortAction:= Action;
  151.  
  152.   if FAbortAction = nil
  153.     then
  154.       begin
  155.         FAbortShortCut:= 0;
  156.  
  157.         FAbortKey:= 0;
  158.         FAbortKeyShift:= [];
  159.       end
  160.     else
  161.       begin
  162.         FAbortShortCut:= Action.ShortCut;
  163.  
  164.         FAbortKey:= KeyFromShortCut(Action.ShortCut);
  165.         FAbortKeyShift:= ShiftFromShortCut(Action.ShortCut);
  166.       end;
  167. end;
  168.  
  169. function TActionKez.KeyFromShortCut (const ShortCut: TShortCut): word;
  170. begin
  171.   Result:= ShortCut and $FF;
  172. end;
  173.  
  174. function TActionKez.ShiftFromShortCut (const ShortCut: TShortCut): TShiftState;
  175. const
  176.   Meta    = $1000; // scMeta
  177.   Shift   = $2000; // scShift
  178.   Control = $4000; // scControl
  179.   Alt     = $8000; // scAlt
  180. begin
  181.   Result:= [];
  182.  
  183.   if ShortCut and Meta = Meta
  184.     then Result:= Result + [ssMeta];
  185.  
  186.   if ShortCut and Shift = Shift
  187.     then Result:= Result + [ssShift];
  188.  
  189.   if ShortCut and Control = Control
  190.     then Result:= Result + [ssCtrl];
  191.  
  192.   if ShortCut and Alt = Alt
  193.     then Result:= Result + [ssAlt];
  194. end;
  195.  
  196. function TActionKez.OnKeyDownAbortKeyFilter (var Key: word; const Shift: TShiftState): boolean;
  197. begin
  198.   Result:= false;
  199.  
  200.   if not(ActionsEnabled) then
  201.     if (AbortKeyShift <> Shift)
  202.         or
  203.        ((AbortKeyShift = Shift) and (AbortKey <> Key))
  204.     then
  205.       begin
  206.         Key:= 0;
  207.         Result:= true;
  208.       end
  209. end;
  210.  
  211. initialization
  212.  
  213. finalization
  214.  
  215. end.
  216.  

Usage in Action.OnExecute, example 1.

Code: Pascal  [Select][+][-]
  1. procedure TxyForm.ACxyExecute(Sender: TObject);
  2. begin
  3.   ActionKez.ExecuteOnly(Sender, @MethodToRun);
  4. end;          
  5.  

Usage in Action.OnExecute, example 2.

Code: Pascal  [Select][+][-]
  1. procedure TxyForm.AcxyExecute(Sender: TObject);
  2. begin
  3.   ActionKez.ActionsEnabled:= false;
  4.   try
  5.     xymethod;
  6.   finally
  7.     ActionKez.ActionsEnabled:= true;
  8.   end;
  9. end;
  10.  

Delete unneded (actions?) shortcut keys while action is running:
Remark: form.KeyPreview:=true needed!

Code: Pascal  [Select][+][-]
  1. procedure TxyForm.FormKeyDown(Sender: TObject; var Key: Word;
  2.   Shift: TShiftState);
  3. begin
  4.   if ActionKez.OnKeyDownAbortKeyFilter(Key, Shift) then;
  5. end;
  6.  
« Last Edit: March 26, 2018, 06:39:44 pm by totya »

ASerge

  • Hero Member
  • *****
  • Posts: 2212
v1.1, because I don't see disabled state on attached menu items. + AbortAction. Usage as above.
If you can avoid creating an object, it's best to avoid it!
Code: Pascal  [Select][+][-]
  1. procedure ExecuteActionAlone(Action: TObject; ExclusiveAction: TObject = nil);
  2.  
  3.   procedure SuspendList(ForAction: TCustomAction; Suspend: Boolean; ExclusiveAction: TObject);
  4.   var
  5.     A: TContainedAction;
  6.   begin
  7.     if Assigned(ForAction.ActionList) then
  8.       for A in ForAction.ActionList do
  9.         if (A <> ExclusiveAction) and (A <> ForAction) and (A is TCustomAction) then
  10.           TCustomAction(A).Enabled := not Suspend;
  11.   end;
  12.  
  13. begin
  14.   if not (Action is TCustomAction) then
  15.     Exit;
  16.   SuspendList(TCustomAction(Action), True, ExclusiveAction);
  17.   try
  18.     TCustomAction(Action).Execute;
  19.   finally
  20.     SuspendList(TCustomAction(Action), False, ExclusiveAction);
  21.   end;
  22. end;

totya

  • Hero Member
  • *****
  • Posts: 720
Thanks ASerge again! I'l try your code later. My code works very well for me, see reply#5

Thanks again!

totya

  • Hero Member
  • *****
  • Posts: 720
Okay, I use ActionList again, and I need fine-tuned solution.

My idea (for the simplified usage): the (part of) action category name used to set action group/enable/visible. Sometimes I need disable functions (group), but not the all functions. For example the "exit function" or some checkbox must stay always enabled. And I need must disabled actions, for example in release compile mode. The code:

Code: Pascal  [Select][+][-]
  1. unit ActionListUtil;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, ActnList;
  9.  
  10. procedure SetActionsParam(const ActionList: TActionList; const aCategoryNamePart: string;
  11.   const aEnabled, aVisible: boolean; const aAlwaysEnableCategoryNamePart: string;
  12.   const aAlwaysDisableCategoryNamePart: string);
  13.  
  14. implementation
  15.  
  16. procedure SetActionsParam(const ActionList: TActionList; const aCategoryNamePart: string;
  17.   const aEnabled, aVisible: boolean; const aAlwaysEnableCategoryNamePart: string;
  18.   const aAlwaysDisableCategoryNamePart: string);
  19.  
  20.   function SetActionsParam(const xPart: string; const xIndex: integer; const xEnabled, xVisible: boolean): boolean;
  21.   begin
  22.     Result := False;
  23.  
  24.     if Trim(xPart) <> '' then
  25.       with (ActionList.Actions[xIndex] as TAction) do
  26.         if Pos(AnsiUpperCase(Trim(xPart)), AnsiUpperCase(Trim(Category))) > 0 then
  27.         begin
  28.           if Enabled <> xEnabled then
  29.             Enabled := xEnabled;
  30.  
  31.           if Visible <> xVisible then
  32.             Visible := xVisible;
  33.  
  34.           Result := True;
  35.         end;
  36.   end;
  37.  
  38. var
  39.   i: integer;
  40. begin
  41.   for i := 0 to ActionList.ActionCount - 1 do
  42.   begin
  43.     if SetActionsParam(aAlwaysEnableCategoryNamePart, i, True, True) then
  44.       Continue;
  45.  
  46.     if SetActionsParam(aAlwaysDisableCategoryNamePart, i, False, False) then
  47.       Continue;
  48.  
  49.     if SetActionsParam(aCategoryNamePart, i, aEnabled, aVisible) then
  50.       Continue;
  51.   end;
  52. end;
  53.  
  54. end.

... and then call to disable other action when run an action:

Code: Pascal  [Select][+][-]
  1. SetActionsParam(ActionList, 'Function', False, True, AlwaysEnabledFunctions, AlwaysDisabledFunctions);
  2.  

... and enable again:

Code: Pascal  [Select][+][-]
  1. SetActionsParam(ActionList, 'Function', True, True, AlwaysEnabledFunctions, AlwaysDisabledFunctions);
  2.  

It's works for me.

lucamar

  • Hero Member
  • *****
  • Posts: 4219
I don't know if this will be useful for you but what I do usually is use the Tag property as a "Flags" field.

For example, in a text editor actions and menu items which should only be available if there is a selection Tag = 1, the ones which are enabled only if we are inside some operation have Tag = 2, etc. That allows me to do something like:

Code: Pascal  [Select][+][-]
  1. procedure UpdateMenuItems(const Root: TMenuItem);
  2. var
  3.   AnItem: TMenuItem;
  4. begin
  5.   for AnItem in Root do
  6.     case AnItem.Tag of
  7.     1: begin
  8.         AnItem.Enabled := Memo.SelLength = 0;
  9.         if Assigned(AnItem.Action) then
  10.           AnItem.Action.Enabled := AnItem.Enabled;
  11.       end;
  12.     2: begin
  13.         AnItem.Enabled := SomeOtherCondition;
  14.         if Assigned(AnItem.Action) then
  15.           {...etc...}
  16.       end;
  17.     end; {case Tag of}
  18. end;

To use it I pass it a "Root" TMenuItem which would be, for example, a top-level item of the main menu, say the "Edit" one:
Code: [Select]
{ on a handler for some event }
  UpdateMenuItems(itEdit);

This is with menu items but the same can be done with actions (inverting the terms, of course).
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

totya

  • Hero Member
  • *****
  • Posts: 720
I don't know if this will be useful for you but what I do usually is use the Tag property as a "Flags" field.

Hi, very thanks for the tip, but my solution logic is much deeper (more level), and no need to new (duplicate) flags. And if I see ActionList in the IDE, I see the action type from the category name, and I can change it easily.

 

TinyPortal © 2005-2018