I was able to inject a combobox to the ToolbarWindow32 control. :-)
Code: Select all
'Coded by UEZ
#Include "windows.bi"
#include "win\tlhelp32.bi"
#Include "win\commctrl.bi"
#Include "win\windowsx.bi"
Dim Shared As HWND hToolbar = 0, hCombobox, hParentHWND
Dim Shared As Integer iCtrlID
Const idTimer = -1
Declare Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
Function _WinAPI_GetParentProcess() As Integer
Dim As DWORD pid = GetCurrentProcessId(), pid_parent = 0
Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Dim As PROCESSENTRY32 tPROCESSENTRY32
tPROCESSENTRY32.dwSize = Sizeof(tPROCESSENTRY32)
Process32First(hSnapshot, @tPROCESSENTRY32)
While TRUE
If tPROCESSENTRY32.th32ProcessID = pid Then
pid_parent = tPROCESSENTRY32.th32ParentProcessID
Exit While
End If
Process32Next(hSnapshot, @tPROCESSENTRY32)
Wend
CloseHandle(hSnapshot)
Return pid_parent
End Function
Sub _WinAPI_GetProcessThreads(pid As DWORD, aThreads() As Integer)
Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0)
Dim As THREADENTRY32 tTHREADENTRY32
tTHREADENTRY32.dwSize = Sizeof(tTHREADENTRY32)
Thread32First(hSnapshot, @tTHREADENTRY32)
Dim As Ushort i = 0
While TRUE
If pid = tTHREADENTRY32.th32OwnerProcessID Then
aThreads(i) = tTHREADENTRY32.th32ThreadID
i += 1
End If
If Thread32Next(hSnapshot, @tTHREADENTRY32) = 0 Then Exit While
Wend
CloseHandle(hSnapshot)
Redim Preserve aThreads(i - 1)
End Sub
Function __WinAPI_EnumWindowsCallback(hWnd As HWND, lParam As LPARAM) As BOOL
Dim as ZString * 4096 buffer
GetClassName(hWnd, @buffer, 4096)
If IsWindowVisible(hWnd) Then 'And buffer = "WinFBE_Class" Then
Dim As Integer Ptr h = Cast(Integer Ptr, lParam)
h[0] = Cast(Integer, hWnd)
End If
Return TRUE
End Function
Function _WinAPI_GetParentHWND(pid As DWORD) As HWND
Dim As Integer aThreads()
Redim aThreads(1000)
_WinAPI_GetProcessThreads(pid, aThreads())
Dim As HWND hWnd_Parent = 0
For i As Ushort = 0 To Ubound(aThreads)
EnumThreadWindows(aThreads(i), Cast(WNDENUMPROC, @__WinAPI_EnumWindowsCallback), Cast(LPARAM, @hWnd_Parent))
Next
Return hWnd_Parent
End Function
'Function _WinAPI_ProcessExists(pid As DWORD) As BOOL
' Dim As HANDLE process = OpenProcess(SYNCHRONIZE, FALSE, pid)
' Dim As DWORD ret = WaitForSingleObject(process, 0)
' CloseHandle(process)
' Return ret = WAIT_TIMEOUT
'End Function
Function _WinAPI_ProcessExists(pid As DWORD) As BOOL
Dim As Bool bExists = False
Dim As PROCESSENTRY32 tPROCESSENTRY32
tPROCESSENTRY32.dwSize = Sizeof(tPROCESSENTRY32)
Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Process32First(hSnapshot, @tPROCESSENTRY32)
While Process32Next(hSnapshot, @tPROCESSENTRY32)
If tPROCESSENTRY32.th32ProcessID = pid Then
bExists = True
Exit While
End If
Wend
CloseHandle(hSnapshot)
Return bExists
End Function
Function __WinAPI_EnumChildProcCallback(hWnd As HWND, lParam As LPARAM) As BOOL
Dim As ZString * 4096 StrBuffer
If lParam Then
GetClassName(hWnd, @StrBuffer, 4096)
If StrBuffer = "ToolbarWindow32" Then
iCtrlID = GetDlgCtrlID(hWnd)
hToolbar = hWnd
'? "Class name: " & StrBuffer, "id: " & iCtrlID
End If
Return True
Else
GetWindowText(hWnd, @StrBuffer, 4096)
'? "Window text: " & StrBuffer
EnumChildWindows(hWnd, Cast(WNDENUMPROC, @__WinAPI_EnumChildProcCallback), 1)
End If
End Function
Sub _WinAPI_EnumChildWindws(hWndParent As HWND)
EnumChildWindows(hWndParent, Cast(WNDENUMPROC, @__WinAPI_EnumChildProcCallback), 0)
End Sub
Dim wc As WNDCLASSEX
Dim msg As MSG
Dim hHWND As HWND
Dim As String sTitle = "Cpath"
Dim Shared As ULong iW, iH
iW = 250
iH = 100
Dim Shared As DWORD parent_pid
parent_pid = _WinAPI_GetParentProcess()
hParentHWND = _WinAPI_GetParentHWND(parent_pid)
_WinAPI_EnumChildWindws(hParentHWND)
If hParentHWND = 0 Or hToolbar = 0 Then End 0
_WinAPI_EnumChildWindws(hParentHWND)
With wc
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetStockObject(WHITE_BRUSH)
.lpszMenuName = Null
.lpszClassName = StrPtr("FB GUI")
.cbSize = SizeOf(WNDCLASSEX)
End With
RegisterClassEx(@wc)
Dim As RECT tPos
GetWindowRect(hParentHWND, @tPos)
Dim As Integer ComboBoxId = 2000
hHWND = CreateWindowEx(WS_EX_TOOLWINDOW, wc.lpszClassName, sTitle, _
WS_OVERLAPPEDWINDOW Or WS_VISIBLE , _
tPos.right - iW - 100, tPos.top - 50, _
iW, iH, _
hParentHWND, Cast(HMENU, Cast(LONG_PTR, ComboBoxId)), wc.hInstance, NULL)
ShowWindow(hHWND, SW_SHOW)
hCombobox = CreateWindowEx(0, WC_COMBOBOX, NULL, _
WS_VISIBLE Or WS_CHILD Or WS_TABSTOP Or WS_VSCROLL Or WS_CLIPCHILDREN Or WS_CLIPSIBLINGS Or CBS_AUTOHSCROLL Or CBS_DROPDOWN, _
1020, 8, 250, 24, hToolbar, Cast(HMENU, Cast(LONG_PTR, ComboBoxId)), GetModuleHandle(NULL), NULL)
ComboBox_AddString(hCombobox, StrPtr("FreeBASIC-1.08.0-gcc-10.0"))
ComboBox_AddString(hCombobox, StrPtr("FreeBASIC-1.08.0-gcc-11.0"))
SendMessage(hCombobox, CB_SETCURSEL, Cast(WPARAM, 0), 0)
While GetMessage(@msg, 0, 0, 0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
Select Case uMsg
Case WM_CLOSE, WM_DESTROY
PostQuitMessage(0)
Return 0
Case WM_CREATE
SetTimer(hWnd, 1, 250, Null)
Case WM_TIMER
If IsWindow(hParentHWND) = 0 Then ' WinFBE is not running
KillTimer(hWnd, 1)
SendMessage(hWnd, WM_CLOSE, 0, 0)
DestroyWindow(hWnd)
End If
Case WM_ERASEBKGND
RedrawWindow(hCombobox, NULL, NULL, RDW_UPDATENOW)
Return DefWindowProc(hWnd, uMsg, wParam, lParam)
Case WM_PAINT
RedrawWindow(hCombobox, NULL, NULL, RDW_UPDATENOW)
Return 0
Case Else
Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Select
End Function
The exit code still doesn't work properly...