|
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 obj As New Shell32.Shell()
' ***************************************************************
' 初期処理
' ***************************************************************
Private Sub Form1_Load(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.Load
' 本体の初期位置と初期サイズ( タブコントロールはアンカーで処理 )
Me.Left = 0
Me.Top = 0
Me.Width = Screen.PrimaryScreen.Bounds.Width
' 初期の捕獲
For Each obj2 As Object In obj.Windows
If "mshtml.HTMLDocumentClass" = obj2.Document.ToString() Then
Dim page As New LboxTabPage( _
Me, _
obj2.Document.title, _
obj2.HWND(), _
TabControl1, _
obj2 _
)
Me.TabControl1.TabPages.Add(page)
End If
Next
' 先頭タブを選択
Try
If TabControl1.TabCount <> 0 Then
Me.TabControl1.SelectTab(0)
CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
End If
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)
timer.Enabled = False
If TabControl1.TabCount <> 0 Then
' 選択されているタブのタイトルを変更する
Dim CurPage As LboxTabPage = TabControl1.SelectedTab
CurPage.Change()
' イベントにより、タイトルが変更されている場合変更する
Dim PageCount As Integer = TabControl1.TabPages.Count
For I As Integer = 0 To PageCount - 1
CurPage = TabControl1.TabPages(I)
If CurPage.testFlg Then
CurPage.Change()
CurPage.testFlg = False
End If
Next
End If
For Each obj2 As Object In obj.Windows
Try
If Not obj2.Busy Then
If "mshtml.HTMLDocumentClass" = obj2.Document.ToString() Then
' 重複しないように新規の IE を登録
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 page As LboxTabPage
page = New LboxTabPage( _
Me, _
obj2.Document.title, _
obj2.HWND(), _
TabControl1, _
obj2 _
)
' 該当 IE を登録
Me.TabControl1.TabPages.Add(page)
' 該当 IE を前面に表示
page.SetWindow()
' 追加されたタブを選択
Me.TabControl1.SelectTab(Me.TabControl1.TabCount - 1)
End If
End If
End If
Catch ex As Exception
End Try
Next
timer.Enabled = True
End Sub
' ***************************************************************
' 選択した時
' ***************************************************************
Private Sub TabControl1_SelectedIndexChanged(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles TabControl1.SelectedIndexChanged
timer.Enabled = False
If TabControl1.TabCount <> 0 Then
CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
End If
timer.Enabled = True
End Sub
' ***************************************************************
' サイズ変更時
' ***************************************************************
Private Sub Form1_ResizeEnd(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.ResizeEnd
timer.Enabled = False
If TabControl1.TabCount <> 0 Then
CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
End If
timer.Enabled = True
End Sub
' ***************************************************************
' 最小化されたカレントを元に戻す
' ***************************************************************
Private Sub TabControl1_DoubleClick(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles TabControl1.DoubleClick
timer.Enabled = False
If TabControl1.TabCount <> 0 Then
CType(TabControl1.SelectedTab, LboxTabPage).SetWindow()
End If
timer.Enabled = True
End Sub
' ***************************************************************
' 終了時
' ***************************************************************
Private Sub Form1_FormClosed(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed
timer.Enabled = False
If TabControl1.TabCount <> 0 Then
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)
Next
End If
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 testFlg As Boolean = False
Private web As SHDocVw.WebBrowser
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
web = Window
AddHandler web.DocumentComplete, AddressOf inner_DocumentComplete
AddHandler web.BeforeNavigate2, AddressOf inner_BeforeNavigate2
AddHandler web.NavigateComplete2, AddressOf inner_NavigateComplete2
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)
Try
If Not curObject.Busy Then
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_RESTORE)
'baseForm.Activate()
End If
Catch ex As Exception
TabControl.TabPages.Remove(Me)
End Try
End Sub
Public Sub Change()
Try
If Not curObject.Busy Then
Dim str As String = curObject.Document.title.ToString()
If str.Length > 10 Then
Me.Text = str.Substring(0, 10)
Else
Me.Text = str
End If
End If
Catch ex As Exception
TabControl.TabPages.Remove(Me)
End Try
End Sub
Private Sub inner_DocumentComplete( _
ByVal pDisp As Object, _
ByRef URL As Object)
testFlg = True
#If DEBUG Then
Dim str As String = pDisp.Document.title + ":" + URL.ToString()
Console.WriteLine("DocumentComplete:" + str)
#End If
End Sub
Private Sub inner_BeforeNavigate2( _
ByVal pDisp As Object, _
ByRef url As Object, _
ByRef Flags As Object, _
ByRef TargetFrameName As Object, _
ByRef PostData As Object, _
ByRef Headers As Object, _
ByRef Cancel As Boolean)
#If DEBUG Then
Dim str As String = pDisp.Document.title + ":" + url.ToString()
Console.WriteLine("BeforeNavigate2:" + str)
#End If
End Sub
Private Sub inner_NavigateComplete2( _
ByVal pDisp As Object, _
ByRef URL As Object)
#If DEBUG Then
Dim str As String = pDisp.Document.title + ":" + URL.ToString()
Console.WriteLine("NavigateComplete2:" + str)
#End If
End Sub
End Class
End Class
| |