zoukankan      html  css  js  c++  java
  • 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;

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

  • 相关阅读:
    Numpy存字符串
    一个类似于postman的协议测试工具
    freetds设置超时
    学习jQuery
    webpy 使用python3开发
    gdb调试coredump文件
    htop和ncdu
    rqalpha-自动量化交易系统(一)
    perl学习-运算符添加引号
    xss 和 csrf攻击详解
  • 原文地址:https://www.cnblogs.com/yzryc/p/6402148.html
Copyright © 2011-2022 走看看