Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 18.01.2011, 09:36
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию Если клик по форме то выполняем это..?

Помогите дописать
Вот значит так:
Если кликнули мышью по определенному приложению (например в аське, имя окна у нее ICQ) то выполняем етот код
Код:
x:=Mouse.CursorPos.X;
y:=Mouse.CursorPos.Y;
ScreenShot(x-100,y-100,201,201, Image1.Picture.Bitmap); 
image1.Picture.SaveToFile('C:\Sc\s'+inttostr(r)); 
r:=r+1;
если некликали то ничего неделаем
Ответить с цитированием
  #2  
Старый 18.01.2011, 12:34
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Два способа. Либо развернуть форму на весь экран и сделать прозрачного цвета, и отловить нажатие (грубо и некрасиво), либо написать хук, и ловить сообщение WM_LBUTTONDOWN
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #3  
Старый 18.01.2011, 12:48
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию

помогите этот хук написать , ваще непонимаю в хуках
Ответить с цитированием
  #4  
Старый 18.01.2011, 13:23
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

По-моему код хука уже 3й раз на этом форуме выкладываю.
Код:
library MouseHook;

uses Windows, Messages;

type msgStruct=record
    pt:TPOINT;
    mouseData:DWORD;
    flags:DWORD;
    time:DWORD;
    dwExtraInfo:ULONG_PTR;
end;
Pstruct=^msgStruct;

var
  HookHandle: hHook = 0;
  wnd:Hwnd = 0;
  Check:boolean = false;
  hMWindow:hwnd = 0;

function MouseProc(Code: integer; wParam: longint; lParam: Pstruct): longint; stdcall;
var point:TPoint;
    fl:boolean;

begin
fl:=false;
 if Check then begin
  if code=HC_ACTION then
   if wparam=WM_LBUTTONDOWN then
    begin
     check:=false;
     fl:=true;
     point:=lparam^.pt;
     wnd:=WindowFromPoint(point);
    end;
 end;
if fl then result:=1
 else result:=CallNextHookEx(0, Code, wParam, longword(lParam));
end;

// установка, отключение ловушки
procedure RunStopHook(lRun:byte; hMainWindow:hwnd); export; stdcall;
begin
 if lRun=0 then begin
  hMWindow:=hMainWindow;
  HookHandle:=SetWindowsHookEx(WH_MOUSE_LL, @MouseProc, hInstance, 0);
 end
 else if lrun=1 then
  begin
   UnhookWindowsHookEx(HookHandle);
   HookHandle:=0;
  end
 else if lrun=2 then
  check:=boolean(1-byte(check));
end;

function Return(State:boolean):hWnd; export; stdcall;
begin
if state then begin             //что делаем, поиск окна или инициализацию
 if not check then begin      //если уже был клик
   if wnd<>0 then           
    result:=wnd
   else result:=$FFFFFFFF;  //ошибка
  end
 else result:=$0;               //не было клика
end
else                                //инициализация
  wnd:=0;
end;

exports RunStopHook index 1;
exports Return Index 2;

begin
end.
и работа с ним:
Код:
//при создании формы
RunStopHook(0, handle);
...
//при закрытии формы
RunStopHook(1, handle);
...
// когда надо найти окно, на которое кликнет юзер

  Return(false);    // обнулим переменную окна
  RunStopHook(2, handle); // сигнал, что надо поймать следующий клик
  H := 0;
  while H = 0 do
  begin
    application.ProcessMessages;
    H := Return(true);
  end;
...
после всех этих махинаций в H будет хэндл окна.
З.Ы. если ткнули на кнопку - соответсвенно хэндл кнопки.
__________________
jmp $ ; Happy End!
The Cake Is A Lie.

Последний раз редактировалось Bargest, 18.01.2011 в 13:28.
Ответить с цитированием
  #5  
Старый 18.01.2011, 13:35
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию

щас попробую
Ответить с цитированием
  #6  
Старый 18.01.2011, 13:59
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию

кто может вот етот хук со скриншотом сделать
вот по клику на мышку в определенном окне (ICQ) делается скриншот
вот функция
Код:
var
r: integer; //это у нас будет счетчик имени файла

//даллее идет процедурка для создания скрин шотов, нашел где в инете
procedure ScreenShot(x: Integer;
 y: Integer;
 Width: Integer;
 Height: Integer;
bm: TBitMap);
var
 dc: HDC;
 lpPal: PLOGPALETTE;
begin
 if ((Width = 0) or
   (Height = 0)) then
   Exit;
 bm.Width  := Width;
 bm.Height := Height;
 {get the screen dc}
 dc := GetDc(0);
 if (dc = 0) then
   Exit;
 {do we have a palette device?}
 if (GetDeviceCaps(dc, RASTERCAPS) and
   RC_PALETTE = RC_PALETTE) then
 begin
   {allocate memory for a logical palette}
   GetMem(lpPal,
     SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)));
   {zero it out to be neat}
   FillChar(lpPal^,
     SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)),
     #0);
   {fill in the palette version}
   lpPal^.palVersion := $300;
   {grab the system palette entries}
   lpPal^.palNumEntries :=
     GetSystemPaletteEntries(dc,
     0,
     256,
     lpPal^.palPalEntry);
   if (lpPal^.PalNumEntries <> 0) then
     {create the palette}
     bm.Palette := CreatePalette(lpPal^);
   FreeMem(lpPal, SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)));
 end;
 {copy from the screen to the bitmap}
 BitBlt(bm.Canvas.Handle,
   0,
   0,
   Width,
   Height,
   Dc,
   x,
   y,
   SRCCOPY);
 {release the screen dc}
 ReleaseDc(0, dc);
end;
Тут с ножатием на бутон в моем приложение
Код:
procedure TForm1.Button1Click(Sender: TObject); //клик по кнопке
var
x,y: integer; //координаты курсора
begin
x:=Mouse.CursorPos.X; //соотвествено х 
y:=Mouse.CursorPos.Y; //и собственно игрек
//GetCursorPos(pt);
ScreenShot(x-50,y-50,100,100, Image1.Picture.Bitmap); //делаем скрин шот нужного размера в нужном месте
image1.Picture.SaveToFile(inttostr(r)+'.bmp'); //сохраняем в файл скрин
r:=r+1; //добавляем единичку чтобы следующий скрин сохранился под другим именем
end;
Ответить с цитированием
  #7  
Старый 18.01.2011, 14:19
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию

Кто сможет за ето взяться?? сколько будет стоить?
Ответить с цитированием
  #8  
Старый 18.01.2011, 15:05
Аватар для EvilRussian
EvilRussian EvilRussian вне форума
Начинающий
 
Регистрация: 21.12.2010
Адрес: Россия, Красноярский край
Сообщения: 177
Репутация: 22
По умолчанию

Ну если ты твёрдо решил встать на путь мецената, то тебе в раздел "работа"
__________________
Если не ты, то кто?
(с) Терри Пратчетт

Не забывайте ставить плюсы и говорить спасибо!
Ответить с цитированием
  #9  
Старый 18.01.2011, 16:12
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию

Цитата:
Ну если ты твёрдо решил встать на путь мецената, то тебе в раздел "работа"
что поделаеш(
мне это просто надо успеть до 24
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 15:31.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025