delphi设置窗体透明度

 

窗体上的控件

PopupMenu;    TrackBar1;    Label1;

窗体上的代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ShellAPI, Menus;

const WM_TRAYICON = WM_APP+0;

type
  PRec = ^TRec;
  TRec = record
    Wnd:THandle;
    bBlend : Boolean;
    ClsName:String;
    WndName:String;
    pNID : PNOTIFYICONDATA;
  end;

  TForm1 = class(TForm)
    PopupMenu: TPopupMenu;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TrackBar1Exit(Sender: TObject);
  private
    { Private declarations }
    nid : TNOTIFYICONDATA;
    WndList : TList;
    procedure WMTrayIcon(var message: TMessage); message WM_TRAYICON;

    procedure UpdatePopupMenu;

    procedure DeActivate(Sender : TOBject);
    procedure MenuItemOnClick(Sender : TObject);
    procedure ExitMenuItemOnClick(Sender : TObject);

  protected
    procedure CreateParams(var Params: TCreateParams); OVERRIDE;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  WndList := TList.Create;

  with nid do
  begin
    cbSize := sizeof(TNotifyIconData);
    UID := UINT(-1);
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    Wnd := Handle;
    // 璝祇ネヴㄆン, 癟肚患倒 Wnd 跌怠
    uCallBackMessage := WM_TRAYICON;
    // 籔祘Αセōㄏノ妓瓜ボ
    HICON := Application.Icon.Handle;
    // 矗ボゅ籔祘Α夹肈
    StrPCopy(szTip, Application.Title);
  end;
  Shell_NotifyIcon(NIM_ADD, @nid);

  Width := 80;
  Application.OnDeactivate := DeActivate;

end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  iLoop : integer;
begin

  for iLoop := 0 to WndList.Count-1 do
    Dispose(WndList.items[iLoop]);

  Shell_NotifyIcon(NIM_DELETE,@nid);

end;

procedure TForm1.UpdatePopupMenu;
var
  clsname,wndname : array [0..100] of char;
  iLoop,iTag : integer;
  hCurWnd : HWND;
  iMenu : TMenuItem;
  Rec   : PRec;

begin
  PopupMenu.Items.Clear;

  iLoop := 0;
  iTag := 0;

  { 穝 WndList 戈才ヘ玡跌怠篈 }
  while ( iLoop < WndList.Count-1 ) do
  begin
     Rec := WndList.Items[iLoop];
     if not IsWindow(Rec^.Wnd) then
     begin
       Dispose(WndList.Items[iLoop]);
       WndList.Delete(iLoop);
       continue;
     end;
     iMenu := TMenuItem.Create(PopupMenu);
     iMenu.Caption := Rec^.WndName;
     iMenu.Tag := iTag;
     iMenu.Checked := Rec^.bBlend;
     iMenu.OnClick := MenuItemOnClick;

     PopupMenu.Items.Add(iMenu);
     Inc(iLoop);
     inc(iTag);
  end;

  { 穝苯磞┮Τ跌怠盢穝糤跌怠 WndList い }
  hCurWnd := GetWindow(Handle,GW_HWNDFIRST);

  while( hCurWnd <> 0 ) do
  begin
    GetClassName( hCurWnd, clsname, 100 );

    if( GetWindowText( hCurWnd, Wndname, 100) > 0 ) and IsWindowVisible( hCurWnd ) and
      ( WndName <> 'Program Manager') then
    begin
        if PopupMenu.Items.Find( Wndname ) = nil then
        begin
          New(Rec);
          Rec^.Wnd := hCurWnd;
          Rec^.bBlend := FALSE;
          Rec^.ClsName := clsname;
          Rec^.WndName := WndName;

          WndList.Add(Rec);

          iMenu := TMenuItem.Create(PopupMenu);
          iMenu.Caption := WndName;
          iMenu.OnClick := MenuItemOnClick;
          iMenu.Tag := iTag;
          PopupMenu.Items.add(iMenu);
          inc(iTag);
        end
        else
        begin
          iMenu := PopupMenu.Items.Find( WndName );

          for iLoop := iMenu.Tag to WndList.Count-1 do
          begin
            Rec := WndList.Items[ iLoop ];
            if (Rec^.Wnd = hCurWnd) and (Rec^.WndName = iMenu.Caption) then
               break;
          end;

          if( iLoop >= (WndList.Count-1) ) and ( Rec^.Wnd <> hCurWnd ) then
          begin
            New(Rec);
            Rec^.Wnd := hCurWnd;
            Rec^.bBlend := FALSE;
            Rec^.ClsName := clsname;
            Rec^.WndName := WndName;

            WndList.Add(Rec);

            iMenu := TMenuItem.Create(PopupMenu);
            iMenu.Caption := WndName;
            iMenu.OnClick := MenuItemOnClick;
            iMenu.Tag := iTag;
            PopupMenu.Items.add(iMenu);
            inc(iTag);
          end;
        end;
    end;

    hCurWnd := GetWindow( hCurWnd, GW_HWNDNEXT );
  end;

  { だ筳絬 PopupMenu }
  iMenu := TMenuItem.Create(PopupMenu);
  iMenu.Caption := '-';
  PopupMenu.Items.Add(iMenu);

  {  Exit  PopupMenu }
  iMenu := TMenuItem.create(PopupMenu);
  iMenu.Caption := 'Close';
  iMenu.OnClick := ExitMenuItemOnClick;
  PopupMenu.Items.Add(iMenu);

end;

procedure TForm1.WMTrayIcon(var message: TMessage);
var
  MousePos: TPoint;

begin
  if message.LPARAM = WM_RBUTTONDOWN then
  begin
    ShowWindow(Handle,SW_HIDE);
    UpdatePopupMenu;

    GetCursorPos(MousePos);
    SetForegroundWindow(Handle);    // 琵 PopupMenu 瞷ㄤ跌怠笆ア
    PopupMenu.Popup(MousePos.X, MousePos.Y);
  end
  else if message.LParam = WM_LBUTTONDOWN then
  begin
    GetCursorPos(MousePos);
    SetForegroundWindow(Handle);    // 琵Form1 瞷ㄤ跌怠笆ア
    ShowWindow(Handle,SW_NORMAL);

    MoveWindow(Handle,MousePos.X-Width,MousePos.Y-Height-16,Width,Height,TRUE);
  end;
end;

procedure TForm1.MenuItemOnClick(Sender: TObject);
var
  Menu : TMenuItem;
  Rec  : PRec;
begin
  Menu := TMenuItem(Sender);
  Rec := WndList.Items[Menu.Tag];

  Rec^.bBlend := not Rec^.bBlend;

  if( Rec^.bBlend ) then
  begin
    { 盢跌怠砞硓 }
    SetWindowLong( Rec^.Wnd,GWL_EXSTYLE,GetWindowLong(Rec^.Wnd,GWL_EXSTYLE) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(Rec^.Wnd,RGB(0,0,0),TrackBar1.Position,LWA_ALPHA);

  end
  else
  begin
    { 临跌怠硓砞﹚ }
    SetLayeredWindowAttributes(Rec^.Wnd,RGB(0,0,0),255,LWA_ALPHA);
    SetWindowLong( Rec^.Wnd,GWL_EXSTYLE,GetWindowLong(Rec^.Wnd,GWL_EXSTYLE) and (NOT WS_EX_LAYERED) );

  end;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  ShowWindow(Handle,SW_HIDE);
  ShowWindow(Application.Handle, SW_HIDE );
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  iLoop :integer;
  Rec : PRec;
begin
  for iLoop := 0 to WndList.Count-1 do
  begin
    Rec := WndList.Items[iLoop];
    if Rec^.bBlend then
       SetLayeredWindowAttributes(Rec^.Wnd,RGB(0,0,0),TrackBar1.Position,LWA_ALPHA)
  end;
end;

procedure TForm1.ExitMenuItemOnClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  iLoop : integer;
  Rec : PRec;
begin
  for iLoop := 0 to WndList.Count-1 do
  begin
    Rec := WndList.Items[iLoop];
    if Rec^.bBlend then
    begin
      SetWindowLong( Rec^.Wnd,GWL_EXSTYLE,GetWindowLong(Rec^.Wnd,GWL_EXSTYLE) xor WS_EX_LAYERED);
    end;
  end;
end;

procedure TForm1.TrackBar1Exit(Sender: TObject);
begin
  ShowWindow(Handle, SW_HIDE);
end;

procedure TForm1.DeActivate(Sender: TOBject);
begin
  ShowWindow(Handle, SW_HIDE);
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  With Params do
    Style := (Style or WS_POPUP) and (not WS_DLGFRAME) ;
end;

end.