Эксперт
Профиль
Группа: Участник Клуба
Сообщений: 1813
Регистрация: 9.11.2004
Где: С.-Петербург
Репутация: нет
Всего: 67
|
Сделал временное, топорное решение. Поставил hook на WM_MOUSEMOVE и вывел картинку курсора вследа за движением мыши. MouseHook.dpr: | Код |
library MouseHook;
uses
Windows, Messages, Graphics;
{$R MouseHook.res}
const
MMFName: PChar = 'HookDLLMMF'; // имя объекта файлового отображения в память
EventName: PChar = 'HookEvent'; // имя объекта "события"
type
{ Структура глобальных данных }
PGlobalData = ^TGlobalData;
TGlobalData = packed record
SysHook: HHook; // дескриптор установленной ловушки
end;
var
GlobalData: PGlobalData; // глобальные данные
hMMF: THandle; // дескриптор объекта файлового отображения в память
hEvent: THandle; // дескриптор объекта "события"
DLLPath: String; // путь, откуда была загружена наша DLL
Cnv: TCanvas;
bmp: TBitmap;
////////////////////////////////////////////////////////////////////////////////
//== Описание основных подпрограмм =============================================
////////////////////////////////////////////////////////////////////////////////
{--- Открытие глобальных данных ---}
procedure OpenGlobalData;
begin
// Пытаемся открыть объект файлового отображения в память (возможно он уже был создан)
hMMF := OpenFileMapping(FILE_MAP_ALL_ACCESS, true, MMFName);
if hMMF = 0 then // если объект ещё не был создан
begin
{ Создаём объект файлового отображения в память, значение INVALID_HANDLE_VALUE = -1 и говорит о том,
что данные будут отображены в файл "подкачки" }
hMMF := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalData), MMFName);
if hMMF = 0 then
begin
MessageBox(0, 'Не удалось создать объект файлового отображения в память !!',
'Error (HookDLL::OpenGlobalData -> CreateFileMapping)', MB_OK + MB_ICONERROR);
DLLProc := nil; // "прячем" точку входа в DLL
HALT
end
end;
{ Отображаем глобальные данные на АП вызывающего процесса и
получаем указатель на начало выделенного пространства }
GlobalData:= MapViewOfFile(hMMF, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalData));
if GlobalData = nil then
begin
MessageBox(0, 'Не удалось отобразить глобальные данные на АП вызывающего процесса !!',
'Error (HookDLL::OpenGlobalData -> MapViewOfFile', MB_OK + MB_ICONERROR);
CloseHandle(hMMF);
DLLProc := nil; // "прячем" точку входа в DLL
HALT
end;
// Пытаемся открыть объект "событие"
hEvent := OpenEvent(EVENT_ALL_ACCESS, true, EventName);
if hEvent = 0 then // если объект ещё не был создан, то ...
hEvent := CreateEvent(nil, false, {false}true, EventName); // создаём его
bmp := TBitmap.Create;
bmp.Handle := LoadBitmap(HInstance,'BITMAP_1');
bmp.TransparentColor := clBlack;
bmp.Transparent := True;
Cnv := TCanvas.Create;
end;
{--- Закрытие глобальных данных ---}
procedure CloseGlobalData;
begin
if GlobalData <> nil then
begin
UnmapViewOfFile(GlobalData); // освобождаем объект файлового отображения
ReleaseDC(0, Cnv.Handle);
Cnv.Free;
GlobalData := nil
end;
if hMMF <> 0 then
begin
CloseHandle(hMMF);
hMMF := 0
end;
if hEvent <> 0 then
CloseHandle(hEvent)
end;
{--- Точка входа в DLL ---}
procedure DLLEntryPoint(dwReason: DWORD);
begin
case dwReason of
{ При подключении процесса к DLL }
DLL_PROCESS_ATTACH: OpenGlobalData; // открываем глобальные данные
{ При отключении процесса от DLL }
DLL_PROCESS_DETACH: CloseGlobalData // закрываем глобальные данные
end
end;
{--- Функция перехвата клавиатуры ---}
function JournalProc(nCode: Integer; wParam: WPARAM; var EventStrut: TEventMsg): LRESULT; stdcall;
var
cord: TPoint;
begin
Result := CallNextHookEx(GlobalData^.SysHook, nCode, wParam, Longint(@EventStrut)); // отдаём на съедение другим :)
if nCode < 0 then Exit;
// Проверяю сообщение
if nCode = HC_ACTION then
begin
case EventStrut.message of
WM_MOUSEMOVE:
begin
InValidateRect(0, nil, false);
GetCursorPos(cord);
//Rectangle(ScreenDC, cord.X, cord.Y, cord.X + 15, cord.Y + 15);
Cnv.Handle := GetDC(0);
Cnv.Draw(cord.X, cord.Y, bmp);
end;
end;
end;
end;
{--- Установка/сброс хука ---}
procedure RSHook(State: Boolean);
begin
if State then
begin
// Устанавливаем Hook
GlobalData^.SysHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
if SetWindowsHook(WH_JOURNALRECORD, @JournalProc) > 0 then
//
else
begin
MessageBox(0, 'Hook не удалось установить !!', 'Error (HookDLL::RSHook -> SetWindowsHookEx)', MB_OK + MB_ICONERROR);
CloseGlobalData; // закрываем глобальные данные
HALT // аут
end;
end
else
// Снимаем хук
if not UnhookWindowsHookEx(GlobalData^.SysHook) then
MessageBox(0, 'Hook снять не удалось !!', 'Error (HookDLL::RSHook -> UnhookWindowsHookEx', MB_OK + MB_ICONERROR)
end;
////////////////////////////////////////////////////////////////////////////////
//== Экспортируемые функции и начальные установки ==============================
////////////////////////////////////////////////////////////////////////////////
exports RSHook;
var
ModPath: PChar;
begin
DLLProc := @DLLEntryPoint; // устанавливаем точку входа в DLL
DLLEntryPoint(DLL_PROCESS_ATTACH); // уведобляем о подключении к DLL-ке нашего процесса
end. |
: | Код |
program SCursor;
uses Windows, Messages;
{$R *.res}
// Внешняя функция установки/сброса хука из нашей DLL-ки
procedure RSHook(State: Boolean); external 'MouseHook.dll';
////////////////////////////////////////////////////////////////////////////////
//==[ Создание окна ]===========================================================
////////////////////////////////////////////////////////////////////////////////
const
wndClassName = 'SCursor_Wnd';
var
MainWndClass: TWndClassEx; // класс главного окна
Msg: TMsg; // обрабатываемое сообщение
hMainWnd: HWND;
{*** Оконная процедура главного окна ***}
function WindowProc(Wnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
Result := 0;
case uMsg of
WM_DESTROY:
begin
PostQuitMessage(0);
Exit;
end;
WM_COMMAND:
case LoWord(wParam) of
IDCANCEL: DestroyWindow(Wnd)
end;
else
Result := DefWindowProc(Wnd, uMsg, wParam, lParam);
end;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
begin
// Структура TWndClassEx
MainWndClass.cbSize := SizeOf(MainWndClass); // размер структуры
MainWndClass.Lpfnwndproc := @WindowProc; // указатель на функцию, выполняющую все операции с окном
MainWndClass.cbClsExtra := 0; // кол-во доп. байт, выделяемых структуре
MainWndClass.cbWndExtra := 0; // кол-во доп. байт, выделяемых для всех доп. структур
MainWndClass.hInstance := hInstance; // экземпляр приложения
MainWndClass.hCursor := LoadCursor(0, IDC_ARROW); // курсор проги
MainWndClass.hbrBackground := COLOR_BTNFACE + 1; // цвет фона окна
MainWndClass.lpszMenuName := nil; // имя ресурса меню
MainWndClass.LpszClassName := wndClassName; // имя класса окна
RegisterClassEx(MainWndClass); // регистрируем класс окна
// Создаём главное окно
hMainWnd := CreateWindowEx(0, wndClassName, 'Mouse Hook', WS_OVERLAPPEDWINDOW,
0,0, 100,100, 0,0, hInstance, nil);
// Устанавливаем хук
RSHook(true);
// Показываем форму
ShowWindow(hMainWnd, SW_SHOW);
// Цикл обработки сообщений
while (GetMessage(Msg, 0,0,0)) do
begin
if hMainWnd <> 0 then
{ IsDialogMessage- Опpеделяет и обpабатывает сообщения для безpежимных блоков
диалога, пpееобpазуя сообщения от клавиатуpы в командные сообщения }
if IsDialogMessage(hMainWnd, Msg) then
Continue;
TranslateMessage(Msg);
DispatchMessage(Msg)
end
end. |
Мало того, что решение топорное, так ещё и ряд глюков: 1) мерцание 2) bmp.TransparentColor := clBlack; - игнорируется в Win8. В Win7 всё нормально Это сообщение отредактировал(а) Ciber SLasH - 4.8.2015, 00:27
Присоединённый файл ( Кол-во скачиваний: 0 )
ShowBitmap.rar 65,60 Kb |
ShowCursor в Windows 8, не отображается курсор 
Загрузка ...
