[Resolvido] Malufator, um programa transparente

[vitor^_^ 0]

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. 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 Malufator