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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 19.01.2011, 15:01
hackvl hackvl вне форума
Прохожий
 
Регистрация: 14.01.2011
Сообщения: 28
Репутация: 10
По умолчанию Чтоб это исполнялось в определенном окне

написал скриншот по клику мышы 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
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter