Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 647

Раздел: Delphi » Программирование с помощью API
/ вопрос открыт /

Здравствуйте, уважаемые эксперты! Пишу программу для работы со "скриншотами". Не могу понять как сделать так, чтобы при нажатии какой-либо клавиши на клавиатуре происходило какое-либо действие, если программа в данный момент не активна, но запущена на компьютере(программа свернута или находится в системном трее). Подскажите, пожалуйста, код этого действия. Заранее спасибо.

Wersel Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Wersel (статус: Посетитель)
Вопрос отправлен: 20 июня 2007, 17:28
Состояние вопроса: открыт, ответов: 3.

Ответ #1. Отвечает эксперт: Градов Ю.М.

Здравствуйте, Wersel!
Привожу пример создания резидентной программы. Взята с сайта <a href=http://delphi.word.narod.ru<Link</a>

Приложение:
  1. program MyResident;
  2. uses
  3. Windows,
  4. ShellAPI,
  5. Messages;
  6.  
  7. const
  8.  
  9.  
  10.  
  11.  
  12. var
  13.  
  14.  
  15.  
  16. function MyWndProc(wnd: hWnd; msg, wParam,
  17. lParam: longint): longint; stdcall;
  18. var
  19. p: TPoint;
  20. s: array [0..255] of char;
  21. tray: TNotifyIconData;
  22. begin
  23. case msg of
  24.  
  25. GetCursorPos(p);
  26.  
  27.  
  28. GetClassName(GetForegroundWindow, s, length(s));
  29. if s <> 'WindowsScreenSaverClass'
  30. then SendMessage(wnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
  31. end;
  32. result := 0;
  33. end;
  34.  
  35.  
  36. if lparam = WM_RBUTTONUP then begin
  37. GetCursorPos(p);
  38. TrackPopupMenu(menu, TPM_LEFTALIGN, p.x, p.x, 0, wnd, nil);
  39. end;
  40. result := 0;
  41. end;
  42.  
  43.  
  44.  
  45. if lo(lparam) = 0 then SendMessage(mywnd, WM_CLOSE, 0, 0);
  46. result := 0;
  47. end;
  48.  
  49.  
  50. SendMessage(wnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
  51. result := 0;
  52. end;
  53.  
  54.  
  55. with tray do begin
  56. cbSize := sizeof(TNotifyIconData);
  57. wnd := mywnd;
  58. uID := 0;
  59. end;
  60. Shell_NotifyIcon(NIM_DELETE, @tray);
  61. PostQuitMessage(0);
  62. result := 0;
  63. end;
  64. else Result := DefWindowProc(wnd, msg, WParam, LParam);
  65. end;
  66. end;
  67.  
  68. function CreateMyWnd: hWnd;
  69. var
  70. wc: WndClass;
  71. begin
  72.  
  73. wc.style := 0;
  74. wc.lpfnWndProc := @MyWndProc;
  75. wc.cbClsExtra := 0;
  76. wc.cbWndExtra := 0;
  77. wc.hInstance := hInstance;
  78. wc.hIcon := 0;
  79. wc.hCursor := 0;
  80. wc.hbrBackground := COLOR_WINDOW;
  81. wc.lpszMenuName := nil;
  82. wc.lpszClassName := ClassName;
  83. if RegisterClass(wc) = 0 then halt(0);
  84.  
  85. result := CreateWindowEx(WS_EX_APPWINDOW, ClassName,
  86. 'My Window', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
  87. if result = 0 then halt(0);
  88. end;
  89.  
  90. procedure CreateTray;
  91. var
  92. tray: TNotifyIconData;
  93. begin
  94.  
  95. with tray do begin
  96. cbSize := sizeof(TNotifyIconData);
  97. wnd := mywnd;
  98. uID := 0;
  99. uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  100. uCallBackMessage := WM_NOTIFYTRAYICON;
  101. hIcon := LoadIcon(0, IDI_ASTERISK);
  102. szTip := ('My Resident');
  103. end;
  104. Shell_NotifyIcon(NIM_ADD, @tray);
  105. end;
  106.  
  107. function CreateMyMenu: hMenu;
  108. begin
  109.  
  110. result := CreatePopupMenu;
  111. if result = 0 then halt(0);
  112. if not AppendMenu(result, MF_STRING, 0, 'Exit') then halt(0);
  113. end;
  114.  
  115. var
  116. msg: TMsg;
  117.  
  118. begin
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126. while (GetMessage(msg, 0, 0, 0)) do begin
  127. TranslateMessage(msg);
  128. DispatchMessage(msg);
  129. end;
  130.  
  131.  
  132. end.


Ответ отправил: Градов Ю.М. (статус: 8-ой класс)
Время отправки: 20 июня 2007, 19:31
Оценка за ответ: 3

Ответ #2. Отвечает эксперт: min@y™

Поищи примеры по функциям RegisterHotkey() и UregisterHotkey(). Они есть в инете на русском языке.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 21 июня 2007, 08:33
Оценка за ответ: 3

Ответ #3. Отвечает эксперт: Матвеев Игорь Владимирович

Здравствуйте, Wersel!
Нужно просто поставить Хук на клавиатуру. См. подробный пример в прикреплённом файле.
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Ответ отправил: Матвеев Игорь Владимирович (статус: Студент)
Время отправки: 22 июня 2007, 05:31


Мини-форум вопроса

Всего сообщений: 3; последнее сообщение — 23 июня 2007, 10:31; участников в обсуждении: 3.
Градов Ю.М.

Градов Ю.М. (статус: 8-ой класс), 20 июня 2007, 19:33 [#1]:

Ошибка с линком!
Link
Wersel

Wersel (статус: Посетитель), 22 июня 2007, 12:55 [#2]:

Я сделал процедуры для RegisterHotkey() и UregisterHotkey():

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey(Handle, 1 ,MOD_CONTROL,vk_F1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle, 1);
end;

А как объявить процедуру,при нажатии этой кнопки,тоесть:
_Процедура_нажатия_кнопки_
Begin
_Событие_присходящее_при_нажатии_этой_кнопки
End
Что надо прописать вместо "_Процедура_нажатия_кнопки_"?
min@y™

min@y™ (статус: Доктор наук), 23 июня 2007, 10:31 [#3]:

Могу прислать 100% РАБОТАЮЩИЙ кусок кода из своей проги. Пишите письма.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:13
Выполнено за 0.02 сек.