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
