atuser.com 网站关闭通知
大家有缘再聚, 多谢大家的长年支持与守护.

Delphi 监听是否有全屏程序.

分类
代码库
更新时间
2019-07-15 11:00:07
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.

腾讯云 / 腾讯AI / 腾讯开源 / 南沙新区 / 信用
分享工作室[粤ICP备16004795号-2] Date:2020-10-27 14:18:01(UTC) RunTime:0.013