⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 使Windows能够像RedHat Linux那样拥有四个桌面。 1.2版添加功能:隐藏任务栏图标。(参考了Delphi盒子网站上的代码)
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, RxMenus, RXShell, AppEvent, StdCtrls, Buttons, ExtCtrls,
  LMDCustomComponent, LMDGlobalHotKey, LMDOneInstance, RzLabel,
  TrayIconForm;

type
  TShareInfo = record
    Actived : array [ 1..4 ] of boolean;
  end;
  PShareInfo = ^TShareInfo;

  TForm1 = class(TForm)
    RxTrayIcon1: TRxTrayIcon;
    RxPopupMenu1: TRxPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    AppEvents1: TAppEvents;
    BitBtn2: TBitBtn;
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    LMDGlobalHotKey1: TLMDGlobalHotKey;
    LMDGlobalHotKey2: TLMDGlobalHotKey;
    LMDGlobalHotKey3: TLMDGlobalHotKey;
    LMDGlobalHotKey4: TLMDGlobalHotKey;
    LMDOneInstance1: TLMDOneInstance;
    Edit1: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    LMDGlobalHotKey5: TLMDGlobalHotKey;
    N4: TMenuItem;
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure AppEvents1Minimize(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RxTrayIcon1DblClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure LMDGlobalHotKey1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDGlobalHotKey2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDGlobalHotKey3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDGlobalHotKey4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDOneInstance1Custom(Sender: TObject);
    procedure LMDGlobalHotKey5KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    RunningOnDesktop: integer;
    Failed : boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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.N2Click(Sender: TObject);
begin
  Show;
end;

procedure TForm1.AppEvents1Minimize(Sender: TObject);
begin
  Hide;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
  SwitchToDeskTop(1);
end;

procedure TForm1.N21Click(Sender: TObject);
begin
  SwitchToDesktop(2);
end;

procedure TForm1.N31Click(Sender: TObject);
begin
  SwitchToDesktop(3);
end;

procedure TForm1.N41Click(Sender: TObject);
begin
  SwitchToDesktop(4);
end;

procedure TForm1.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RXPopupMenu1.Popup(x, y);
end;

procedure TForm1.RxTrayIcon1DblClick(Sender: TObject);
begin
  Show;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Hide;
end;

procedure TForm1.LMDGlobalHotKey1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  N11.Click;
end;

procedure TForm1.LMDGlobalHotKey2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  N21.Click;
end;

procedure TForm1.LMDGlobalHotKey3KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  N31.Click;
end;

procedure TForm1.LMDGlobalHotKey4KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  N41.Click;
end;

procedure TForm1.LMDOneInstance1Custom(Sender: TObject);
begin
  N11.Click;
end;

procedure TForm1.LMDGlobalHotKey5KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  RxTrayIcon1.Active := not RxTrayIcon1.Active;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  TrayForm.ShowModal;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TrayForm := TTrayForm.Create(nil);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -