'親ウィンドウの列挙
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
'子ウィンドウの列挙
Public Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Public Declare Function GetClassName _
Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long _
, ByVal lpClassName As String _
, ByVal nMaxCount As Long) As Long
'可視判定
Public Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
'キャプション取得
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'オーナーフォームを指定してハンドル取得
Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
'定数：オーナーフォームチェック用
Public Const GW_OWNER = 4
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_SETTEXT As Long = &HC
Public Const WM_COMMAND As Long = &H111
Public Const BM_CLICK = &HF5
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Public Const CB_SELECTSTRING = &H14D 'コンボボックスを選択する
Public Const CB_SETCURSEL = &H14E
Public Const CBN_SELCHANGE = &H10000
Public Const VK_RETURN As Integer = &HD
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetParent Lib "user32" _
(ByVal hWnd As Long) As Long
Public Const MOUSE_MOVED = &H1 'マウスを移動する(相対座標)
Public Const MOUSEEVENTF_ABSOLUTE = &H8000& 'MOUSE_MOVED or で絶対座標を指定
Public Const MOUSEEVENTF_LEFTUP = &H4 '左ボタンUP
Public Const MOUSEEVENTF_LEFTDOWN = &H2 '左ボタンDown
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 '中央ボタンDown
Public Const MOUSEEVENTF_MIDDLEUP = &H40 '中央ボタンUP
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 '右ボタンDown
Public Const MOUSEEVENTF_RIGHTUP = &H10 '右ボタンUP
Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Public Declare Function GetActiveWindow Lib "user32.dll" () As Long
Public Declare Function GetFocus Lib "user32.dll" () As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function PostMessageStr Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Public Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
'指定されたウィンドウを最小化します。破棄するわけではありません。
Public Declare Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long
'最小化（ アイコン化）されているウィンドウを元の位置とサイズに戻した後、アクティブにします。
Public Declare Function OpenIcon Lib "user32" (ByVal hWnd As Long) As Long
'指定されたウィンドウが最小化（ アイコン化）されているかどうかを調べます。
Public Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Public Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
'次のwindow検索
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
'子ウィンドウ取得
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Public SetRow As Integer
Public SetColumn As Integer
Public strChildProc As String
Public Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Type WNDCLASSEX
cbSize As Long '構造体のサイズ
style As Long 'クラスのスタイル
lpfnwndproc As LongPtr 'ウィンドウプロシージャへのポインタ
cbClsextra As Long 'クラス32ビット値のバイト数
cbWndExtra As Long 'ウィンドウ32ビット値のバイト数
hInstance As LongPtr 'インスタンスハンドル
hIcon As LongPtr 'アイコンのハンドル
hCursor As LongPtr 'カーソルのハンドル
hbrBackground As LongPtr 'ブラシのハンドル
lpszMenuName As String 'メニューの名
lpszClassName As String 'クラスの名前
hIconSm As LongPtr '小さいアイコンのハンドル
End Type
Type coordinate
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As coordinate) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Sub mouse_event Lib "user32" ( _
ByVal dwFlags As Long, _
Optional ByVal dx As Long = 0, _
Optional ByVal dy As Long = 0, _
Optional ByVal dwDate As Long = 0, _
Optional ByVal dwExtraInfo As Long = 0)
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'*************************************************************
'ウィンドウの位置やサイズ、表示を設定するＡＰＩ
'*************************************************************
Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
'hWndInsertAfterに指定する値の定義
Const HWND_TOP = 0 '手前にセット
Const HWND_BOTTOM = 1 '後ろにセット
Const HWND_TOPMOST = -1 '常に手前にセット
Const HWND_NOTOPMOST = -2 '常に手前を解除
'wFlagsに指定する値の定義
Const SWP_SHOWWINDOW = &H40 'ウィンドウを表示する
Const SWP_NOSIZE = &H1 'ウィンドウのサイズを変更しない
Const SWP_NOMOVE = &H2 'ウィンドウの位置を変更しない
'既存のプロセスオブジェクトのハンドルを取得(P665)
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
'指定のプロセスの終了コードを取得（P660)
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
'開かれているオブジェクトのハンドルを解放する（P1252)
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const STILL_ACTIVE = &H103&
Public Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'指定されたハンドルを持つウィンドウを強制的にアクティブにします。
Public Sub SetForceForegroundWindow(ByVal targetHandle As Long)
'ターゲットとなるスレッドを取得
Dim targetThreadId As Long
Dim currentThreadId As Long
Dim lngRet As Long
targetThreadId = GetWindowThreadProcessId(targetHandle, 0)
currentThreadId = GetWindowThreadProcessId(GetForegroundWindow, 0)
If targetThreadId <> currentThreadId Then
lngRet = AttachThreadInput(targetThreadId, currentThreadId, 1&)
End If
End Sub
Public Function MenuTitle(ByVal hWnd As Long) As String
Dim moji As String * 50
moji = String(Len(moji), vbNullChar)
Call GetMenuString(hWnd, 13, moji, Len(moji), &H400)
MenuTitle = moji
End Function
Public Function DragAndDrop(ByVal Parenthwnd As Long, ByVal hWnd As Long, ByVal addTop As Long, ByVal addLeft As Long)
Dim ret As Long
Dim myRect As RECT
'親ウィンドウ（Parenthwnd）がトップ又は指定しない場合は0と設定する
If Parenthwnd <> 0 Then
Call BringWindowToTop(Parenthwnd)
ret = GetWindowRect(hWnd, myRect)
End If
SetCursorPos myRect.Left + 10, myRect.Top + 10
mouse_event MOUSEEVENTF_LEFTDOWN
Sleep 100
mouse_event MOUSE_MOVED, addLeft, addTop, 0, 0
mouse_event MOUSEEVENTF_LEFTUP
End Function
Public Function fncMoveWindow(ByVal Parenthwnd As Long, ByVal hWnd As Long)
Dim ret As Long
Dim myRect As RECT
Call BringWindowToTop(Parenthwnd)
ret = GetWindowRect(hWnd, myRect)
' ret = SetWindowPos(hwnd, HWND_TOPMOST, myRect.Left + 230, myRect.Top, 0, _
' 0, SWP_SHOWWINDOW)
'
' ret = MoveWindow(hwnd, myRect.Left, myRect.Top, myRect.Right - myRect.Left, myRect.Bottom - myRect.Top, 1)
SetCursorPos myRect.Left, myRect.Top
Call mouse_event(2, myRect.Left + 30, myRect.Top)
'SetCursorPos myRect.Left + 30, myRect.Top
mouse_event 4 '左ボタン解放のコード
End Function
Public Function DeskTop() As RECT
Dim ret As Long
Dim myRect As RECT
'位置､サイズ情報の取得
ret = GetWindowRect(GetDesktopWindow(), myRect)
DeskTop = myRect
End Function
Public Sub ShellEnd(ProcessID As Long)
Dim hProcess As Long
Dim EndCode As Long
Dim EndRet As Long
'ハンドルを取得する
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, ProcessID)
'終わるまで待つ
Do
EndRet = GetExitCodeProcess(hProcess, EndCode)
DoEvents
Loop While (EndCode = STILL_ACTIVE)
'ハンドルを閉じる
EndRet = CloseHandle(hProcess)
End Sub
Public Function HundleClick(ByVal hWnd As Long) As Boolean
On Error GoTo err_HundleClick
HundleClick = True
Dim ret As Long
Dim myRect As RECT
'位置､サイズ情報の取得
ret = GetWindowRect(hWnd, myRect)
SetCursorPos myRect.Left, myRect.Top
mouse_event 2 '左ボタン押下のコード
mouse_event 4 '左ボタン解放のコード
Exit Function
err_HundleClick:
HundleClick = False
End Function
Public Function HundleLeft(ByVal hWnd As Long) As Long
On Error GoTo err_HundleLeft
Dim ret As Long
Dim myRect As RECT
'位置、サイズ情報の取得
ret = GetWindowRect(hWnd, myRect)
HundleLeft = myRect.Left
Exit Function
err_HundleLeft:
HundleLeft = False
End Function
Public Function HundleTop(ByVal hWnd As Long) As Long
On Error GoTo err_HundleTop
Dim ret As Long
Dim myRect As RECT
'位置、サイズ情報の取得
ret = GetWindowRect(hWnd, myRect)
HundleTop = myRect.Top
Exit Function
err_HundleTop:
HundleTop = False
End Function
Public Sub SaveHundleOutput()
Dim hWnd As Long
Dim MyName As String * 128
Dim ret As Long
Dim myFixClassName As String * 255
Dim myClassName As String
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
hWnd = CLng(GetSetting("MyTool", "Hundle", "Reg"))
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If length > 10000 Then
length = 10000
End If
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
GetClassName hWnd, myFixClassName, Len(myFixClassName)
myClassName _
= Left$(myFixClassName, InStr(myFixClassName, vbNullChar) - 1)
MyName = ""
'ハンドルのテキストを取得
ret = GetWindowText(hWnd, MyName, Len(MyName))
Cells(ActiveCell.Row, ActiveCell.Column).Value = hWnd
Cells(ActiveCell.Row, ActiveCell.Column + 1).Value = myFixClassName
Cells(ActiveCell.Row, ActiveCell.Column + 2).Value = DisplayStr
End Sub
Public Sub MouseSave()
Dim c As coordinate
GetCursorPos c
SaveSetting "MyTool", "Mouse", "X", CStr(c.x)
SaveSetting "MyTool", "Mouse", "Y", CStr(c.y)
MouseClickAndHwndSave
End Sub
Public Sub MouseSaveClear()
ThisWorkbook.Worksheets("HundleSave").Rows("2:10000").Delete Shift:=xlUp
End Sub
Public Sub MouseSaveExcel()
Dim c As coordinate
Dim MouseX As Long
Dim MouseY As Long
Dim hWnd As Long
GetCursorPos c
SetCursorPos c.x, c.y
mouse_event 2 '左ボタン押下のコード
mouse_event 4 '左ボタン解放のコード
hWnd = 0
Do While hWnd = 0
hWnd = GetForegroundWindow
Loop
Dim MyName As String * 128
Dim ret As Long
Dim myFixClassName As String * 255
Dim myClassName As String
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If length > 10000 Then
length = 10000
End If
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
GetClassName hWnd, myFixClassName, Len(myFixClassName)
myClassName _
= Left$(myFixClassName, InStr(myFixClassName, vbNullChar) - 1)
MyName = ""
'ハンドルのテキストを取得
ret = GetWindowText(hWnd, MyName, Len(MyName))
SqlExecute ("INSERT INTO [HundleSave$] ([HundleID], [ClassName], [X], [Y]) VALUES (" & CStr(hWnd) & ",'" & myClassName & "'," & CStr(c.x) & " ," & CStr(c.y) & ")")
End Sub
Public Sub ForeGroudWindowSave()
Dim hWnd As Long
Dim waitTime As Variant
hWnd = 0
Do While hWnd = 0
hWnd = GetForegroundWindow
Loop
SaveSetting "MyTool", "Hundle", "Reg", CStr(hWnd)
End Sub
Public Sub MouseClickAndHwndSave()
Dim MouseX As Long
Dim MouseY As Long
Dim hWnd As Long
MouseX = CLng(GetSetting("MyTool", "Mouse", "X"))
MouseY = CLng(GetSetting("MyTool", "Mouse", "Y"))
SetCursorPos MouseX, MouseY
mouse_event 2 '左ボタン押下のコード
mouse_event 4 '左ボタン解放のコード
hWnd = 0
Do While hWnd = 0
hWnd = GetForegroundWindow
Loop
'Hwnd = GetFocus
'Hwnd = GetForegroundWindow
SaveSetting "MyTool", "Hundle", "Reg", CStr(hWnd)
End Sub
Public Function sndComboSet(ByVal hWnd As Long, ByVal intData As Integer) As Long
sndComboSet = SendMessage(hWnd, CB_SETCURSEL, intData, 0)
Dim OyaHundle As Long
Dim ret As Long
Dim cntCount As Long
OyaHundle = GetParent(hWnd)
ret = 0
cntCount = 0
Do While (cntCount <> 100)
If intData = PostMessage(OyaHundle, WM_COMMAND, CBN_SELCHANGE, hWnd) Then Exit Do
cntCount = cntCount + 1
Loop
'Call PostMessage(OyaHundle, WM_COMMAND, CBN_SELCHANGE, hWnd)
End Function
Public Function SndMsSetText(ByVal hWnd As Long, ByVal strData As String) As Long
SndMsSetText = SendMessageStr(hWnd, WM_SETTEXT, 0, strData)
End Function
Public Function PstMsSetText(ByVal hWnd As Long, ByVal strData As String) As Long
Dim strMozi As String
Dim i As Integer
For i = 1 To Len(strData)
PostMessage hWnd, WM_CHAR, Asc(Mid(strData, i, 1)), 0
Next i
End Function
Public Function pstMsClick(ByVal hWnd As Long) As Long
pstMsClick = PostMessage(hWnd, BM_CLICK, 0, 0)
End Function
Public Function pstRightClick(ByVal hWnd As Long) As Long
Dim ret As Long
Dim cntAccess As Long
pstRightClick = 0
ret = PostMessage(hWnd, WM_RBUTTONDOWN, 0, 0)
If ret = 0 Then
Exit Function
End If
ret = PostMessage(hWnd, WM_RBUTTONUP, 0, 0)
If ret = 0 Then
Exit Function
End If
pstRightClick = ret
End Function
Public Function SndMsClick(ByVal hWnd As Long) As Long
SndMsClick = SendMessage(hWnd, BM_CLICK, 0, 0)
End Function
Public Function getText(ByVal hWnd As Long) As String
Dim ret As Long
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If length > 10000 Then
length = 10000
End If
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
getText = DisplayStr
End Function
'コールバック
Public Function GetThunderRT6FormDCList(ByVal hWnd As Long, lParam As Long) As Boolean
Dim MyName As String * 128
Dim ret As Long
Dim myFixClassName As String * 255
Dim myClassName As String
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If length > 10000 Then
length = 10000
End If
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
GetClassName hWnd, myFixClassName, Len(myFixClassName)
myClassName _
= Left$(myFixClassName, InStr(myFixClassName, vbNullChar) - 1)
MyName = ""
'ハンドルのテキストを取得
ret = GetWindowText(hWnd, MyName, Len(MyName))
'対象のハンドルが可視状態の場合
If IsWindowVisible(hWnd) Then
'対象のハンドルの情報を取得
If GetWindow(hWnd, GW_OWNER) = 0 Then
'テキストが取得できた場合
If InStr(myClassName, "ThunderRT6FormDC") > 0 Then
Cells(SetRow, SetColumn).Value = hWnd
Cells(SetRow, SetColumn + 1).Value = MyName
Cells(SetRow, SetColumn + 2).Value = DisplayStr
Cells(SetRow, SetColumn + 3).Value = myWndTitle
SetRow = SetRow + 1
End If
End If
End If
GetThunderRT6FormDCList = True
End Function
Public Function GetProc(ByVal hWnd As Long, lParam As Long) As Boolean
Dim MyName As String * 128
Dim ret As Long
Dim myFixClassName As String * 255
Dim myClassName As String
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
GetClassName hWnd, myFixClassName, Len(myFixClassName)
myClassName _
= Left$(myFixClassName, InStr(myFixClassName, vbNullChar) - 1)
MyName = ""
'ハンドルのテキストを取得
ret = GetWindowText(hWnd, MyName, Len(MyName))
'対象のハンドルが可視状態の場合
If IsWindowVisible(hWnd) Then
'対象のハンドルの情報を取得
If GetWindow(hWnd, GW_OWNER) = 0 Then
'テキストが取得できた場合
' If ret <> 0 Then
' Debug.Print MyName & vbCrLf
' End If
Cells(SetRow, SetColumn).Value = hWnd
Cells(SetRow, SetColumn + 1).Value = MyName
Cells(SetRow, SetColumn + 2).Value = DisplayStr
Cells(SetRow, SetColumn + 3).Value = myWndTitle
SetRow = SetRow + 1
End If
End If
GetProc = True
End Function
'ここからはフォームの処理です
Public Sub ChildListSet()
Dim ret As Long
Dim parmhWnd As Long
SetRow = ActiveCell.Row + 1
SetColumn = ActiveCell.Column
Cells(ActiveCell.Row, SetColumn).Value = "親ウィンドウ(10)"
Cells(ActiveCell.Row, SetColumn + 1).Value = "'(16)"
Cells(ActiveCell.Row, SetColumn + 2).Value = "子ウィンドウ(10)"
Cells(ActiveCell.Row, SetColumn + 3).Value = "'(16)"
Cells(ActiveCell.Row, SetColumn + 4).Value = "WindowName"
Cells(ActiveCell.Row, SetColumn + 5).Value = "クラス"
Cells(ActiveCell.Row, SetColumn + 6).Value = "設定内容"
ret = EnumChildWindows(parmhWnd, AddressOf EnumChildProc, 0)
End Sub
'ここからはフォームの処理です
Public Function ChildSearchSet(ByVal strClass As String, ByVal strStart As String, ByVal strEnd As String) As Long
Dim ret As Long
Dim parmhWnd As Long
parmhWnd = GetDesktopWindow()
SearchClassName = strClass
SearchWindowNameStart = strStart
SearchWindowNameEnd = strEnd
ret = EnumChildWindows(parmhWnd, AddressOf GetFormCreateFormList, 0)
ChildSearchSet = Type_Edt_SearchhWnd
End Function
'ここからはフォームの処理です
Public Sub ChildRT6FormDCListListSet()
Dim ret As Long
Dim parmhWnd As Long
parmhWnd = GetDesktopWindow
SetRow = ActiveCell.Row
SetColumn = ActiveCell.Column
ret = EnumChildWindows(parmhWnd, AddressOf GetThunderRT6FormDCList, 0)
End Sub
Public Function GetFormCreateFormList(ByVal hWnd As Long, lParam As Long) As Long
Dim ret As Long
Dim Leng As Long
Dim Name As String
Dim myFixClassName As String * 255
Dim myClassName As String
Dim myWndTitle As String * 1000
GetClassName hWnd, myFixClassName, Len(myFixClassName)
myClassName _
= Left$(myFixClassName, InStr(myFixClassName, vbNullChar) - 1)
GetWindowText hWnd, myWndTitle, 1000
'バッファ確保
Name = String(255, Chr(0))
Leng = Len(Name)
'名前を取得する
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If length > 100000 Then
length = 100000
End If
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
If myClassName = SearchClassName Then
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
If Left(DisplayStr, Len(SearchWindowNameStart)) = SearchWindowNameStart Then
If Right(DisplayStr, Len(SearchWindowNameEnd)) = SearchWindowNameEnd Then
Type_Edt_SearchhWnd = hWnd
GetFormCreateFormList = 0
Exit Function
End If
End If
End If
'If Ret <> 0 Then Form1.List1.AddItem Name
DoEvents
GetFormCreateFormList = 1
End Function
Public Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
Dim ret As Long
Dim Leng As Long
Dim Name As String
Dim myFixClassName As String * 255
Dim myClassName As String
Dim myWndTitle As String * 1000
GetClassName hWnd, myFixClassName, Len(myFixClassName)
myClassName _
= Left$(myFixClassName, InStr(myFixClassName, vbNullChar) - 1)
GetWindowText hWnd, myWndTitle, 1000
'バッファ確保
Name = String(255, Chr(0))
Leng = Len(Name)
'名前を取得する
Dim length As Long '表示部の文字列のバイト数を調べる
Dim DisplayStr As String
length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If length > 100000 Then
length = 100000
End If
DisplayStr = String(length, vbNullChar)
ret = SendMessageStr(hWnd, WM_GETTEXT, length + 1, DisplayStr)
Cells(SetRow, SetColumn).Value = GetParent(hWnd)
Cells(SetRow, SetColumn + 1).Value = ConvertDecHex(GetParent(hWnd))
Cells(SetRow, SetColumn + 2).Value = hWnd
Cells(SetRow, SetColumn + 3).Value = ConvertDecHex(hWnd)
Cells(SetRow, SetColumn + 4).Value = Name
Cells(SetRow, SetColumn + 5).Value = myClassName
Cells(SetRow, SetColumn + 6).Value = DisplayStr
SetRow = SetRow + 1
'If Ret <> 0 Then Form1.List1.AddItem Name
EnumChildProc = 1
End Function
Function ConvertDecHex(Num_Dec As Long) As String
Dim sTemp As String
If Num_Dec >= 16 Then
'if greater than 16 then
'call recursively this function
sTemp = ConvertDecHex(Num_Dec \ 16) _
& ConvertDecHex(Num_Dec Mod 16)
ElseIf Num_Dec > 9 Then
'if within 10 to 15 then assign A...F
Select Case Num_Dec
Case 10: sTemp = "A"
Case 11: sTemp = "B"
Case 12: sTemp = "C"
Case 13: sTemp = "D"
Case 14: sTemp = "E"
Case 15: sTemp = "F"
End Select
Else
'If within 0 to 9 then no change
sTemp = Num_Dec
End If
ConvertDecHex = sTemp
End Function
'親直下の同階層の数指定
Public Function hWndSerach(ByVal hWnd_Parent As Long, ByVal hWnd_Count As Integer) As Long
Dim rtn_hWnd As Long
Dim iCount As Integer
rtn_hWnd = 0
For iCount = 1 To hWnd_Count
rtn_hWnd = FindWindowEx(hWnd_Parent, rtn_hWnd, vbNullString, vbNullString)
Next iCount
hWndSerach = rtn_hWnd
End Function