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;

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

  • 相关阅读:
    在React中使用Redux数据流
    开发中经常遇到的一些css样式问题
    记录一下CSS outline-width 属性
    使用git stash命令保存和恢复进度
    一分钟搭建好webpack通用坏境
    二维码生成(QRCode.js)
    IE6浏览器有哪些常见的bug,缺陷或者与标准不一致的地方,如何解决
    如何进行网站性能优化
    JavaScript深拷贝与浅拷贝的理解
    新问题: 两个样式对同一个元素操作,为什么最新的样式没有起作用?(已解决)
  • 原文地址:https://www.cnblogs.com/yzryc/p/6402148.html
Copyright © 2011-2022 走看看