在XP下实现Vista下的开始菜单与状态栏透明效果

深爱番茄滴橙子 · 2007-09-17, 11:50

程序代码如下：

代码:

 
unit frmMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GlassWindow, StdCtrls, RzTrkBar, RaOuterControls, RzTray, Menus,
  ImgList, ExtCtrls;
 
type
  TFormMain = class(TForm)
    RaOuterControls1: TRaOuterControls;
    chkStart:         TCheckBox;
    chkTool:          TCheckBox;
    chkForm:          TCheckBox;
    Label1:           TLabel;
    TB:               TRzTrackBar;
    btnOK:            TButton;
    btnCancel:        TButton;
    RzTrayIcon1:      TRzTrayIcon;
    PopupMenu1:       TPopupMenu;
    X1:               TMenuItem;
    ImageList1:       TImageList;
    Timer1:           TTimer;
    procedure X1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure btnCancelClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    GlassW: TGlassedWindow;
    procedure RestoreWindows;
  end;
 
var
  FormMain: TFormMain;
 
implementation
{$R *.dfm}
 
procedure TFormMain.btnCancelClick(Sender: TObject);
begin
  Application.Minimize;
end;
 
procedure TFormMain.btnOKClick(Sender: TObject);
begin
  RestoreWindows;
  if chkStart.Checked then
    GlassW.GlassWindow(IntToStr(TB.Position), 'DV2ControlHost', nil)
  else
    GlassW.GlassWindow('0', 'DV2ControlHost', nil);
  if chkTool.Checked then
    GlassW.GlassWindow(IntToStr(tb.Position), 'Shell_TrayWnd', nil)
  else
    GlassW.GlassWindow('0', 'Shell_TrayWnd', nil);
  if chkForm.Checked then
    Timer1.Enabled := True;
  Application.Minimize;
end;
 
procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  RestoreWindows;
end;
 
procedure TFormMain.RestoreWindows;
var
  i: integer;
begin
  GlassW.GlassWindow('0', 'Shell_TrayWnd', nil);
  self.RaOuterControls1.GetPossibleWindows;
  if chkForm.Checked then
  begin
    for i := 0 to RaOuterControls1.PossibleWindows.Count - 1 do
    begin
      GlassW.GlassWindow('0', nil,
        PChar(RaOuterControls1.PossibleWindows[i]));
    end;
  end;
end;
 
procedure TFormMain.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  self.RaOuterControls1.GetPossibleWindows;
  if chkForm.Checked then
  begin
    for i := 0 to RaOuterControls1.PossibleWindows.Count - 1 do
    begin
      GlassW.GlassWindow(IntToStr(tb.Position), nil,
        PChar(RaOuterControls1.PossibleWindows[i]));
    end;
  end;
end;
 
procedure TFormMain.X1Click(Sender: TObject);
begin
  RestoreWindows;
  Close;
end;
 
end.

程序效果如果所示