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;
不喜勿喷,这是我自己花了很长时间才想出来的
Delphi判断是否有全屏程序的更多相关文章
- 从零开始学 Web 之 HTML5(三)网络监听,全屏,文件读取,地理定位接口,应用程序缓存
大家好,这里是「 从零开始学 Web 系列教程 」,并在下列地址同步更新...... github:https://github.com/Daotin/Web 微信公众号:Web前端之巅 博客园:ht ...
- [转]Android WebView播放视频(包括全屏播放),androidwebview
Android WebView播放视频(包括全屏播放),androidwebview 最近项目开发中用到了WebView播放视频的功能,总结了开发中犯过的错误,这些错误在开发是及容易遇到的,所以我这里 ...
- 全屏显示网页FULLSCREEN API
第一次看到应用 Fullscreen API 全屏显示网页,是 FaceBook 中的照片放大.作为一个比较新的 API,目前只有 Safari.Chrome 和 FireFox 三种浏览器支持该特性 ...
- 浏览器全屏之requestFullScreen全屏与F11全屏
一.简介 浏览器全屏有两种方式,一种是HTML5新增的requestFullscree全屏,另一种是摁F11实现的全屏,本文将详解两种全屏的特点以及实现代码. 二.requestFullscreen全 ...
- 12、Libgdx的图像之全屏和垂直同步
(官网:www.libgdx.cn) 检测当前设置 判断是否设置全屏,可以通过如下方式: boolean fullscreen = Gdx.graphics.isFullscreen(); 设置全屏和 ...
- H5实现全屏与F11全屏
最近做项目用到全屏,现总结一下全屏: 1.局部全屏:H5全屏和F11有区别,在这种情况下判断全屏只需要通过H5全屏属性,无论全屏后有无滚动条都可判断. /** * [isFullscreen 判断浏览 ...
- js控制全屏及退出全屏
js控制全屏及退出全屏,网上很多代码例子,我这里需求和标准的有点出入: 1.当用户点击某按钮,触发iframe下的页面全屏. 2.不允许用户退出全屏. 解决第一点,触发全屏可以按照网上的例子,代码如下 ...
- Android之针对WebView的全屏播放
转载请标明转载处:http://bbs.csdn.net/topics/390839259 本人刚学android,菜鸟一个,第一次写帖子,最近因为项目要用webview加载html5的视频,开始不能 ...
- x5webview 自定义全屏界面
集成X5WEBVIEW可以选择全屏模式为标准全屏还是x5全屏,而不设置默认为false. 首先看看标准全屏的基本设置, if (webView.getX5WebViewExtension() != n ...
随机推荐
- CentOS之Shell基础
Linux默认的shell版本是bash. 我们所敲的命令都是有记录的:被保存在.bash_history文件中.只有当用户正常突出shell时,命令才会保存至.bash_history中. !!:连 ...
- ZooKeeper系列(7):ZooKeeper一致性原理
一.ZooKeeper 的实现 1.1 ZooKeeper处理单点故障 我们知道可以通过ZooKeeper对分布式系统进行Master选举,来解决分布式系统的单点故障,如图所示. 图 1.1 ZooK ...
- TCP/IP SIGPIPE信号
往一个已经接受FIN的套接中写是允许的,接受到FIN仅仅代表对方不再发送数据. 在收到RST段之后,如果在调用write就 会产生SIGPIPE信息,对于这个信号的处理我们通常 解决方法 signal ...
- mysql数据备份与操作
物理备份: 直接复制数据库文件,适用于大型数据库环境.但不能恢复到异构系统中如Windows. 逻辑备份: 备份的是建表.建库.插入等操作所执行SQL语句,适用于中小型数据库,效率相对较低. 导出表: ...
- 电商系统架构总结3(webapi授权机制)
三 Web API 授权方式 web api的客户端,包括 android,ios,h5,自然对访问权限要加上授权机制.对于h5,要求把h5站点和web api部署在同一个域名下,然后对web api ...
- cas client
(The client and server are the same thekeystore) cas client version: 3.5.1(cas-client-core-3.5.1) gi ...
- MySQL-MMM实现MySQL高可用
一.MMM简介 MMM(Master-Master replication manager for MySQL)是一套支持双主故障切换和双主日常管理的脚本程序.MMM使用Perl语言开发,主要用来监控 ...
- MySQL 全局锁、表锁以及行锁
1. 系统版本 MySQL 5.7.25 ubuntu 16.04 2. 全局锁 全局锁即对整个数据库实例加锁,使得整个库处于只读状态,会阻塞DML和DDL语句.使用如下命令(简称FTWRL)可为数据 ...
- 我也说说Nginx——先搞搞清楚
一.Nginx的诞生 这个很多文章里都有,总之就是当年啊有个技术困难叫C10K问题,就是如何解决10万个客户端的并发请求问题.然后有个俄罗斯大牛某某某,在02年使用C语言搞了个东东声称可以处理每天5亿 ...
- poi excel超出65536行数限制自动扩展Invalid row number (65536) outside allow
1.xls一个sheet只能装65536行,多余则报错 poi包导出或写入excel超出65536报错: java.lang.IllegalArgumentException: Invalid row ...