unit1.pas

Virtual Desktop虚拟桌面很简单的实现

unit Unit1;

interface

uses
  Windows,  Controls, Forms,SysUtils,    LMDGlobalHotKey,
  ComCtrls, XPMan, Menus, RzTray, StdCtrls, Classes,messages;
const
  CM_RESTORE = WM_USER + $1000; // 自定义一个消息，用来恢复窗口
  APPNAME = '虚拟桌面';    // 应用程序名称

type
  TForm1 = class(TForm)
    RzTrayIcon1: TRzTrayIcon;
    PopupMenu1: TPopupMenu;
    close1: TMenuItem;
    Label4: TLabel;
    XPManifest1: TXPManifest;
    Button1: TButton;
    Label1: TLabel;
    N1: TMenuItem;
    N2: TMenuItem;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    N51: TMenuItem;
    N61: TMenuItem;
    N71: TMenuItem;
    N81: TMenuItem;
    N91: TMenuItem;
    N101: TMenuItem;
    N111: TMenuItem;
    N121: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure close1Click(Sender: TObject);
    procedure LMDGlobalHotKeyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure N11Click(Sender: TObject);

  private
    { Private declarations }
  public
    procedure CreateParams(var Params: TCreateParams); override;
    Procedure RestoreRequest(var message: TMessage); message CM_RESTORE;    { Public declarations }
    { Public declarations }
  end;

var
  Form1: TForm1;
  LMDGlobalHotKey1: TLMDGlobalHotKey;
  LMDGlobalHotKey2: TLMDGlobalHotKey;
  LMDGlobalHotKey3: TLMDGlobalHotKey;
  LMDGlobalHotKey4: TLMDGlobalHotKey;
  LMDGlobalHotKey5: TLMDGlobalHotKey;
  LMDGlobalHotKey6: TLMDGlobalHotKey;
  LMDGlobalHotKey7: TLMDGlobalHotKey;
  LMDGlobalHotKey8: TLMDGlobalHotKey;
  LMDGlobalHotKey9: TLMDGlobalHotKey;
  LMDGlobalHotKey10: TLMDGlobalHotKey;
  LMDGlobalHotKey11: TLMDGlobalHotKey;
  LMDGlobalHotKey12: TLMDGlobalHotKey;

implementation

{$R *.dfm}
procedure Tform1.CreateParams(var Params: TCreateParams);
begin
  // 设置应用程序名称
  inherited CreateParams(Params);
  Params.WinClassName := APPNAME;
end;

procedure Tform1.RestoreRequest(var message: TMessage);
begin
  // 接到自定义的消息后，如果处于最小化状态则恢复，否则放置到桌面的最前面
  MessageBox(Handle,'程序" '+APPNAME+'" 已经运行了。','信息',MB_OK+MB_ICONINFORMATION+MB_SYSTEMMODAL);
{  if IsIconic(Application.Handle) = TRUE then
    Application.Restore
  else
    Application.BringToFront;}
end;

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
      Application.MessageBox(PChar('打开桌面失败!' + #13#10 + SysErrorMessage(GetLastError)), '错误', MB_OK +   MB_ICONSTOP);
      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
      Application.MessageBox(pchar('进程创建失败!' + #13#10 + SysErrorMessage(GetLastError)), '错误', MB_OK +   MB_ICONSTOP);
      CloseDesktop(DsktpHandle);
      Exit;
    end;
  end;
  SwitchDesktop(DsktpHandle);
end;

procedure init(LMDGlobalHotKey: TLMDGlobalHotKey; Key: integer);
begin
  LMDGlobalHotKey := TLMDGlobalHotKey.Create(Form1);
  LMDGlobalHotKey.HotKey := TextToShortCut('Ctrl+F' + Trim(IntToStr(Key)));
  LMDGlobalHotKey.OnKeyDown := Form1.LMDGlobalHotKeyKeyDown;
  LMDGlobalHotKey.Active := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  init(LMDGlobalHotKey1, 1);
  init(LMDGlobalHotKey2, 2);
  init(LMDGlobalHotKey3, 3);
  init(LMDGlobalHotKey4, 4);
  init(LMDGlobalHotKey5, 5);
  init(LMDGlobalHotKey6, 6);
  init(LMDGlobalHotKey7, 7);
  init(LMDGlobalHotKey8, 8);
  init(LMDGlobalHotKey9, 9);
  init(LMDGlobalHotKey10, 10);
  init(LMDGlobalHotKey11, 11);
  init(LMDGlobalHotKey12, 12);
end;

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

procedure TForm1.LMDGlobalHotKeyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  SwitchToDesktop(Key - 111);
  case (Key - 111) of
    2: n21.Checked :=True;
    3: n31.Checked :=True;
    4: n41.Checked :=True;
    5: n51.Checked :=True;
    6: n61.Checked :=True;
    7: n71.Checked :=True;
    8: n81.Checked :=True;
    9: n91.Checked :=True;
    10: n101.Checked :=True;
    11: n111.Checked :=True;
    12: n121.Checked :=True;
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  RzTrayIcon1.MinimizeApp;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RzTrayIcon1.MinimizeApp;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SwitchToDesktop(1);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   RzTrayIcon1.RestoreApp;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
  SwitchToDesktop(StrToInt(Copy((sender as TMenuItem).Caption,5,2)));
end;
end.