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;