Przezroczysty komponent (zamazujący tło)

 private
  procedure PrzyciemnijOkno(Wlacz: Boolean = True);

type
  TTransparentPanel = class(TPanel)
  private
    Bmp: TBitmap;
    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  protected
    procedure CaptureBackground;
    procedure Paint; override;
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property Canvas;
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  end;
  
var
 {Panel symulujący ściemnienie i rozmycie okna}
 P_Przyciemnij: TTransparentPanel;

procedure GBlur(Bmp: TBitmap; Radius: Single);
type
 TRGB  = packed record b, g, r: Byte; end;
 TRGBs = packed record b, g, r: Single; end;
 TRGBArray = array[0..0] of TRGB;
var
 MatrixRadius: Byte;
 Matrix: array[-100..100] of Single;
 R, G, B, Divisor: Single;
 BmpSL: ^TRGBArray;
 BmpRGB: ^TRGB;
 BmpCopy: Array of Array of TRGBs;
 BmpCopyRGB: ^TRGBs;
 x, y, mx, BmpWidth, BmpHeight: Integer;
begin
 Bmp.PixelFormat := pf24bit;
 if Radius <= 0 then Radius := 1
 else
 if Radius > 99 then Radius := 99;

 Radius := Radius + 1;
 MatrixRadius := Trunc(Radius);
 if Frac(Radius) = 0 then Dec(MatrixRadius);
 Divisor := 0;
 for x := -MatrixRadius to MatrixRadius do
   begin
    Matrix[x] := Radius - Abs(x);
    Divisor   := Divisor + Matrix[x];
   end;

 for x := -MatrixRadius to MatrixRadius do Matrix[x] := Matrix[x] / Divisor;
 BmpWidth  := Bmp.Width;
 BmpHeight := Bmp.Height;
 SetLength(BmpCopy, BmpHeight, BmpWidth);

 for y :=0 to Pred(BmpHeight) do
   begin
    BmpSL      := Bmp.Scanline[y];
    BmpCopyRGB := @BmpCopy[y,0];
    for x := 0 to Pred(BmpWidth) do
      begin
       R := 0;
       G := 0;
       B := 0;
       for mx := -MatrixRadius to MatrixRadius do
         begin
          if x + mx < 0 then BmpRGB := @BmpSL^[0]
          else
          if x + mx >= BmpWidth then BmpRGB := @BmpSL^[Pred(BmpWidth)]
          else BmpRGB := @BmpSL^[x + mx];

          B := B + BmpRGB^.b * Matrix[mx];
          G := G + BmpRGB^.g * Matrix[mx];
          R := R + BmpRGB^.r  *Matrix[mx];
         end;

       BmpCopyRGB^.b := B;
       BmpCopyRGB^.g := G;
       BmpCopyRGB^.r := R;
       Inc(BmpCopyRGB);
      end;
   end;

 for y := 0 to Pred(BmpHeight) do
   begin
    BmpRGB := Bmp.ScanLine[y];
    for x := 0 to Pred(BmpWidth) do
      begin
       R := 0;
       G := 0;
       B := 0;
       for mx := -MatrixRadius to MatrixRadius do
         begin
          if y + mx <= 0 then BmpCopyRGB := @BmpCopy[0,x]
          else
          if y + mx >= BmpHeight then BmpCopyRGB := @BmpCopy[Pred(BmpHeight),x]
          else BmpCopyRGB := @BmpCopy[y + mx,x];

          B := B + BmpCopyRGB^.b * Matrix[mx];
          G := G + BmpCopyRGB^.g * Matrix[mx];
          R := R + BmpCopyRGB^.r * Matrix[mx];
         end;

       BmpRGB^.b := Round(B);
       BmpRGB^.g := Round(G);
       BmpRGB^.r := Round(R);
       Inc(BmpRGB);
      end;
   end;
end;

procedure TTransparentPanel.CaptureBackground;
var
 Canvas: TCanvas;
 DC: HDC;
 SourceRect: TRect;
begin
 Bmp := TBitmap.Create;
 with Bmp do
   begin
    PixelFormat := pf24bit;
    Width  := ClientWidth;
    Height := ClientHeight;
   end;

 SourceRect.TopLeft     := ClientToScreen(ClientRect.TopLeft);
 SourceRect.BottomRight := ClientToScreen(ClientRect.BottomRight);
 DC := CreateDC('DISPLAY', nil, nil, nil);
 try
  Canvas := TCanvas.Create;
  try
   Canvas.Handle := DC;
   Bmp.Canvas.CopyRect(ClientRect, Canvas, SourceRect);

   {Rozmycie Gaussowskie}
   GBlur(Bmp, 6);
  finally
   Canvas.Handle := 0;
   Canvas.Free;
  end;
 finally
  DeleteDC(DC);
 end;
end;

constructor TTransparentPanel.Create(aOwner: TComponent);
begin
 inherited;

 ControlStyle := ControlStyle - [csSetCaption];
end;

destructor TTransparentPanel.Destroy;
begin
 Bmp.Free;

 inherited;
end;

procedure TTransparentPanel.Paint;
begin
 if csDesigning in ComponentState then inherited;
 // would need to draw frame and optional caption here
 // do NOT call inherited, the control fills its client area if you do!
end;

procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
 if Visible and HandleAllocated and not (csDesigning in ComponentState) then
   begin
    Bmp.Free;
    Bmp := nil;
    Hide;

    inherited;
    Parent.Update;
    Show;
   end
 else inherited;
end;

procedure TTransparentPanel.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
var
 Canvas: TCanvas;
begin
 if csDesigning in ComponentState then inherited
 else
   begin
    if not Assigned(Bmp) then CaptureBackground;
    Canvas := TCanvas.Create;
    try
     Canvas.Handle := Msg.DC;
     Canvas.Draw(0, 0, Bmp);
    finally
     Canvas.Handle := 0;
     Canvas.Free;
    end;

    Msg.Result := 1;
   end;
end;

procedure TForm1.PrzyciemnijOkno(const FormaRodzic: TForm; Wlacz: Boolean = True);
begin
 if not Wlacz then
   begin
    P_Przyciemnij.Free;

    Exit;
   end;

 if Wlacz then
   begin
    {Tworzenie przeźroczystego panelu}
    P_Przyciemnij := TTransparentPanel.Create(FormaRodzic);
    with P_Przyciemnij do
      begin
       Visible  := False;
       Parent   := FormaRodzic;
       AutoSize := False;
       DoubleBuffered := True;
       Left     := 0;
       Top      := 0;
       Height   := FormaRodzic.ClientHeight;
       Width    := FormaRodzic.ClientWidth;
       Name     := 'P_Przyciemnij';
       BringToFront;
      end;

    Application.ProcessMessages;
    P_Przyciemnij.Visible := True;
   end;
end;
{
Wywołanie np.: poprzez komponent TMS VistaDialog.
Pamiętaj o przywrócenia okna do stanu normalnego: Najpierw (True), potem (False)
}
procedure TFormMR.DialogVistaDialogCreated(Sender: TObject);
begin
 PrzyciemnijOkno;
end;

{Przywrócenie okna i zwolnienie zmiennych}
procedure TFormMR.DialogVistaDialogClose(Sender: TObject;
  var CanClose: Boolean);
begin
 PrzyciemnijOkno(False);
end;