Dimmed Sample

[Gustav.R]

[OT]

Gerade in einem alten Projekt (Delphi 5) gefunden:

Delphi-Quellcode:

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 TFormCountDown.MakeDesktopGray(Zeit: Integer);
var
  x, y, z: integer;
  dwStyle: DWord;
  dc, ddc: HDC;
  hbm: HBitmap;
  bmp: TBitmap;
  //  b3: integer;
  geschwindigkeit: integer;
begin
  geschwindigkeit := 200; 
  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);
end;

K.A. wo ich das damals herhatte und ob's bei zwei Monitoren auch klappt

GG
[/OT]