{*******************************************************}
{                                                       }
{       Tocsg.WndUtil                                   }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.WndUtil;

interface

uses
  System.SysUtils, Winapi.Windows, Winapi.Messages, Vcl.Forms, Tocsg.Thread,
  System.Generics.Collections;



type
  TEvActiveWndNotify = procedure(aSender: TObject; hActiveWnd: HWND) of object;
  TThdActiveWndMon = class(TTgThread)
  protected
    bSync_: Boolean;
    evNotify_: TEvActiveWndNotify;
    hActiveWnd_: HWND;
    procedure ProcessNotify;
    procedure Execute; override;
  public
    Constructor Create(bSync: Boolean = true);

    property OnActiveWndNotify: TEvActiveWndNotify write evNotify_;
  end;

const
  // GWL_STYLE
  WS_VAL: array [0..19] of DWORD = (
    WS_OVERLAPPED, WS_POPUP, WS_CHILD, WS_MINIMIZE, WS_VISIBLE, WS_DISABLED,
    WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_MAXIMIZE, WS_CAPTION, WS_BORDER,
    WS_DLGFRAME, WS_VSCROLL, WS_HSCROLL, WS_SYSMENU, WS_THICKFRAME, WS_GROUP,
    WS_TABSTOP, WS_MINIMIZEBOX, WS_MAXIMIZEBOX
  );

  WS_STR: array [0..19] of String = (
    'WS_OVERLAPPED', 'WS_POPUP', 'WS_CHILD', 'WS_MINIMIZE', 'WS_VISIBLE', 'WS_DISABLED',
    'WS_CLIPSIBLINGS', 'WS_CLIPCHILDREN', 'WS_MAXIMIZE', 'WS_CAPTION', 'WS_BORDER',
    'WS_DLGFRAME', 'WS_VSCROLL', 'WS_HSCROLL', 'WS_SYSMENU', 'WS_THICKFRAME', 'WS_GROUP',
    'WS_TABSTOP', 'WS_MINIMIZEBOX', 'WS_MAXIMIZEBOX'
  );

  // GWL_EXSTYLE
  WS_EX_VAL: array [0..23] of LongInt = (
    WS_EX_DLGMODALFRAME, WS_EX_NOPARENTNOTIFY, WS_EX_TOPMOST, WS_EX_ACCEPTFILES,
    WS_EX_TRANSPARENT, WS_EX_MDICHILD, WS_EX_TOOLWINDOW, WS_EX_WINDOWEDGE,
    WS_EX_CLIENTEDGE, WS_EX_CONTEXTHELP, WS_EX_RIGHT, WS_EX_LEFT, WS_EX_RTLREADING,
    WS_EX_LTRREADING, WS_EX_LEFTSCROLLBAR, WS_EX_RIGHTSCROLLBAR, WS_EX_CONTROLPARENT,
    WS_EX_STATICEDGE, WS_EX_APPWINDOW, WS_EX_LAYERED, WS_EX_NOINHERITLAYOUT,
    WS_EX_LAYOUTRTL, WS_EX_COMPOSITED, WS_EX_NOACTIVATE
  );

  WS_EX_STR: array [0..23] of String = (
    'WS_EX_DLGMODALFRAME', 'WS_EX_NOPARENTNOTIFY', 'WS_EX_TOPMOST', 'WS_EX_ACCEPTFILES',
    'WS_EX_TRANSPARENT', 'WS_EX_MDICHILD', 'WS_EX_TOOLWINDOW', 'WS_EX_WINDOWEDGE',
    'WS_EX_CLIENTEDGE', 'WS_EX_CONTEXTHELP', 'WS_EX_RIGHT', 'WS_EX_LEFT', 'WS_EX_RTLREADING',
    'WS_EX_LTRREADING', 'WS_EX_LEFTSCROLLBAR', 'WS_EX_RIGHTSCROLLBAR', 'WS_EX_CONTROLPARENT',
    'WS_EX_STATICEDGE', 'WS_EX_APPWINDOW', 'WS_EX_LAYERED', 'WS_EX_NOINHERITLAYOUT',
    'WS_EX_LAYOUTRTL', 'WS_EX_COMPOSITED', 'WS_EX_NOACTIVATE'
  );

function GetWindowStyle(h: HWND): NativeInt;
function GetWindowStyleStr(h: HWND): String;

function GetWindowExStyle(h: HWND): NativeInt;
function GetWindowExStyleStr(h: HWND): String;

function GetWindowCaption(h: HWND): String;
function GetEditText(h: HWND): String;
procedure SetEditText(h: HWND; const sText: String);
function GetTopParentHWND(h: HWND): HWND;
function GetWndChildClass(h: HWND; const sClassName: String; hNextChild: HWND = 0): HWND;
function GetWndChildByCaption(h: HWND; const sFindCaption: String; hNextChild: HWND = 0): HWND;
function GetWndClassName(h: HWND): String;
function HasWndChild(hParent, hSrc: HWND): Boolean;

function GetProgressMax(h: HWND): Integer; // for "msctls_progress32" class
function GetProgressPos(h: HWND): Integer; // for "msctls_progress32" class

procedure SetScreenCenterForm(aForm: TForm);

function FindWindowFromProcessName(sPName: String; bIncInvisible: Boolean = false): HWND;

function SendData(h: HWND; dwCmd: DWORD; const sData: String): LONGLONG;

implementation

uses
  Tocsg.Trace, Tocsg.Exception, Tocsg.Process;

{ TThdActiveWndMon }

Constructor TThdActiveWndMon.Create(bSync: Boolean = true);
begin
  Inherited Create;
  bSync_ := bSync;
  hActiveWnd_ := 0;
  @evNotify_ := nil;
end;

procedure TThdActiveWndMon.ProcessNotify;
begin
  if Assigned(evNotify_) and (hActiveWnd_ <> 0) then
    evNotify_(Self, hActiveWnd_);
end;

procedure TThdActiveWndMon.Execute;
var
  h, hRecentWnd: HWND;
begin
  hRecentWnd := 0;
  while not Terminated and not GetWorkStop do
  begin
    h := GetForegroundWindow;
    if h <> hRecentWnd then
    begin
      hRecentWnd := h;
      if bSync_ then
      begin
        hActiveWnd_ := h;
        Synchronize(ProcessNotify);
      end else
      if Assigned(evNotify_) then
        evNotify_(Self, h);
    end;
    Sleep(500);
  end;
end;


{ Other }

// GWL_STYLE
function GetWindowStyle(h: HWND): NativeInt;
begin
  Result := 0;
  if h <> 0 then
    Result := GetWindowLong(h, GWL_STYLE);
end;

function GetWindowStyleStr(h: HWND): String;
var
  i: Integer;
  wStyle: LongInt;
begin
  Result := '';

  wStyle := GetWindowStyle(h);
  if wStyle <> 0 then
    for i := 0 to Length(WS_VAL) - 1 do
      if (WS_VAL[i] and wStyle) = WS_VAL[i] then
      begin
        if Length(Result) > 0 then
          Result := Result + '|' + WS_STR[i]
        else
          Result := WS_STR[i];
      end;
end;


// GWL_EXSTYLE
function GetWindowExStyle(h: HWND): NativeInt;
begin
  Result := 0;
  if h <> 0 then
    Result := GetWindowLong(h, GWL_EXSTYLE);
end;


function GetWindowExStyleStr(h: HWND): String;
var
  i: Integer;
  wExStyle: LongInt;
begin
  Result := '';

  wExStyle := GetWindowExStyle(h);
  if wExStyle <> 0 then
  begin
    for i := 0 to Length(WS_EX_VAL) - 1 do
    begin
      if (WS_EX_VAL[i] and wExStyle) = WS_EX_VAL[i] then
      begin
        if Length(Result) > 0 then
          Result := Result + '|' + WS_EX_STR[i]
        else
          Result := WS_EX_STR[i];
      end;
    end;
  end;
end;

function GetWindowCaption(h: HWND): String;
var
  nLen: Integer;
  str: array of Char;
begin

  Result := '';
  nLen := GetWindowTextLength(h);
  if nLen > 0 then
  begin
    Inc(nLen); // GetWindowText()에서 1 더해줘야 정상 처리 되는 경우 있음 24_1209 13:39:07 kku

    SetLength(str, nLen);
    ZeroMemory(@str[0], nLen * 2);
    if GetWindowText(h, @str[0], nLen) <> 0 then
      Result := String(PChar(@str[0]));
  end;
end;

function GetEditText(h: HWND): String;
var
  str: array of Char;
  dwResult: DWORD;
begin
  Result := '';

  SetLength(str, 1024);
  try
//    SendMessageTimeout(h, WM_GETTEXT, 1024, LPARAM(str), SMTO_NORMAL, 3000, @dwResult);
    SendMessage(h, WM_GETTEXT, 1024, LPARAM(str));
    Result := PChar(@str[0]);
  finally
    SetLength(str, 0);
  end;
end;

procedure SetEditText(h: HWND; const sText: String);
begin
  SendMessage(h, WM_SETTEXT, 0, LPARAM(@sText[1]));
end;

function GetTopParentHWND(h: HWND): HWND;
begin
  Result := h;
  while Result <> 0  do
  begin
    if GetParent(Result) = 0 then
      exit;
    Result:= GetParent(Result);
  end;
end;

function GetWndChildClass(h: HWND; const sClassName: String; hNextChild: HWND = 0): HWND;
var
  hChild: HWND;
  arrClassName: array [0..255] of Char;
begin
  Result := 0;
  hChild := GetWindow(h, GW_CHILD);

  if hChild <> 0 then
  begin
    if hNextChild <> 0 then
      hChild := GetWindow(hNextChild, GW_HWNDNEXT);

    while hChild <> 0 do
    begin
      if GetClassName(hChild, arrClassName, SizeOf(arrClassName)) > 0 then
      begin
        if CompareMem(@arrClassName[0], @sClassName[1], Length(sClassName)) then
        begin
          Result := hChild;
          exit;
        end;
      end;

      if GetWindow(hChild, GW_CHILD) <> 0 then
      begin
        Result := GetWndChildClass(hChild, sClassName);
        if Result <> 0 then
          exit;
      end;

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

function GetWndChildByCaption(h: HWND; const sFindCaption: String; hNextChild: HWND = 0): HWND;
var
  hChild: HWND;
  sCaption: String;
begin
  Result := 0;
  hChild := GetWindow(h, GW_CHILD);

  if hChild <> 0 then
  begin
    if hNextChild <> 0 then
      while hNextChild <> hChild do
        hChild := GetWindow(hChild, GW_HWNDNEXT);

    while hChild <> 0 do
    begin
      sCaption := GetWindowCaption(hChild);
      if sCaption = sFindCaption then
      begin
        Result := hChild;
        exit;
      end;

      if GetWindow(hChild, GW_CHILD) <> 0 then
      begin
        Result := GetWndChildClass(hChild, sFindCaption);
        if Result <> 0 then
          exit;
      end;

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

function GetWndClassName(h: HWND): String;
var
  arrClassName: array [0..255] of Char;
begin
  Result := '';
  if h <> 0 then
    if GetClassName(h, arrClassName, SizeOf(arrClassName)) > 0 then
      Result := String(arrClassName);
end;

function HasWndChild(hParent, hSrc: HWND): Boolean;
var
  hChild: HWND;
begin
  Result := false;
  hChild := GetWindow(hParent, GW_CHILD);

  while hChild <> 0 do
  begin
    if hChild = hSrc then
    begin
      Result := true;
      exit;
    end;

    if HasWndChild(hChild, hSrc) then
    begin
      Result := true;
      exit;
    end;

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

function GetProgressMax(h: HWND): Integer; // for "msctls_progress32" class
const
  PBM_GETRANGE = $0407;
begin
  Result := SendMessage(h, PBM_GETRANGE, 0, 0);
end;

function GetProgressPos(h: HWND): Integer; // for "msctls_progress32" class
const
  PBM_GETPOS = $0408;
begin
  Result := SendMessage(h, PBM_GETPOS, 0, 0);
end;

procedure SetScreenCenterForm(aForm: TForm);
var
  i: Integer;
begin
  for i := 0 to Screen.MonitorCount - 1 do
    if Screen.Monitors[i].Primary then
    begin
      if (Screen.Monitors[i].Width > aForm.Width) and
         (Screen.Monitors[i].Height > aForm.Height) then
      begin
        aForm.Left := (Screen.Monitors[i].Width div 2) - (aForm.Width div 2);
        aForm.Top := (Screen.Monitors[i].Height div 2) - (aForm.Height div 2);
      end else begin
        aForm.Left := 0;
        aForm.Top := 0;
      end;
      break;
    end;
end;

function FindWindowFromProcessName(sPName: String; bIncInvisible: Boolean = false): HWND;
var
  h: HWND;
  llStyle: LONGLONG;
  sTemp: String;
begin
  Result := 0;
  try
    h := FindWindow(nil, nil);
    while h <> 0 do
    begin
      llStyle := GetWindowStyle(h);
      if bIncInvisible or
         ( ((llStyle and WS_VISIBLE) <> 0) and
           ((llStyle and WS_MINIMIZE) = 0) ) then
      begin
        sTemp := GetWindowCaption(h);
        if sTemp <> '' then
        begin
          sTemp := GetProcessNameFromWndHandle(h);
          if sTemp = sPName then
          begin
            Result := h;
            exit;
          end;
        end;
      end;
       h := GetWindow(h, GW_HWNDNEXT);
    end;
  except
    on E: ETgException do
      ETgException.TraceException(E, 'Fail .. FindWindowFromProcessName()');
  end;
end;

function SendData(h: HWND; dwCmd: DWORD; const sData: String): LONGLONG;
var
  CopyData: TCopyDataStruct;
begin
  CopyData.dwData := dwCmd;

  CopyData.cbData := (Length(sData) + 1) * 2;
  CopyData.lpData := PChar(sData);

  Result := SendMessage(h, WM_COPYDATA, 0, NativeInt(@CopyData));
  Application.ProcessMessages;
end;

end.