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

Frees

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

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

Загрузка ...

Эксперт

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

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

На форме есть кнопка которой назначена Action1 у акций ShortCut = Del

Если активным контролом будет Edit1 и нажать кнопку Del, что бы удалить символ из Edit1, то начнет выполняться акция а символ не удалится.

А нужно что бы когда активным контролом был Edit1 при нажатий кнопки Del акция не выполнялась а удалился символ в Edit1

как можно решить?

пробовал так:
в событий OnUpdate у ActionList написать

Код


procedure TForm1.ActionList1Update(Action: TBasicAction;
  var Handled: Boolean);
begin
  inherited;
  if ActiveControl is TEdit then
     ActionList1.State := asSuspended
     else ActionList1.State := asNormal;
end;

но в таком случае находясь в Edit1 и нажав на Button в котором указана Action1 она не выполняется, так как кнопки которые я использую не принимаю на себя фокус и ActionList1.State := asNormal; не выполняется.

Это сообщение отредактировал(а) Frees - 7.5.2008, 11:56

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

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

MetalFan

Дата 7.5.2008, 10:16 (ссылка)

(голосов:1)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(Frees @ 7.5.2008, 09:37

)

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

шо сказал?! smile

не понял

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

There are always someone smarter than you...

Frees

Дата 7.5.2008, 10:25 (ссылка)

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

Загрузка ...

Эксперт

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

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

Если активным контролом будет Edit1 и нажать кнопку Del, что бы удалить символ из Edit1, то начнет выполняться акция а символ не удалится.

так понятнее или еще пояснить?

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

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

MetalFan

Дата 7.5.2008, 10:59 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

так, это выяснили... а что надо, чтобы происходило?

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

There are always someone smarter than you...

Frees

Дата 7.5.2008, 11:33 (ссылка)

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

Загрузка ...

Эксперт

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

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

нужно что бы когда активным контролом был Edit1 при нажатий кнопки Del акция не выполнялась а удалился символ в Edit1

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

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

Rennigth

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

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

Загрузка ...

Эксперт

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

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

Frees, А дизейслить Action по события едита OnEnter и енаблить по OnExit непробовал?

Добавлено через 5 минут и 6 секунд
Frees, вот например, все ок работает.

Код


unit Unit31;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdCtrls;

type
  TForm31 = class(TForm)
    edt1: TEdit;
    actlst1: TActionList;
    actTest: TAction;
    btn1: TButton;
    procedure actTestExecute(Sender: TObject);
    procedure edt1Enter(Sender: TObject);
    procedure edt1Exit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form31: TForm31;

implementation

{$R *.dfm}

procedure TForm31.actTestExecute(Sender: TObject);
begin
  ShowMessage('');
end;

procedure TForm31.edt1Enter(Sender: TObject);
begin
  actTest.Enabled := False;
end;

procedure TForm31.edt1Exit(Sender: TObject);
begin
  actTest.Enabled := True;
end;

end.

Нужно сделать конечно более универсально, но эт ты уже сам smile

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

(* Honesta mors turpi vita potior *)

Frees

Дата 7.5.2008, 12:00 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Rennigth @ 7.5.2008, 11:52

)

А дизейслить Action по события едита OnEnter и енаблить по OnExit непробовал?

тут 2 проблемы первое: форм много контролов на них тоже и писать обработку OnEnter и OnExit в каждой форме не очень хочется
второе если дизаблить Action то кнопки с этими Action тоже будут отдизеблены что будет не оч красиво выглядеть

Это сообщение отредактировал(а) Frees - 7.5.2008, 12:00

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

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

Rennigth

Дата 7.5.2008, 12:31 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Frees @ 7.5.2008, 12:00

)

второе если дизаблить Action то кнопки с этими Action тоже будут отдизеблены что что будет не оч красиво выглядеть

Тады так можно:

Код


unit Unit31;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdCtrls;

type
  TForm31 = class(TForm)
    edt1: TEdit;
    actlst1: TActionList;
    actTest: TAction;
    btnTest: TButton;
    procedure actTestExecute(Sender: TObject);
    procedure edt1Enter(Sender: TObject);
    procedure edt1Exit(Sender: TObject);
  private
    lSaveShotCut: TShortCut;
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form31: TForm31;

implementation

{$R *.dfm}

procedure TForm31.actTestExecute(Sender: TObject);
begin
  ShowMessage('');
end;

constructor TForm31.Create(AOwner: TComponent);
begin
  inherited;
  lSaveShotCut := actTest.ShortCut;
end;

procedure TForm31.edt1Enter(Sender: TObject);
begin
  actTest.ShortCut := 0;
end;

procedure TForm31.edt1Exit(Sender: TObject);
begin
  actTest.ShortCut := lSaveShotCut;
end;

end.

Цитата(Frees @ 7.5.2008, 12:00

)

тут 2 проблемы первое: форм много контролов на них тоже и писать обработку OnEnter и OnExit в каждой форме не очень хочется

Цитата(Rennigth @ 7.5.2008, 11:52

)

Нужно сделать конечно более универсально

Вообще нужно сделать класс который натравливать на форму, он и будет искать едитбл контролы и эшены, запонимать и переопределять у них OnEnter/OnExit.
Может не самый оптимальный вариант, но пока ничего лутшего не придумал.

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

(* Honesta mors turpi vita potior *)

MetalFan

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

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

вариант номер 3: написать наследника от TAction, перекрыть Execute, в котором сделать проверку контрола в фокусе....

Это сообщение отредактировал(а) MetalFan - 7.5.2008, 13:05

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

There are always someone smarter than you...

Rrader

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

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

Загрузка ...

Inspired =)

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

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

Frees,

Код


Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdCtrls, Buttons;

Type
  TForm1 = Class(TForm)
    Edit1: TEdit;
    ActionList1: TActionList;
    Action1: TAction;
    SpeedButton1: TSpeedButton;
    Button1: TButton;
    Procedure Action1Execute(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
  Private
    { Private declarations }
  Public
    Procedure OnMyShortCut(Var Msg: TWMKey; Var Handled: Boolean);
    { Public declarations }
  End;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.Action1Execute(Sender: TObject);
Begin
  ShowMessage('Yes');
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  OnShortCut := OnMyShortCut;
End;

Procedure TForm1.OnMyShortCut(Var Msg: TWMKey; Var Handled: Boolean);
Begin
  Handled := False;
  If Msg.CharCode = VK_DELETE Then
    If ActiveControl Is TEdit Then
    Begin
      (ActiveControl As TEdit).Perform(WM_KEYDOWN, Msg.CharCode, 0);
      Handled := True;
    End;
End;

End.

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

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

Rennigth

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

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

Загрузка ...

Эксперт

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

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

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.

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

(* Honesta mors turpi vita potior *)

aktuba

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

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

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

вариант 4: использовать ActionManager. в нем больше возможностей.

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

Frees

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

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

Загрузка ...

Эксперт

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

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

Цитата(Rennigth @ 7.5.2008, 12:31

)

запонимать и переопределять у них OnEnter/OnExit.

есть едиты которые у которых эти событи уже обрабатываются

Цитата(aktuba @ 7.5.2008, 14:17

)

использовать ActionManager. в нем больше возможностей.

я правдо не пробовал но мне кажется он мою проблему не решит а доп функционал ActionManager мне пока что не нужен

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

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

Rennigth

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

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

Загрузка ...

Эксперт

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

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

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

)

есть едиты которые у которых эти событи уже обрабатываются

Дык кто мешает их запоминать smile

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

(* Honesta mors turpi vita potior *)

Frees

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

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

Загрузка ...

Эксперт

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

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

Rennigth, Rrader, попробую покуть то что вы предлжили

Добавлено через 2 минуты и 23 секунды
Rennigth, Есть едиты которым это событие ставится в динамике

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

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

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