unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TfMain = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    procedure DisplayVisiblePortion();
    function CalcVisiblePortion() : Integer;
  end;

var
  fMain: TfMain;

implementation

{$R *.DFM}

function RectSquare (const Rect : TRect) : Integer;
begin
  with Rect do
    Result := (Right - Left) * (Bottom - Top);
  if Result < 0 then
    Result := - Result;
end;

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

function RgnSquare (Rgn : HRGN) : Integer;
var
  DataSize : DWORD;
  RgnData : PRGNDATA;
  Rectangles : PRectArray;
  I : Integer;
begin
  Result := 0;
  DataSize := GetRegionData(Rgn, 0, nil);
  if DataSize > 0 then begin
    GetMem(RgnData, DataSize);
    try
      GetRegionData(Rgn, DataSize, RgnData);
      Rectangles := PRectArray(@RgnData.Buffer);
      for I:=0 to Pred(RgnData^.rdh.nCount) do
        Inc(Result, RectSquare(Rectangles^[I]));
    finally
      FreeMem(RgnData, DataSize);
    end;
  end;
end;

function CalcSquarePortion (SquareWhole, SquarePart : Integer) : Integer;
begin
  if SquarePart >= SquareWhole then
    Result := 100
  else
    Result := Trunc((SquarePart / SquareWhole) * 100);
end;

function TfMain.CalcVisiblePortion: Integer;
var
  SiblingRect : TRect;
  Workarea : TRect;
  WinRect : TRect;
  Tmp : TRect;
  VisiblePortion : TRect;
  Sibling : HWND;
  WindowSquare : Integer;
  WindowRgn, Rgn, TmpRgn : HRGN;
begin
  if IsIconic(Handle) then begin
    Result := 0;
    Exit;
  end;
  Rgn := CreateRectRgn (0, 0, 0, 0);
  try
    SystemParametersInfo(SPI_GETWORKAREA, 0, @Workarea, 0);
    GetWindowRect(Handle, WinRect);
    WindowSquare := RectSquare(WinRect);
    IntersectRect(VisiblePortion, WinRect, WorkArea);
    Result := CalcSquarePortion(WindowSquare, RectSquare(VisiblePortion));
    if Result > 0 then begin
      WindowRgn := CreateRectRgnIndirect(VisiblePortion);
      try
        Sibling := GetWindow(Handle, GW_HWNDPREV);
        while (Sibling <> 0) and (Result > 0) do begin
          if IsWindowVisible(Sibling) and not IsIconic(Sibling) then
            if IsZoomed(Sibling) then begin
              Result := 0;
              Break;
            end else begin
              GetWindowRect(Sibling, SiblingRect);
              IntersectRect(Tmp, VisiblePortion, SiblingRect);
              if not IsRectEmpty(Tmp) then begin
                TmpRgn := CreateRectRgnIndirect(Tmp);
                try
                  if CombineRgn(Rgn, Rgn, TmpRgn, RGN_OR) = ERROR then
                    RaiseLastWin32Error();
                finally
                  DeleteObject(TmpRgn);
                end;
              end;
              TmpRgn := CreateRectRgn(0, 0, 0, 0);
              if CombineRgn(TmpRgn, WindowRgn, Rgn, RGN_DIFF) = ERROR then
                RaiseLastWin32Error();
              Result := CalcSquarePortion(WindowSquare, RgnSquare(TmpRgn));
              DeleteObject(TmpRgn);
            end;
          Sibling := GetWindow(Sibling, GW_HWNDPREV);
        end;
      finally
        DeleteObject(WindowRgn);
      end;
    end;
  finally
    DeleteObject(Rgn);
  end;
end;

procedure TfMain.DisplayVisiblePortion;
begin
  Caption := Format ('%d%% percents visible', [CalcVisiblePortion()]);
end;

procedure TfMain.Timer1Timer(Sender: TObject);
begin
  DisplayVisiblePortion();
end;

end.