написал скриншот по клику мышы 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.
|
исходник http://depositfiles.com/files/g16npa5p1 |
человек кого то хакнуть собрался, столько усилий прикладывает, а ты его в раздел для новичков отправил 
рода.