Советы по Delphi
         

После снесения через родной uninstall


После снесения через родной uninstall Interbase Server 5.0 для Windows и желания поставить 5.1.1 вылетает ошибка: IBCheck. Что делать? Nomadic отвечает:

Решение найдено. Прочитай сам и передай товарищу:

Надо запустить regedit, и открыть ключ HKEY_LOCAL_MACHINE\Environment Там есть строка PATH. Так вот иногда она почему-то становится не строкой, а еще чем-то. Ее надо убить, и пересоздать как строку, прописав туда прежнее содержимое (в виде строки). [001257]


При попытке регистрации UDF возникает


При попытке регистрации UDF возникает ошибка (udf not defined). Что не так? Nomadic отвечает:

Располагайте DLL в каталоге Interbase/Bin, или в одном из каталогов, в которых ОС обязательно будет произведен поиск этой библиотеки (для Windows это %SystemRoot% и %Path%);

При декларировании функции не следует указывать расширение модуля (в Windows по умолчанию DLL): declare external function f_SubStr cstring(254), integer, integer returns cstring(254) entry_point "Substr" module_name "UDF1" Где UDF1 - UDF1.DLL. [001326]


Как заставить Interbase принять COLLATE




Как заставить Interbase принять COLLATE PXW_CYRL по умолчанию? Nomadic отвечает:

(Это очень полезно при прямой работе с IB из различного CASE-инструментария, типа PowerDesigner или ErWIN)

Чтобы не писать каждый раз COLLATE, я сделал следующее: Создал сохранённую процедуру create procedure fix_character_sets as begin update rdb$character_sets set rdb$default_collate_name = 'PXW_CYRL' where rdb$character_set_name = 'WIN1251' and rdb$default_collate_name = 'WIN1251' ; end Запустил ее один раз.

Создаю таблицы без указания COLLATE.

После восстановления из архива, запускаю еще раз. [001391]


Почему мои ISAPI-ориентированные


Nomadic отвечает:

Волшебник по созданию ISAPI DLL в Delphi 3 создает полностью безопасную многопоточную библиотеку, но не выставляет флаг, говорящий приложению, что эта библиотека в этом отношении безопасна. Это легко исправить, просто добавив строчку:

    IsMultiThread := TRUE;
end;

первой строкой в Вашем блоке begin-end файла проекта (DPR). [001448]



Контроль джойстика в Delphi


Действительно, Delphi это позволяет. Нижеприведенный код был взят из действующего приложения, вы можете переписать его под себя, главное - он показывает технологию работы с джойстиком.

    var
myjoy: tjoyinfo; begin
joygetpos(joystickid1,@myjoy); trackbar1.position := myjoy.wypos; trackbar2.position := myjoy.wxpos; radiobutton1.checked := (myjoy.wbuttons and joy_button1)>0; radiobutton2.checked := (myjoy.wbuttons and joy_button2)>0; end;

Не забудьте включить MMSYSTEM в список используемых (USES) модулей. [000184]



Caps Lock (и другие подобные клавиши)


Как мне включить Caps Lock? (Естественно, программным путем в Delphi) ...я уж и пробовал, и спрашивал...

попробуй это...

    procedure TMyForm.Button1Click(Sender: TObject);
Var KeyState  :  TKeyboardState; begin GetKeyboardState(KeyState); if (KeyState[VK_NUMLOCK] = 0) then KeyState[VK_NUMLOCK] := 1 else KeyState[VK_NUMLOCK] := 0; SetKeyboardState(KeyState); end;

Для Caps Lock замените VK_NUMLOCK на VK_CAPITAL. [000144]



Чтение и установка клавиши NumLock


    VAR KS : TKeyboardState; ... GetKeyboardState(KS); IF Odd(KS[VK_NUMLOCK]) THEN {NumLock включен}
KS[VK_NUMLOCK] := KS[VK_NUMLOCK] XOR 1; {переключение NumLock} KS[VK_NUMLOCK] := KS[VK_NUMLOCK] OR 1; {включение NumLock} KS[VK_NUMLOCK] := KS[VK_NUMLOCK] AND (NOT 1); {выключение NumLock}
SetKeyboardState(KS);

Таким же образом:

    ... VK_CAPITAL ... VK_SCROLL ... VK_INSERT

Nomadic предлагает немного другой способ:

    var
abKeyState: array [0..255] of byte; begin
GetKeyboardState( Addr( abKeyState[ 0 ] ) ); abKeyState[ VK_NUMLOCK ] := abKeyState[ VK_NUMLOCK ] or $01; SetKeyboardState( Addr( abKeyState[ 0 ] ) );

Slava Kostin замечает:

Вот что по этому поводу сказано в Help Delphi: Remarks Because the SetKeyboardState function alters the input state of the calling thread and not the global input state of the system, an application cannot use SetKeyboardState to set the NUM LOCK, CAPS LOCK, or SCROLL LOCK indicator lights on the keyboard. [000560]



Хитрость KeyPreview


В обработчик события FormCreate вставьте следующую строчку кода:

    KeyPreview:=TRUE;

Это позволит всем событиям, связанным с нажатием клавиш, в первую очередь передаваться форме, чьи обработчики могут выполнить какое-то заранее заданное действие или "подавить" клавиши. Только после этого они передаются выбранному элементу управления. Чтобы полностью "подавить" клавишу, используйте событие OnKeyPress, где код нажатой клавиши имеет тип Char, и для того, чтобы "подавить" его, просто напишите key:=#0. [000348]



Имитация нажатия клавиши


Я имею набор кнопок (caption ='0'..'9') и хотел бы имитировать их нажатие во время нажатия пользователем соответствующей клавиши. То есть, когда пользователь нажимает клавишу '1', кнопка с таким заголовком также должна быть нажата на экране. Как мне это сделать без нового компонента Tbutton?

Нет проблем:

Вероятно вы захотите использовать 10 элементов управления TSpeedButton или их массив, поскольку этот тип кнопок имеет свойство "Down". Для начала установите у свойства "KeyPreview" вашей формы значение "True". Затем создайте обработчик события "OnKeyDown" примерно такого вида...

    case Key of VK_NUMPAD0: btn0.Down := True; VK_NUMPAD1: btn1.Down := True; VK_NUMPAD2: btn2.Down := True; VK_NUMPAD3: btn3.Down := True; VK_NUMPAD4: btn4.Down := True; VK_NUMPAD5: btn5.Down := True; VK_NUMPAD6: btn6.Down := True; VK_NUMPAD7: btn7.Down := True; VK_NUMPAD8: btn8.Down := True; VK_NUMPAD9: btn9.Down := True; end;

в этом случае обработчик события "OnKeyUp" будет следующего вида...

    case Key of VK_NUMPAD0: btn0.Down := False; VK_NUMPAD1: btn1.Down := False; VK_NUMPAD2: btn2.Down := False; VK_NUMPAD3: btn3.Down := False; VK_NUMPAD4: btn4.Down := False; VK_NUMPAD5: btn5.Down := False; VK_NUMPAD6: btn6.Down := False; VK_NUMPAD7: btn7.Down := False; VK_NUMPAD8: btn8.Down := False; VK_NUMPAD9: btn9.Down := False; end;

Поэкспериментируйте со свойствами "AllowAllUp" и "GroupIndex" для получения необходимого эффекта.

Кроме того, массив кнопок TSpeedButtons был бы наиболее изящным решением в данной задаче, поскольку в этом случае вы могли бы использовать константу VK_ constant в качестве индекса, делая обработчики обоих событий длиной всего в одну строчку - Button[VK_x].Down := True {или False}. [000141]



Имитация Tab


    SelectNext(screen.ActiveControl, True, True);

Разместите приведенный код в обработчике одного из собитий. SelectNext - защищенный метод TWinControl со следующим прототипом:

    procedure SelectNext(CurControl: TWinControl; GoForward, CheckTabStop: Boolean);

Так как форма также является потомком TWinControl, то она имеет доступ к защищенным методам. [000634]



Индикация статуса клавиш I


Вы можете отслеживать состояние "индикаторных" клавиш с помощью таймера с интервалом, скажем, в 100мс. Я просто считываю состояние клавиш следующим образом:

    VAR KS : TKeyboardState; ... GetKeyboardState(KS); IF Odd(KS[VK_NUMLOCK]) THEN {caps lock нажат} ... VK_VK_CAPITAL ... VK_SCROLL ... VK_INSERT
[000404]



Индикация статуса клавиш II


Может мне кто-нибудь сказать, где найти код, который помог бы мне связать текст строки состояния с состоянием клавиш caps lock, num lock и др.?

Событие OnIdle происходит каждый раз, когда приложение свободно. С помощью обработчика данного события можно сделать так, чтобы во время "простоя" приложение могло бы осуществлять второстепенные задачи. В это время ваше приложение ожидает наступление какого-то события, например, ввод пользователем новой величины.

TIdleEvent - процедурный тип, имеющий логический параметр Done со значением по умолчанию True. Когда Done равен True, после обработки события OnIdle вызывается функция Windows API WaitMessage. WaitMessage передает управление другим приложениям до тех пор, пока в очереди сообщений вашего приложения не появится новое сообщение. Если Done равно False, WaitMessage не вызывается.

Итак, как мы можем решить нашу задачу в свете вышесказанного:

Добавьте 4 компонента Checkbox к вашему компоненту Statusbar и сделайте следующее объявление в секции Private вашей формы:

    procedure AppOnIdle(Sender: TObject; var Done: Boolean);

Добавьте в секции реализации:

    procedure TForm1.AppOnIdle(Sender: TObject; var Done: Boolean);
begin
CheckBox1.Checked := Odd(GetKeyState(VK_CAPITAL)); CheckBox2.Checked := Odd(GetKeyState(VK_SHIFT)); CheckBox3.Checked := Odd(GetKeyState(VK_NUMLOCK)); CheckBox4.Checked := Odd(GetKeyState(VK_SCROLL)); Done := False; end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnIdle := AppOnIdle; end;

[000617]



Использование клавиш для управления компонентами


Так, если у меня есть своего рода кнопка (check, radio, speed и т.п.), то почему я не могу с помощью клавиш курсора управлять ею?

После некоторых экспериметов я создал метод, который привожу ниже, способный перехватывать в форме все нажатые клавиши позиционирования и управлять ими выбранным в настоящий момент элементом управления. Имейте в виду, что элементы управления (кроме компонентов Label) должны иметь возможность "выбираться". Для возможности выбрать GroupBox или другой компонент, удедитесь, что их свойство TabStop установлено в True. Вы можете переместить управление на GroupBox, но, так как он не выделяется целиком, узнать, что он действительно имеет управление, достаточно непросто. Если вам не нужно передавать управление в контейнерные элементы (нижеследующий код исходит из этого предположения), то вы можете управлять элементами, просто перемещая управление в сам GroupBox.

В нижеследующем коде FormActivate является обработчиком события формы OnActivate, тогда как ProcessFormMessages никакого отношения к событиям формы не имеет. Не забудьте поместить объявление процедуры ProcessFormMessages в секцию 'Private' класса вашей формы.

Надеюсь, что вам помог.

Robert Wittig

    {==================================================================}

procedure TForm1.FormActivate(Sender: TObject);
begin
{ Делаем ссылку на нового обработчика сообщений } Application.OnMessage := ProcessFormMessages; end;

procedure tForm1.ProcessFormMessages ( var Msg : tMsg; var Handled : Boolean );
Var
Increment  : Byte; TheControl : tWinControl; begin
{ проверка наличия системного сообщения KeyDown } Case Msg.Message Of WM_KEYDOWN : If Msg.wParam In [VK_UP,VK_DOWN,VK_LEFT,VK_RIGHT] Then Begin { изменяем величину приращения взависимости от состояния клавиши Shift } If GetKeyState ( VK_SHIFT ) And $80 = 0 Then Increment := 8 Else Increment := 1;
{ Этот код перемещает управление на родительский GroupBox, если один из его контейнерных элементов получает фокус. Если вам необходимо управлять элементами внутри контейнера, удалите блок IF и измените в блоке CASE TheControl на ActiveControl }
If ( ActiveControl.Parent Is tGroupBox ) Then TheControl := ActiveControl.Parent Else TheControl := ActiveControl;
Case Msg.wParam Of VK_UP    : TheControl.Top  := TheControl.Top - Increment; VK_DOWN  : TheControl.Top  := TheControl.Top + Increment; VK_LEFT  : TheControl.Left := TheControl.Left - Increment; VK_RIGHT : TheControl.Left := TheControl.Left + Increment; End;
{ сообщаем о том, что сообщение обработано } Handled := True; End; End; end;
[000442]



Как из программы переключить раскладку клавиатуры?


Nomadic отвечает:

A: ActivateKeyboardLayout(). Учтите, что использование этой функции -- плохой тон. [001545]



Как? Клавиша ENTER вместо клавиши TAB I


Вот что я нашел на Compuserve, это должно помочь.

Использование клавиши "Enter" подобно клавише "Tab" в элементах управления Delphi

Приведенный здесь пример кода демонстрирует алгоритм перехвата клавиш "Enter" и курсорных клавиш для обеспечения комфортного ввода данных.

Хитрость заключается в переписывании событий Keypress и KeyDown для обработки нажатий любых клавиш. В предоставленном примере я использовал клавишу "Enter" для перемещения к следующему элементу управления (подобно клавише "Tab") и клавиши Up и Down для перемещения к предшествующему и следующему элементу соответственно.

Edit и EBEdit используют клавиши как было сказано выше, но Combobox и Listbox используют Shift-Up и Shift-Down для того, чтобы не создавать помехи существующему функциональному назначению.

Компонент Grid использует клавишу "Enter" для перемещения между полями, тем не менее использование "Enter" не позволяет переместиться из последнего поля последней строки. Это легко позволяет сделать так, чтобы выход из сетки происходил из необходимой точки.

Метод использует для перемещения на следующий/предыдущий элемент управления вызов Windows API функции SendMessage, которая посылает сообщение WM_NEXTDLGCTL форме, для которой данный элемент является дочерним. Для получения дескриптора родительской формы Delphi осуществляет вызов функции GetParentForm.

Данный код открыт для расширения функциональности, например, на реакцию события при нажатии почти любой клавиши, и я думаю, что использование данного метода является лучшим решением, чем организация перехвата клавиш в событиях формы OnKey (используя keypreview:=true).

Код абсолютно свободен для распространения и использования, но если вы нашли ошибку или хотите предложить что-то новое, пожалуйста сообщите мне об этом!

    {
Код, дающий функциональность клавиши "Tab" клавише "Enter", позволяющий при нажатии на последнюю переместиться к следующему элементу управления. Так как событие KeyPress переделано незначительно, данный код стабильно работает и с компонентом TDBedit, полезным для ввода данных в приложении. Я думаю, что использование данного кода является лучшим решением, чем организация перехвата клавиш в событиях формы OnKey (keypreview:=true).
Код абсолютно свободен для использования и распространения.
Simon Callcott CIS: 100574, 1034 }

unit Entedit;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TEnterEdit = class(TEdit) private
protected
procedure KeyPress(var Key: Char); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
published
end;
procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TEnterEdit]); end;

procedure TEnterEdit.KeyPress(var Key: Char);
var
MYForm: TForm; begin

if Key = #13 then begin MYForm := GetParentForm( Self ); if not (MYForm = nil ) then SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0); Key := #0; end;
if Key <> #0 then inherited KeyPress(Key);
end;

procedure TEnterEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
MYForm: TForm; CtlDir: Word; begin

if (Key = VK_UP) or (Key = VK_DOWN) then begin MYForm := GetParentForm( Self ); if Key = VK_UP then CtlDir := 1 else CtlDir :=0; if not (MYForm = nil ) then SendMessage(MYForm.Handle, WM_NEXTDLGCTL, CtlDir, 0); end else inherited KeyDown(Key, Shift);
end;

end.

Решение 2

В. "Есть ли какое-нибудь решение, чтобы использовать клавишу Enter вместа Tab или мыши?"

О. Используйте этот код для обработчика события OnKeyPress компонента Edit:

    procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin If Key = #13 Then Begin SelectNext(Sender as tWinControl, True, True ); Key := #0; end; end;

Это заставляет клавишу Enter вести себя подобно клавише Tab. Теперь произведите выбор всех элементов управления на форме (кроме кнопок), для которых вы хотели бы применить данное поведение, и назначьте им в Инспекторе Объектов для события OnKeyPress уже созданный нами обработчик EditKeyPress. Теперь каждый компонент, выбранный вами, будет обрабатывать клавишу Enter подобно клавише Tab. Если вы хотите передать функциональность на другой родительский уровень (по сравнению с элементами управления), сбросьте у всех компонентов событие OnKeyPress (просто сотрите название обработчика) и назначьте _формам_ для события OnKeyPress обработчик EditKeyPress. Затем измените Sender на ActiveControl и присвойте свойству форм KeyPreview значение True:

    procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin If Key = #13 Then begin SelectNext(ActiveControl as tWinControl, True, True ); Key := #0; end; end;

Это заставит клавишу Enter вести себя подобно клавише Tab для всех (возможных) элементов управления. [000142]



Как? Клавиша ENTER вместо клавиши TAB II


Установите свойство KeyPreview формы в True и используйте следующий обработчик события OnKeyPress.

    procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
begin if Key = #13 then begin Key := #0; PostMessage(Handle, WM_NEXTDLGCTL, 0, 0); end; end;
[000427]



Как? Клавиша ENTER вместо клавиши TAB III


Я хочу предложить Вашему вниманию процедуру, с помощью которой можно передвигаться по нажатию клавиши "Enter" по возрастанию значений свойства элемента - "Tag".

В обработчик события onKeyPress нужно написать вот что:

    procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
Enter_KeyPress(Form,Sender,Key); end;

А сама процедура имеет следующий вид:

    procedure Enter_KeyPress(Form: TForm; Sender: TObject; var Key: Char);
var i,next:integer;
begin
with Sender as TWinControl do if key=#13 then begin next:=Tag+1; for i:=0 to Form.ComponentCount-1 do begin if (Form.Components[i].Tag=next) then try TWinControl(Form.Components[i]).SetFocus; exit; except next:=next+1; end; end; key:=#0; end; end;

Надеюсь, эта процедура пригодится...
Сочнев Петр Георгиевич ... [001999]



Как мне определить нажатие клавиш со стрелками?


Используя событие KeyDown или KeyUp протестируйте это для VK_LEFT, VK_RIGHT и др.

[000139]

Как можно назначить быструю клавишу объекту, не имеющему Caption?


Своим опытом делится Олег Кулабухов:

В данном случае можно выкрутиться, создав невидимый Label и назначив ему соответствующий обработчик. В приведенном примере по Alt-M фокус будет переведен на Memo1.

    procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Visible := false;
Label1.Caption := '&M';
Label1.FocusControl := Memo1;
end;

[001919]



Как определить нажатие PrintScreen?


Своим опытом делится Олег Кулабухов:

    type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure AppIdle(Sender: TObject; var Done: Boolean);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnIdle := AppIdle;
end;

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
Form1.Caption := 'SnapShot';
Done := True;
end;

[001816]



Как определить нажаты ли Shift, Control, Alt в определенный момент?


Своим опытом делится Олег Кулабухов:

    function CtrlDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Control] And 128) <> 0);
end;

function ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;

function AltDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Menu] and 128) <> 0);
end;

procedure TForm1.MenuItem12Click(Sender: TObject);
begin
if ShiftDown then
Form1.Caption := 'Shift' else
Form1.Caption := '';
end;

[001822]



Как отловить нажатия клавиш в системе


Для этого используется функция GetAsyncKeyState(KeyCode)
в качестве параметра используются коды клавиш(например A - 65).
GetAsyncKeyState возвращает не нулевое значение если, во время ее вызова нажата указаная клавиша.

    //----Этот пример отлавливает нажатие клавиши "A"
//Этот код необходимо поместить в процедуру обработки
//таймера с интервалом "1"
if getasynckeystate(65)<>0 then showmessage('A - pressed');
//----------

Прислал Igor Nikolaev aKa The Sprite.

Nomadic дополняет, что функция GetAsyncKeyState годится как для клавиатуpы, так и для мыши. [001407]



Как подавить реакцию Windows на CTRL+ALT+DEL, ALT-TAB, CTRL-ESC


Nomadic поясняет:

В некоторых случаях (например, при работе в полноэкранном режиме, показе своей презентации или экранной заставки ...) бывает полезно заблокировать перечисленные комбинации клавиш. Они блокируются при работе системы в режиме "экранная заставка" , который в свою очередь несложно включить и выключить:

    // Включение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
// Выключение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);

Кстати, SystemParametersInfo имеет еще кучу полезных ключей SPI_****, подробности см. в win32.hlp [001753]



Как программно нажать клавишу


Пришло от читателя письмо:

// для WINNT

К сожалению работает хорошо, только когда фокус у вызывающего окна, в противном случае может глючить

    procedure TForm1.SetKey(Key:Integer);
begin
keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY,0);
keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
end;

Применение

    SetKey(VK_SCROLL); SetKey(VK_CAPITAL);

Den is Com [000819]



Как убрать мою программу из списка Alt+Ctrl+Del?


Nomadic делится своими секретами:

    function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

implementation

procedure TForm1.Button1Click(Sender: TObject);
begin //Hide
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin //Show
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 0);
end;

[001770]



Как включать/выключать лампочки на numlock, capslock, etc...?


Nomadic дает следующий пример:

    procedure SetNumLock(bState:Boolean);
var
KeyState : TKeyboardState; begin
GetKeyboardState(KeyState); if ( (bState) and (not ((KeyState[VK_NUMLOCK] and 1)=1) ) or ( (not (bState)) and ((KeyState[VK_NUMLOCK] and 1)=1))) then // Simulate a key press keybd_event(VK_NUMLOCK, $45, (KEYEVENTF_EXTENDEDKEY or 0), 0); // Simulate a key release keybd_event( VK_NUMLOCK, $45,  (KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP), 0);
end;

Заменяйте VK_NUMLOCK на все что душе угодно. [001704]



Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?


Пример (работает только в Win'95):

    var  WnHnd   : Integer; ........................................................ WnHnd := GetWindowLong(Application.Handle, GWL_EXSTYLE); WnHnd := WnHnd or WS_EX_TOOLWINDOW; SetWindowLong(Application.Handle, GWL_EXSTYLE, WnHnd); ........................................................

Прислал Nomadic. [001642]




В действительности она служит флагом проверки нажатия клавиши, по соглашению, код #0 означает, что никакой клавиши нажато не было. В некоторых случаях событие может активизировать передачу этого кода (например, прямым вызовом), или предок, возможно, уже обработал нажатие клавиши, и Key был установлен в #0. [001446]


Коды виртуальных клавиш


    vk_LButton   = $01; vk_RButton   = $02; vk_Cancel    = $03; vk_MButton   = $04;   { генерятся только системой вместе с L & RBUTTON } vk_Back      = $08; vk_Tab       = $09; vk_Clear     = $0C; vk_Return    = $0D; vk_Shift     = $10; vk_Control   = $11; vk_Menu      = $12; vk_Pause     = $13; vk_Capital   = $14; vk_Escape    = $1B; vk_Space     = $20; vk_Prior     = $21; vk_Next      = $22;
vk_End       = $23; vk_Home      = $24; vk_Left      = $25; vk_Up        = $26; vk_Right     = $27; vk_Down      = $28; vk_Select    = $29; vk_Print     = $2A; vk_Execute   = $2B; vk_SnapShot  = $2C; { vk_Copy      = $2C не используется клавиатурой }
vk_Insert    = $2D; vk_Delete    = $2E; vk_Help      = $2F; { vk_A - vk_Z такие же, как и их ASCII-эквиваленты: 'A' - 'Z' }
{ vk_0 - vk_9 такие же, как и их ASCII-эквиваленты: '0' - '9' }

vk_NumPad0   = $60; vk_NumPad1   = $61; vk_NumPad2   = $62; vk_NumPad3   = $63; vk_NumPad4   = $64; vk_NumPad5   = $65; vk_NumPad6   = $66; vk_NumPad7   = $67; vk_NumPad8   = $68; vk_NumPad9   = $69; vk_Multiply  = $6A; vk_Add       = $6B; vk_Separator = $6C; vk_Subtract  = $6D; vk_Decimal   = $6E; vk_Divide    = $6F; vk_F1        = $70; vk_F2        = $71; vk_F3        = $72; vk_F4        = $73; vk_F5        = $74;
vk_F6        = $75; vk_F7        = $76; vk_F8        = $77; vk_F9        = $78; vk_F10       = $79; vk_F11       = $7A; vk_F12       = $7B; vk_F13       = $7C; vk_F14       = $7D; vk_F15       = $7E; vk_F16       = $7F; vk_F17       = $80; vk_F18       = $81; vk_F19       = $82; vk_F20       = $83; vk_F21       = $84; vk_F22       = $85; vk_F23       = $86; vk_F24       = $87; vk_NumLock   = $90; vk_Scroll    = $91;

{ Данные коды взяты из файлов помощи Ллойда (Lloyd) }

[000255]

Комбинация клавиш ALT-? в диалоговом окне О ПРОГРАММЕ


...во всяком случае этот код делает что-то похожее. Тем не менее, если у вас имеется условие shift=[ssalt], то это означает, что нажатие клавиши интерпретируется обработчиком по-умолчанию, и каждое нажатие вызывает сигнал динамика. На форме вам нужно выставить флажок previewkey.

Разместите следующий код в обработчике события OnKeyDown:

    procedure TAboutBox.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); var
i:integer; working:integer; begin
if (shift=[ssalt]) and (key>=$41) and (key<=$5A) then begin s:=s+chr(key); working:=0; for i:=1 to 4 do begin if (s=copy(strings[i],1,length(s))) then working:=-i; if (s=strings[i]) then working:=i; end; if working=0 then s:=''; if working>0 then showmessage(strings[working]); end; end;

Создайте обработчик события создания формы: {для проверки на то, что первоначально строка будет пустая}

    procedure TAboutBox.FormCreate(Sender: TObject);
begin
s:=''; end;

В верхней части модуля формы для определения различных сообщений:

    type
Tst=array[1..4] of string; const
strings:Tst= ('ПРИВЕТ','ПОКА','ВЕРСИЯ','ПРОГРАММИСТ');

В секции public вашей формы:

    public s:string;

Разместите вне экрана кнопку с комбинацией горячих клавиш Alt-?. Поскольку речь идет о диалоговом окне "О программе", то, по всей видимости, окно не ресайзится, и значит пользователь никогда не увидит вашу кнопку. Все, что вы хотели бы сделать по этим горячим клавишам, поместите в обработчик события OnClick. [001989]



Можно ли запретить Alt-F4, чтобы предотвратить закрытие формы?


Своим опытом делится Олег Кулабухов:

    procedure TForm1.FormCreate(Sender: TObject);
begin
KeyPreview := true;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ((ssAlt in Shift) and (Key = VK_F4)) then
Key := 0;
end;

[001834]



Недоступность Ctrl-Alt-Del I


Вопрос:

Программа должна быть классной и небольшой, к тому же она должна загружаться прежде, чем пользователь сможет нажать CTRL-ALT-DEL.

Мое решение:

С помощью Delphi скомпилируйте единственный вызов WIN32API в небольшой .exe файле.

Программа:

    program small;

{автор Richard Leigh, Deakin Univesity 1997}

uses
WinProcs;
{$R *.RES}

var
Dummy : integer;
begin
Dummy := 0; {Отключаем ALT-TAB} SystemParametersInfo( SPI_SETFASTTASKSWITCH, 1, @Dummy, 0); {Отключаем CTRL-ALT-DEL} SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @Dummy, 0); end.

Это главный модуль - без форм и после компиляции ма-а-а-а-ленький такой... [000146]



Недоступность Ctrl-Alt-Del II


Пришло от читателя письмо:

Решил тут вам послать кое какое решение проблемки ctr+alt+del

    Function RegisterServiceProcess(dwProcessID, dwType : DWord): DWord;
stdcall external 'Kernel32.dll' name 'RegisterServiceProcess'; //
вызываю kernel32, кричу ей RegisterServiceProcess с каким то
параметрам 1- скрыть , 0 - показать

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessId(), 1); end;
end.

таки образом пользователь нажав ctr+alt+del не видет прогу в списке.

Fred Dzjuba From DHPon [000774]



Недоступность комбинаций alt-tab и ctrl+esc I


    procedure TurnSysKeysOff;
var
OldVal : LongInt; begin
SystemParametersInfo (97, Word (True), @OldVal, 0) end;

procedure TurnSysKeysBackOn;
var
OldVal : LongInt; begin
SystemParametersInfo (97, Word (False), @OldVal, 0) end;
[000138]



Недоступность комбинаций alt-tab и ctrl+esc II


Subfire советует:

    program small;

{автор Richard Leigh, Deakin Univesity 1997}

Dummy : integer;
begin

Dummy := 0;
{Отключаем ALT-TAB}
SystemParametersInfo( SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);
{Отключаем CTRL-ALT-DEL}
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
end.

Великолепный способ!!! Хочу добавить, что он спасает не только от ALT-TAB, CTRL-ALT-DEL но и от CTRL-ESC и клавишы вызова меню из кнопки пуск (#91 - Win95 Keyb), что в сочетании с убиранием с экрана кнопки пуск создает классный эффект :) Распространенный вопрос: а как все назад-то вернуть? Вот ответ:

    //Включаем системную обработку
SystemParametersInfo( SPI_SETFASTTASKSWITCH, 0, 0, 0); SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, 0, 0);

А вообще посмотрите Windows SDK SystemParametersInfo
Много интересного.... [000901]



Обработка нажатий клавиш `вверх-вниз`


Пришло от читателя письмо:

Почти всегда требуется обработка нажатий клавиш "вверх-вниз" для смены фокуса ввода - мои "тетки-юзеры" боются мышей, да и сам я не любитель комбинаций мышь-клавиатура.

    procedure TfmAbProps.edNameKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); begin
if (Key=vk_down) and
not (ssAlt in Shift)  // здесь обработка для "выпадающих" окошек типа
TRxDBCalcEdit
then begin Key:=0;
SelectNext(Sender as TWinControl,true,true);
end else
if Key=vk_up then begin
Key:=0;
SelectNext(Sender as TWinControl,false,true);
end;
end;

Для элементов редактирования типа TDbEdit, TRxDBCalcEdit or TDBDateEdit назначим

    OnKeyDown:=edNameKeyDown

Сложнее с типами вроде TRxDBLookupCombo. Наш прежний обработчик для них не подходит. Я пытался изменить характер TRxDBLookupCombo - но вовремя опомнился - есть же FormKeyDown;

    procedure TfmAbProps.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); begin
if (ActiveControl is TRxDBLookupCombo) then begin
if Key=vk_down then begin
if not (ssAlt in Shift) and not  // здесь нельзя обработать нажатие при вызове "выпадающего"
(ActiveControl as TRxDBLookupCombo).IsDropDown then begin // и в случае уже "выпвшего"
Key:=0; selectnext(ActiveControl,true,true); end; end else
if Key=vk_up then begin if not (ActiveControl as TRxDBLookupCombo).IsDropDown then begin Key:=0; selectnext(ActiveControl,false,true); end; end;
end;
end;

С уважением, Галимарзанов Фанис [000796]



Отмена нажатия клавиши


Допустим, у нас имеется задача не допустить появление в окне компонента Tedit символа "+" или "-":

    Tformz.EditzKeyDown(Sender:Tobject;Var key:word;Shift:TshiftState);
var
save_key:byte; begin
save_key := key;
KEY := $0;
If ((save_key = VK_ADD)or(save_key=VK_SUBTRACT)) then do что-то делаем...
else key := save_key;
..
..
end;

Я не уверен в том, что VK_ADD, VK_SUBTRACT как VK_значения могут соответствовать кодам клавиш на дополнительной цифровой клавиатуре, ее значения могут идти и после VK_NUMPAD-значений.

VK-коды клавиш приведены в справке помощи по API-функциям, в разделе Virtual Key Codes. Но не все они поддерживаются в DELPHI.

    ..
implementation
const
proof:integer = 0;   {Просто для тестирования} var
key_sig:integer;     {Код клавиши с Numeric KeyPad +/- ?} {Простой способ передачи для KeyDown и KeyPress}
{**************** Обработка клавиши*******************}
procedure Tformxyz.EditzzzKeyDown(...var key:word...);
var
save_key:byte; begin
key_sig := 0;             {Значение по-умолчанию} save_key := key;          {сохраняем код клавиши, если она нужна позднее} if (key = VK_ADD) then key_sig := +1;
if (key + VY_SUBTRACT) then key_sig := -1;
end;

procedure Tformxyz.EditzzzKeyPress(...var key:char...);
var
save_key:char; begin
save_key := key;
key := #0;                                {Подавляем печать символа...сейчас} if key_sig = 0 then key := char(save_key) {Печатаем символ}

{Выше я уже обращал ваше внимание на то, что данный}
{код не является обязательным}

else
begin proof := proof + key_sig;         {Демонстрация того, как это работает} edityyy.text := inttostr(proof); end; end;
..
..
end.

[001994]



Перехват формой нажатия клавиши ESC


Проверьте в обработчике события TEdit OnKeyPress наличие кода клавиши #27 если код не перехватывается, установите свойство формы KeyPreview (убедитесь, что свойство имеет значение true, восстановить его в исходное состояние можно, задав его значение, равное false), и затем в обработчике события формы OnKeyPress проверяйте если Key = #27.

Если и это потерпит неудачу, то для проверки того, какой код нажатой клавиши передается вашему приложению, можно воспользоваться системой сообщений windows. Я делал такие трюки в паре моих приложений, и это совсем не трудно. Если вам это интересно, я сделаю пример. [001772]



Перехват (Hook) клавиатуры (программа Sendkeys)


Я уже видел несколько сообщений в новостных группах, касающиеся данного вопроса. Вот код, который, по моему мнению, наиболее полно раскрывает данную тему. Совет имеет один существенный недостаток. В том виде, в каком я нашел его, отсутствует программа, осуществляющая управление данной DLL, то есть приводится реализации самого перехвата, а часть, позволяющая управлять им, к сожалению, отсутствует. Если у читателей имеется реализация программы или другой аналогичный код, поделитесь со мной, а я в свою очередь попытаюсь найти полную реализацию данного проекта. Тем не менее данный материал раскрывает технологию осуществления перехвата и может использоваться в качестве отправной точки для дальнейшего экспериментирования.

    library Sendkey;

{Данный код написан по мотивам книги "Delphi Developer's Guide"
авторов Xavier Pacheco и Steve Teixeira.}
uses SysUtils, WinTypes, WinProcs, Messages, Classes, KeyDefs;
type
{ Коды ошибок } TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, sk_UnknownError);
{ исключения } ESendKeyError = class(Exception); ESetHookError = class(ESendKeyError); EInvalidToken = class(ESendKeyError);
{ потомок TList, который знает как избавляться от своего содержания } TMessageList = class(TList) public destructor Destroy; override; end;
destructor TMessageList.Destroy;
var
i: longint; begin
{ освобождаем все записи сообщений перед тем как разрушить список } for i := 0 to Count - 1 do Dispose(PEventMsg(Items[i])); inherited Destroy; end;

var
{ глобальные переменные для DLL } MsgCount: word; MessageBuffer: TEventMsg; HookHandle: hHook; Playing: Boolean; MessageList: TMessageList; AltPressed, ControlPressed, ShiftPressed: Boolean; NextSpecialKey: TKeyString;
function MakeWord(L, H: Byte): Word;
{ макрос создает число из самого большого и самого маленького байтов }
inline(
$5A/            { pop dx } $58/            { pop ax } $8A/$E2);       { mov ah, dl }
procedure StopPlayback;
{ Снимаем перехват и наводим порядок }
begin
{ если перехват к настоящему времени активен, отключаем его } if Playing then UnhookWindowsHookEx(HookHandle); MessageList.Free; Playing := False; end;

function Play(Code: integer; wParam: word; lParam: Longint): Longint; export;
{ Это функция-оболочка возвращает JournalPlayback. Вызывается системой во время }
{ опроса аппаратных событий. Параметр Code указывает что нужно делать. }
begin
case Code of
hc_Skip: begin { hc_Skip пропускает очередное сообщение из нашего списка. Если мы } { в конце списка, это хорошо, снимаем захват JournalPlayback } { в данном месте кода. } { увеличиваем счетчик сообщений } inc(MsgCount); { проверка воспроизведения всех сообщений } if MsgCount >= MessageList.Count then StopPlayback else { копируем очередное сообщение из списка в буфер } MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^); Result := 0; end;
hc_GetNext: begin { hc_GetNext нужен для заполнения wParam и lParam соответствующими } { значениями, необходимыми для воспроизведения сообщения. НЕ СНИМАЙТЕ } { захват в этом участке кода. Возвращаемая величина указывает время, } { в течение которого Windows должна воспроизвести сообщение. Мы } { возвращаем 0 для того, чтобы это было обработано немедленно. } { перемещаем сообщение в буфер для очереди сообщений } PEventMsg(lParam)^ := MessageBuffer; Result := 0 { немедленная обработка } end
else { если Code не hc_Skip или hc_GetNext, то вызываем следующий hook в цепочке } Result := CallNextHookEx(HookHandle, Code, wParam, lParam); end; end;

procedure StartPlayback;
{ Инициализируем глобальные и вешаем hook }
begin
{ захватываем из списка первое сообщение и помещаем } { в буфер, если hc_GetNext получено перед hc_Skip } MessageBuffer := TEventMsg(MessageList.Items[0]^); { инициализируем счетчик сообщений } MsgCount := 0; { инициализируем флаги клавиш Alt, Control и Shift } AltPressed := False; ControlPressed := False; ShiftPressed := False; { вешаем hook! } HookHandle := SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0); if HookHandle = 0 then raise ESetHookError.Create('Не могу повесить hook') else Playing := True; end;

procedure MakeMessage(vKey: byte; M: word);
{ процедура создает запись TEventMsg, эмулирующую нажатие клавиши и }
{ добавляет это к списку сообщений }
var
E: PEventMsg; begin
New(E);                                 { выделяем память под запись сообщения } with E^ do begin Message := M;                         { устанавливаем поле сообщения } { больший байт ParamL является кодом vk, меньший - кодом сканирования } ParamL := MakeWord(vKey, MapVirtualKey(vKey, 0)); ParamH := 1;                          { счетчик повторов равен 1 } Time := GetTickCount;                 { устанавливаем время } end; MessageList.Add(E); end;

procedure KeyDown(vKey: byte);
{ Генерируем KeyDownMessage }
begin
{ не генерим клавишу "sys" (F10), если нажата клавиша Ctrl (одна из причуд Windows) } if (AltPressed and (not ControlPressed) and (vKey in [Ord('A')..Ord('Z')])) or (vKey = vk_Menu) then MakeMessage(vKey, wm_SysKeyDown) else MakeMessage(vKey, wm_KeyDown); end;

procedure KeyUp(vKey: byte);
{ Генерируем сообщение KeyUp }
begin
{ не генерим клавишу "sys" (F10), если нажата клавиша Ctrl (одна из причуд Windows) } if AltPressed and (not ControlPressed) and (vKey in [Ord('A')..Ord('Z')]) then MakeMessage(vKey, wm_SysKeyUp) else MakeMessage(vKey, wm_KeyUp); end;

procedure SimKeyPresses(VKeyCode: Word);
{ Данная функция имитирует нажатие клавиши, передаваемой ей в качестве параметра, }
{ учитывая текущий статус клавиш Alt, Control и Shift }
begin
{ нажимаем клавишу Alt, если выставлен соответствующий флаг } if AltPressed then KeyDown(vk_Menu); { нажимаем клавишу Control, если выставлен соответствующий флаг } if ControlPressed then KeyDown(vk_Control); { если shift не нажат, или не нажаты клавиши shif и control... } if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then KeyDown(vk_Shift);    { ...нажимаем shift } KeyDown(Lo(VKeyCode));  { нажимаем клавишу down } KeyUp(Lo(VKeyCode));    { отпускаем клавишу } { если shift нажат, или не нажаты клавиши shif и control... } if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then KeyUp(vk_Shift);      { ...отпускаем shift } { если флаг shift установлен, сбрасываем его } if ShiftPressed then begin ShiftPressed := False; end; { Отпускаем клавишу Control, и если флаг клавиши был установлен, сбрасываем его } if ControlPressed then begin KeyUp(vk_Control); ControlPressed := False; end; { Отпускаем клавишу Alt, и если флаг клавиши был установлен, сбрасываем его } if AltPressed then begin KeyUp(vk_Menu); AltPressed := False; end; end;

procedure ProcessKey(S: String);
{ Данная функция выполняет разбор каждого символа в строке для создания списка сообщений }
var
KeyCode: word; Key: byte; index: integer; Token: TKeyString; begin
index := 1; repeat case S[index] of
KeyGroupOpen : begin { Это начало специального признака! } Token := ''; inc(index); while S[index] <> KeyGroupClose do begin { добавляем к признаку до тех пор, пока не столкнемся с символом окончания признака } Token := Token + S[index]; inc(index); { убеждаемся, что признак не слишком длинный } if (Length(Token) = 7) and (S[index] <> KeyGroupClose) then raise EInvalidToken.Create('Незакрытая скобка'); end; { ищем признак в массиве, в случае удачи } { параметр Key будет содержать код vk } if not FindKeyInArray(Token, Key) then raise EInvalidToken.Create('Неверный признак'); { эмулируем последовательность нажатия клавиш } SimKeyPresses(MakeWord(Key, 0)); end;
AltKey : begin { устанавливаем флаг клавиши Alt } AltPressed := True; end;
ControlKey : begin { устанавливаем флаг клавиши Control } ControlPressed := True; end;
ShiftKey : begin { устанавливаем флаг клавиши Shift } ShiftPressed := True; end;
else begin { Была нажата клавиша с нормальным символом } { конвертируем символ в число типа word, содержащее наибольший байт } { статуса shift и наименьший байт кода vk } KeyCode := vkKeyScan(MakeWord(Byte(S[index]), 0)); { эмулируем последовательность нажатия клавиш } SimKeyPresses(KeyCode); end; end; inc(index); until index > Length(S); end;

function SendKeys(S: String): TSendKeyError; export;
{ Это первая точка входа. Базируясь на входном параметре - строке  }
{ S, данная функция создает список keyup/keydown-сообщений, вешает }
{ hook на JournalPlayback, и повторяет сообщения нажатий клавиш.   }
var
i: byte; begin
try Result := sk_None;                   { успешный прием } MessageList := TMessageList.Create;  { создаем список сообщений } ProcessKey(S);                       { создаем сообщения из строки } StartPlayback;                       { вешаем хук и воспроизводим сообщения } except { при возникновении исключения возвращаем код ошибки и наводим порядок } on E:ESendKeyError do begin MessageList.Free; if E is ESetHookError then Result := sk_FailSetHook else if E is EInvalidToken then Result := sk_InvalidToken; end else { Перехват дескрипторов всех объектов исключений гарантирует, } { что исключение не попадет в стек приложения } Result := sk_UnknownError; end; end;

exports
SendKeys index 1;
begin end
[000140]




Вот она! Работающая! С комментариями! Полная версия! Привожу код полностью. Автор Bogachev. Большое человеческое ему спасибо. Старую версию на всякий случай оставляю, авось пригодится.

SendKey - DLL-ка
Project1 - Управляющая программа

Project1.dpr

    program Project1;

uses
Forms, Unit1 in '..\Hooks1\Unit1.pas' {Form1};
{$R *.RES}

begin
Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

SendKey.dpr

    library SendKey;

uses
SysUtils, Classes, Windows, Messages;
const
{пользовательские сообщения} wm_LeftShow_Event = wm_User + 133; wm_RightShow_Event = wm_User + 134; wm_UpShow_Event = wm_User + 135; wm_DownShow_Event = wm_User + 136;
{handle для ловушки} HookHandle: hHook = 0;
var
SaveExitProc : Pointer;
{собственно ловушка} function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint;stdcall; export;
var H: HWND;
begin
{если Code>=0, то ловушка может обработать событие} if (Code >= 0) and (lParam and $40000000 = 0) then begin {ищем окно по имени класса и по заголовку (Caption формы управляющей программы должен быть равен 'XXX' !!!!)} H := FindWindow('TForm1', 'XXX');
{это те клавиши?} Case wParam of VK_Left: SendMessage(H, wm_LeftShow_Event, 0, 0); VK_Right: SendMessage(H, wm_RightShow_Event, 0, 0); VK_Up: SendMessage(H, wm_UpShow_Event, 0, 0); VK_Down: SendMessage(H, wm_DownShow_Event, 0, 0); end; {если 0, то система должна дальше обработать это событие} {если 1 - нет} Result:=0; end
else if Code<0 {если Code<0, то нужно вызвать следующую ловушку} then Result := CallNextHookEx(HookHandle,Code, wParam, lParam); end;

{при выгрузке DLL надо снять ловушку}
procedure LocalExitProc; far;
begin
if HookHandle<>0 then begin UnhookWindowsHookEx(HookHandle); ExitProc := SaveExitProc; end; end;

exports Key_Hook;

{инициализация DLL при загрузке ее в память}
begin
{устанавливаем ловушку}
HookHandle := SetWindowsHookEx(wh_Keyboard, @Key_Hook, hInstance, 0); if HookHandle = 0 then MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok) else begin SaveExitProc := ExitProc; ExitProc := @LocalExitProc; end; end.

Unit1.dfm

    object Form1: TForm1
Left = 200 Top = 104 Width = 544 Height = 375 Caption = 'XXX' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 128 Top = 68 Width = 32 Height = 13 Caption = 'Label1' end end

Unit1.pas

    unit Unit1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

{пользовательские сообщения}

const
wm_LeftShow_Event = wm_User + 133; wm_RightShow_Event = wm_User + 134; wm_UpShow_Event = wm_User + 135; wm_DownShow_Event = wm_User + 136;
type
TForm1 = class(TForm) Label1: TLabel;
procedure FormCreate(Sender: TObject);

private //Обработчики сообщений
procedure WM_LeftMSG (Var M : TMessage); message wm_LeftShow_Event;
procedure WM_RightMSG (Var M : TMessage); message wm_RightShow_Event;
procedure WM_UpMSG (Var M : TMessage); message wm_UpShow_Event;
procedure WM_DownMSG (Var M : TMessage); message wm_DownShow_Event; end;

var
Form1: TForm1; P : Pointer;
implementation

{$R *.DFM}

//Загрузка DLL
function Key_Hook(Code: integer; wParam: word; lParam: Longint) : Longint; stdcall; external 'SendKey' name 'Key_Hook';

procedure TForm1.WM_LefttMSG (Var M : TMessage);
begin
Label1.Caption:='Left'; end;

procedure TForm1.WM_RightMSG (Var M : TMessage);
begin
Label1.Caption:='Right'; end;

procedure TForm1.WM_UptMSG (Var M : TMessage);
begin
Label1.Caption:='Up'; end;

procedure TForm1.WM_DownMSG (Var M : TMessage);
begin
Label1.Caption:='Down'; end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{если не использовать вызов процедуры из DLL в программе,
то компилятор удалит загрузку DLL из программы}
P:=@Key_Hook;
end;

end.

[000503]



Перехват курсорных клавиш I


Вы должны перехватывать и обрабатывать сообщение WM_GETDLGCODE. Объявите обработчик сообщения в вашем компоненте (в секции protected будет в самый раз)

    procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;

и реализуйте его:

    procedure TMyControl.WMGetDlgCode(var Msg : TMessage); begin Msg.Result := DLGC_WANTARROWS; end;

Cheers, Julian (TeamB & TurboPower Software) [000476]



Перехват курсорных клавиш II


Вы можете перехватывать нажатие курсорных клавиш на уровне приложения:

Создайте HandleMessages как метод формы и затем назначьте его Application.HandleMessages.

    Procedure tForm1.HandleMessages ( Var Msg : tMsg; Var Handled : Boolean );
Begin
If ( Msg.Message = WM_KeyDown ) And ( Msg.wParam In [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT] ) Then Begin Case Msg.wParam Of VK_UP    : ShowMessage ( 'Нажата стрелка вверх' ); VK_DOWN  : ShowMessage ( 'Нажата стрелка вниз' ); VK_LEFT  : ShowMessage ( 'Нажата стрелка влево' ); VK_RIGHT : ShowMessage ( 'Нажата стрелка вправо' ); End; Handled := True; End; End;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := HandleMessages; end;

Надеюсь, что помог вам,
Robert Wittig [000669]



Переключение клавиатуры I


Переключение языков из программы

Для переключения языка применяется вызов LoadKeyboardLayout:

    var russian, latin: HKL;
russian:=LoadKeyboardLayout('00000419', 0);
latin:=LoadKeyboardLayout('00000409', 0); где то в программе
SetActiveKeyboardLayout(russian);

Прислал Igor Nikolaev aKa The Sprite. [001405]



Переключение клавиатуры II


Здесь переключатели на русский и на английский.

    procedure SetRU;
var
Layout: array[0.. KL_NAMELENGTH] of char; begin
LoadKeyboardLayout( StrCopy(Layout,'00000419'),KLF_ACTIVATE); end;

procedure SetEN;
var
Layout: array[0.. KL_NAMELENGTH] of char; begin
LoadKeyboardLayout(StrCopy(Layout,'00000409'),KLF_ACTIVATE); end;

Прислал Nomadic. [001616]



Подскажите пожалуйста как сделать


Nomadic дает следующий пример:

    const
ExtendedKeys: set of Byte = [  // incomplete list VK_INSERT, VK_DELETE, VK_HOME,   VK_END,    VK_PRIOR,   VK_NEXT, VK_LEFT,   VK_UP,     VK_RIGHT,  VK_DOWN,   VK_NUMLOCK ];
procedure SimulateKeyDown(Key : byte);
var
flags: DWORD; begin
if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0; keybd_event(Key, MapVirtualKey(Key, 0), flags, 0); end;

procedure SimulateKeyUp(Key : byte);
var
flags: DWORD; begin
if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0; keybd_event(Key, MapVirtualKey(Key, 0), KEYEVENTF_KEYUP or flags, 0); end;

procedure SimulateKeystroke(Key : byte);
var
flags: DWORD; scancode: BYTE; begin
if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0; scancode := MapVirtualKey(Key, 0); keybd_event(Key, scancode, flags, 0); keybd_event(Key, scancode, KEYEVENTF_KEYUP or flags, 0); end;

[001694]



Посылка кода клавиши/Текста в окно...


Надеюсь это поможет:

    unit Unit1;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); private AppInst: THandle; AppWind: THandle; public { Public declarations } end;
var
Form1: TForm1;
implementation

{$R *.DFM}

uses ShellAPI;

procedure SendShift(H: HWnd; Down: Boolean);
var vKey, ScanCode, wParam: Word;
lParam: longint; begin
vKey:= $10; ScanCode:= MapVirtualKey(vKey, 0); wParam:= vKey or ScanCode shl 8; lParam:= longint(ScanCode) shl 16 or 1; if not(Down) then lParam:= lParam or $C0000000; SendMessage(H, WM_KEYDOWN, vKey, lParam); end;

procedure SendCtrl(H: HWnd; Down: Boolean);
var vKey, ScanCode, wParam: Word;
lParam: longint; begin
vKey:= $11; ScanCode:= MapVirtualKey(vKey, 0); wParam:= vKey or ScanCode shl 8; lParam:= longint(ScanCode) shl 16 or 1; if not(Down) then lParam:= lParam or $C0000000; SendMessage(H, WM_KEYDOWN, vKey, lParam); end;

procedure SendKey(H: Hwnd; Key: char);
var vKey, ScanCode, wParam: Word;
lParam, ConvKey: longint; Shift, Ctrl: boolean; begin
ConvKey:= OemKeyScan(ord(Key)); Shift:= (ConvKey and $00020000) <> 0; Ctrl:= (ConvKey and $00040000) <> 0; ScanCode:= ConvKey and $000000FF or $FF00; vKey:= ord(Key); wParam:= vKey; lParam:= longint(ScanCode) shl 16 or 1; if Shift then SendShift(H, true); if Ctrl then SendCtrl(H, true); SendMessage(H, WM_KEYDOWN, vKey, lParam); SendMessage(H, WM_CHAR, vKey, lParam); lParam:= lParam or $C0000000; SendMessage(H, WM_KEYUP, vKey, lParam); if Shift then SendShift(H, false); if Ctrl then SendCtrl(H, false); end;

function EnumFunc(Handle: HWnd; TF: TForm1): Bool; Far;
begin
TF.AppWind:= 0; if GetWindowWord(Handle, GWW_HINSTANCE) = TF.AppInst then TF.AppWind:= Handle; result:= (TF.AppWind = 0); end;

procedure TForm1.Button1Click(Sender: TObject);
var Text: Array[0..255] of char;
begin
AppInst:= ShellExecute(Handle, 'open', 'notepad.exe', nil, '', SW_NORMAL); EnumWindows(@EnumFunc, longint(self)); AppWind:= GetWindow(AppWind, GW_CHILD); end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SendKey(AppWind, 'T'); SendKey(AppWind, 'e'); SendKey(AppWind, 's'); SendKey(AppWind, 't'); end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if AppWind <> 0 then SendKey(AppWind, Key); end;

end.

[000287]



Прерывание клавиши ENTER


Лучший путь решения проблемы - заставить форму возвратить код другой клавиши, в противном случае система найдет на форме кнопку "по умолчанию" и "нажмет" ее. Далее поместите необходимый для обработки клавиши Enter код в обработчик события кнопок OnClick. Основное вы уже сделали, осталось только запустить программу, проконтролировать ее поведение при нажатии Enter и заставить действовать соответственно обстоятельствам. [000434]



Прерывание клавиши Tab


Единственное место в программе, где можно перехватить нажатие клавиши tab - в обработчике Application.OnMessages. Пример ниже:

    unit Hndltabu;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Label1: TLabel; procedure FormCreate(Sender: TObject); private { Private-Deklarationen } procedure AppMessage(var Msg: TMsg; var Handled: Boolean); public { Public-Deklarationen } end;
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean); const shiftPressed: boolean = false; begin if Msg.Message = WM_KEYDOWN then if not shiftPressed and (Msg.wParam = VK_SHIFT) then begin shiftPressed := true; Exit; end else begin if Msg.wParam = VK_TAB then if ActiveControl = Edit1 then begin if shiftPressed then Label1.Caption := 'BACKTAB!' else Label1.Caption := 'TAB!';
Handled        := true end else Label1.Caption := '';
shiftPressed := false; end; end;
procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := AppMessage; end;
end.

- Ralph Friedman [000956]



Создание собственных горячих клавиш


Как мне перехватывать нажатие созданных мною горячих клавиш?

Во первых установите свойство формы KeyPreview := true;

Затем сделайте что-то типа этого:

    procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then ShowMessage('Ctrl-A'); end;

[000938]



Тpебyется чтобы пpи нажатии =Enter=


Nomadic дает следующий пример:

    procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then Begin Key:=#0; SelectNext(Sender as TWinControl, true, true); { или Perform(WM_NEXTDLGCTL, 0, 0);  } End;
end;

А кстати как у тебя с Tab order ... список правильно выстроен... [001714]