エクスプローラ キャプチャー

  Shell32 ( COM ) と Windows API





画面が少しちらつくの気にいらないのですが、一応使えるはずです。
フォームにタブコントロールを貼っただけ。

現在実行中のエクスプローラを捕獲します。
( IE も捕獲できるはずなんですが、いまのところ必要無いので )

終了時に最後に捕獲したエクスプローラを次の起動で再現できれば
もっといい感じになるでしょう
( 二重起動も止めないと )





  コード





  
Imports System.Runtime.InteropServices

Public Class Form1

	' ***************************************************************
	' API 定義
	' ***************************************************************
	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Private Shared Function MoveWindow( _
	ByVal hwnd As IntPtr, ByVal x As Integer, ByVal y As Integer, _
	   ByVal nWidth As Integer, ByVal nHeight As Integer, _
	   ByVal bRepaint As Integer) As Integer
	End Function

	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Public Shared Function ShowWindow(ByVal hWnd As Integer, _
	 ByVal nCmdShow As Integer _
	 ) As Integer
	End Function

	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Public Shared Function SetForegroundWindow(ByVal hWnd As Integer _
	 ) As Integer
	End Function

	Const SW_RESTORE = 9
	Const SW_HIDE = 0
	Const SW_SHOW = 5

	Private timer As Timer = New Timer()

	' ***************************************************************
	' 初期処理
	' ***************************************************************
	Private Sub Form1_Load(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.Load

		Dim obj As New Shell32.Shell()

		For Each obj2 As Object In obj.Windows

			If "System.__ComObject" = obj2.Document.ToString() Then

				Dim curDir As String = obj2.Document.Folder.Self.Path
				curDir = System.IO.Path.GetFileName(curDir)

				Dim page As New LboxTabPage( _
				 Me, _
				 curDir, _
				 obj2.HWND(), _
				 TabControl1, _
				 obj2 _
				 )
				Me.TabControl1.TabPages.Add(page)

			End If

		Next

		Try

			HideTabPage()
			Me.TabControl1.SelectTab(0)
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()

		Catch ex As Exception

		End Try

		AddHandler timer.Tick, New EventHandler(AddressOf DirChange)
		timer.Interval = 1000
		timer.Enabled = True

	End Sub


	' ***************************************************************
	' 一定時間の処理
	' ***************************************************************
	Private Sub DirChange(ByVal sender As Object, ByVal e As EventArgs)

		Try
			CType(TabControl1.SelectedTab, LboxTabPage).Change()
		Catch ex As Exception
		End Try

		Dim obj As New Shell32.Shell()

		For Each obj2 As Object In obj.Windows

			If "System.__ComObject" = obj2.Document.ToString() Then

				Dim flg As Boolean = False
				Dim PageCount As Integer = TabControl1.TabPages.Count
				Dim CurPage As LboxTabPage = Nothing
				For I As Integer = 0 To PageCount - 1
					CurPage = TabControl1.TabPages(I)
					If CurPage.curHandle = obj2.HWND() Then
						flg = True
					End If
				Next

				If Not flg Then
					Dim curDir As String = obj2.Document.Folder.Self.Path
					curDir = System.IO.Path.GetFileName(curDir)

					Dim page As New LboxTabPage( _
					 Me, _
					 curDir, _
					 obj2.HWND(), _
					 TabControl1, _
					 obj2 _
					 )
					Me.TabControl1.TabPages.Add(page)
					page.HideDir()
				End If

			End If

		Next

	End Sub

	' ***************************************************************
	' 選択した時
	' ***************************************************************
	Private Sub TabControl1_SelectedIndexChanged(ByVal sender As System.Object, _
	  ByVal e As System.EventArgs) Handles TabControl1.SelectedIndexChanged

		CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		HideTabPage()

	End Sub


	' ***************************************************************
	' サイズ変更時
	' ***************************************************************
	Private Sub Form1_ResizeEnd(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.ResizeEnd

		Try
			CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
			HideTabPage()
		Catch ex As Exception

		End Try

	End Sub

	' ***************************************************************
	' 最小化された時
	' ***************************************************************
	Private Sub Form1_Resize(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles MyBase.Resize

		If Me.WindowState = FormWindowState.Minimized Then
			Try
				HideTabPage()
				ShowWindow( _
				 CType(TabControl1.SelectedTab, LboxTabPage).curHandle, _
				 SW_HIDE)
			Catch ex As Exception

			End Try
		End If

	End Sub

	' ***************************************************************
	' 最小化されたカレントを元に戻す
	' ***************************************************************
	Private Sub TabControl1_DoubleClick(ByVal sender As System.Object, _
	ByVal e As System.EventArgs) Handles TabControl1.DoubleClick

		CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
		HideTabPage()

	End Sub

	' ***************************************************************
	' 終了時
	' ***************************************************************
	Private Sub Form1_FormClosed(ByVal sender As System.Object, _
	ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed

		timer.Enabled = False

		Dim PageCount As Integer = TabControl1.TabPages.Count
		Dim CurPage As LboxTabPage = Nothing
		Dim handle As Integer = 0
		For I As Integer = 0 To PageCount - 1
			CurPage = TabControl1.TabPages(I)
			CurPage.ShowDir()
		Next

	End Sub

	' ***************************************************************
	' 全て非表示
	' ***************************************************************
	Private Sub HideTabPage()

		Dim PageCount As Integer = TabControl1.TabPages.Count
		Dim CurPage As LboxTabPage = Nothing
		For I As Integer = 0 To PageCount - 1
			CurPage = TabControl1.TabPages(I)
			CurPage.HideDir()
		Next

	End Sub


	' ***************************************************************
	' 内部タブページ
	' ***************************************************************
	Private Class LboxTabPage
		Inherits System.Windows.Forms.TabPage

		Public curHandle As Integer
		Public TabControl As TabControl = Nothing
		Public curObject As Object
		Public baseForm As Form

		Public Sub New( _
		 ByVal base As Form, _
		 ByVal target As String, _
		 ByVal hWnd As Integer, _
		 ByVal tab As TabControl, _
		 ByVal Window As Object)

			MyBase.New(target)

			Me.curHandle = hWnd
			Me.TabControl = tab
			Me.curObject = Window
			Me.baseForm = base

		End Sub

		Public Sub SetWindow()

			Dim base As New System.Drawing.Point(-9, baseForm.ClientSize.Height - 14)
			Dim pos As System.Drawing.Point = Me.PointToScreen(base)

			SetForegroundWindow(curHandle)
			ShowWindow(curHandle, SW_RESTORE)

			MoveWindow( _
			 curHandle, _
			 pos.X + 1, _
			 pos.Y, _
			 baseForm.Width, _
			 Screen.PrimaryScreen.Bounds.Height - pos.Y - 50, _
			 1 _
			)

			ShowWindow(curHandle, SW_SHOW)
			baseForm.Activate()

		End Sub

		Public Sub HideDir()

			If CType(TabControl.SelectedTab, LboxTabPage).curHandle <> Me.curHandle Then

				Try

					ShowWindow(Me.curHandle, SW_HIDE)

					Dim base As New System.Drawing.Point( _
					 -5, _
					 baseForm.ClientSize.Height + 5 _
					 )
					Dim pos As System.Drawing.Point = Me.PointToScreen(base)

					MoveWindow( _
					 curHandle, _
					 pos.X + 1, _
					 pos.Y, _
					 baseForm.Width, _
					 Screen.PrimaryScreen.Bounds.Height - pos.Y - 50, _
					 1 _
					)

					Dim curDir As String = curObject.Document.Folder.Self.Path
					Me.Text = System.IO.Path.GetFileName(curDir)

				Catch ex As Exception

				End Try

			End If

		End Sub

		Public Sub ShowDir()

			Try

				ShowWindow(Me.curHandle, SW_SHOW)

			Catch ex As Exception

			End Try

		End Sub

		Public Sub Change()

			Try

				Dim curDir As String = curObject.Document.Folder.Self.Path
				Me.Text = System.IO.Path.GetFileName(curDir)

			Catch ex As Exception
				TabControl.TabPages.Remove(Me)
			End Try

		End Sub

	End Class

End Class
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ