|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Чтоб это исполнялось в определенном окне
написал скриншот по клику мышы 100х100
теперь нужно чтоб это выполнялось в определенном окне например ICQ Что и куда дописать? Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Timer1: TTimer; Image1: TImage; procedure Timer1Timer(Sender: TObject); end; var Form1: TForm1; r: integer; implementation {$R *.dfm} var hHook, hThread, hEvent: THandle; function MouseProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT stdcall; begin if nCode = HC_ACTION then Result := CallNextHookEx(hHook, nCode, WParam, LParam); if WParam = WM_LBUTTONDOWN then SetEvent(hEvent); end; function ThreadProc(lpParameters: Pointer): DWORD; stdcall; const WH_MOUSE_LL = 14; begin hHook := SetWindowsHookEx(WH_MOUSE_LL, @MouseProc, HInstance, 0); if hHook <> 0 then try while True do if WaitForSingleObject(hEvent, 10) = WAIT_TIMEOUT then Application.HandleMessage else Exit; finally UnhookWindowsHook(hHook, @MouseProc); end; end; ////////////////////////////////// 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.Timer1Timer(Sender: TObject); var x,y: integer; //координаты курсора const Timeout = 99999999; begin hEvent := CreateEvent(nil, False, False, nil); if hEvent <> 0 then try hThread := CreateThread(nil, 0, @ThreadProc, nil, 0, PDWORD(nil)^); if hThread <> 0 then try case WaitForSingleObject(hEvent, Timeout) of WAIT_TIMEOUT: ShowMessage('хахахах.'); WAIT_OBJECT_0: /////////////////////////////// begin x:=Mouse.CursorPos.X; //соотвествено х y:=Mouse.CursorPos.Y; //и собственно игрек //GetCursorPos(pt); ScreenShot(x-50,y-50,100,100, Image1.Picture.Bitmap); //делаем скрин шот нужного размера в нужном месте image1.Picture.SaveToFile('C:\s\sc'+inttostr(r)); //сохраняем в файл скрин r:=r+1; //добавляем единичку чтобы следующий скрин сохранился под другим именем end; ////////////////////////////////// end; finally CloseHandle(hThread); end; finally CloseHandle(hEvent); end; end; end. |