Delphi判断是否有全屏程序

时间:2023-03-09 12:46:12
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;

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