4

我正在尝试在 Windows 10 的 Turbo Delphi 中使用 IVirtualDesktopManager。我没有收到任何错误，但 IsWindowOnCurrentVirtualDesktop 和 GetWindowDesktopId 没有返回任何有用的信息。有谁知道我在这里做错了什么？谢谢。

unit VDMUnit;

interface

uses ActiveX, Comobj;

Const
 IID_VDM: TGUID ='{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}';
 CLSID_VDM: TGUID ='{AA509086-5CA9-4C25-8F95-589D3C07B48A}';

type
  {$EXTERNALSYM IVirtualDesktopManager}
  IVirtualDesktopManager = interface(IUnknown)
    ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}']
    function IsWindowOnCurrentVirtualDesktop(Wnd:cardinal; var IsTrue: boolean): HResult; stdcall;
    function GetWindowDesktopId(Wnd:cardinal; pDesktopID: PGUID): HResult; stdcall;
    function MoveWindowToDesktop(Wnd:cardinal; DesktopID: PGUID): HResult; stdcall;
  end;

function IsOnCurrentDesktop(wnd:cardinal):boolean;
procedure GetWindowDesktopId(Wnd:cardinal; pDesktopID: PGUID);
procedure MoveWindowToDesktop(Wnd:cardinal; DesktopID: PGUID);

implementation

var
  vdm:IVirtualDesktopManager;

function IsOnCurrentDesktop(wnd:cardinal):boolean;
begin
  CoInitialize(nil);
  OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER,IVirtualDesktopManager,vdm));
  OleCheck(vdm.IsWindowOnCurrentVirtualDesktop(wnd,result));
  CoUninitialize;
end;

procedure GetWindowDesktopId(Wnd:cardinal; pDesktopID: PGUID);
begin
  CoInitialize(nil);
  OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER ,IVirtualDesktopManager,vdm));
  OleCheck(vdm.GetWindowDesktopId(wnd,pDesktopID));
  CoUninitialize;
end;

procedure MoveWindowToDesktop(Wnd:cardinal; DesktopID: PGUID);
begin
  CoInitialize(nil);
  OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER,IVirtualDesktopManager,vdm));
  OleCheck(vdm.MoveWindowToDesktop(wnd,DesktopID));
  CoUninitialize;
end;

end.

好的，这是一个简单的例子：这个项目只是一个带有 TMemo 和 Ttimer 的表单。这表明 Form1.handle 不能用于检查窗口是否在当前桌面上。但是，如果您检查 Application.Handle，那么如果您切换到另一个桌面并再次返回，那么 is 将正确返回 false，因此请检查备忘录中写的内容。我觉得这很了不起，因为我认为一个应用程序可以在不同的桌面上显示多个窗口？

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, Comobj, StdCtrls, ExtCtrls;

const
 IID_VDM: TGUID = '{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}';
 CLSID_VDM: TGUID ='{AA509086-5CA9-4C25-8F95-589D3C07B48A}';

type
  IVirtualDesktopManager = interface(IUnknown)
    ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}']
    function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall;
    function GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall;
    function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall;
  end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetVDM: IVirtualDesktopManager;
begin
  Result := nil;
  OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER, IVirtualDesktopManager, Result));
end;

function IsOnCurrentDesktop(wnd: HWND): Boolean;
var
  value: BOOL;
begin
  OleCheck(GetVDM.IsWindowOnCurrentVirtualDesktop(Wnd, value));
  Result := value;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if IsOnCurrentDesktop(Form1.Handle) then
    Memo1.Lines.Add('Yes')
  else
    Memo1.Lines.Add('No');
end;



end.
4

1 回答 1

4

您的所有接口方法都被错误地声明，但IsWindowOnCurrentVirtualDesktop()特别麻烦，因为它的第二个参数需要一个指向 a 的指针BOOL，而不是指向 a 的指针Boolean。 BOOL并且Boolean是非常不同的数据类型。 BOOL是 的别名LongBool，大小为 4 个字节，而大小Boolean为 1 个字节。

除此之外，您应该使用而HWND不是参数。而且我还建议使用and作为参数而不是原始指针。CardinalWndoutconstDesktopID

此外，您确实需要摆脱Co(Un)Initialize()调用，它们根本不属于您的函数。调用者负责（取消）初始化 COM，因为它必须决定在访问 COM 时要使用哪个 COM 线程模型。单个函数不应代表调用者做出该决定。COM 必须在每个线程的基础上进行初始化，因此您的各个应用程序线程有责任CoInitialize()在调用您的函数之前调用，并CoUninitialize()在终止之前调用。

由于您的vdm变量，这一点尤其重要。该变量属于每个函数内部，而不是全局内存。当编译器在单元完成后尝试释放该接口时，您将面临崩溃的风险CoUninitialize()。

综上所述，尝试更多类似的东西：

unit VDMUnit;

interface

uses
  Windows;

function IsOnCurrentDesktop(wnd: HWND): Boolean;
function GetWindowDesktopId(Wnd: HWND): TGUID;
procedure MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID);

implementation

uses
  ActiveX, Comobj;

const
 IID_VDM: TGUID = '{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}';
 CLSID_VDM: TGUID ='{AA509086-5CA9-4C25-8F95-589D3C07B48A}';

type
  IVirtualDesktopManager = interface(IUnknown)
    ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}']
    function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall;
    function GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall;
    function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall;
  end;

function GetVDM: IVirtualDesktopManager;
begin
  Result := nil;
  OleCheck(CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER, IVirtualDesktopManager, Result));
end;

function IsOnCurrentDesktop(wnd: HWND): Boolean;
var
  value: BOOL;
begin
  OleCheck(GetVDM.IsWindowOnCurrentVirtualDesktop(Wnd, value));
  Result := value;
end;

function GetWindowDesktopId(Wnd: HWND): TGUID;
being
  OleCheck(GetVDM.GetWindowDesktopId(Wnd, Result));
end;

procedure MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID);
begin
  OleCheck(GetVDM.MoveWindowToDesktop(Wnd, DesktopID));
end;

end.

最后，请注意IVirtualDesktopManager仅适用于 Windows 10 及更高版本，因此如果您不希望代码在早期 Windows 版本上崩溃，则应删除OleCheck()onCoCreateInstance()以便更优雅地处理错误，例如：

uses
  Classes;

type
  TFakeVirtualDesktopManager = class(TInterfacedObject, IVirtualDesktopManager)
  public
    function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall;
    function GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall;
    function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall;
  end;

function TFakeVirtualDesktopManager.IsWindowOnCurrentVirtualDesktop(Wnd: HWND; out IsTrue: BOOL): HResult; stdcall;
begin
  IsTrue := False;
  Result := S_OK;
end;

function TFakeVirtualDesktopManager.GetWindowDesktopId(Wnd: HWND; out DesktopID: TGUID): HResult; stdcall;
begin
  DesktopID := GUID_NULL;
  Result := S_OK;
end;

function TFakeVirtualDesktopManager.MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall;
begin
  Result := S_OK;
end;

function GetVDM: IVirtualDesktopManager;
var
  hr: HResult;
begin
  Result := nil;
  hr := CoCreateInstance(CLSID_VDM, nil, CLSCTX_INPROC_SERVER, IVirtualDesktopManager, Result);
  if Failed(hr) then
  begin
    if hr = REGDB_E_CLASSNOTREG then
      Result := TFakeVirtualDesktopManager.Create as IVirtualDesktopManager
    else
      OleCheck(hr);
  end;
end;
于 2017-01-24T00:25:01.053 回答