Fórum Malufator, um programa transparente #369671

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

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.

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