Frees,
Накатал класс, сырой но рабочий, если понравиться, то доработаю. Пока только с Edit-ами умеет общаться:
| Код |
unit uAEASCBlocker;
(* By Bifor Rennigth *)
(* ... *)
interface
uses
Windows, SysUtils, Classes, Controls, ActnList, Forms, StdCtrls;
type
PEditbleCtrl = ^TEditbleCtrl;
TEditbleCtrl = record
Control: TEdit;
OldOnEnter: TNotifyEvent;
OldOnExit: TNotifyEvent;
end;
PActionCtrl = ^TActionCtrl;
TActionCtrl = record
Control: TAction;
SaveShortCut: TShortCut;
end;
TAEActionSCBlocker = class(TComponent)
private
FEditbleCtrls: TList;
FActions: TList;
FShortCuts: array of TShortCut;
FTargerForm: TCustomForm;
protected
procedure EditbleCtrlEnterEvent(ASender: TObject);
procedure EditbleCtrlExitEvent(ASender: TObject);
procedure LoadEditbleCtrls;
procedure ClearEditbleCtrls;
procedure LoadActions;
procedure ClearActions;
public
constructor Create(AOwner: TComponent;
ATargetForm: TCustomForm); reintroduce; virtual;
destructor Destroy; override;
procedure RegisterShortCuts(AShortCuts: array of TShortCut);
end;
implementation
{ TAEActionSCBlocker }
procedure TAEActionSCBlocker.ClearActions;
var
i: Integer;
begin
for I := 0 to FActions.Count - 1 do
begin
FreeMemory(FActions.Items[i]);
FActions.Clear;
end;
end;
procedure TAEActionSCBlocker.ClearEditbleCtrls;
var
i: Integer;
begin
for I := 0 to FEditbleCtrls.Count - 1 do
begin
FreeMemory(FEditbleCtrls.Items[i]);
FEditbleCtrls.Clear;
end;
end;
constructor TAEActionSCBlocker.Create(AOwner: TComponent;
ATargetForm: TCustomForm);
begin
inherited Create(AOwner);
FTargerForm := ATargetForm;
FEditbleCtrls := TList.Create;
FActions := TList.Create;
end;
destructor TAEActionSCBlocker.Destroy;
begin
ClearEditbleCtrls;
ClearActions;
FreeAndNil(FEditbleCtrls);
FreeAndNil(FActions);
inherited;
end;
procedure TAEActionSCBlocker.EditbleCtrlEnterEvent(ASender: TObject);
var
i: Integer;
lpAC: PActionCtrl;
begin
for i := 0 to FActions.Count - 1 do
begin
lpAC := FActions.Items[i];
lpAC^.Control.ShortCut := 0;
end;
end;
procedure TAEActionSCBlocker.EditbleCtrlExitEvent(ASender: TObject);
var
i: Integer;
lpAC: PActionCtrl;
begin
for i := 0 to FActions.Count - 1 do
begin
lpAC := FActions.Items[i];
lpAC^.Control.ShortCut := lpAC^.SaveShortCut;
end;
end;
procedure TAEActionSCBlocker.LoadEditbleCtrls;
var
i: Integer;
lpEC: PEditbleCtrl;
lEdit: TEdit;
begin
ClearEditbleCtrls;
if Assigned(FTargerForm) then
begin
for i := 0 to FTargerForm.ComponentCount - 1 do
if (FTargerForm.Components[i] is TEdit) then
begin
lEdit := TEdit(FTargerForm.Components[i]);
if Assigned(lEdit) then
begin
lpEC := GetMemory(SizeOF(TEditbleCtrl));
lpEC^.Control := lEdit;
lpEC^.OldOnEnter := lEdit.OnEnter;
lpEC^.OldOnExit := lEdit.OnExit;
lEdit.OnEnter := EditbleCtrlEnterEvent;
lEdit.OnExit := EditbleCtrlExitEvent;
FEditbleCtrls.Add(lpEC);
end;
end;
end;
end;
procedure TAEActionSCBlocker.LoadActions;
function ExistSC(ASC: TShortCut): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FShortCuts) to High(FShortCuts) do
if FShortCuts[i] = ASC then
begin
Result := True;
Break;
end;
end;
var
lAction: TAction;
lpAC: PActionCtrl;
i: Integer;
begin
ClearActions;
if Assigned(FTargerForm) then
begin
for i := 0 to FTargerForm.ComponentCount - 1 do
if (FTargerForm.Components[i] is TAction) then
begin
lAction := TAction(FTargerForm.Components[i]);
if Assigned(lAction) and ExistSC(lAction.ShortCut) then
begin
lpAC := GetMemory(SizeOF(TActionCtrl));
lpAC^.Control := lAction;
lpAC^.SaveShortCut := lAction.ShortCut;
FActions.Add(lpAC);
end;
end;
end;
end;
procedure TAEActionSCBlocker.RegisterShortCuts(AShortCuts: array of TShortCut);
var
i: Integer;
begin
SetLength(FShortCuts, Length(AShortCuts));
for i := Low(AShortCuts) to High(AShortCuts) do
FShortCuts[i] := AShortCuts[i];
LoadEditbleCtrls;
LoadActions;
end;
end.
|
Использовать так:
| Код |
unit Unit31;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActnList, StdCtrls, Unit32;
type
TForm31 = class(TForm)
edt1: TEdit;
actlst1: TActionList;
actTest: TAction;
btnTest: TButton;
procedure actTestExecute(Sender: TObject);
private
FBlocker: TAEActionSCBlocker;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
var
Form31: TForm31;
implementation
{$R *.dfm}
procedure TForm31.actTestExecute(Sender: TObject);
begin
ShowMessage('');
end;
constructor TForm31.Create(AOwner: TComponent);
begin
inherited;
FBlocker := TAEActionSCBlocker.Create(Self, Self);
FBlocker.RegisterShortCuts([VK_DELETE]);
end;
destructor TForm31.Destroy;
begin
FBlocker.Free;
inherited;
end;
end.
|
|
)
не понял
