delphi 多桌面切换-木庄网络博客

本文整理自网络，侵删。
 unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, Menus, StdCtrls, Buttons, ExtCtrls,  
  TrayIconForm, AppEvnts;  
  
type  
  TShareInfo = record  
    Actived : array [ 1..4 ] of boolean;  
  end;  
  PShareInfo = ^TShareInfo;  
  
  TForm1 = class(TForm)  
    N1: TMenuItem;  
    N2: TMenuItem;  
    N3: TMenuItem;  
    N11: TMenuItem;  
    N21: TMenuItem;  
    N31: TMenuItem;  
    N41: TMenuItem;  
    BitBtn2: TBitBtn;  
    Panel1: TPanel;  
    Image1: TImage;  
    Label1: TLabel;  
    Label2: TLabel;  
    Edit1: TEdit;  
    Label3: TLabel;  
    Label4: TLabel;  
    N4: TMenuItem;  
    PopupMenu1: TPopupMenu;  
    ApplicationEvents1: TApplicationEvents;  
    procedure N3Click(Sender: TObject);  
    procedure N2Click(Sender: TObject);  
    procedure BitBtn2Click(Sender: TObject);  
    procedure N4Click(Sender: TObject);  
    procedure FormCreate(Sender: TObject);  
    procedure ApplicationEvents1Minimize(Sender: TObject);  
    procedure N11Click(Sender: TObject);  
    procedure TrayIcon1DblClick(Sender: TObject);  
  private  
    { Private declarations }  
    RunningOnDesktop: integer;  
    Failed : boolean;  
    procedure OnHotKey(var Msg: TMessage); message WM_HOTKEY;  
  public  
    { Public declarations }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
{$R UAC.res}  
  
procedure SwitchToDesktop(number: integer);  
var name: string;  
  DsktpHandle: HDESK;  
  SysPath: array[1..MAX_PATH] of char;  
  PPath: PChar;  
  StrPath: string;  
  len: integer;  
  si: STARTUPINFO;  
  pi: PROCESS_INFORMATION;  
begin  
  if number = 1 then  
    name := 'Default'  
  else  
    name := 'NewDesktop' + inttostr(number);  
  
  ZeroMemory(@si, sizeof(STARTUPINFO));  
  si.cb := sizeof(STARTUPINFO);  
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;  
  si.wShowWindow := SW_SHOW;  
  si.lpDesktop := PChar(Name);  
  
  DsktpHandle := OpenDesktop(pchar(Name),  
    DF_ALLOWOTHERACCOUNTHOOK, true,  
    DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or  
    DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or  
    DESKTOP_JOURNALPLAYBACK or  
    DESKTOP_JOURNALRECORD or DESKTOP_READOBJECTS or  
    DESKTOP_SWITCHDESKTOP or DESKTOP_WRITEOBJECTS);  
  if DsktpHandle = 0 then  
  begin  
    //  桌面不存在，创建桌面  
    DsktpHandle := CreateDesktop(PChar(Name), nil, nil,  
      DF_ALLOWOTHERACCOUNTHOOK,  
      DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or  
      DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or  
      DESKTOP_JOURNALPLAYBACK or  
      DESKTOP_JOURNALRECORD or DESKTOP_READOBJECTS or  
      DESKTOP_SWITCHDESKTOP or DESKTOP_WRITEOBJECTS,  
      nil);  
    if DsktpHandle = 0 then  
    begin  
      ShowMessage('打开桌面失败! ' + SysErrorMessage(GetLastError));  
      exit;  
    end;  
  
    PPath := @SysPath;  
    len := GetWindowsDirectory(@SysPath, MAX_PATH);  
    SetString(StrPath, PPath, len);  
    if (not CreateProcess(PChar(StrPath + '/explorer.exe'), nil, nil, nil, True, 0, nil, nil, si, pi)) then  
    begin  
      ShowMessage('进程创建失败! ' + SysErrorMessage(GetLastError));  
      CloseDeskTop(DsktpHandle);  
      exit;  
    end;  
  
  end;  
  
  SwitchDesktop(DsktpHandle);  
end;  
  
procedure TForm1.N3Click(Sender: TObject);  
begin  
  Close;  
end;  
  
procedure TForm1.N11Click(Sender: TObject);  
begin  
  if Sender is TMenuItem then  
    SwitchToDesktop((Sender as TMenuItem).Tag);  
end;  
  
procedure TForm1.N2Click(Sender: TObject);  
begin  
  Show;  
end;  
  
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);  
begin  
  Hide;  
end;  
  
procedure TForm1.BitBtn2Click(Sender: TObject);  
begin  
  Hide;  
end;  
  
procedure TForm1.N4Click(Sender: TObject);  
begin  
  TrayForm.Show;  
end;  
  
procedure TForm1.OnHotKey(var Msg: TMessage);  
begin  
  if Msg.WParam >0 then  
  if Msg.WParam <=4 then  
    SwitchToDesktop(Msg.WParam);  
  
  //if Msg.WParam=5 then  
//    TrayIcon1.Visible := not TrayIcon1.Visible;  
end;  
  
procedure TForm1.TrayIcon1DblClick(Sender: TObject);  
begin  
  Show;  
end;  
  
procedure TForm1.FormCreate(Sender: TObject);  
begin  
  RegisterHotKey(Handle, 1, MOD_CONTROL, VK_F1);  
  RegisterHotKey(Handle, 2, MOD_CONTROL, VK_F2);  
  RegisterHotKey(Handle, 3, MOD_CONTROL, VK_F3);  
  RegisterHotKey(Handle, 4, MOD_CONTROL, VK_F4);  
  RegisterHotKey(Handle, 5, MOD_CONTROL, VK_F5);  
end;  
  
end.
delphi 多桌面切换

相关推荐

评论
