:: MVP ::
|
|
:: RSS ::
|
|
|
Как различить правый и левый Ctrl?
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMKEYDOWN(var msg: TMessage); message WM_KEYDOWN;
public
{ Public declarations }
end;
{...}
// Форма должна иметь фокус
procedure TForm1.WMKEYDOWN(var msg: TMessage);
begin
if (msg.LParam and (255 shl 16)) shr 16 <> 29 then
Exit;
if msg.LParam and (1 shl 24) > 0 then
Form1.Caption := 'Right'
else
Form1.Caption := 'Left';
end;
|
Как изменить раскладку клавиатуры?
// Способ первый
// Русский язык
procedure TForm1.Button1Click(Sender: TObject);
var
Russian: HKL;
begin
Russian := LoadKeyboardLayout('00000419', 0);
ActivateKeyboardLayout(Russian, KLF_ACTIVATE);
end;
// Английский язык
procedure TForm1.Button2Click(Sender: TObject);
var
Latin: HKL;
begin
Latin := LoadKeyboardLayout('00000409', 0);
ActivateKeyboardLayout(Latin, KLF_ACTIVATE);
end;
// Способ второй
// Русский язык
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadKeyboardLayout('00000419', KLF_ACTIVATE);
end;
// Английский язык
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadKeyboardLayout('00000409', KLF_ACTIVATE);
end;
// Способ третий
function ChangeLayout(LANG: Integer): Boolean;
var
Buf: array[0..255] of Char;
Layouts: array [0..16] of HKL;
i, Count: Integer;
const
INPUTLANGCHANGE_SYSCHARSET = $0001;
begin
Result := False;
Count := GetKeyboardLayoutList(High(Layouts)+1, Layouts);
for i := 0 to Count-1 do
if LoWord(Layouts[i]) and $FF = LANG then
begin
Result := ActivateKeyboardLayout(Layouts[i], 0) <> 0;
if Result then
begin
GetLocaleInfo(LoWord(Layouts[i]), LOCALE_ILANGUAGE, Buf, SizeOf(Buf));
PostMessage(Application.Handle, WM_INPUTLANGCHANGEREQUEST,
INPUTLANGCHANGE_SYSCHARSET, LParam(@Buf));
end;
end;
end;
// Русский язык
procedure TForm1.Button1Click(Sender: TObject);
begin
ChangeLayout(LANG_RUSSIAN);
end;
// Английский язык
procedure TForm1.Button2Click(Sender: TObject);
begin
ChangeLayout(LANG_ENGLISH);
end;
|
Как определить тип клавиатуры?
function TForm1.GettingKeybType: string;
var
Flag: integer;
begin
Flag:=0;
case GetKeyboardType( Flag ) of
1: Result := 'IBM PC/XT or compatible (83-key) keyboard';
2: Result := 'Olivetti "ICO" (102-key) keyboard';
3: Result := 'IBM PC/AT (84-key) or similar keyboard';
4: Result := 'IBM enhanced (101- or 102-key) keyboard';
5: Result := 'Nokia 1050 and similar keyboards';
6: Result := 'Nokia 9140 and similar keyboards';
7: Result := 'Japanese keyboard';
end;
end;
|
Как узнать состояние кнопок Caps Lock, Num Lock, Scroll Lock?
// Способ первый
// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
var
KS: TKeyboardState;
begin
GetKeyboardState(KS);
if KS[VK_CAPITAL] and 1 = 1 then
LabelCapsLock.Enabled := True
else
LabelCapsLock.Enabled := False;
if KS[VK_NUMLOCK] and 1 = 1 then
LabelNumLock.Enabled := True
else
LabelNumLock.Enabled := False;
if KS[VK_SCROLL] and 1 = 1 then
LabelScrollLock.Enabled := True
else
LabelScrollLock.Enabled := False;
end;
// Способ второй
// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (GetKeyState(VK_CAPITAL) and $01) <> 0 then
LabelCapsLock.Enabled := True
else
LabelCapsLock.Enabled := False;
if (GetKeyState(VK_NUMLOCK) and $01) <> 0 then
LabelNumLock.Enabled := True
else
LabelNumLock.Enabled := False;
if (GetKeyState(VK_SCROLL) and $01) <> 0 then
LabelScrollLock.Enabled := True
else
LabelScrollLock.Enabled := False;
end;
|
Как изменить состояние кнопок Caps Lock, Num Lock, Scroll Lock и подобных?
// Коды некоторых клавиш:
// Caps Lock - 020
// Shift - 016
// Insert - 045
// NumLock - 144
// Contrl - 017
// Delete - 046
// Scroll Lock - 145
// Alt - 018
// Tab - 009
// Следующий пример меняет состояние клавиш Caps Lock,
// Num Lock и Scroll Lock на противоположное:
procedure TForm1.Button1Click(Sender: TObject);
var
KS: TKeyboardState;
begin
GetKeyboardState(KS);
KS[VK_CAPITAL] := KS[VK_CAPITAL] xor 1;
KS[VK_NUMLOCK] := KS[VK_NUMLOCK] xor 1;
KS[VK_SCROLL] := KS[VK_SCROLL] xor 1;
SetKeyboardState(KS);
end;
|
Как отловить правый Enter (NumPad)?
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
public
{ Public declarations }
end;
procedure TForm1.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
case Message.CharCode of
VK_RETURN:
begin
if (Message.KeyData and $1000000 <> 0) then
Form1.Caption := 'Правый Enter'
else
Form1.Caption := 'Нормальный Enter';
end;
end;
end;
|
Как определить, нажал ли пользователь клавишу PrintScreen?
// Способ первый
// Форма должна иметь фокус
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure AppIdle(Sender: TObject; var Done: Boolean);
end;
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 := 'PrintScreen нажата!';
Done := True;
end;
// Способ второй
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WMHotKey( var Msg: TWMHotKey ); message WM_HOTKEY;
end;
{...}
implementation
const
ID_SNAPSHOT = 101;
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
if Msg.HotKey = ID_SNAPSHOT then
ShowMessage('GotIt');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey(Form1.Handle, ID_SNAPSHOT, 0, VK_SNAPSHOT);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(Form1.Handle, ID_SNAPSHOT);
end;
|
Как определить, что была нажата клавиша Tab?
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure CMDialogKey( var msg: TCMDialogKey ); message CM_DIALOGKEY;
public
{ Public declarations }
end;
procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
if msg.Charcode <> VK_TAB then
inherited;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_TAB then
Form1.Caption := 'Клавиша Tab нажата!';
end;
|
При использовании материала - ссылка на сайт обязательна
|
|