Отловить нажатия клавиш мыши, клавиатуры через winapi

Alexandr_17_10 · #1 05.07.2014, 12:59

Пробывал сделать так

Код:

public
    { Public declarations }
    id1, id2:Integer;
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
  end;
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
var DC: HDC;
  cur:TPoint;
begin
  if (Msg.HotKey = id1)or(Msg.HotKey = id2) then begin
    DC := CreateDC('MONITOR', nil, nil, nil);
    Windows.GetCursorPos(Cur);
    label8.Color:=GetPixel(DC, Cur.X, Cur.Y);
    DeleteDC(DC);
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  id1 := GlobalAddAtom('Hotkey1');
  RegisterHotKey(Handle, id1, 0, VK_MBUTTON);
  id2 := GlobalAddAtom('Hotkey2');
  RegisterHotKey(Handle, id2, $12 + $10,  $5A);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Handle, id1);
  GlobalDeleteAtom(id1);
  UnRegisterHotKey(Handle, id2);
  GlobalDeleteAtom(id2);
end;

но не работает
Цель: отловить нажатия клавиши не в зависимости где находится курсор мыши и не используя таймера.

Alegun · #2 05.07.2014, 16:51

Похоже проще "мышиной" ловушкой

Код:

var
 MouseHook: HHOOK;
function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
 DC: HDC;
 Cur: TPoint;
begin
 Result:= CallNextHookEx(MouseHook, nCode, WParam, LParam);

 if WParam = WM_MBUTTONDOWN then
  begin
   DC:= CreateDC('MONITOR', nil, nil, nil);
   Windows.GetCursorPos(Cur);
   Form1.Label8.Color:= GetPixel(DC, Cur.X, Cur.Y);
   DeleteDC(DC);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MouseHook:= SetWindowsHookEx(14 {для клавиатуры 13}, @LowLevelMouseProc, HInstance, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 UnhookWindowsHookEx(MouseHook);
end;

Alexandr_17_10 · #3 05.07.2014, 18:53

А если нужна использовать вместо средний кнопки мыши комбинацию клавишь
И вообще мне нужно общее событие которое будет происходить и при нажатии мышки и при нажатии клавиатуры

Alegun · #4 05.07.2014, 19:48

На мышку мне установить хоткей так и не удалось ни разу, вешались лишь на клаву. Можно при срабатывании данной ловушки проверить состояние нужных клавиш с помощью GetKeyboardState, напр.

Код:

var
KS : TKeyboardState;
...
GetKeyboardState(KS);
if Odd(KS[VK_CAPITAL]) then ..

т.е. получится что если вместе с мышкой нажата и VK_CAPITAL на клаве, нужно сделать то-то и то-то

Alexandr_17_10 · #5 08.07.2014, 20:03

Мне нужно сделать одно действие если нажата комбинация клавишь alt+shift+z или если нажата средняя клавиша. Поэтому нужно общее событие которое срабатывает и при нажатии мышки и при нажатии клавы. Ну или если 1 вариант невозможен то 2 события 1 для мышки другое для клавы и в обоиъх запускать процедуру которая и получит цвет пикселя окна

Alegun · #6 09.07.2014, 05:16

У вас есть весь код для подобной реализации, но видимо проблема как раз в организации такого действа. Тогда вот, окончательная копипаста

Код:

procedure ptg;
var
 DC: HDC;
 Cur: TPoint;
begin
   DC:= CreateDC('MONITOR', nil, nil, nil);
   Windows.GetCursorPos(Cur);
   Form1.Label8.Color:= GetPixel(DC, Cur.X, Cur.Y);
   DeleteDC(DC);
end;

var
 MouseHook: HHOOK;

 function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
 Result:= CallNextHookEx(MouseHook, nCode, WParam, LParam);
 if WParam = WM_MBUTTONDOWN then ptg;
end;

procedure TForm1.WMHotKey(var Message: TMessage);
begin
 ptg;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 RegisterHotKey(form1.Handle,12345, MOD_ALT or MOD_SHIFT,  $5A);
 MouseHook:= SetWindowsHookEx(14, @LowLevelMouseProc, HInstance, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 UnregisterHotKey(Handle, 12345);
 UnhookWindowsHookEx(MouseHook);
end;

Alexandr_17_10 · #7 09.07.2014, 09:59

код клавиатуры не работает как и для левого alt и shift как и для правого alt и shift

Alegun · #8 09.07.2014, 14:52

Код рабочий, проверено под D7. Советую на время вместо строки

Код:

Form1.Label8.Color:= GetPixel(DC, Cur.X, Cur.Y);

задействовать

Код:

Form1.Label8.Caption:= IntToStr(Cur.X) + ' : ' + IntToStr(Cur.Y);

Alexandr_17_10 · #9 09.07.2014, 19:01

Яже говорю не работает вот весь код

Код:

unit UnCTOC;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,clipbrd, AppEvnts, XPMan, Buttons, INIFILES;

type
  TForm1 = class(TForm)
    ColorDialog1: TColorDialog;
    label8: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ListBox1: TListBox;
    Panel3: TPanel;
    CB1: TCheckBox;
    CB2: TCheckBox;
    CB3: TCheckBox;
    procedure CB1Click(Sender: TObject);
    procedure CB2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CB3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
    procedure WMHotKey(var Message: TMessage);
  public
    { Public declarations }
    procedure primenenie(r,g,b:Byte);
    procedure readiniparam;
    procedure writeiniparam;
  end;

var
  Form1: TForm1;
  indexlistbox:integer;
  indexlb:integer;
  rectlb:trect;
  drawlb:TOwnerDrawState;
  MouseHook: HHOOK;
  ini:tinifile;
implementation

{$R *.dfm}

procedure TForm1.readiniparam;
begin
  try
    ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+ExtractFileName(ParamStr(0))+'.ini');
    cb1.Checked:=ini.ReadBool('Application_Main_Form',':'+name+ '|cb1|Checked-->', false);
    cb2.Checked:=ini.ReadBool('Application_Main_Form',':'+name+ '|cb2|Checked-->', false);
    cb3.Checked:=ini.ReadBool('Application_Main_Form',':'+name+ '|cb3|Checked-->', false);
    label8.Color:=StringToColor(ini.ReadString('Application_Main_Form',':'+name+ '|EdColorCode|Color-->', 'clblack'));
    label8.Text:=ini.ReadString('Application_Main_Form',':'+name+ '|EdColorCode|Text-->', '');
    listbox1.ItemIndex:=ini.ReadInteger('Application_Main_Form',':'+name+ '|LBS|ID-->', 0);
  finally
    ini.Free;
  end;
end;

procedure TForm1.writeiniparam;
begin
  try
    ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+ExtractFileName(ParamStr(0))+'.ini');
    ini.WriteString('Application_Main_Form',':'+name+ '|EdColorCode|Color-->',ColorToString(label8.Color));
    ini.WriteString('Application_Main_Form',':'+name+ '|EdColorCode|Text-->',label8.Text);
    ini.WriteBool('Application_Main_Form',':'+name+ '|cb1|Checked-->',cb1.Checked);
    ini.WriteBool('Application_Main_Form',':'+name+ '|cb2|Checked-->',cb2.Checked);
    ini.WriteBool('Application_Main_Form',':'+name+ '|cb3|Checked-->',cb3.Checked);
    ini.WriteInteger('Application_Main_Form',':'+name+ '|LBS|ID-->', indexlb);
  finally
    ini.Free;
  end;
end;

procedure ptg;
var DC: HDC;
  cur:TPoint;
begin
  Windows.GetCursorPos(Cur);
  DC := GetDC(GetDesktopWindow);
  try
    Form1.Label8.Text := IntToStr(Cur.X) + ' : ' + IntToStr(Cur.Y);
    Form1.Label8.Color:= GetPixel(DC, Cur.X, Cur.Y);
    Form1.ListBox1DrawItem(Form1.listbox1, indexlb, rectlb, drawlb);
  finally
    ReleaseDC(GetDesktopWindow, DC)
  end;
end;

function TColorToKAM(Color : TColor) : string;
 begin
    Result :='[$'+
      IntToHex(GetBValue(Color), 2) +
      IntToHex(GetGValue(Color), 2) +
      IntToHex(GetRValue(Color), 2)+']';
end;

procedure TForm1.primenenie(r, g, b: Byte);
VAR
  VremText1,VremText2,VremText3,VremText4,VremText5:String;
begin
  If CB1.Checked Then begin
    VremText1:=#39;
    VremText2:=#59;
    VremText3:=#40;
    VremText4:=#41;
    VremText5:='RGB';
  end else begin
    VremText1:='';
    VremText2:='';
    VremText3:='';
    VremText4:='';
    VremText5:='';
  end;
  Case indexlistbox of
    0:Clipboard.SetTextBuf(PChar(ColorToString(RGB(R, G, B))+VremText2));
    1:Clipboard.SetTextBuf(PChar(IntToStr(RGB(R, G, B))+VremText2));
    2:Clipboard.SetTextBuf(PChar(VremText1+TColorToKAM(RGB(R, G, B))+VremText1+VremText2));
    3:Clipboard.SetTextBuf(PChar(VremText5+VremText3+IntToStr(r)+', '+IntToStr(g)+', '+IntToStr(b)+VremText4+VremText2));
  end;
end;

procedure TForm1.WMHotKey(var Message: TMessage);
begin
  ptg;
end;

function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var DC: HDC;
  cur:TPoint;
begin
  Result:= CallNextHookEx(MouseHook, nCode, WParam, LParam);
  if WParam = WM_MBUTTONDOWN then ptg;
end;

procedure TForm1.CB1Click(Sender: TObject);
begin
  If CB1.Checked then begin
    CB1.Font.Style:=[fsbold];
    CB2.Enabled:=TRUE;
  END else BEGIN
    CB1.Font.Style:=[];
    CB2.Enabled:=FALSE;
    IF CB2.Checked THEN
      CB2.Checked:=fALSE;
  END;
  ListBox1DrawItem(listbox1, indexlb, rectlb, drawlb);
end;

procedure TForm1.CB2Click(Sender: TObject);
begin
  If CB2.Checked then
    CB2.Font.Style:=[fsbold]
  else
    CB2.Font.Style:=[];
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  application.Terminate;
  writeiniparam;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
Var
  Colors: Longint;
  r, g, b: Byte;
begin
  listbox1.Canvas.FillRect(rect);
  listbox1.Canvas.TextOut(rect.Left, rect.Top, listbox1.Items.Strings[Index]);
  indexlistbox:=listbox1.Itemindex;
  Colors:=label8.Color;
  r     := Colors;
  g     := Colors shr 8;
  b     := Colors shr 16;
  primenenie(R, G, B);
  Label8.Text:=Clipboard.AsText;
  Label8.Hint:='Сейчас в буфере: "'+Clipboard.AsText+'"';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterHotKey(form1.Handle,12345, MOD_ALT or MOD_SHIFT,  $5A);
  MouseHook:= SetWindowsHookEx(14, @LowLevelMouseProc, HInstance, 0);
  readiniparam;
  if cb3.Checked then
    ListBox1DrawItem(listbox1, indexlb, rectlb, drawlb);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  If ColorDialog1.Execute then begin
    label8.Color:=ColorDialog1.Color;
    ListBox1DrawItem(listbox1, indexlb, rectlb, drawlb);
  end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
VAR
  r, g, b: Byte;
begin
  RANDOMIZE;
  R:=RANDOM(256);
  G:=RANDOM(256);
  B:=RANDOM(256);
  label8.Color:=RGB(R, G, B);
  ListBox1DrawItem(listbox1, indexlb, rectlb, drawlb);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnregisterHotKey(Handle, 12345);
  UnhookWindowsHookEx(MouseHook);
end;

procedure TForm1.CB3Click(Sender: TObject);
begin
  If CB3.Checked then
    CB3.Font.Style:=[fsbold]
  else
    CB3.Font.Style:=[];
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  indexlb:=listbox1.ItemIndex;
end;

end.

событие procedure TForm1.WMHotKey(var Message: TMessage);
даже не происходит я нажимал клавиши в пределах формы и вот какие я комбинации перепробывал
1 Левый Alt + левый shift + z
2 Правый Alt + Правый shift + Правый z
3 Левый и правый alt + Левый и правый Shift + z
4 Левый alt + z
5 Левый Shift + z
6 Правый alt + z
7 Правый shift + z
8 Левый и Правый Alt + z
9 Левый и Правый Shift + z
Помоему я перепробыал все комбинации но ничего не происходит.
Темболее что программу я запускал используя дебаг (красный кружок и запускал я ее через f4)
Если что я на Windows 8.1 но без разницы на какой я винде главное что код должен работать под любой windows

Alegun · #10 09.07.2014, 22:41

Вот всё что накодилось по вашей теме в одном архиве, сборка под W7 на D7

Alexandr_17_10 · #11 10.07.2014, 15:04

В принципе проблема решена второй аналогичной функцией

Код:

function LowLevelMouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var DC: HDC;
  cur:TPoint;
begin
  Result:= CallNextHookEx(MouseHook, nCode, WParam, LParam);
  if WParam = WM_MBUTTONDOWN then ptg;
end;

только для клавиатуры

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты