Anwendung grau werden lassen? Wie bei WinXP beenden!

[sniper_w]

So, ich schlage dir etwas konkretes vor

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    ScrollBar1: TScrollBar;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    LabeledEdit1: TLabeledEdit;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    slika : tbitmap;
  end;

var
  Form1: TForm1;
  Scale : byte;

implementation

{$R *.dfm}

procedure ConverToGrayStep(const Bitmap:TBitmap; const Progress, MaxSteps : Byte);//---------SNIPER_W
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Reserved: Byte;
  end;
var
  X: Integer;
  Y: Integer;
  P: PPixelRec;
  Gray: Byte;
begin
  Assert(Bitmap.PixelFormat = pf32Bit);
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    P := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := (P.R + P.G + P.B) div 3;

//---------SNIPER_W
      P.R := P.R + BYTE(Round((Gray-P.R) * Progress / MaxSteps));
      P.G := P.G + BYTE(Round((Gray-P.G) * Progress / MaxSteps));
      P.B := P.B + BYTE(Round((Gray-P.B) * Progress / MaxSteps));
//---------SNIPER_W

      Inc(P);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var ddc: cardinal;
begin
 slika := TBitmap.Create;
 slika.PixelFormat := pf32bit;
 slika.Width := Width;
 slika.Height := Height;
 ddc :=  GetWindowDC(handle);
 BitBlt(slika.Canvas.Handle,0,0,slika.Width,slika.Height,ddc,0,0,SRCCOPY);
 ReleaseDC(handle,ddc);
 Scale := 0;
 Timer1.Interval := 100; // <<-- die Geschwidigkeit, was Timer betrifft
 Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 slika.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
 var ddc: cardinal;
begin //
 if Scale < 255 then
 begin
 ConverToGrayStep(slika,Scale,255);
 Inc(Scale,3);  // Progress pro 1 Timer Proc (durchlauf)
 ddc :=  GetWindowDC(handle);

 BitBlt(ddc,0,0,width,height,slika.Canvas.Handle,0,0,SRCCOPY);

 ReleaseDC(handle,ddc);
 end
        else Timer1.Enabled := False;
end;

end.