VPF::Снимок экрана - Форум программистов

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!
Может быть есть другие способы сделать это?

Я в отчаянии

Pakshin A. S.

Дата 11.5.2004, 18:14 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

А для чего второй таймер?
Корректней, на мой взгляд, всё в один поставить... и вообще я за поток

Fima

Дата 11.5.2004, 23:44 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

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

Как бы этот поток организовать...?

Medved

Дата 12.5.2004, 05:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

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

Смотри в справке по Дельфи TThread. И еще FAQ.

--------------------

http://extreme.sport-express.ru/
...и неважно сколько падал, важно сколько ты вставал...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »