xdesktop.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xDesktop;

interface

uses Windows, Messages, SysUtils, Forms, Controls, Graphics, ShellAPI, Registry;

//------------------------------------------------------------------//
function GetDesktopDefView: HWND;
function GetDesktopListView: HWND;
function GetActiveDesktopWindow: HWND;

//------------------------------------------------------------------//
procedure RebuildIconCache;

//------------------------------------------------------------------//
function IsScreenSaverRunning(KillIt: Boolean): Boolean;


implementation

uses xStrings, xFiles;

//------------------------------------------------------------------//
//取得ProgMan窗口的第一个子窗口，窗口类为SHELLDLL_DefView。
function GetDesktopDefView: HWND;
begin
  Result := GetWindow(FindWindow(PChar('ProgMan'), nil), GW_CHILD);
end;

//------------------------------------------------------------------//
//取得DefView窗口的第一个子窗口，窗口类为SysListView32，即负责显示桌
//布图标的窗口。如果要对桌面进行特殊处理或消息拦截，通常由此窗口入手。
function GetDesktopListView: HWND;
begin
  Result := GetWindow(GetWindow(FindWindow(PChar('ProgMan'), nil), GW_CHILD), GW_CHILD);
end;

//------------------------------------------------------------------//
//取得ListView窗口的下一个窗口，窗口类为InternetExplorer_Server，若
//Active Desktop功能激活时，就可找到此窗口，否则不会有此窗口存在。此
//函数可判断Active Desktop是否激活。
function GetActiveDesktopWindow: HWND;
var
  Buf: array[0..255] of Char;
begin
  Result := GetDesktopListView;
  repeat
    Result := GetWindow(Result, GW_HWNDNEXT);
    if Result = 0 then Exit;
    GetClassName(Result, Buf, 256);
  until StrIComp(Buf, 'Internet Explorer_Server') = 0;
end;

//------------------------------------------------------------------//
//重建所谓的图标快取，由于图标的重绘频繁，Windows使用图标快取机制，降低
//图标重复读取建立的工作。此函数会强迫所有正在显示的图标重新加载，用于：
//1、有时图标因为不知名原因（显卡驱动程序或不当应用程序）产生图象错误或
//破碎现象，重建图标快取可修复此情况。
//2、若要更新桌面图标，先将新图标写入系统注册表，再调用本函数，可强迫
//Shell重新读取图标文件，更新桌面图标。
procedure RebuildIconCache;
var
  IconW: Integer;
begin
  IconW := GetSystemMetrics(SM_CXICON);
  with TRegIniFile.Create('Control Panel\Desktop') do
    try
      WriteString('WindowMetrics', 'Shell Icon Size', IntToStr(IconW - 1));
      SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, 0);
      WriteString('WindowMetrics', 'Shell Icon Size', IntToStr(IconW));
      SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, 0);
    finally
      Free;
    end;
end;

//------------------------------------------------------------------//
//检查屏幕保护程序是否正在执行，若KillIt = True，且正处于屏保状态，则
//立即中止屏保程序的运行。
function IsScreenSaverRunning(KillIt: Boolean): Boolean;
var
  hd: HDESK;
  hw: HWND;
  PT: TPoint;
begin
  Result := False;

  if Win32Platform = VER_PLATFORM_WIN32_NT then { Windows NT }
  begin

    //为兼容XP，加入修正代码。但NT系统较复杂，能否完全适用，待观察，
    //此部分来自.NET帮助Seek "OpenDesktop" 找到的
    //Force a Screeb Saver to Close Once Started in Windows NT.
    hw:=GetForegroundWindow();
    if hw <> 0 then
        if IsWindowVisible(hw) then
        begin
            PostMessage(hw,WM_CLOSE,0,0);
            Result := True; // 正在执行
            Exit;
        end;

    // 萤幕保护程式所在的 desktop
    hd := OpenDesktop('Screen-saver', 0, False, MAXIMUM_ALLOWED);
    if hd <> 0 then
    begin
      Result := True; // 正在执行
      CloseDesktop(hd);
    end else
    begin
      // 权限不足
      if GetLastError = ERROR_ACCESS_DENIED then Result := True;
    end;
  end else
  begin { Windows 95/98 or Win32s }
    // 取得萤幕保护程式的视窗 handle
    hw := FindWindow('WindowsScreenSaverClass', nil);
    if hw <> 0 then
    begin
      Result := True; // 正在执行
    end;
  end;

  if Result and KillIt then
  begin
    GetCursorPos(PT); // 取得目前滑鼠指标
    SetCursorPos(PT.X + 20, PT.Y + 20); // 设定滑鼠指标, 偏移位置
  end;
end;

end.