type 
  wert = 1..250; // langsam .. schnell 
 
var 
  dc, ddc: HDC; 
  hbm: HBitmap; 
  bmp: TBitmap; 
  b3: integer; 
  geschwindigkeit: wert = 190; // z.B. 
 
procedure TeilGrau(b: TBitmap; stufe: byte); 
var 
  sp1: byte; 
  x, y: integer; 
  p: PBytearray; 
  g: byte; 
  function rech(b: byte): byte; 
  begin 
    result := (b * stufe + g) div sp1; 
  end; 
begin 
  sp1 := succ(stufe); 
  for y := 0 to b.height - 1 do begin 
    p := b.scanline[y]; 
    x := 0; 
    while x < b3 do begin 
      g := (p[x] + p[x + 1] + p[x + 2]) div 3; 
      p[x] := rech(p[x]); 
      p[x + 1] := rech(p[x + 1]); 
      p[x + 2] := rech(p[x + 2]); 
      inc(x, 3); 
    end; 
  end; 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
var 
  x, y, z: integer; 
begin 
  TButton(Sender).enabled := false; 
  dc := createDC('DISPLAY', nil, nil, nil); 
// --- Bildschirm in einer Bitmap sichern --- 
  ddc := CreateCompatibleDC(dc); 
  hbm := CreateCompatibleBitmap(dc, screen.width, screen.height); 
  selectobject(ddc, hbm); 
  BitBlt(ddc, 0, 0, screen.width, screen.height, dc, 0, 0, srcCopy); 
// ------------------------------------------- 
  bmp := TBitmap.create; 
  bmp.pixelformat := pf24bit; 
  bmp.width := screen.width; 
  bmp.height := screen.height; 
  b3 := screen.width * 3; 
  BitBlt(bmp.canvas.handle, 0, 0, screen.width, screen.height, dc, 0, 0, srcCopy); 
  z := 255 - geschwindigkeit; 
  y := round(2.5 * z / sqrt(z)); 
  x := 1; 
  while x < y do begin 
    TeilGrau(bmp, z div x); 
    BitBlt(dc, 0, 0, screen.width, screen.height, bmp.canvas.handle, 0, 0, srcCopy); 
    application.processmessages; 
    sleep(10); 
    inc(x); 
  end; 
// etwas den grauen Bildschirm stehen lassen 
  sleep(2000); 
// Wiederherstellen des farbigen Desktops 
  BitBlt(dc, 0, 0, screen.width, screen.height, ddc, 0, 0, srcCopy); 
// freigeben 
  bmp.free; 
  deleteobject(hbm); 
  deletedc(ddc); 
  deletedc(dc); 
  TButton(Sender).enabled := true; 
end;