Developing.ru

Andreich писал(а):Почему программа должна будет занимать много ресурсов? Просто по таймеру производится копирование части экрана в TBitmap... но ведь не нужно копировать весь экран! По-моему для такой программы как лупа, фактор системных ресурсов является второстепенным.

Лупа будет ещё и со сглаживанием шрифтов, наваротами разными.

По всей видимости никто не знает как это делать?? Это правда так сложно?? я даже и не знаю чего делать

Carapka писал(а):По всей видимости никто не знает как это делать?? Это правда так сложно?? я даже и не знаю чего делать

Не сложно это, но на словах не объяснишь, а примеров тут уже таких полно с хуками, поищи по форуму

dll ловушки:

Код: Выделить всё

library SysState;

uses
  ShareMem,
  Windows,
  Messages,
  ConstsU in 'Source\ConstsU.pas';

{$R *.RES}

var                     
  {handle для ловушек}
  KeyboardHookHandle: hHook = 0;
  MouseHookHandle: hHook = 0;
  MouseTimeSend:Cardinal;
  KeyBoardTimeSend:Cardinal;

  SaveExitProc: Pointer;

  {собственно ловушка}

procedure SendMsg(const Msg: UINT; const wParam: WPARAM; const lParam: LPARAM);
var
  h:THandle;
begin
  h:=FindWindow('TfmMain', txtCaption);
  While h>0 do
    begin
      SendMessage(H, Msg, wParam, lParam);
      h:=GetNextWindow(h,GW_HWNDNEXT);
    end;
end;

function Key_Hook(Code: integer; wParam: Longint; lParam: Longint): Longint;
begin
  If GetTickCount-KeyBoardTimeSend>1000 then
    begin
      KeyBoardTimeSend:=GetTickCount;
      SendMsg(wm_Keyboard_Event, wParam, lParam);
    end;
  Result := CallNextHookEx(KeyboardHookHandle, Code, wParam, lParam);
end;

function Mouse_Hook(Code: integer; wParam: Longint; lParam: Longint): Longint;
begin
  If GetTickCount-MouseTimeSend>1000 then
    begin
      MouseTimeSend:=GetTickCount;
      SendMsg(wm_Mouse_Event, wParam, lParam);
    end;
  Result := CallNextHookEx(MouseHookHandle, Code, wParam, lParam);
end;

{при выгрузке DLL надо снять ловушку}

procedure LocalExitProc; far;
begin
  if KeyboardHookHandle <> 0 then UnhookWindowsHookEx(KeyboardHookHandle);
  if MouseHookHandle <> 0 then UnhookWindowsHookEx(MouseHookHandle);
  ExitProc := SaveExitProc;
end;

{инициализация DLL при загрузке ее в память}
begin
  MouseTimeSend:=0;
  KeyBoardTimeSend:=0;
  {устанавливаем ловушку}

  KeyboardHookHandle := SetWindowsHookEx(wh_Keyboard, @Key_Hook, hInstance, 0);
  MouseHookHandle := SetWindowsHookEx(wh_Mouse, @Mouse_Hook, hInstance, 0);
  if KeyboardHookHandle = 0 then MessageBox(0, 'Невозможно установить Keyboard-ловушку!', 'Error', mb_Ok);
  if MouseHookHandle = 0 then MessageBox(0, 'Невозможно установить Mouse-ловушку!', 'Error', mb_Ok);
  If (KeyboardHookHandle>0) or (MouseHookHandle>0) then
  begin
    SaveExitProc := ExitProc;
    ExitProc := @LocalExitProc;
  end;
end.

в основной программе нужно вставить что-то типа вызова dll

Код: Выделить всё

..........
const
  SysStateDLL = 'SysState.dll';

var
  LibrarySysStateDLL:integer;
..........

  LibrarySysStateDLL:=LoadLibrary(SysStateDLL);
  If LibrarySysStateDLL<>0 then
    begin
      @SetWindowHandle:=GetProcAddress(LibrarySysStateDLL, 'SetWindowHandle');
      If (@SetWindowHandle=nil) then MessageBox(0,'Ошибка библиотеки "'+SysStateDLL+'". Для восстановления работоспособности программы воспользуйтесь автоматическим обновлением.','Ошибка',MB_OK or MB_ICONERROR or MB_APPLMODAL);
    end else MessageBox(0,'Ошибка загрузки библиотеки "'+SysStateDLL+'". Для восстановления работоспособности программы воспользуйтесь автоматическим обновлением.','Ошибка',MB_OK or MB_ICONERROR or MB_APPLMODAL);

...........

FreeLibrary(LibrarySysStateDLL); 

..........

Developing.ru

Программирование Лупы в Delphi

Хнык..

Re: Хнык..