Использование IVirtualDesktopManager в Delphi

Я пытаюсь использовать IVirtualDesktopManager в Turbo Delphi в Windows 10. Я не получаю никаких ошибок, но 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, то он вернётся правильно, если вы переключитесь на другой рабочий стол и вернетесь обратно, поэтому проверьте, что написано в памятке. Я нахожу это замечательным, поскольку я предполагаю, что одно приложение может иметь более одного окна, отображаемого на разных рабочих столах?

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.
Источник

1 ответ

Все ваши методы интерфейса объявлены неправильно, но IsWindowOnCurrentVirtualDesktop() в частности, это хлопотно, потому что его второй параметр ожидает указатель на BOOL, а не указатель на Boolean, BOOL а также Boolean очень разные типы данных. BOOL это псевдоним для LongBoolразмером 4 байта, тогда как Boolean имеет размер 1 байт.

Помимо этого, вы должны использовать HWND вместо Cardinal для Wnd параметры. И я также предлагаю использовать out а также const для DesktopID параметры вместо необработанных указателей.

Кроме того, вам действительно нужно избавиться от 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() на CoCreateInstance() так что вы можете обработать ошибку более изящно, например:

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;
Источник
Другие вопросы по тегам