VPF::ShorCut у Action - Форум программистов

Rennigth

Дата 7.5.2008, 14:52 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Frees, поправил свой вариант, чтобы уже использованные OnEnter и OnExit тоже вызывались. Проморгал... smile

Добавлено через 16 секунд

Код


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
    function FindEditbleCtrl(AObject: TObject): PEditbleCtrl;
    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;
  lpEC: PEditbleCtrl;
begin
  lpEC := FindEditbleCtrl(ASender);
  if Assigned(lpEC) and Assigned(lpEC^.OldOnEnter) then
    lpEC^.OldOnEnter(ASender);

  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;
  lpEC: PEditbleCtrl;
begin
  lpEC := FindEditbleCtrl(ASender);
  if Assigned(lpEC) and Assigned(lpEC^.OldOnExit) then
    lpEC^.OldOnExit(ASender);

  for i := 0 to FActions.Count - 1 do
  begin
    lpAC := FActions.Items[i];
    lpAC^.Control.ShortCut := lpAC^.SaveShortCut;
  end;
end;

function TAEActionSCBlocker.FindEditbleCtrl(AObject: TObject): PEditbleCtrl;
var
  i: Integer;
begin
  Result := nil;
  if Assigned(AObject) then
  begin
    for I := 0 to FEditbleCtrls.Count - 1 do
      if TObject(FEditbleCtrls.Items[i]) = AObject then
      begin
        Result := PEditbleCtrl(FEditbleCtrls.Items[i]);
        Break;
      end;
  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.

Добавлено через 2 минуты и 35 секунд

Цитата(Frees @ 7.5.2008, 14:49

)

Rennigth, Есть едиты которым это событие ставится в динамике

Вызывай RegisterShortCuts вызывай после присвоения своих событий.

--------------------

(* Honesta mors turpi vita potior *)

Frees

Дата 7.5.2008, 15:09 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54

сейчас вот нашли пока такое решение, идея не моя колега придумал

Код


SaveActionList: TActionList;
function GetShortCut_Disabled: Boolean;
procedure SetShortCutDisabled(const Value: Boolean);
property actlShortCutDisabled: Boolean read GetShortCut_Disabled write SetShortCut_Disabled;

....
procedure TForm1.SetShortCutDisabled(const Value: Boolean);
begin
  if Value = (ActionList1.Owner = nil) then exit;
  if Value then
    RemoveComponent(ActionList1) else
    InsertComponent(ActionList1);
end;

function TForm1.GetShortCutDisabled: Boolean;
begin
  Result := ActionList1.Owner = nil;
end;

в событий OnUpdate у ActionList написатл

Код


procedure TForm1.ActionList1Update(Action: TBasicAction;
  var Handled: Boolean);
begin
   actlShortCutDisabled := ActiveControl is TEdit;
end;

теперь получается что если мы зашли в Едит то ActionList1 перестает пренадлежать форме и ей не прейдут сообщения о нажатий кнопок на клавиатуре но в то же время сами акции будут жить и работать

как думаете нормальное решение?

--------------------

Кольцов Виктор Владимирович

Rennigth

Дата 7.5.2008, 15:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Frees, Ну если подходит почемубы нет, только не забывай того что если ты отвязываешь ActionList от Owner то при закрытии(дестрое) формы ActionList не уничножиться автоматом, и получишь меморилик.

--------------------

(* Honesta mors turpi vita potior *)

Rrader

Дата 7.5.2008, 15:26 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191

Frees, чем мой вариант не подходит? smile

--------------------

Let's do this quickly!
Rest in peace, Vit!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »