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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Снимок экрана 
:(
    Опции темы
Fima
  Дата 8.5.2004, 22:40 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Программа должна сохранять снимки экрана на жесткий диск в формате jpg через определенные промежутки времени...
Подскажите пожалуйста наиболее эффективный способ сохранять снимки.
Тот, которым я пользуюсь, жутко тормозит во время записи файла.
_____________
Delphi6.
  Вверх
dm9
Дата 8.5.2004, 23:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Дмитрий Копытин
****


Профиль
Группа: Vingrad developer
Сообщений: 3876
Регистрация: 22.7.2002
Где: Москва

Репутация: 3
Всего: 137
Попробуй так:

Цитата
uses ..., JPEG;

procedure TForm1.Button1Click(Sender: TObject);
var
  C : TCanvas;
  B : TBitMap;
  J : TJPEGImage;
  R : TRect;
begin
  try
      B := TBitMap.Create;
      C := TCanvas.Create;
      J := TJPEGImage.Create;
      B.Width := Screen.Width;
      B.Height := Screen.Height;
      C := TCanvas.Create;
      C.Handle := GetDC (0);
      R := Rect(0, 0, Screen.Width-1, Screen.Height-1);
      B.Canvas.CopyRect (R, C, R);
      J.Assign (B);
      J.SaveToFile ('d:\desktop.jpeg');
  finally
      J.Free;
      C.Free;
      B.Free;
  end;
end;

Добавлено @ 23:35
В случае, когда снимки надо делать периодически, логично делать так: периодически выполняешь

Цитата
B.Canvas.CopyRect (R, C, R);
      J.Assign (B);
      J.SaveToFile ('d:\desktop.jpeg');


А остальное выполняешь 1 раз - при старте и завершении программы.
PM MAIL ICQ   Вверх
Fima
Дата 9.5.2004, 10:49 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Попробуй во время этого подвигать окна!!! thumbs-up.gif
Всё просто подвисает. А если ещё и периодически фотографировать........

Но я попробовал сохранять не в Jpg, а в bmp.
Тормозов вообще не было. Значит глючит только когда конвертируется в Jpg.
А если это делать как-нибудь отдельно от процедуры фотографирования...
  Вверх
Pakshin A. S.
Дата 9.5.2004, 10:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 61
Может поток организовать...
PM   Вверх
x77
Дата 9.5.2004, 11:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: нет
Всего: 22
я делаю обычно так:
Код
type
 TForm1 = class(TForm)
   Button1: TButton;
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   Bmp: TBitmap;
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Bmp := TBitmap.Create;
 bmp.Width := Screen.Width;
 bmp.Height := Screen.Height;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 Bmp.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 BitBlt (Bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, GetDC (0), 0, 0, SRCCOPY);
 TJpegImage (Bmp).SaveToFile ('c:\1.jpg');
end;

end.


т.е. в самом обработчике ничего не создаётся, никаких левых канвасов, дескрипторов, битмапов и пр. быстрее скопировать экран нельзя. но тормоза всё равно будут: если непрерывно таскать форму по экрану, можно заметить, как она на доли секунды стопориться в момент скриншота.

я сам не пробовал, но мысль Pakshin A. S.'а мне представляется очень здравой.



--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
Pakshin A. S.
Дата 9.5.2004, 11:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 61
Цитата

...но мысль Pakshin A. S.'а мне представляется очень здравой.

biggrin.gif
Спасибо... парвый раз прочел
Цитата

...но мысль Pakshin A. S.'а мне представляется НЕ очень здравой.
PM   Вверх
<Spawn>
Дата 9.5.2004, 13:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Око кары:)
****


Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 2
Всего: 64
Цитата(x77 @ 9.5.2004, 03:17)
я делаю обычно так:
[CODE]

...

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 BitBlt (Bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, GetDC (0), 0, 0, SRCCOPY);
 TJpegImage (Bmp).SaveToFile ('c:\1.jpg');
end;

стопориться в момент скриншота.

я сам не пробовал, но мысль Pakshin A. S.'а мне представляется очень здравой.

Это не есть правильно. Где ReleaseDC? Получая ссылку на контекст устройства ее обязательно нужно освобождать иначе будет утечка ресурсов))

Это сообщение отредактировал(а) <Spawn> - 9.5.2004, 13:33


--------------------
"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.
PM MAIL ICQ   Вверх
cardinal
Дата 9.5.2004, 16:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: нет
Всего: 99
Код
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BitBlt (Bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, GetDC (0), 0, 0, SRCCOPY);
TJpegImage (Bmp).SaveToFile ('c:\1.jpg');
end;

А вот такая мысль:
У вас же делаются фотки с таким-то интервалом, а потом старый файл заменяется новым. А зачем его записывать то каждый раз. Записать на диск его можно и при закрытии программы, нет?
Код
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BitBlt (Bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, GetDC (0), 0, 0, SRCCOPY);
end;

а это при закрытии:
Код
TJpegImage (Bmp).SaveToFile ('c:\1.jpg');

А вообще помоему Timer и поток это не одно и тоже. Я бы попробовал с потоком.


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Pakshin A. S.
Дата 9.5.2004, 16:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 61
Вот ещё в тему накапал:
1) Получим дескриптор рабочего стола GetDesktopWindows
2) GetDC() для получения дескриптора контекста экрана (HDC)
3) Испольцуя TCanvas.Handle в качестве HDC, можно при помощи WinAPI реализовать функцию рисования или присвоить HDC свойству Hanble непосредственно при ссоздании TCanvas
4) Не забыть освобождить HDC

Может не то, но в книге это звучит как "Моментальный снимок с экрана"
PM   Вверх
Fima
Дата 9.5.2004, 22:42 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Цитата
У вас же делаются фотки с таким-то интервалом, а потом старый файл заменяется новым. А зачем его записывать то каждый раз. Записать на диск его можно и при закрытии программы, нет?


Нет. У меня каждая фотка сохраняется под новым именем (число и время снимка).

А вот в варианте у x77 подвисаний почти не было. Но фотка сохранялась
размером 3 мегабайта каждая! Это же тот самый bmp!
Проблемма тормозов давно уже ясна -- трудоёмкое сжатие bmp в jpg. Но как сжать так, чтобы не было подвисания? Может как-нибудь отдельно, не в самой процедуре фотографирования?
  Вверх
x77
Дата 9.5.2004, 23:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: нет
Всего: 22
<Spawn>, меня очень долго мучил этот вопрос: будет прога течь, или нет smile.gif спасибо, Наконец определюсь smile.gif

Добавлено @ 23:06
Fima. в моём варианте битпам храниться глобально. т.е. ты можешь повесть на форму второй таймер, который будет создавать свой битмап, копировать в него "сохранённый" и писать на диск.
а первый таймер будет просто совать в битмап скриншот.


--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
Pakshin A. S.
Дата 10.5.2004, 20:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 61
Цитата(Pakshin @ 9.5.2004, 17:59)
Вот ещё в тему накапал:
1) Получим дескриптор рабочего стола GetDesktopWindows
2) GetDC() для получения дескриптора контекста экрана (HDC)
3) Испольцуя TCanvas.Handle в качестве HDC, можно при помощи WinAPI реализовать функцию рисования или присвоить HDC свойству Hanble непосредственно при ссоздании TCanvas
4) Не забыть освобождить HDC

Может не то, но в книге это звучит как "Моментальный снимок с экрана"

Pegas За то что-ли унизил меня??? biggrin.gif
PM   Вверх
x77
Дата 10.5.2004, 20:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: нет
Всего: 22
Pakshin A. S., а ты его "унизь". smile.gif за грязные домогательства к честному флудеру ;)



--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
Pakshin A. S.
Дата 10.5.2004, 20:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 61
Зы... будем друг другу репутацию инижать; интересно, какая минимальная репутация? biggrin.gif
PM   Вверх
Medved
Дата 10.5.2004, 22:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 7209
Регистрация: 15.9.2002
Где: Kazakhstan, Astan a

Репутация: нет
Всего: 154
М
 
Давайте вернемся к тебе обсуждения.



--------------------
http://extreme.sport-express.ru/
...и неважно сколько падал, важно сколько ты вставал...
PM MAIL WWW ICQ Skype GTalk   Вверх
Fima
Дата 11.5.2004, 14:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Вот весь код моей программы (может быть и кривой, но, как сумел... не осуждайте):

Код
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls, Jpeg;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Timer1: TTimer;
   Timer2: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure Timer2Timer(Sender: TObject);
 private
 Bmp: TBitmap;

 public
   { Public declarations }
 end;

var
 e:string;
 Form1: TForm1;
 jpg:TJpegImage;

 
implementation

{$R *.dfm}

//Время снимка указывается в имени файла:
function Timenow: TDateTime;

var
 SystemTime: TSystemTime;
begin

 GetLocalTime(SystemTime);
 Result := SystemTimeToDateTime(SystemTime);
end;

function tim:string;
begin
Result:=DateTimeToStr(Timenow);
end;
{Формат времени получаем такой:  11.05.2004 14:51:40 , но ":" в имя файла
записать нельзя, поэтому ":" заменяю на "."(Не смейтесь... Как могу, так и заменяю :) )  }
function fullname (e:string):string;
var full:string;
begin
e:='D:\myscreen.jpg';
full:=copy(e,1,pos('.jpg',e)-1)+' '+copy(tim,1,length(tim)-6)+'.'+
copy(tim,length(tim)-4,2)+'.'+copy(tim,length(tim)-1,2)+'.jpg';
result:=full;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp := TBitmap.Create;
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Bmp.Free;
jpg.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
timer2.Enabled:=true;
ReleaseDC(Handle, Hwnd_Desktop);
BitBlt (Bmp.Canvas.Handle, 0, 0, Screen.Width,
Screen.Height, GetDC (0), 0, 0, SRCCOPY);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if timer1.Enabled=true then timer1.Enabled:=false else timer1.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
timer2.Enabled:=false;
 jpg:=TJpegImage.Create;
 jpg.Assign(bmp);
 jpg.CompressionQuality:=70;
 jpg.Compress;
 jpg.SaveToFile(fullname(e));
end;

end.



Цитата
Fima. в моём варианте битпам храниться глобально. т.е. ты можешь повесть на форму второй таймер, который будет создавать свой битмап, копировать в него "сохранённый" и писать на диск.
а первый таймер будет просто совать в битмап скриншот.


И всё равно тормозит при сжатии в jpg!
Может быть есть другие способы сделать это?

Я в отчаянии sad.gif


PM MAIL   Вверх
Pakshin A. S.
Дата 11.5.2004, 18:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 61
А для чего второй таймер?
Корректней, на мой взгляд, всё в один поставить... и вообще я за поток biggrin.gif
PM   Вверх
Fima
Дата 11.5.2004, 23:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Как бы этот поток организовать...?
PM MAIL   Вверх
Medved
Дата 12.5.2004, 05:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 7209
Регистрация: 15.9.2002
Где: Kazakhstan, Astan a

Репутация: нет
Всего: 154
Смотри в справке по Дельфи TThread. И еще FAQ.


--------------------
http://extreme.sport-express.ru/
...и неважно сколько падал, важно сколько ты вставал...
PM MAIL WWW ICQ Skype GTalk   Вверх
Страницы: (2) [Все] 1 2 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

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

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

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

FAQ раздела лежит здесь!

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

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


 




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


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

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