unit WindowUnit;

interface

uses
  SysUtils,
  Forms,
  Windows,
  Messages,
  TLHelp32,
  Types,
  Controls,
  Graphics,
  RectPointUnit,
  XPtest;

function GetProcessIDFromWinHandle(Handle: hWnd): Cardinal;
function GetProcessFileNameFromWinHandle(Handle: hWnd): String;
function GetWindowState(WndHandle: HWnd): TWindowState;
procedure SetWinRect(Handle: THandle; Rect: TRect);
function GetWinRect(AHandle: THandle): TRect;

function NoneTaskBarDesktopRect: TRect;
function UsingMonitorRect: TRect;
function GetDesktopTop: Integer;
function GetDesktopLeft: Integer;
function GetDesktopHeight: Integer;
function GetDesktopWidth: Integer;
function GetDesktopRect: TRect;
function IsTopMostWnd(Target: HWND): boolean;
procedure SetTopMostWnd(Target: HWND; const Value: Boolean);

function SetLayeredWindowAttributes(hwnd: HWND; crKey: COLORREF;
 bAlpha: BYTE; dwFlags: DWORD): BOOL; stdcall;

function SetExStyle(WinHandle: Hwnd): Boolean;

procedure SetTransparent(WinHandle: Hwnd; Value: Byte);
procedure SetTransparentFadeOut(WinHandle: Hwnd; Value: Byte; Step: Byte = 8);
procedure SetTransparentFadeOutMulti(Handles: array of DWORD; Value: Byte; Step: Byte = 8);
procedure SetTransparentFadeIn(WinHandle: Hwnd; Value: Byte; Step: Byte = 8);
procedure SetTransparentFadeInMulti(Handles: array of DWORD; Value: Byte; Step: Byte = 8);

function ForceForegroundWindow(hwnd: THandle): Boolean;

implementation


{-------------------------------
//  ハンドルからProcessIDを得る関数
機能:
備考:       uses TLHelp32;
参考:[Delphi:70691] Re: 実行ファイルのフルパスの取得(win2000)
履歴:       2006/05/07(日) 17:18
//------------------------------}
function GetProcessIDFromWinHandle(Handle: hWnd): Cardinal;
var
  PID: Cardinal;
begin
  Result := 0;
  // ハンドルから作成スレッドを調べてプロセスＩＤを得る
  GetWindowThreadProcessId(Handle, Result);
end;
//------------------------------

{-------------------------------
//  ハンドルからファイル名フルパスを得る関数
機能:
備考:       uses TLHelp32;
参考:[Delphi:70691] Re: 実行ファイルのフルパスの取得(win2000)
履歴:       2006/05/07(日) 17:18
//------------------------------}
function GetProcessFileNameFromWinHandle(Handle: hWnd): String;
var
  PID: Cardinal;
  SnapShot: THandle;
  ModuleEntry32: TModuleEntry32;
begin
  Result := '';
  // ハンドルから作成スレッドを調べてプロセスＩＤを得る
  GetWindowThreadProcessId(Handle, PID);

  // TModuleEntry32構造体の初期化
  ModuleEntry32.dwSize := SizeOf( TModuleEntry32 );

  // システム中の情報のスナップショットをとる
  SnapShot := CreateToolhelp32Snapshot( TH32CS_SNAPMODULE, PID);
  try
    // 最初のモジュールの検索
    if Module32First( SnapShot, ModuleEntry32 ) then
      Result := string( ModuleEntry32.szExePath );
  finally
    CloseHandle( SnapShot );
  end;
end;
//------------------------------

(*-------------------------------
//ハンドルからWindowStateを調べる
引数説明:   WndHandle: ハンドル
  -------------------------------*)
function GetWindowState(WndHandle: HWnd): TWindowState;
var
  pw : TWINDOWPLACEMENT;
begin
  Result := wsNormal;
  pw.length := SizeOf(TWINDOWPLACEMENT);
  GetWindowPlacement(WndHandle, @pw);

  case pw.showCmd of
    SW_SHOWNORMAL:{=1}
      Result := wsNormal;
    SW_SHOWMINIMIZED: {=2}
      Result := wsMinimized;
    SW_MAXIMIZE: {=3}
      Result := wsMaximized;
  else
//    raise Exception.Create('WindowStateのエラー'+IntToStr(pw.showCmd));
    Assert(False, 'WindowStateのエラー');
  end;
end;

{-------------------------------
//  Windowを指定位置に移動させる処理          
機能:
備考:
履歴:       2006/05/24(水) 00:41
//------------------------------}
//↓廃止予定
//procedure MoveWindowRect(Handle: THandle; Rect: TRect);
//begin
//  MoveWindow(Handle, Rect.Left, Rect.Top,
//             GetRectWidth(Rect), GetRectHeight(Rect), True);
//end;
procedure SetWinRect(Handle: THandle; Rect: TRect);
begin
  MoveWindow(Handle, Rect.Left, Rect.Top,
             GetRectWidth(Rect), GetRectHeight(Rect), True);
end;
function GetWinRect(AHandle: THandle): TRect;
begin
  GetWindowRect(AHandle, Result);
end;
//------------------------------

(*-------------------------------
//タスクバーを除いたデスクトップの大きさを求める
備考:       タスクバーのプロパティが
            『常に手前に表示ON』『自動で隠すOFF』
            の場合だけがResult.Top/Leftが0でなくなり
            Screen.Height/Width値とずれることになる
履歴:       2000/11/07
  -------------------------------*)
function NoneTaskBarDesktopRect: TRect;
var
  rectDesktop  :  TRect;
begin
  Result := Rect(0,0,0,0);
  if  SystemParametersInfo(SPI_GETWORKAREA, 0, @rectDesktop, 0)  then
  begin
    Result := rectDesktop;
  end;
end;

{-------------------------------
//  マルチディスプレイ環境でマウスのあるモニターのRectを返す関数         
機能:       
備考:       
履歴:       2006/05/17(水) 11:55
//------------------------------}
function UsingMonitorRect: TRect;
var
  i: Integer;
begin
  for i := 0 to Screen.MonitorCount - 1 do
  begin
    if PointInRect(Mouse.CursorPos, Screen.Monitors[i].WorkareaRect) then
    begin
      if Screen.Monitors[i].Primary then
      begin
        Result := NoneTaskBarDesktopRect;
      end else
      begin
        Result := Screen.Monitors[i].WorkareaRect;
      end;
    end;
  end;
end;
//------------------------------


{-------------------------------
//  デスクトップサイズを求める
機能:       マルチディスプレイ環境でも全てのウィンドウ含めた
            デスクトップサイズを求める事ができる
備考:       TScreen.Desktop系プロパティからの抜粋
履歴:       2006/04/28(金) 22:00
              作成
//------------------------------}
function GetDesktopTop: Integer;
begin
  Result := GetSystemMetrics(SM_YVIRTUALSCREEN);
end;

function GetDesktopLeft: Integer;
begin
  Result := GetSystemMetrics(SM_XVIRTUALSCREEN);
end;

function GetDesktopHeight: Integer;
begin
  Result := GetSystemMetrics(SM_CYVIRTUALSCREEN);
end;

function GetDesktopWidth: Integer;
begin
  Result := GetSystemMetrics(SM_CXVIRTUALSCREEN);
end;

function GetDesktopRect: TRect;
begin
  Result := Bounds(GetDesktopLeft, GetDesktopTop, GetDesktopWidth, GetDesktopHeight);
end;
//------------------------------

{-------------------------------
//  ハンドルから最善面かどうかを調べる関数
機能:
備考:
履歴:       2006/05/24(水) 01:28
//------------------------------}
function IsTopMostWnd(Target: HWND): boolean;
begin
  Result := ((GetWindowLong(Target, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0);
end;

procedure SetTopMostWnd(Target: HWND; const Value: Boolean);
begin
  if Value then
  begin
    SetWindowPos(Target, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  end else
  begin
    SetWindowPos(Target, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  end;
end;
//------------------------------


{-------------------------------
//  透明化API処理
機能:       SetLayeredWindowAttributesのAPI宣言
引数説明:   hwnd : HWND     透明にするウィンドウのハンドル
            crKey: COLORREF 透過色
            bAlpha: BYTE    透過度合 (0 = 完全透明 255 = 不透明)
            dwFlags: DWORD  アクションフラグ(LWA_COLORKEY, LWA_ALPHA)
            LWA_COLORKEY 透明色として crKey を使います。
            LWA_ALPHA    bAlpha を使って、レイヤードウィンドウの不透明度を決定します。
備考:
↓使用例
begin
  SetLayeredWindowAttributes(
    Handle, ColorToRGB(clWindow), 200, LWA_ALPHA or LWA_COLORKEY);
end;
↓SetLayeredWindowAttributes APIの詳細は以下のURLを参照
http://www.microsoft.com/japan/developer/library/psdk/jpuipf/_Win32_SetLayeredWindowAttributes.htm
参考:
・	サンプル: "透明なウィンドウ(Windows2000のみ)"
	http://forum.nifty.com/fdelphi/samples/00998.html
・	Nichiyo Delphian, Tips & Samples for Delphi
	http://www.d1.dion.ne.jp/~aide/misc/deltips/deltip06.html
・	[Delphi:44902] Win2k での半透明ウィンドウ
履歴:       2005/08/15
//------------------------------}
//↓Interface部にも以下のような宣言が必要
//function SetLayeredWindowAttributes(hwnd: HWND; crKey: COLORREF;
// bAlpha: BYTE; dwFlags: DWORD): BOOL; stdcall;

const
  WS_EX_LAYERED = $80000;
  LWA_COLORKEY  = 1;
  LWA_ALPHA     = 2;

function SetLayeredWindowAttributes; external 'user32.dll' name 'SetLayeredWindowAttributes';

function SetExStyle(WinHandle: Hwnd): Boolean;
var
  APIReturn1, APIReturn2: Longint;
  i: Integer;
begin
  Result := False;
  APIReturn1 := GetWindowLong(WinHandle, GWL_EXSTYLE);
  if not ((APIReturn1 and WS_EX_LAYERED) = WS_EX_LAYERED) then
  begin
    SetWindowLong(WinHandle, GWL_EXSTYLE, APIReturn1 or WS_EX_LAYERED);
    {↑なんかちらつく}

    i := 1;
    while (SetLayeredWindowAttributes(WinHandle, 0, 255, LWA_ALPHA)=False) do
    begin
      if 10 <= i then
      begin
        Result := False;
        Exit;
      end;
      Inc(i)
    end; {↑透明化処理をONにするために不透明設定をかっきりと指定してやる}

    Result := True;
  end;
end;

procedure SetTransparent(WinHandle: Hwnd; Value: Byte);
begin
  SetLayeredWindowAttributes(WinHandle, 0, Value, LWA_ALPHA);
end;

//透明になっていく
procedure SetTransparentFadeOut(WinHandle: Hwnd; Value: Byte;
 Step: Byte = 8);
var
  i: Integer;
begin
  for i := 255 downto Value do
  begin
    if (i mod Step) <> 0 then continue;

    SetTransparent(WinHandle, i);
  end;
  SetTransparent(WinHandle, Value);
end;

procedure SetTransparentFadeOutMulti(Handles: array of DWORD; Value: Byte;
 Step: Byte = 8);
var
  i, j: Integer;
begin
  for i := 255 downto Value do
  begin
    if (i mod Step) <> 0 then continue;

    for j := 0 to Length(Handles) - 1 do
    begin
      SetTransparent(Handles[j], i);
    end;
  end;
  for j := 0 to Length(Handles) - 1 do
  begin
    SetTransparent(Handles[j], Value);
  end;
end;


//不透明になる
procedure SetTransparentFadeIn(WinHandle: Hwnd; Value: Byte;
 Step: Byte = 8);
var
  i: Integer;
begin
  for i := Value to 255 do
  begin
    if (i mod Step) <> 0 then continue;

    SetTransparent(WinHandle, i);
  end;
  SetTransparent(WinHandle, 255);
end;

procedure SetTransparentFadeInMulti(Handles: array of DWORD; Value: Byte;
 Step: Byte = 8);
var
  i, j: Integer;
begin
  for i := Value to 255 do
  begin
    if (i mod Step) <> 0 then continue;

    for j := 0 to Length(Handles) - 1 do
    begin
      SetTransparent(Handles[j], i);
    end;
  end;
  for j := 0 to Length(Handles) - 1 do
  begin
    SetTransparent(Handles[j], 255);
  end;
end;
//------------------------------


function ForceForegroundWindow(hwnd: THandle): Boolean;
const
  SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
  ForegroundThreadID: DWORD;
  ThisThreadID: DWORD;
  timeout: DWORD;
begin
  if IsIconic(hwnd) then ShowWindow(hwnd, SW_RESTORE);

  if GetForegroundWindow = hwnd then Result := True
  else
  begin
    // Windows 98/2000 doesn't want to foreground a window when some other
    // window has keyboard focus

    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
      ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
      (Win32MinorVersion > 0)))) then
    begin
      // Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
      // Converted to Delphi by Ray Lischner
      // Published in The Delphi Magazine 55, page 16

      Result := False;
      ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil);
      ThisThreadID := GetWindowThreadPRocessId(hwnd, nil);
      if AttachThreadInput(ThisThreadID, ForegroundThreadID, True) then
      begin
        BringWindowToTop(hwnd); // IE 5.5 related hack
        SetForegroundWindow(hwnd);
        AttachThreadInput(ThisThreadID, ForegroundThreadID, False);
        Result := (GetForegroundWindow = hwnd);
      end;
      if not Result then
      begin
        // Code by Daniel P. Stasinski
        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),
          SPIF_SENDCHANGE);
        BringWindowToTop(hwnd); // IE 5.5 related hack
        SetForegroundWindow(hWnd);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
      end;
    end
    else
    begin
      BringWindowToTop(hwnd); // IE 5.5 related hack
      SetForegroundWindow(hwnd);
    end;

    Result := (GetForegroundWindow = hwnd);
  end;
end; { ForceForegroundWindow }



end.