Страница 1 из 2

Действие при нажатии F8, F9, F10

Добавлено: 24 окт 2019, 23:32
DjoserZee
Доброй ночи,

подскажите, пожалуйста, как реализовать скрипт - при нажатии F8, F9 или F10 происходило нажатие соответсвующей кнопок dxButton1, dxButton2, dxButton3 в форме.

Действие при нажатии F8, F9, F10

Добавлено: 24 окт 2019, 23:45
Develop-Soft
А режим формы какой?

Действие при нажатии F8, F9, F10

Добавлено: 25 окт 2019, 08:36
DjoserZee
Режим формы - только таблица.

Действие при нажатии F8, F9, F10

Добавлено: 08 ноя 2019, 01:55
DjoserZee
Доброй ночи,
не могу заставить работать скрипт :(, где ошибка

Код: Выделить всё

procedure OKD(Sender: TObject; var Key: Word; Shift: TShiftState);
begin if (Key=119) then Key:=32 end;

procedure Form_Create;
var i:integer;
begin
  for i:=0 to Self.ComponentCount-1 do
 if Pos(LowerCase(Self.Components[i].ClassName), 'dxButton3') > 0
 then
  TWinControl(Self.Components[i]).OnKeyDown:=@OKD;
end;   

Действие при нажатии F8, F9, F10

Добавлено: 08 ноя 2019, 08:00
jurist23rus
Вместе со скриптом не ленитесь прикреплять пример базы данных - это здорово экономит время отвечающему.

Действие при нажатии F8, F9, F10

Добавлено: 08 ноя 2019, 08:20
Develop-Soft
DjoserZee писал(а):не могу заставить работать скрипт :(, где ошибка
Это не тот (сабж) скрипт.
DjoserZee писал(а):как реализовать скрипт - при нажатии F8, F9 или F10 происходило нажатие соответсвующей кнопок dxButton1, dxButton2, dxButton3 в форме.

Код: Выделить всё

const VK_F8 = 119;
      VK_F9 = 120;
      VK_F10 = 121;

var OldOnKeyDown:TKeyEvent;

procedure OKD(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Shift = [] then
  case Key of
    VK_F8: dxButton1.Click;
    VK_F9: dxButton2.Click;
    VK_F10: dxButton3.Click;
  end;
if OldOnKeyDown<>nil then
OldOnKeyDown(Sender,Key,Shift);
end;

procedure Form_Create;
begin
  if Self.EditWindow<>nil then
  begin
    OldOnKeyDown := Self.EditWindow.OnKeyDown;
    Self.EditWindow.OnKeyDown:=@OKD;
  end;
end;

Действие при нажатии F8, F9, F10

Добавлено: 09 ноя 2019, 00:21
DjoserZee
Дорой ночи,

большое спасибо за помощь, я страюсь разобраться со скриптами, но пока плохо получается :cry:

Ваш скрипт прекрасно работает, но у меня на форме уже есть скрипт:

Код: Выделить всё

procedure OKD(Sender: TObject; var Key: Word; Shift: TShiftState);
    begin if (Key=13) then Key:=9 end;
     
    procedure Form_Create;
    var i:integer;
    begin
      for i:=0 to Self.ComponentCount-1 do
     if Pos(LowerCase(Self.Components[i].ClassName), 'tdxedit tdxcalcedit tdxmemo'+
     ' tdxobjectfield tdxdateedit tdxtimeedit tdxcombobox tdxlookupcombobox tdxfile '+
     ' tdxcounter tdxcheckbox ') > 0
     then
      TWinControl(Self.Components[i]).OnKeyDown:=@OKD;
    end;
... и теперь работает только один из скриптов.

Подскжите, пожайлуста, как можно заставить раьотать оба скрипта.

Работаю в свере здравоохранения, пытаюсь перейти с DOS-ской базы учета больных на виндовс, "досовские" привычки у врачей остались - переход по Enter, подпись или поиск F8-F9-F10 :(

Действие при нажатии F8, F9, F10

Добавлено: 09 ноя 2019, 13:37
Develop-Soft

Код: Выделить всё

const VK_F8 = 119;
      VK_F9 = 120;
      VK_F10 = 121;
      VK_RETURN = 13;
      VK_TAB = 9;

var OldOnKeyDown:TKeyEvent;

function GetProp(hWnd:HWND; lpString:Pchar):THANDLE;
external 'GetPropA@user32 stdcall';

function GetFocus:HWND;
external 'GetFocus@user32 stdcall';

function FindControl(Handle: HWND): TWinControl;
begin
  if Handle <> 0
  then Result := TWinControl(GetProp(Handle,'WinControl'))
  else Result := nil;
end;

procedure OKD(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Pos(LowerCase(FindControl(GetFocus).ClassName),
'tdxedit tdxcalcedit tdxmemo tdxobjectfield tdxdateedit tdxtimeedit '+
'tdxcombobox tdxlookupcombobox tdxfile tdxcounter tdxcheckbox ')>0
// для переноса в "Заметке" по Enter можно исключить из спиcка "tdxmemo"
// иначе перенос возможен по Shift+Enter
  then
if Shift = [] then
  case Key of
    VK_F8: dxButton1.Click;
    VK_F9: dxButton2.Click;
    VK_F10: dxButton3.Click;
    VK_RETURN: Key:=VK_TAB;
  end;
if OldOnKeyDown<>nil then
OldOnKeyDown(Sender,Key,Shift);
end;

procedure Form_Create;
begin
  if Self.EditWindow<>nil then
  begin
    OldOnKeyDown := Self.EditWindow.OnKeyDown;
    Self.EditWindow.OnKeyDown:=@OKD;
  end;
end;

Действие при нажатии F8, F9, F10

Добавлено: 09 ноя 2019, 23:09
DjoserZee
Добрый вечер,

большое спасибо за скрипт. Появилась ошибка при переходе по Enter на dxLookupComboBox1, если убрать dxLookupComboBox1 то ошибка пропадает. Клавиши F8, F9, F10 работают.
pic.jpg
pic.jpg (50.09 КБ) 891 просмотр

TEST.zip
(48.09 КБ) 65 скачиваний

Действие при нажатии F8, F9, F10

Добавлено: 10 ноя 2019, 14:25
Develop-Soft
DjoserZee писал(а):если убрать dxLookupComboBox1 то ошибка пропадает

Ошибка была не в dxLookupComboBox1 а dxComboBox1. Это составной компонент и он неверно определялся функцией WinApi: GetFocus. Пришлось дописать под него код.

Код: Выделить всё

const VK_F8 = 119;
      VK_F9 = 120;
      VK_F10 = 121;
      VK_RETURN = 13;
      VK_TAB = 9;

var OldOnKeyDown:TKeyEvent;

function GetProp(hWnd:HWND; lpString:Pchar):THANDLE;
external 'GetPropA@user32 stdcall';

function GetFocus:HWND;
external 'GetFocus@user32 stdcall';

function GetParent(hWnd:HWND):HWND;
external 'GetParent@user32 stdcall';

function FindControl(Handle: HWND): TWinControl;
begin
  if Handle <> 0
  then Result := TWinControl(GetProp(Handle,'WinControl'))
  else Result := nil;
end;

function FindOwnerControl(Handle: HWND): TWinControl;
begin
  while Handle<>0 do
  begin
  Result := FindControl(Handle);
  if Result <> nil then
    Exit;
  Handle := GetParent(Handle);
  end;
  Result := nil;
end;

function FindTdxControl(Handle: HWND):TWinControl;
begin
  result:=FindControl(Handle);
  if result=nil then
  result:=FindOwnerControl(Handle);
end;

procedure OKD(Sender: TObject; var Key: Word; Shift: TShiftState);
var WC:TWinControl;
begin
WC := FindTdxControl(GetFocus);
if WC <> nil then
if Pos(LowerCase(FindTdxControl(GetFocus).ClassName),
'tdxedit tdxcalcedit tdxmemo tdxobjectfield tdxdateedit tdxtimeedit '+
'tdxcombobox tdxlookupcombobox tdxfile tdxcounter tdxcheckbox')>0
// для переноса в "Заметке" по Enter можно исключить из спиcка "tdxmemo"
// иначе перенос возможен по Shift+Enter
  then
if Shift = [] then
  case Key of
    VK_F8: dxButton1.Click;
    VK_F9: dxButton2.Click;
    VK_F10: dxButton3.Click;
    VK_RETURN: Key:=VK_TAB;
  end;
if OldOnKeyDown<>nil then
OldOnKeyDown(Sender,Key,Shift);
end;

procedure Form_Create;
begin
  if Self.EditWindow<>nil then
  begin
    OldOnKeyDown := Self.EditWindow.OnKeyDown;
    Self.EditWindow.OnKeyDown:=@OKD;
  end;
end;