Форум: "Media";
Текущий архив: 2006.06.04;
Скачать: [xml.tar.bz2];
ВнизПЕРИОДИЧЕСКИЙ СОХРАНЕНИЕ ЭКРАНА Найти похожие ветки
← →
DoSpyRap © (2006-01-03 01:11) [0]Буду благодарен тому, кто подскажет как делать снимок экрана так что-бы он сохранялся с переодичностью (например 20 сек) и сохранялся в каком-нибудь каталоге.
← →
Gydvin © (2006-01-03 11:52) [1]Можно плясать от этого
procedure TScrnFrm.GrabScreen;
var
DeskTopDC: HDc;
DeskTopCanvas: TCanvas;
DeskTopRect: TRect;
begin
DeskTopDC := GetWindowDC(GetDeskTopWindow);
DeskTopCanvas := TCanvas.Create;
DeskTopCanvas.Handle := DeskTopDC;
DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);
ScrnForm.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);
ReleaseDC(GetDeskTopWindow,DeskTopDC);
end;
← →
Fenik © (2006-01-03 13:07) [2]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
StartBtn: TButton;
StopBtn: TButton;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure StartBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
private
FCounter: Integer;
FPath: string;
FBitmap: TBitmap;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Timer1Timer(Sender: TObject);
var ScreenDC: HDC;
begin
ScreenDC := GetDC(0);
try
with FBitmap do
BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, 0, 0, SRCCOPY);
FBitmap.SaveToFile(Format("%s%d.bmp", [FPath, FCounter]));
Inc(FCounter);
finally
ReleaseDC(0, ScreenDC);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FBitmap := TBitmap.Create;
FBitmap.PixelFormat := pf24Bit;
FBitmap.Width := Screen.Width;
FBitmap.Height := Screen.Height;
Caption := ExtractFilePath(ParamStr(0));
Timer1.Enabled := False;
Timer1.Interval := 20000;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FBitmap.Free;
end;
procedure TForm1.StartBtnClick(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TForm1.StopBtnClick(Sender: TObject);
begin
Timer1.Enabled := False;
end;
end.
← →
Fenik © (2006-01-03 13:09) [3]Упс.
Вместо этого
Caption := ExtractFilePath(ParamStr(0));
надо
FPath := ExtractFilePath(ParamStr(0));
← →
DoSpyRap © (2006-01-05 22:10) [4]Всем спасибо
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2006.06.04;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.041 c