Malufator, um programa transparente

Delphi

08/04/2009

Alguns programas possuem janelas semitransparentes. Isso é possivel desde o windows XP, graças ao recurso de alphablend da api do Windows.
Algumas aplicações que vem junto com drivers de video usam esse recurso para acrescentar efeitos muito interessantes ao seu desktop.
Todo mundo conhece ese recurso, é o recurso que deixa a janela do msn semitransparente quando você instala o messenger plus. Se eu não me engano, lá nas opções de segurança
anti patrão você encontra o recurso de semitransparência.

Vamos criar um software que deixe semitransparente qualquer janela nativa do windows, através de seu handle. Isso é muito util para se assistir a um video enquanto se digita um texto (ou ver pornografia no trabalho). Você pode segurar control + shift e pressionar um numero de 0 a 9 para o nivel de transparencia desejado, ou rolar o scroll do mouse segurando somente shift até obter a transparencia desejada.

Na verdade é inutil, mas tem alguns exemplos bastante interessantes do uso da api do windows.

Resolvi dar o nome de ´Malufator´ ao programa porque é um nome que me lembra muito ´Transparência´...

Primeiro de tudo façamos com que o programa tenha um ícone da barra de tarefas. Já usei rx tray icon, vou usar jv tray icon (você precisa da biblioteca JEDI instalada, ou de qualquer outra que possua um componente para por o icone na system tray)

Quando o usuario rolar o scroll do mouse segurando control (ou qualquer outra tecla que você queira) , o nivel de transparência da janela ativa poderá aumentar ou diminuir. Para capturar esse tipo de evento do mouse precisamos criar um low level hook.

A unit windows do delphi já vem com várias hook apis, mas algumas não estão presentes, porque não são documentadas. A de low level mesmo, por exemplo, fucei na net pra achar. O codigo dela é 14, não tem em nenhuma unit do delphi.

visite esses sites para ter uma ideia de como isso funciona:

http://msdn.microsoft.com/en-us/library/ms644970(VS.85).aspx
http://msdn.microsoft.com/en-us/library/ms644959(VS.85).aspx

//estrutura para se usar a mensagem que captura o scroll do mouse
type
  TMSLLHOOKSTRUCT = packed record
    pt: TPoint;
    mouseData: Integer;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: PULONG;
  end;
  PTMSLLHOOKSTRUCT = ^TMSLLHOOKSTRUCT;

const
    WH_MOUSE_LL = 14;




abaixo o código fonte completo, comentado. Detalhe: o edit1 está aí apenas para fins de debug, para você poder visualizar o valor corrente do alphablend.


unit Unit1;

interface

uses
  Windows,
  Messages,
  Graphics,
  Forms,
  Menus,
  Classes,
  Controls,
  StdCtrls,
  sysutils,
  JvComponentBase,
  JvTrayIcon;

type
  TfrmTransp = class(TForm)
    PopupMenu1: TPopupMenu;
    Fechar1: TMenuItem;
    Edit1: TEdit;
    JvTrayIcon1: TJvTrayIcon;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Fechar1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

  public
    hForeground: THandle;
    FTransp: byte;
    JHook: THandle;
    FLista: TStringList;

    procedure Minimizar(Sender: TObject);
    procedure Mensagem(var Msg: tagMSG; var Handled: Boolean);
    procedure Transparente(Gral:byte; hw: THandle);
    procedure IncEspecial(var x:byte; qtd:byte=1);
    procedure DecEspecial(var x:byte; qtd:byte=1);
  end;

//http://msdn.microsoft.com/en-us/library/ms644970(VS.85).aspx
//http://msdn.microsoft.com/en-us/library/ms644959(VS.85).aspx



//estrutura para se usar a mensagem que captura o scroll do mouse
type
  TMSLLHOOKSTRUCT = packed record
    pt: TPoint;
    mouseData: Integer;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: PULONG;
  end;
  PTMSLLHOOKSTRUCT = ^TMSLLHOOKSTRUCT;

const
    WH_MOUSE_LL = 14;

var
  frmTransp: TfrmTransp;


procedure SetAlphaBlend(hTransp: hwnd; semitransp, cortransp: boolean; niveltransp: byte; numcortransp: cardinal);
function JournalProc(Code: Integer; wParam, lParam:DWORD): Integer; stdcall;

implementation

{$R *.dfm}


//esta função usa a api do windows para deixar um handle semi-transparente. Foi inspirado em units do proprio delphi, procure dar uma olhada no que acontece dentro do source da classe form quando você seta o seu alphablend pra true e dá um alphablendvalue pra ela
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
  JvTrayIcon1.Icon := Application.Icon;

  //mantemos na memoria uma lista dos handles que tiveram sua transparencia alterada, para podermos voltar ao normal quando se sair do aplicativo
  FLista := TStringList.Create;

  //inicia o hook do evento do scroll do mouse, usando um ponteiro para a hookproc que criamos e a constante de hookproc WH_MOUSE_LL que não está documentada nas units do delphi
  JHook := SetWindowsHookEx(WH_MOUSE_LL, @JournalProc, hInstance, 0);

  //minimiza assim que inicia
  Application.OnMinimize := Minimizar;
  //define o evento OnMessage com a procedure Mensagem
  Application.OnMessage := Mensagem;

  Application.Title := ´Malufator Next Generation´;

  FTransp := 0;

  Left := 1;
  Top := 1;
  Width := 1;
  Height := 1;

  //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);
begin

  FLista.Free;

end;

procedure TfrmTransp.Transparente(Gral: byte; hw: THandle);
begin

  if (FLista.IndexOf(IntToStr(hw)) < 0) then
    FLista.Add(IntToStr(hw));

  if (Gral = 0) then
    setAlphaBlend(hw, false, false, 255, 0)
  else
    setAlphaBlend(hw, true, false, Gral, 0);

end;

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


procedure TfrmTransp.Mensagem(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

    //faz a janela ativa ficar transparente, ou reaparecer se o id for 0
    hForeground := GetForegroundWindow;

    //wparam é o id da hotkey pressionada
    case Msg.wParam of
      0..9: Transparente(byte(255-(Msg.wParam*25)), hForeground);
    end;
    Exit;
  end;


  if (Msg.message = WM_CANCELJOURNAL) and (JHook > 0) then
    JHook := SetWindowsHookEx(WH_MOUSE_LL, @JournalProc, 0, 0);

end;

procedure TfrmTransp.DecEspecial(var x: byte;qtd:byte=1);
begin
  if (x-qtd) <0 then
    x := 0
  else
    dec(x, qtd);
end;

procedure TfrmTransp.IncEspecial(var x: byte;qtd:byte=1);
begin
  if (x+qtd) > 255 then
    x := 255
  else
    inc(x, qtd);
end;

procedure TfrmTransp.FormShow(Sender: TObject);
begin
  //deixa o corpo da form transparente (se bem que ela tem tamanho 1x1)
  brush.Style := bsClear;
  //esconde a janela da aplicação e a barra de minimizado
  ShowWindow(Application.Handle, SW_HIDE);
  ShowWindow(Handle, SW_HIDE);
end;

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




//nossa hook proc, só funciona com a tecla de ataloh pressionada
function JournalProc(Code: Integer; wParam, lParam:DWORD): LongInt; stdcall;
var TeclaAtalho: BOOL;
begin

  TeclaAtalho := (GetKeyState(VK_SHIFT) < 0);

  if not TeclaAtalho then
  begin
    Result := CallNextHookEx(frmTransp.JHook, Code, wParam, lParam);
    Exit;
  end;

  if Code < 0 then
  begin
    Result := 0;
    Exit;
  end;

  {Cancelar operação}
  if Code = HC_SYSMODALON then
  begin
    Result := 0;
    Exit;
  end;

  if Code = HC_ACTION then
  begin
    if (wParam = WM_MOUSEWHEEL) then
    begin
      frmTransp.Edit1.Text := IntToStr(PTMSLLHOOKSTRUCT(lParam)^.mouseData);
      if TeclaAtalho then
      begin
        if PTMSLLHOOKSTRUCT(lParam)^.mouseData > 0 then
        begin
          frmTransp.hForeground := GetForegroundWindow;
          frmTransp.IncEspecial(frmTransp.FTransp, 10);
          frmTransp.Transparente(255-frmTransp.FTransp, frmTransp.hForeground);
        end
        else
        begin
          frmTransp.hForeground := GetForegroundWindow;
          frmTransp.DecEspecial(frmTransp.FTransp, 10);
          frmTransp.Transparente(255-frmTransp.FTransp, frmTransp.hForeground);
        end;
        Exit;
      end;
    end;
  end;

  Result := CallNextHookEx(frmTransp.JHook, Code, wParam, lParam);

end;


procedure TfrmTransp.FormClose(Sender: TObject; var Action: TCloseAction);
var i,j: Integer;
begin
  //desregistra as hotkeys
  for i := 0 to 9 do
    UnregisterHotKey(Handle, i);

  //descarrega a hook proc
  UnhookWindowsHookEx(JHook);
  JHook := 0;

  //volta ao normal todas as janelas
  for j := 0 to FLista.Count-1 do
  begin
    setAlphaBlend(strtoint(FLista.Strings[j]), true, false, 255, 0);
    setAlphaBlend(strtoint(FLista.Strings[j]), false, false, 255, 0);
  end;

end;

end.






agora a dfm:

object frmTransp: TfrmTransp
  Left = 337
  Top = 563
  AlphaBlendValue = 0
  BorderIcons = []
  BorderStyle = bsNone
  Caption = ´Transparente!´
  ClientHeight = 45
  ClientWidth = 449
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = ´MS Sans Serif´
  Font.Style = []
  FormStyle = fsStayOnTop
  KeyPreview = True
  OldCreateOrder = False
  WindowState = wsMinimized
  OnClose = FormClose
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Edit1: TEdit
    Left = 24
    Top = 8
    Width = 409
    Height = 21
    TabOrder = 0
    Text = ´Edit1´
  end
  object PopupMenu1: TPopupMenu
    Left = 40
    object Fechar1: TMenuItem
      Caption = ´Fechar´
      OnClick = Fechar1Click
    end
  end
  object JvTrayIcon1: TJvTrayIcon
    Active = True

    IconIndex = 0
    PopupMenu = PopupMenu1
    Left = 408
    Top = 8
  end
end


download do malufator com os fontes acima:
[url]http://cid-a3e4fd1c20f4d546.skydrive.live.com/self.aspx/.Public/MalufatorNextGeneration.zip[/url]


Vitor Rubio

Vitor Rubio

Curtidas 0
POSTAR