alphablend (transparencia) em qualquer janela do windows

procedure setAlphaBlend(hTransp: hwnd; semitransp, cortransp: boolean; niveltransp: byte; numcortransp: cardinal);
const
  cUseAlpha: array[Boolean] of Integer = (0, LWA_ALPHA);
  cUseColorKey: array[Boolean] of Integer = (0, LWA_COLORKEY);
var
  AStyle: Integer;
begin
  AStyle := GetWindowLong(htransp, GWL_EXSTYLE);
  SetWindowLong(htransp, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
  SetLayeredWindowAttributes(htransp, numcortransp, niveltransp, cUseAlpha[semitransp] or cUseColorKey[cortransp]);
end;

unit Unit1;

interface

uses
  Windows,
  Messages,
  Graphics,
  Forms,
  AppEvnts,
  RXShell,
  Menus, Classes;

type
  TfrmTransp = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    RxTrayIcon1: TRxTrayIcon;
    PopupMenu1: TPopupMenu;
    Fechar1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure Fechar1Click(Sender: TObject);
  private
    { Private declarations }
  public
      procedure Transparente(id:Integer);
  end;

var
  frmTransp: TfrmTransp;

procedure setAlphaBlend(hTransp: hwnd; semitransp, cortransp: boolean; niveltransp: byte; numcortransp: cardinal);

implementation

{$R *.dfm}

procedure setAlphaBlend(hTransp: hwnd; semitransp, cortransp: boolean; niveltransp: byte; numcortransp: cardinal);
const
  cUseAlpha: array[Boolean] of Integer = (0, LWA_ALPHA);
  cUseColorKey: array[Boolean] of Integer = (0, LWA_COLORKEY);
var
  AStyle: Integer;
begin
  AStyle := GetWindowLong(htransp, GWL_EXSTYLE);
  SetWindowLong(htransp, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
  SetLayeredWindowAttributes(htransp, numcortransp, niveltransp, cUseAlpha[semitransp] or cUseColorKey[cortransp]);
end;

procedure TfrmTransp.FormCreate(Sender: TObject);
var i: Integer;
begin
  //coloca o icone para a barra de tarefas
  RxTrayIcon1.Icon := Application.Icon;

  //esconde a janela da aplicação e a barra de minimizado
  ShowWindow(Application.Handle, SW_HIDE);
  ShowWindow(Handle, SW_HIDE);

  //registra 10 hotkeys, de ctrl+shift 0.. até 9   (i é o id da hotkey e 48+i são os codigos ascii das teclas numericas do teclado normal)
  for i := 0 to 9 do
    RegisterHotKey(Handle, i, MOD_CONTROL or MOD_SHIFT, 48+i);
end;

procedure TfrmTransp.FormDestroy(Sender: TObject);
var i: Integer;
begin

  //desregistra as hotkeys
  for i := 0 to 9 do
    UnregisterHotKey(Handle, i);
end;

procedure TfrmTransp.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin

  //esse appevents monitora as mensagens do sistema procurando por mensagens de hotkey para saber que uma key foi pressionada
  if Msg.message = wm_hotkey   then
  begin
    //wparam é o id da hotkey pressionada
    case Msg.wParam of
      0..9: Transparente(Msg.wParam);
    end;
  end;
end;


procedure TfrmTransp.ApplicationEvents1Minimize(Sender: TObject);
begin
  //esconde janelas ao minimizar
  ShowWindow(Application.Handle, SW_HIDE);
  ShowWindow(Handle, SW_HIDE);
end;

procedure TfrmTransp.Transparente(id: Integer);
var       hForeground: Thandle;
begin

  //faz a janela ativa ficar transparente, ou reaparecer se o id for 0
  hForeground := GetForegroundWindow;
  if (id = 0) then
    setAlphaBlend(hForeground, true, false, 255, 0)
  else
    setAlphaBlend(hForeground, true, false, Byte((id)*25), 0);

end;

procedure TfrmTransp.Fechar1Click(Sender: TObject);
begin
  close;
end;

end.