Delphi判断是否有全屏程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,
  ShellAPI; // 要引用此单元

const
  WM_APPBAR_MESSAGE = WM_USER + 1;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    IsFullScreenAppRun: Boolean; //放个全局变量用于记录
    procedure WMAppBarMessage(var Msg: TMessage); message WM_APPBAR_MESSAGE;
  end;

var
  Form1: TForm1;
  AppBar_Data: APPBARDATA;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SHAppBarMessage(ABM_REMOVE, AppBar_Data); //窗口关闭时移除此消息
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillChar(AppBar_Data, SizeOf(AppBar_Data), #0);
  AppBar_Data.cbSize := SizeOf(AppBar_Data);
  AppBar_Data.hWnd := Handle;
  AppBar_Data.uCallbackMessage := WM_APPBAR_MESSAGE; //指定回调消息
  SHAppBarMessage(ABM_NEW, AppBar_Data); //建立监听
end;

procedure TForm1.WMAppBarMessage(var Msg: TMessage);
var
  retCode: Cardinal ;
begin
  if Msg.Msg = WM_APPBAR_MESSAGE then begin
    if msg.WParam = ABN_FULLSCREENAPP then begin
      if msg.LParam = 1 then begin
        Memo1.Lines.Add('有全屏程序运行');
        IsFullScreenAppRun := True;
      end else if Msg.LParam = 0 then begin
        Memo1.Lines.Add('无全屏程序运行');
        IsFullScreenAppRun := False;
      end;
    end;
  end;
end;

end.

自我改编代码：

 

 

function IsFullScreen: Boolean; forward;
function GetClassNameFX(h: HWND): string; forward;

function GetClassNameFX(h: HWND): string;
var
  ClassName: PChar;
begin
  Result := '';
  GetMem(ClassName, 256);
  try
    GetClassName(h, ClassName, 256);

    Result := string(ClassName);

  finally
    FreeMem(ClassName);
  end;
end;

function IsFullScreen: Boolean;
var
  h, h1, h2, h3: HWND;
  r, r1: TRect;
  rk, rg, r1k, r1g: Integer;
  s: string;
begin

  Result := False;

  h := Windows.GetDesktopWindow();
  h1 := GetForegroundwindow;
  h2 := FindWindow('Progman', nil);
  h3 := FindWindow('WorkerW', nil);

  if (h1 = h2) or (h1 = h3) or (h1 = h) then
    Exit;
  if h3 > 0 then
  begin
    s := GetClassNameFX(h1);
    if (s = 'WorkerW') or (s = 'Progman') then
      Exit;
  end;

  GetWindowRect(h, r);
  rk := r.Right - r.Left;
  rg := r.Bottom - r.Top;

  GetWindowRect(h1, r1);
  r1k := r1.Right - r1.Left;
  r1g := r1.Bottom - r1.Top;

  if (rk = r1k) and (rg = r1g) and (r.BottomRight.X = r1.BottomRight.X) then
    Result := True;
end;

不喜勿喷，这是我自己花了很长时间才想出来的