unit unit_action_kez;
{$mode objfpc}{$H+}
{
v1.4 by Totya
see: http://forum.lazarus.freepascal.org/index.php/topic,40606.0.html
}
interface
uses
Classes, SysUtils,
Forms, Controls,
ActnList;
type
TProcedureOfObject = procedure of object;
type TActionKez = class
public
constructor Create (const ActionList: TActionList;
const Screen: TScreen);
private
FActionList: TActionList;
FScreen: TScreen;
public
procedure ExecuteOnly (const Method: TProcedureOfObject);
private
FAbortAction: TAction;
protected
procedure SetAbortAction(const Action: TAction);
published
property AbortAction: TAction
read FAbortAction write SetAbortAction default nil;
private
FActionsEnabled: boolean;
protected
procedure SetActionsEnabled (const Value: boolean);
published
property ActionsEnabled: boolean
read FActionsEnabled write SetActionsEnabled default false;
public
FAbortShortCut: TShortCut;
published
property AbortShortCut : TShortCut
read FAbortShortCut default 0;
public
FAbortKey: word;
published
property AbortKey : word
read FAbortKey default 0;
public
FAbortKeyShift: TShiftState;
published
property AbortKeyShift : TShiftState
read FAbortKeyShift default [];
protected
function KeyFromShortCut (const ShortCut: TShortCut): word;
function ShiftFromShortCut (const ShortCut: TShortCut): TShiftState;
public
function OnKeyDownAbortKeyFilter (var Key: word; const Shift: TShiftState): boolean;
end;
var
ActionKez: TActionKez;
implementation
constructor TActionKez.Create (const ActionList: TActionList;
const Screen: TScreen);
begin
Inherited Create;
FActionList:= ActionList;
FScreen:= Screen;
FActionsEnabled:= true;
AbortAction:= nil;
FAbortShortCut:= 0;
FAbortKey:= 0;
FAbortKeyShift:= [];
end;
procedure TActionKez.SetActionsEnabled(const Value: boolean);
var
i: integer;
begin
with FActionList do
case Value of
false:
begin
for i:= 0 to ActionCount -1 do
(Actions[i] as TAction).Enabled:= false;
if Assigned(AbortAction)
then AbortAction.Enabled:= true;
if Assigned(FScreen)
then FScreen.Cursor:= crHourGlass;
FActionsEnabled:= false;
end;
true:
begin
for i:= 0 to ActionCount -1 do
(Actions[i] as TAction).Enabled:= true;
if Assigned(AbortAction)
then AbortAction.Enabled:= false;
if Assigned(FScreen)
then FScreen.Cursor:= crDefault;
FActionsEnabled:= true;
end;
end;
end;
procedure TActionKez.ExecuteOnly (const Method: TProcedureOfObject);
begin
ActionsEnabled:= false;
try
if Assigned(Method)
then Method;
finally
ActionsEnabled:= true;
end;
end;
procedure TActionKez.SetAbortAction(const Action: TAction);
begin
FAbortAction:= Action;
if FAbortAction = nil
then
begin
FAbortShortCut:= 0;
FAbortKey:= 0;
FAbortKeyShift:= [];
end
else
begin
FAbortShortCut:= Action.ShortCut;
FAbortKey:= KeyFromShortCut(Action.ShortCut);
FAbortKeyShift:= ShiftFromShortCut(Action.ShortCut);
end;
end;
function TActionKez.KeyFromShortCut (const ShortCut: TShortCut): word;
begin
Result:= ShortCut and $FF;
end;
function TActionKez.ShiftFromShortCut (const ShortCut: TShortCut): TShiftState;
const
Meta = $1000; // scMeta
Shift = $2000; // scShift
Control = $4000; // scControl
Alt = $8000; // scAlt
begin
Result:= [];
if ShortCut and Meta = Meta
then Result:= Result + [ssMeta];
if ShortCut and Shift = Shift
then Result:= Result + [ssShift];
if ShortCut and Control = Control
then Result:= Result + [ssCtrl];
if ShortCut and Alt = Alt
then Result:= Result + [ssAlt];
end;
function TActionKez.OnKeyDownAbortKeyFilter (var Key: word; const Shift: TShiftState): boolean;
begin
Result:= false;
if not(ActionsEnabled) then
if (AbortKeyShift <> Shift)
or
((AbortKeyShift = Shift) and (AbortKey <> Key))
then
begin
Key:= 0;
Result:= true;
end
end;
initialization
finalization
end.