unit Unit1;
interface
uses
{$IFDEF VER170}
XPMan,
{$ENDIF}
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons;
type
TFadeThread =
class(TThread)
private
FParameter: Integer;
protected
procedure Execute;
override;
public
constructor Create(FadeLevel: Integer);
end;
TForm1 =
class(TForm)
Panel1: TPanel;
Button1: TButton;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
{ Private-Deklarationen }
bmp: TBitmap;
Fade: TFadeThread;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TPixRGBArray =
Array [0..2]
of Byte;
PPixRGBArray = ^TPixRGBArray;
procedure ScreenCapture(Bitmap: TBitmap);
var
c: TCanvas;
r: TRect;
begin
c := TCanvas.Create;
c.Handle := GetWindowDC(GetDesktopWindow);
try
r := Rect(0, 0, Screen.Width, Screen.Height);
Bitmap.Width := Screen.Width;
Bitmap.Height := Screen.Height;
Bitmap.Canvas.CopyRect(r, c, r);
finally
ReleaseDC(0, c.Handle);
c.Free;
end;
end;
procedure MakeGray(Bitmap: TBitmap; HowGray : Byte);
var
x, y: integer;
R, G, B, h: Byte;
Pixel: PPixRGBArray;
begin
if Bitmap.PixelFormat <> pf24bit
then
Bitmap.PixelFormat := pf24bit;
for y := 0
to Bitmap.height - 1
do
begin
Pixel := Bitmap.ScanLine[y];
for x := 0
to Bitmap.Width - 1
do
begin
R := Pixel^[2];
G := Pixel^[0];
B := Pixel^[1];
//h := (r+b+g) div 3;
h:= HiByte(r * 77 + g * 150 + b * 28);
Pixel^[2] := h + Round((R - h) / 255 * HowGray);
Pixel^[0] := h + Round((G - h) / 255 * HowGray);
Pixel^[1] := h + Round((B - h) / 255 * HowGray);
inc(Pixel);
end;
end;
end;
constructor TFadeThread.Create(FadeLevel: Integer);
begin
inherited Create(True);
// Create thread as suspended
FreeOnTerminate := True;
// Fire and forget
Priority := tpNormal;
// the priority
FParameter := FadeLevel;
end;
procedure TFadeThread.Execute;
var
fa: integer;
begin
fa := 255;
while (fa > FParameter)
do
begin
if not Terminated
then Sleep(2)
else Break;
MakeGray(Form1.bmp, fa);
Form1.PaintBox1.Canvas.Lock;
Form1.PaintBox1.Canvas.Draw(0, 0, Form1.bmp);
Form1.PaintBox1.Canvas.Unlock;
if fa > 0
then dec(fa);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bmp := TBitmap.Create;
ScreenCapture(bmp);
Width := Screen.DesktopWidth;
Height := Screen.DesktopHeight;
Panel1.Left := (ClientRect.Right
div 2) - (Panel1.Width
div 2);
Panel1.Top := (ClientRect.Bottom
div 2) - (Panel1.Height
div 2);
Fade := TFadeThread.Create(196);
Fade.Resume;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmp.free;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0, 0, bmp);
end;
end.