| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

ПЕРИОДИЧЕСКИЙ СОХРАНЕНИЕ ЭКРАНА [D6, WinXP]

DoSpyRap ©   (2006-01-03 01:11:00) 

Буду благодарен тому, кто подскажет как делать снимок экрана так что-бы он сохранялся с переодичностью (например 20 сек) и сохранялся в каком-нибудь каталоге.

---

DoSpyRap   (2006-01-05 22:10:00) [1]

Всем спасибо

---

Fenik   (2006-01-03 13:09:00) [2]

Упс.
Вместо этого
 Caption := ExtractFilePath(ParamStr(0));

надо
 FPath := ExtractFilePath(ParamStr(0));

---

Fenik   (2006-01-03 13:07:00) [3]

unitUnit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    StartBtn: TButton;
    StopBtn: TButton;
    procedureTimer1Timer(Sender: TObject);
    procedureFormCreate(Sender: TObject);
    procedureFormDestroy(Sender: TObject);
    procedureStartBtnClick(Sender: TObject);
    procedureStopBtnClick(Sender: TObject);
  private
    FCounter: Integer;
    FPath: string;
    FBitmap: TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedureTForm1.Timer1Timer(Sender: TObject);
varScreenDC: HDC;
begin
  ScreenDC := GetDC(0);
  try
    withFBitmap 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;

procedureTForm1.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;

procedureTForm1.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedureTForm1.StartBtnClick(Sender: TObject);
begin
  Timer1.Enabled := True;
end;

procedureTForm1.StopBtnClick(Sender: TObject);
begin
  Timer1.Enabled := False;
end;

end.

---

Gydvin   (2006-01-03 11:52:00) [4]

Можно плясать от этого

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;

---

Наверх