Запрет смены фокуса и обработка событий при нажатии стрелок

Бывает так. Пишешь какой-нибудь красочный визуальный CustomControl, и в какой-то момент хочешь добавить реакцию на клавиатурные кнопки влево-вправо-вверх-вниз. Как грамотный человек, переопределяешь методы KeyDown или KeyPress. И тут приходит жесткий облом…

А бывает так, что творишь нечто на форме, что должно воспринимать эти злосчастные кнопки, но тут же рядом разбросаны всякие button‘ы и checkbox‘ы. Установка свойства KeyPreview формы в true с последующей обработкой OnKeyDown проблемы не решает. События просто нет. Зато фокус скачет с radiobutton на checkbox, тем самым произвольно меняя настройки.

На самом деле событие возникает, просто не всегда. Если фокус, например, на checkbox’е, событие не наступит. Хочется, мало того, чтобы всегда ловить события стрелок, но и запретить смену фокуса.

Давайте не будем трогать событие Application.OnMessage. Это слишком эпично для небольшой задачи.

Делаем так. KeyPreview оставляем true. Событие OnKeyDown формы, выглядит, например, так:

procedure TFmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key in [VK_LEFT, VK_DOWN] then
  begin
    SpinEdit1.Value := SpinEdit1.Value - 1;
    Key := 0;
  end;
  if Key in [VK_RIGHT, VK_UP] then
  begin
    SpinEdit1.Value := SpinEdit1.Value + 1;
    Key := 0;
  end;
end;

procedure TFmMain.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key in [VK_LEFT, VK_DOWN] then

begin

SpinEdit1.Value := SpinEdit1.Value - 1;

Key := 0;

end;

if Key in [VK_RIGHT, VK_UP] then

begin

SpinEdit1.Value := SpinEdit1.Value + 1;

Key := 0;

end;

То есть это то, что сделали изначально, но не получили видимого результата.

Сообщаем форме ловить событие CM_DIALOGKEY.

type
  TFmMain = class(TForm)

    ...
  private
    procedure CmDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;

type

TFmMain = class(TForm)

...

private

procedure CmDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;

И метод-обработчик:

procedure TFmMain.CmDialogKey(var Msg: TCMDialogKey);
var
  Key: Word;
begin
  Key := Msg.CharCode;
  FormKeyDown(Self, Key, KeyboardStateToShiftState);
  if Key <> 0 then
    inherited;
end;

procedure TFmMain.CmDialogKey(var Msg: TCMDialogKey);

var

Key: Word;

begin

Key := Msg.CharCode;

FormKeyDown(Self, Key, KeyboardStateToShiftState);

if Key <> 0 then

inherited;

end;

Событие CM_DIALOGKEY обслуживает нажатия кнопок VK_TAB, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL.

В CmDialogKey вызываем метод-обработчик FormKeyDown, который вернет Key равный нулю, если нажаты стрелки. Если нажаты не стрелки, обработка пойдет дальше. Если нажаты — фокус никуда скакать не будет. Таким образом сделали запрет смены фокуса и корректную обработку событий стрелочных кнопок для формы.

Запрет смены фокуса и перехват стрелочных кнопок для наследника TWinControl осуществляется другими событиями.

    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CNKeyUp(var Message: TWMKeyDown); message CN_KEYUP;

1 2	procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; procedure CNKeyUp(var Message: TWMKeyDown); message CN_KEYUP;

И реализация:

procedure TIPHueCircleTaker.CNKeyDown(var Message: TWMKeyDown);
begin
  if Message.CharCode in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then
  begin
    KeyDown(Message.CharCode, KeyboardStateToShiftState);
    Message.Result := 1;
  end else
    inherited;
end;

procedure TIPHueCircleTaker.CNKeyUp(var Message: TWMKeyDown);
begin
  if Message.CharCode in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then
  begin
    KeyUp(Message.CharCode, KeyboardStateToShiftState);
    Message.Result := 1;
  end else
    inherited;
end;

procedure TIPHueCircleTaker.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
  begin
    // нажата кнопка стрелки 
    FKeyDowning := True;
    // запомнить какая стрелка нажата для таймера
    FKey := Key;
    // Обнулить Key, чтобы дальше никуда не ушло. Запрет фокуса
    Key := 0;
    // Стартовать таймер, который будет повторять нажатие кнопки FKey 
    StartKeyTimer;
  end;
end;

procedure TIPHueCircleTaker.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if Key = FKey then
  begin
    // Обнулить ранее запомненную кнопку стрелки
    FKey := 0;
    // Остановить таймер
    StopKeyTimer;
  end;
end;

procedure TIPHueCircleTaker.CNKeyDown(var Message: TWMKeyDown);

begin

if Message.CharCode in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then

begin

KeyDown(Message.CharCode, KeyboardStateToShiftState);

Message.Result := 1;

end else

inherited;

end;

procedure TIPHueCircleTaker.CNKeyUp(var Message: TWMKeyDown);

begin

if Message.CharCode in [VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN] then

begin

KeyUp(Message.CharCode, KeyboardStateToShiftState);

Message.Result := 1;

end else

inherited;

end;

procedure TIPHueCircleTaker.KeyDown(var Key: Word; Shift: TShiftState);

begin

if Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then

begin

// нажата кнопка стрелки

FKeyDowning := True;

// запомнить какая стрелка нажата для таймера

FKey := Key;

// Обнулить Key, чтобы дальше никуда не ушло. Запрет фокуса

Key := 0;

// Стартовать таймер, который будет повторять нажатие кнопки FKey

StartKeyTimer;

end;

procedure TIPHueCircleTaker.KeyUp(var Key: Word; Shift: TShiftState);

begin

if Key = FKey then

begin

// Обнулить ранее запомненную кнопку стрелки

FKey := 0;

// Остановить таймер

StopKeyTimer;

end;

То есть мы все равно переопределяем KeyDown и KeyUp. Потому что это логично. Но вот вызываем эти методы в случае нажатых стрелок из CNKeyDown и CNKeyUp. Потому что виртуальные методы KeyDown и KeyUp стандартно просто не вызываются в этом случае.