![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
![]() Пробывал сделать так
Код:
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; Цель: отловить нажатия клавиши не в зависимости где находится курсор мыши и не используя таймера. |
#2
|
||||
|
||||
![]() Похоже проще "мышиной" ловушкой
Код:
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; Я не понял Вашего вопроса, но всё же Вам на него отвечу! Последний раз редактировалось Alegun, 05.07.2014 в 17:26. |
#3
|
|||
|
|||
![]() А если нужна использовать вместо средний кнопки мыши комбинацию клавишь
И вообще мне нужно общее событие которое будет происходить и при нажатии мышки и при нажатии клавиатуры Последний раз редактировалось Alexandr_17_10, 05.07.2014 в 19:18. |
#4
|
||||
|
||||
![]() На мышку мне установить хоткей так и не удалось ни разу, вешались лишь на клаву. Можно при срабатывании данной ловушки проверить состояние нужных клавиш с помощью GetKeyboardState, напр.
Код:
var KS : TKeyboardState; ... GetKeyboardState(KS); if Odd(KS[VK_CAPITAL]) then .. Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#5
|
|||
|
|||
![]() Мне нужно сделать одно действие если нажата комбинация клавишь alt+shift+z или если нажата средняя клавиша. Поэтому нужно общее событие которое срабатывает и при нажатии мышки и при нажатии клавы. Ну или если 1 вариант невозможен то 2 события 1 для мышки другое для клавы и в обоиъх запускать процедуру которая и получит цвет пикселя окна
|
#6
|
||||
|
||||
![]() У вас есть весь код для подобной реализации, но видимо проблема как раз в организации такого действа. Тогда вот, окончательная копипаста
Код:
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; Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#7
|
|||
|
|||
![]() код клавиатуры не работает как и для левого alt и shift как и для правого alt и shift
|
#8
|
||||
|
||||
![]() Код рабочий, проверено под D7. Советую на время вместо строки
Код:
Form1.Label8.Color:= GetPixel(DC, Cur.X, Cur.Y); Код:
Form1.Label8.Caption:= IntToStr(Cur.X) + ' : ' + IntToStr(Cur.Y); Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#9
|
|||
|
|||
![]() Яже говорю не работает вот весь код
Код:
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. даже не происходит я нажимал клавиши в пределах формы и вот какие я комбинации перепробывал 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 Последний раз редактировалось Alexandr_17_10, 09.07.2014 в 19:09. |
#10
|
||||
|
||||
![]() Вот всё что накодилось по вашей теме в одном архиве, сборка под W7 на D7
Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#11
|
|||
|
|||
![]() В принципе проблема решена второй аналогичной функцией
Код:
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; |