TWindowsInformation

/*
   Class show information about windows: list of windows, size, caption, coordinates,
   calculates area of visibilty window, etc.

   Delphi 2009+ (used Generics)

   zardoz.antony@gmail.com
   lang = RU
*/
unit WindowsTools;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Forms, Generics.Collections;

type
  TWindowData = record
    Handle: HWND;
    Caption: string;
    Position: TRect;
  end;

  pWindowData = ^TWindowData;

  TRectArray = array[0..16384] of TRect;
  pRectArray = ^TRectArray;

  TWindowsInformation = class
  private
    FWindowsList: TList<pWindowData>;

    //проверяет пересекаются ли 2 области
    function OverlapRects(R1, R2: TRect): Boolean;
    //считает площадь области
    function CalcRectSquare(const Rect: TRect): Integer;
    function GetWindowHandleByCaption(Caption: string): HWND;
    //возвращает индекс окна с переданным хэндлом в списке окон
    function GetWindowIndexByHandle(Wnd: HWND): Integer;
  protected
    //получает видимую площадь окна в пикселях
    function GetVisibleWindowSquare(Wnd: HWND): Integer; virtual;
    //получает текущий список видимых окон упорядоченному как в z-order (индекс 0 - самое верхнее окно)
    procedure GetWindowsList; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    //возвращает процент видимости по Wnd окна
    function GetWindowVisibleAreaProcent(Wnd: HWND): Extended; overload;
    //возвращает процент видимости по заголовку окна, в том числе по частичному совпадению заголовка
    //(если совпадений больше 1, то выбьет исключение)
    function GetWindowVisibleAreaProcent(WindowCaption: string): Extended; overload;

    procedure RefreshWindowList;

    property WindowsList: TList<pWindowData> read FWindowsList;
  end;

implementation

{ TWindowsInformation }

function TWindowsInformation.CalcRectSquare(const Rect: TRect): Integer;
begin
  with Rect do
    Result := (Right - Left) * (Bottom - Top);

  Result := Abs(Result);
end;

constructor TWindowsInformation.Create;
begin
  inherited;
  FWindowsList := TList<pWindowData>.Create;
  GetWindowsList;
end;

destructor TWindowsInformation.Destroy;
var
  i: Integer;
begin
  for i := 0 to FWindowsList.Count - 1 do
    Dispose(FWindowsList[i]);

  FWindowsList.Free;
  inherited;
end;

function TWindowsInformation.GetVisibleWindowSquare(Wnd: HWND): Integer;
var
  i,
  CurIdx: Integer;
  CurWinData,
  WinData: pWindowData;
  HgrCurReg,
  HgrNewReg,
  HgrDestReg: HRGN;
  SizeBuff: DWORD;
  DestRegnData: pRgnData;
  Rectangles: pRectArray;
begin
  Result := -1;
  CurIdx := GetWindowIndexByHandle(Wnd);

  if CurIdx = -1 then
    raise Exception.Create('Указанный Handle окна не найдет в списке!');

  //окон выше нет
  if CurIdx = 0 then
    Exit;

  CurWinData := FWindowsList[CurIdx];

  HgrNewReg := 0;
  try
    //пустой регион назначения
    HgrDestReg := CreateRectRgn(0,0,0,0);
    //регион целевого окна
    HgrCurReg := CreateRectRgnIndirect(CurWinData.Position);

    for i := 0 to CurIdx - 1 do
    begin
      WinData := pWindowData(FWindowsList[i]);
      //окно не перекрывается с нашим
      if not OverlapRects(CurWinData.Position, WinData.Position) then
        Continue;

      if HgrNewReg <> 0 then
        DeleteObject(HgrNewReg);

      HgrNewReg := CreateRectRgnIndirect(WinData.Position);
      //объединяем все регионы окон сверху
      CombineRgn(HgrDestReg, HgrDestReg, HgrNewReg, RGN_OR);
    end;

    //находим область перекрытия
    CombineRgn(HgrDestReg, HgrCurReg, HgrDestReg, RGN_DIFF);

    //подготавливает структуру для получения данных о регионе
    SizeBuff := GetRegionData(HgrDestReg, 0, nil);
    GetMem(DestRegnData, SizeBuff);
    FillChar(DestRegnData^, SizeBuff, 0);

    //получаем данные о регионе
    if GetRegionData(HgrDestReg, SizeBuff, DestRegnData) = 0 then
      raise Exception.Create('Не удалось получить данные по региону!');

    //приводим указатель на буфер к нужному типу
    Rectangles := pRectArray(@DestRegnData.Buffer);
    //считаем площадь всех регионов в буфере
    Result := 0;
    for i := 0 to Pred(DestRegnData.rdh.nCount) do
      Inc(Result, CalcRectSquare(Rectangles^[i]));
  finally
    DeleteObject(HgrNewReg);
    DeleteObject(HgrDestReg);
    DeleteObject(HgrCurReg);
    FreeMem(DestRegnData, SizeBuff);
  end;
end;

function TWindowsInformation.GetWindowHandleByCaption(Caption: string): HWND;
var
  CurWinData: pWindowData;
  i: Integer;
begin
  Result := 0;
  for i := 0 to FWindowsList.Count - 1 do
  begin
    CurWinData := FWindowsList[i];

    if (Pos(Caption, CurWinData.Caption) <> 0) then
    begin
      if Result = 0 then
        Result := CurWinData.Handle
      else
        raise Exception.Create('Больше одного окна с такими словами в заголовке!');
    end;
  end;
end;

function TWindowsInformation.GetWindowIndexByHandle(Wnd: HWND): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to FWindowsList.Count - 1 do
  begin
    if FWindowsList[i].Handle <> Wnd then
      Continue;

    Result := i;
    Break;
  end;
end;

procedure TWindowsInformation.GetWindowsList;
var
  Wnd: HWND;
  Buff: array [0 .. 1024] of Char;  //будет выбивать исключения, если текст заголовка окна будет больше 1024 символов
  Data: pWindowData;
  WinInfo: TWindowInfo;
begin
  FWindowsList.Clear;
  Wnd := GetWindow(Application.MainForm.Handle, GW_HWNDFIRST);

  while Wnd <> 0 do
  begin
    if (Wnd <> Application.handle) // Собственное окно
      and IsWindowVisible(Wnd)
      and (GetWindow(wnd, GW_OWNER) = 0) // Дочерние окна
      and (GetWindowText(Wnd, Buff, SizeOf(Buff)) <> 0) then
    begin
      New(Data);
      Data.Handle := Wnd;

      GetWindowText(Wnd, Buff, SizeOf(Buff));
      Data.Caption := StrPas(buff);

      GetWindowInfo(Wnd, WinInfo);
      Data.Position:= WinInfo.rcWindow;

      FWindowsList.Add(Data);
    end;

    Wnd := GetWindow(Wnd, GW_HWNDNEXT);
  end;
end;

function TWindowsInformation.GetWindowVisibleAreaProcent(Wnd: HWND): Extended;
var
  CurWinData: pWindowData;
  CurIdx,
  Square: Integer;
begin
  CurIdx := GetWindowIndexByHandle(Wnd);
  if CurIdx = -1 then
    raise Exception.Create('Указанный Handle окна не найдет в списке!');

  CurWinData := FWindowsList[CurIdx];

  Square := GetVisibleWindowSquare(Wnd);
  //если окон выше нет
  if Square = -1 then
    Result := 100
  else
    Result := 100 * Square / (CurWinData.Position.Size.Width * CurWinData.Position.Size.Height);
end;

function TWindowsInformation.GetWindowVisibleAreaProcent(WindowCaption: string): Extended;
begin
  Result := GetWindowVisibleAreaProcent(GetWindowHandleByCaption(WindowCaption));
end;

function TWindowsInformation.OverlapRects(R1, R2: TRect): Boolean;
var
  Temp: TRect;
begin
  Result := False;
  if not UnionRect(Temp, R1, R2) then
    Exit;
  if (Temp.Right - Temp.Left <= R1.Right - R1.Left + R2.Right - R2.Left) and
    (Temp.Bottom - Temp.Top <= R1.Bottom - R1.Top + R2.Bottom - R2.Top) then
    Result := True;
end;

procedure TWindowsInformation.RefreshWindowList;
begin
  GetWindowsList;
end;

end.