Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Как сделать скриншот окна 
V
    Опции темы
arm11111
Дата 10.8.2009, 18:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
как сделать скриншот окна зная его Handle даже если оно за приделами рабочего стола ?
PM MAIL   Вверх
THandle
Дата 10.8.2009, 18:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372
http://forum.vingrad.ru/forum/topic-245243...y1769994/0.html
PM   Вверх
arm11111
Дата 10.8.2009, 23:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
Цитата(THandle @ 10.8.2009,  18:35)
http://forum.vingrad.ru/forum/topic-245243...y1769994/0.html

че то ничего не получается , а по названию окна ? 
PM MAIL   Вверх
Данкинг
Дата 10.8.2009, 23:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Yersinia pestis
****


Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 11
Всего: 130
Из ДРКБ:

Код

function GetScreenShot(const AHandle: THandle; const CompressPercent: Byte;

var AImage: TJPEGImage): Boolean;

var

fBitmap: TBitmap;

DC: HDC;

Rect: TRect;

begin

Result := False;

if AImage = nil then Exit;

DC := GetDC(AHandle);

if DC <> 0 then

try

   fBitmap := TBitmap.Create;

   try

     if not GetClientRect(AHandle, Rect) then Exit;

     fBitmap.Width := Rect.Right - Rect.Left;

     fBitmap.Height := Rect.Bottom - Rect.Top;

     fBitmap.PixelFormat := pf32bit;

     Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width,

       fBitmap.Height, DC, 0, 0, SRCCOPY);

     if not Result then Exit;

     AImage.Assign(fBitmap);

     AImage.CompressionQuality := CompressPercent;

   finally

     fBitmap.Free;

   end;

finally

   ReleaseDC(AHandle, DC);

end;

end;

 

// Пример использования...

procedure TForm1.Button1Click(Sender: TObject);

var

Image: TJPEGImage;

begin

// Скриншот рабочего стола

Image := TJPEGImage.Create;

try

   if GetScreenShot(GetDesktopWindow, 150, Image) then

     Image1.Picture.Assign(Image);

finally

   Image.Free;

end;

// Скриншот нашей формы

Image := TJPEGImage.Create;

try

   if GetScreenShot(Handle, 150, Image) then

     Image2.Picture.Assign(Image);

finally

   Image.Free;

end;

end;




--------------------
There's nothing left but silent epitaphs.
PM MAIL WWW   Вверх
arm11111
Дата 11.8.2009, 21:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
Цитата(Данкинг @ 10.8.2009,  23:38)
Из ДРКБ:

Код

function GetScreenShot(const AHandle: THandle; const CompressPercent: Byte;

var AImage: TJPEGImage): Boolean;

var

fBitmap: TBitmap;

DC: HDC;

Rect: TRect;

begin

Result := False;

if AImage = nil then Exit;

DC := GetDC(AHandle);

if DC <> 0 then

try

   fBitmap := TBitmap.Create;

   try

     if not GetClientRect(AHandle, Rect) then Exit;

     fBitmap.Width := Rect.Right - Rect.Left;

     fBitmap.Height := Rect.Bottom - Rect.Top;

     fBitmap.PixelFormat := pf32bit;

     Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width,

       fBitmap.Height, DC, 0, 0, SRCCOPY);

     if not Result then Exit;

     AImage.Assign(fBitmap);

     AImage.CompressionQuality := CompressPercent;

   finally

     fBitmap.Free;

   end;

finally

   ReleaseDC(AHandle, DC);

end;

end;

 

// Пример использования...

procedure TForm1.Button1Click(Sender: TObject);

var

Image: TJPEGImage;

begin

// Скриншот рабочего стола

Image := TJPEGImage.Create;

try

   if GetScreenShot(GetDesktopWindow, 150, Image) then

     Image1.Picture.Assign(Image);

finally

   Image.Free;

end;

// Скриншот нашей формы

Image := TJPEGImage.Create;

try

   if GetScreenShot(Handle, 150, Image) then

     Image2.Picture.Assign(Image);

finally

   Image.Free;

end;

end;

то что надо , спасибо огромное
PM MAIL   Вверх
arm11111
Дата 12.8.2009, 14:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
наверное задам глупый вопрос ... но это же форум для новичков . А где здесь (в коде вверху) Handle окна?

я думал будет нечто подобное 

H : HWND; // 
begin
H := FindWindow ('TForml', 'Form1’);       // вот например 
PM MAIL   Вверх
Keeper89
Дата 12.8.2009, 15:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 9
Всего: 58
arm11111, функция GetDesktopWindow дает хендл рабочего стола, а во втором случае используется хендл формы (просто Handle).


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
arm11111
Дата 12.8.2009, 16:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
а как мне получить заполучить окно к примеру программы Paint для того чтобы сделать с него скрин ( запутался я совсем ) 
PM MAIL   Вверх
Keeper89
Дата 12.8.2009, 17:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 9
Всего: 58
Цитата(arm11111 @  12.8.2009,  17:15 Найти цитируемый пост)
а как мне получить заполучить окно к примеру программы Paint для того чтобы сделать с него скрин ( запутался я совсем )  

Ты же сам пример написал выше...

Добавлено через 2 минуты и 30 секунд
Пока судьба дала посидеть под Вистой smile это будет так (поиск первого окна по классу):
Код

var
  paintHandle: THandle;
begin
  ...
  paintHandle := FindWindow ('MSPaintApp', Nil);
  ...
end.



--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
arm11111
Дата 12.8.2009, 19:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
уважаемый Keeper89 а скриншот сделать вы забыли ? у меня именно с этим проблема 

я просто прячу чужое окно за пределы рабочего стола 


var
  h: HWND;
begin
  h := findwindow(nil, 'XXX');// xxx это нужное приложение 
  if h <> 0 then
    SetWindowPos(h, HWND_BOTTOM, 1, 1, 20, 20, swp_nosize);

теперь скрин нужно сделать , плизззз
PM MAIL   Вверх
Keeper89
Дата 12.8.2009, 20:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 9
Всего: 58
Цитата(arm11111 @  12.8.2009,  17:15 Найти цитируемый пост)
а как мне получить заполучить окно к примеру программы Paint

Цитата(arm11111 @  12.8.2009,  20:24 Найти цитируемый пост)
а скриншот сделать вы забыли ? у меня именно с этим проблема

 smile  Я не телепат. С каждый постом у тебя новые подробности.
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  Image: TJPEGImage;
  paintHandle: THandle;
begin

  Image := TJPEGImage.Create;
  paintHandle := FindWindow ('MSPaintApp', Nil);
  if paintHandle = 0 then Exit;
  try
    SetWindowPos(paintHandle, HWND_BOTTOM, 0, 0, 0, 0,
                 SWP_NOSIZE or SWP_SHOWWINDOW);
    SendMessage(paintHandle, WM_PAINT, 0, 0);
    if GetScreenShot(paintHandle, 150, Image) then
      Image.SaveToFile('C:\1.jpg');
    SetWindowPos(paintHandle, HWND_BOTTOM, 0, 0, 0, 0,
                 SWP_NOSIZE or SWP_HIDEWINDOW);
    SetFocus;
    ShowMessage('Скриншот сделан!');
  finally
    Image.Free;
  end;
end;


Это сообщение отредактировал(а) Keeper89 - 12.8.2009, 20:20


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
arm11111
Дата 12.8.2009, 20:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 31.7.2009

Репутация: нет
Всего: нет
Цитата(Keeper89 @ 12.8.2009,  20:20)
Цитата(arm11111 @  12.8.2009,  17:15 Найти цитируемый пост)
а как мне получить заполучить окно к примеру программы Paint

Цитата(arm11111 @  12.8.2009,  20:24 Найти цитируемый пост)
а скриншот сделать вы забыли ? у меня именно с этим проблема

 smile  Я не телепат. С каждый постом у тебя новые подробности.
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  Image: TJPEGImage;
  paintHandle: THandle;
begin

  Image := TJPEGImage.Create;
  paintHandle := FindWindow ('MSPaintApp', Nil);
  if paintHandle = 0 then Exit;
  try
    SetWindowPos(paintHandle, HWND_BOTTOM, 0, 0, 0, 0,
                 SWP_NOSIZE or SWP_SHOWWINDOW);
    SendMessage(paintHandle, WM_PAINT, 0, 0);
    if GetScreenShot(paintHandle, 150, Image) then
      Image.SaveToFile('C:\1.jpg');
    SetWindowPos(paintHandle, HWND_BOTTOM, 0, 0, 0, 0,
                 SWP_NOSIZE or SWP_HIDEWINDOW);
    SetFocus;
    ShowMessage('Скриншот сделан!');
  finally
    Image.Free;
  end;
end;

наиогромнейшее спасибо !!!!!!!!!!!!!!  все стало на свои места )))) Извини если надоел ))) 
PM MAIL   Вверх
Keeper89
Дата 12.8.2009, 21:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 9
Всего: 58
Цитата(arm11111 @  12.8.2009,  21:39 Найти цитируемый пост)
наиогромнейшее спасибо !!!!!!!!!!!!!!  все стало на свои места )))) Извини если надоел )))  

Пожалуйста, закрывай тему. smile


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0853 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.