unit1.~pas

实现窗口的隐藏 标题的改变 图标的替换

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, RxMenus, RXShell, AppEvent, ExtCtrls, Mask,
  ToolEdit, ShellApi, ComCtrls;

type
  Tmyitem = class(TMenuItem)
  private
  public
  hand1: HWND;
  end;
  TForm1 = class(TForm)
    RxTrayIcon1: TRxTrayIcon;
    PM1: TRxPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Edit2: TFilenameEdit;
    Edit3: TEdit;
    Timer1: TTimer;
    TrackBar1: TTrackBar;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private declarations }
  atom1,atom2,atom3,atom4,atom5:atom;
  hwnd1:HWND;
  procedure hotkey(var msg:tmessage);message wm_hotkey;
  procedure DesignClick(Sender: TObject);
  Function GetFileIconIndex(aExt: String): Integer;
  public
  myhand:HWND;
  myicon : HICON;
  mycaption:String;
  cuthand:HWND;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.DesignClick(Sender: TObject);
begin
  ShowWindow(Tmyitem(Sender).hand1,SW_NORMAL);
  hwnd1:=Handle;
  Tmyitem(Sender).Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  atom1:=globaladdatom('hotkey1');
  atom2:=globaladdatom('hotkey2');
  atom3:=globaladdatom('hotkey3');
  atom4:=globaladdatom('hotkey4');
  atom5:=globaladdatom('hotkey5');
  RegisterHotKey(handle,atom1,MOD_ALT,ord('Q'));
  RegisterHotKey(handle,atom2,MOD_ALT,ord('W'));
  RegisterHotKey(handle,atom3,MOD_ALT,ord('E'));
  RegisterHotKey(handle,atom4,MOD_ALT,ord('M'));
  RegisterHotKey(handle,atom5,MOD_ALT,ord('N'));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
globalDeleteatom(atom1);
globalDeleteatom(atom2);
globalDeleteatom(atom3);
globalDeleteatom(atom4);
globalDeleteatom(atom5);
end;

procedure TForm1.hotkey(var msg: Tmessage);
var
itm:Tmyitem;
ckbt:array[0..255] of char ;
Pos: TPoint;
begin
  if (msg.LParamHi=ord('Q')) and (msg.LParamLo=MOD_ALT) then
  begin
  if GetForegroundWindow=hwnd1 then Exit;
  hwnd1:=GetForegroundWindow;
  ShowWindow(hwnd1,SW_HIDE);
  Itm:=Tmyitem.Create(self);
  GetWindowText(hwnd1,@ckbt,255);
  Itm.Caption:=ckbt;
  itm.hand1:=hwnd1;
  itm.OnClick:=DesignClick;
  PM1.Items.Add(itm);
  end;
  if (msg.LParamHi=ord('W')) and (msg.LParamLo=MOD_ALT) then
  begin
  if PM1.Items.Count>3 then PM1.Items.Items[PM1.Items.Count-1].Click;
  end;
  if (msg.LParamHi=ord('E')) and (msg.LParamLo=MOD_ALT) then
  begin
  myhand:=GetForegroundWindow;
  GetWindowText(myhand,@ckbt,255);
  mycaption:=ckbt;
  Edit1.Text:=mycaption;
  ShowWindow(Handle, SW_NORMAL);
  SetForeGroundWindow(handle);
  end;
  if (msg.LParamHi=ord('M')) and (msg.LParamLo=MOD_ALT) then
  begin
    GetCursorPos(Pos); // 得到当前光标位置
    cuthand:=WindowFromPoint(Pos); // 返回当前位置的句柄
    ShowWindow(cuthand,SW_HIDE);
  end;
  if (msg.LParamHi=ord('N')) and (msg.LParamLo=MOD_ALT) then
  begin
    GetCursorPos(Pos); // 得到当前光标位置
    if cuthand<>0 then
    begin
    Windows.SetParent(cuthand,WindowFromPoint(Pos));
    ShowWindow(cuthand,SW_NORMAL);
    end;
  end;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
if PM1.Items.Count<4 then Application.Terminate
else ShowMessage('现在退出可能会无法找回隐藏的窗口');
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  while PM1.Items.Count>3 do PM1.Items.Items[3].Click;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    action:=canone;
    ShowWindow(Handle, SW_HIDE);
    ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Edit1.Text:=mycaption;
Edit2.Text:='"myico\delphi.ICO"';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IconIndex : word;
  fname:String;
begin
  fname:=trim(StringReplace(Edit2.text,'"','',[rfReplaceAll]));
  if Edit1.Text<>'' then SetWindowText(Form1.myhand,pchar(Edit1.Text));
  if fname<>'' then
  try
    IconIndex:=StrToInt(Edit3.Text);
    myicon:=ExtractAssociatedIcon(hInstance,pchar(fname),IconIndex);
    SendMessage(myhand,WM_SETICON,ICON_SMALL,myicon);
    ShowWindow(Handle, SW_HIDE);
    ShowWindow(Application.Handle, SW_HIDE);
  finally

  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
    ShowWindow(Handle, SW_HIDE);
    ShowWindow(Application.Handle, SW_HIDE);
    Timer1.Enabled:=False;
end;

Function TForm1.GetFileIconIndex(aExt: String): Integer;
Const
  aFlags = SHGFI_SMALLICON OR SHGFI_SYSICONINDEX;
Var
  SFileinfo: TShFileInfo;
begin
  FillChar(SFileinfo, Sizeof(SFileinfo), #0);
  ShGetFileInfo(Pchar(aExt), 0, SFileinfo, SizeOf(SFileinfo), aFlags);
  Result := SFileinfo.iIcon;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
    if myicon<>0 then SendMessage(myhand,WM_SETICON,ICON_SMALL,myicon);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
    SetWindowLong(myhand, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(myhand, 180, TrackBar1.Position, LWA_ALPHA or LWA_COLORKEY);
end;

end.