unit screensh; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, ExtCtrls, Clipbrd; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    PaintBox1: TPaintBox; 
    ScrollBar1: TScrollBar; 
    ScrollBar2: TScrollBar; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure ScrollBarChange(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
  private 
    cnv: TCanvas; 
  public 
    procedure screenholen(speichern: Boolean; Datei: string; ZwAblage: 
      Boolean; verzoegern: word); 
  end; 
 
var 
  Form1: TForm1; 
  bm: TBitmap; 
  sr, pr: TRect; 
  hnd: HWND; 
 
implementation 
 
{$R *.DFM} 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  cnv := TCanvas.create; 
  hnd := GetWindowDC(0); 
  cnv.handle := hnd; 
  bm := TBitmap.create; 
  sr := rect(0, 0, screen.width, screen.height); 
  pr := rect(0, 0, paintbox1.width, paintbox1.height); 
  bm.width := screen.width; 
  bm.height := screen.height; 
  scrollbar1.enabled := false; 
  scrollbar2.enabled := false; 
  scrollbar1.max := screen.width - paintbox1.width; 
  scrollbar2.max := screen.height - paintbox1.height; 
  scrollbar1.min := 0; 
  scrollbar2.min := 0; 
  scrollbar1.LargeChange := 80; 
  scrollbar2.LargeChange := 80; 
  scrollbar1.smallChange := 4; 
  scrollbar2.smallChange := 4; 
  scrollbar1.OnChange := ScrollBarChange; 
  scrollbar2.OnChange := ScrollBarChange; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
  cnv.free; 
  releasedc(0, hnd); 
end; 
 
procedure TForm1.screenholen(speichern: Boolean; Datei: string; ZwAblage: 
  Boolean; verzoegern: word); 
begin 
  form1.hide; 
  sleep(verzoegern); // wichtig für Bildschirmaufbau 
  bm.Canvas.CopyRect(sr, cnv, sr); 
  scrollbar1.enabled := true; 
  scrollbar2.enabled := true; 
  scrollbar1.position := 0; 
  scrollbar2.position := 0; 
  if ZwAblage then clipboard.assign(bm); 
  if speichern then begin 
    if fileexists(datei) then 
      if application.messagebox(pchar('Soll die Datei ' + 
        extractfilename(datei) + ' überschrieben werden?'), 
        'Datei existiert schon', mb_yesno or mb_iconquestion) = idyes then 
        bm.savetofile(datei); 
  end; 
  form1.show; 
end; 
 
procedure TForm1.ScrollBarChange(Sender: TObject); 
begin 
  BitBlt(paintbox1.canvas.handle, 0, 0, paintbox1.width, paintbox1.height, 
    bm.canvas.handle, scrollbar1.position, scrollbar2.position, srccopy); 
end; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  if scrollbar1.enabled then 
    scrollbarchange(form1); 
end; 
 

// Beispielaufrufe 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  screenholen(false, '', true, 100); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  screenholen(true, 'c:\test.bmp', false, 100); 
end; 
 
end.