Delphi判断是否有全屏程序

来源：互联网发布：python检测ip能否ping 编辑：程序博客网时间：2024/05/22 00:08

Delphi判断是否有全屏程序

网络流传代码

unit Unit1;interfaceuses  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;

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

0 0