segunda-feira, 6 de abril de 2009

Malufator, um programa transparente

    Alguns programas possuem janelas semitransparentes.Isso épossivel desde o windows XP, graças ao recurso de alphablend daapi do Windows.
    Algumas aplicações que vem junto comdrivers de videousam esse recurso para acrescentar efeitos muito interessantes ao seudesktop.
    Todo mundo conhece ese recurso, é o recursoque deixa a janelado msn semitransparente quando você instala o messenger plus. Seeu não me engano, lá nas opções desegurança anti patrão você encontra o recurso desemitransparência.
    Vamos criar um software que deixe semitransparentequalquer janelanativa do windows, através de seu handle. Isso é muitoutil para se assistir a um video enquanto se digita um texto.
    Você podesegurar control + shift epressionar um numero de 0 a 9 para o nivel de transparencia desejado,ou rolar o scroll do mouse segurando somente shift até obter atransparencia  desejada.Na verdade é inutil, mas tem alguns exemplos bastanteinteressantes 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 programatenha umícone da barra de tarefas. Já usei rx tray icon, vou usarjv tray icon (você precisa da biblioteca JEDI instalada, ou dequalquer outra que possua um componente para por o icone na system tray)
    Quando o usuario rolar o scroll do mouse segurandocontrol (ou qualqueroutra tecla que você queira) , o nivel de transparência dajanela ativa poderá aumentar ou diminuir. Para capturar essetipo de evento do mouse precisamos criar um low level hook.A unit windows do delphi já vem com várias hook apis, masalgumas não estão presentes, porque não sãodocumentadas. A de low level mesmo, por exemplo, fucei na net praachar.
    O codigo dela é 14, não tem em nenhumaunit dodelphi.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: oedit1 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

Nenhum comentário:

Postar um comentário

Postagens populares

Marcadores

delphi (60) C# (31) poo (21) Lazarus (19) Site aos Pedaços (15) sql (13) Reflexões (10) .Net (9) Humor (9) javascript (9) ASp.Net (8) api (8) Básico (6) Programação (6) ms sql server (5) Web (4) banco de dados (4) HTML (3) PHP (3) Python (3) design patterns (3) jQuery (3) livros (3) metaprogramação (3) Ajax (2) Debug (2) Dicas Básicas Windows (2) Pascal (2) games (2) linguagem (2) música (2) singleton (2) tecnologia (2) Anime (1) Api do Windows (1) Assembly (1) Eventos (1) Experts (1) GNU (1) Inglês (1) JSON (1) SO (1) datas (1) developers (1) dicas (1) easter egg (1) firebird (1) interfaces (1) introspecção (1) memo (1) oracle (1) reflexão (1)