喫茶XRAYトップページ

[スレッド全体
]

[10975] 起動したアプリをTOPMOSTにする返信 削除
2017/3/28 (火) 18:53:24 Mr.XRAY
[ShellExecuteで表示された画面が隠れないようにするには?]
https://forums.embarcadero.com/thread.jspa?threadID=248197&tstart=0

相変わらず変わりませんな.

起動したアプリを最前面にするには,普通に ShellExecute 等で起動すれば,
自動で最前面になります.
しかし,TOPMOST,つまり,Delphi でいうこところの TForm.FormStyle := fsStayOnTop
の状態にするには,SetWindowPos 関数で設定しないとなりません.

ウィンドウを操作するには,そのウィンドウのハンドルが必要です.
ShellExecute で起動した場合,ウィンドウハンドルの取得が面倒なので,
ShellExecuteEx 関数を使用しています.
詳しくは,ZIP ファイルをダウンロードして確認してください.


//=============================================================================
//  指定ブラウザのアプリでウェブページを表示
//  ブラウザは新規起動を前提としている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LExeName    : string;
  LCmdLine    : string;
  LGetWndFlag : Boolean;
begin
  LExeName := '';
  if RadioGroup1.ItemIndex = 0 then begin
    LExeName := GetRelatedExeName('.html');
  end else
  if RadioGroup1.ItemIndex = 1 then begin
    LExeName := 'iexplore.exe';
  end else
  if RadioGroup1.ItemIndex = 2 then begin
    LExeName := 'firefox.exe';
  end else
  if RadioGroup1.ItemIndex = 3 then begin
    LExeName := 'chrome.exe';
  end;


  LCmdLine := 'http://mrxray.on.coocan.jp/index.htm';

  //アプリ起動
  LGetWndFlag := (FCurrentExeName <> LExeName);
  FTargetWnd := RunExeFile(0, LExeName, LCmdLine, '', SW_SHOW, LGetWndFlag);

  if FTargetWnd > 0 then begin
    FCurrentExeName := LExeName;
    //Zオーダのトップに
    SetHWND_TOPMOST_Window(FTargetWnd);
  end;
end;

//-----------------------------------------------------------------------------
//  指定したウィンドウをHWND_TOPMOSTにする
//  これはDelphiで言えばTForm.FormStyle := fsStayOnTopと同じ
//-----------------------------------------------------------------------------
procedure TForm1.SetHWND_TOPMOST_Window(hWindow: HWND);
begin
  SetWindowPos(hWindow, HWND_TOPMOST, 0, 0, 0, 0,
               SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
end;


当サイト (Habow 資料館のコードも含めて) に同様のコードがありますが,
メモ帳程度であればウィンドウハンドルの取得は,ネット上のコードで十分可能です.
ブラウザは,プロセスID が取得できても,実際にウィンドウハンドルが取得可能に
なるまでに時間がかかる場合があります.
そこで,以下の工夫をしています.


        LWaitCount  := 0;
        LdwIDOrigin := GetProcessId(LShellExeInfo.hProcess);

        //最初のSleepを10にしてループ回数を大きな値にする
        //重たいアプリの対応策
        repeat
          Sleep(10);
          LTargetWnd := LdwIDOrigin;
          EnumWindows(@EnumTopWindow, LPARAM(@LTargetWnd));
          if LTargetWnd <> LdwIDOrigin then begin
            Result := LTargetWnd;
            break;
          end;
          Inc(LWaitCount);
        until IsWindow(LTargetWnd) or (LWaitCount > 50000);
      end;


ちなみに,

>折角助言頂きましたが、私はWindowsAPIに精通しておりませんので、
>すぐには役立てることができません。


プロとして,自分が開発したアプリを販売している立場の人が言うことではありません.
ハッキリ言って.
精通も便通もありません.
いや,便通はあった方がいいです.

サンプルのコードは,新規にブラウザを起動することを前提にしています.
Form1 の FormStyle の値は fsNormal となっていますが,
fsStayOnTop にしても動作します.
例によって,動作確認は Windows7 U64(SP1) + Delphi XE(UP1) Pro です.

しかし,何故 FormStyle := fsStayOnTop; なんだろう ?


[plBrowseURL_TOPMOST.zip]  544 KB
http://mrxray.on.coocan.jp/Delphi/zip/plBrowseURL_TOPMOST.zip



[10978] Re:起動したアプリをTOPMOSTにする返信 削除
2017/3/28 (火) 21:48:42 Mr.XRAY
> サンプルのコードは,新規にブラウザを起動することを前提にしています.

起動中のブラウザに対応したコードを追加しました.
ただし,IE11 は起動中のウィンドウに対して操作しても TOPMOST になりません.

[plBrowseURL_TOPMOST.zip]  1,160 KB
http://mrxray.on.coocan.jp/Delphi/zip/plBrowseURL_TOPMOST.zip

起動中のブラウザのハンドルの取得は,以下のコードを使用しています.


//-----------------------------------------------------------------------------
//  指定プロセスの起動をチェック
//  戻り値はそのプロセスのウィンドウのハンドル値
//  Toolhelp32Snapshotを使用する方法
//
//  CreateToolhelp32Snapshotの使用には,usesにTlhelp32が必要
//-----------------------------------------------------------------------------
function TForm1.CheckRunExe(RunExeName: string): THandle;
const
  MAX_PROCCOUNT = 2048;
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  PROCESS_NAME_NATIVE = 1;
var
  LListHandle : THandle;
  LProcEntry  : TProcessEntry32;
  LProcessID  : DWORD;
  LTargetWnd  : THandle;
  LExePath    : String;
begin
  Result := 0;
  //デバッグの特権を有効にする
  Privilege.SetPrivilege(SE_DEBUG_NAME, True);

  //プロセスのスナップショットのハンドルを取得
  LListHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if LListHandle > 0 then begin
    try
      //最初のプロセスに関する情報をTProcessEntry32レコード型に取得
      LProcEntry.dwSize := SizeOf(TProcessEntry32);
      Process32First(LListHandle, LProcEntry);
      repeat
        //パス名とプロセスIDを取得
        LExePath := LProcEntry.szExeFile;

        if LowerCase(LExePath) = LowerCase(RunExeName) then begin
          LProcessID := LProcEntry.th32ProcessID;
          LTargetWnd := LProcessID;
          EnumWindows(@EnumTopWindow, LPARAM(@LTargetWnd));
          if LTargetWnd <> LProcessID then begin
            Result := LTargetWnd;
            Break;
          end;
        end;

      //次のプロセスに関する情報をTProcessEntry32レコード型に取得
      until Process32Next(LListHandle, LProcEntry) = False;
    finally
      CloseHandle(LListHandle);
    end;
  end;
end;


[10979] Re2:起動したアプリをTOPMOSTにする返信 削除
2017/3/28 (火) 22:37:00 Mr.XRAY
▼ Mr.XRAYさん
 
> 起動中のブラウザに対応したコードを追加しました.
> ただし,IE11 は起動中のウィンドウに対して操作しても TOPMOST になりません.


ハイ.また追加しました.
今度は,自分で起動したブラウザが終了まで待つサンプルです.
「自分で起動して」ですから,既に起動中の場合は何もしません.
>
[plBrowseURL_TOPMOST.zip]  1,697 KB
http://mrxray.on.coocan.jp/Delphi/zip/plBrowseURL_TOPMOST.zip



[10980] Re3:起動したアプリをTOPMOSTにする返信 削除
2017/3/28 (火) 23:10:14 Mr.XRAY
ハイ.さらに追加しました.

今度は,ブラウザの終了を自動検出します.
WMI のイベントシンクを使用しています.
 
[plBrowseURL_TOPMOST.zip]  2,336 KB
http://mrxray.on.coocan.jp/Delphi/zip/plBrowseURL_TOPMOST.zip

イベントシンクのコードは以下のようになっています.

//-----------------------------------------------------------------------------
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と,この実装部はWbemScripting_TLBのコードをコピペ
//-----------------------------------------------------------------------------
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject;
  const objWbemAsyncContext: ISWbemNamedValueSet);
var
  LPropVal   : OleVariant;
  LPropValue : OleVariant;
  LText      : string;
begin
  LPropVal   := objWbemObject;
  LPropValue := LPropVal.TargetInstance;

  if VarToStr( LPropVal.Path_.Class) = '__InstanceDeletionEvent' then begin
    if FCloseDlgFlag = False then begin
      FCloseDlgFlag := True;
      LText := 'ブラウザが閉じられました';
      MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);

      SetActiveWindow(Handle);
      SetForegroundWindow(Handle);
    end;
  end;
end;


UP したサンプルコードは,当サイトのサンプル記事のコードをコピペ
して,少し修正を加えだものでごさいます.



[▼次のスレッド]
INCM/CMT
Cyclamen v3.82