Page 1 of 1

[IDE tool] WinInfo

Posted: Wed Sep 03, 2025 5:08 pm
by AZJIO
WinInfo

Image

Code: Select all

;- TOP
; AZJIO 2025.09.03

EnableExplicit

#Black_theme = 1

Define UserIntLang, *Lang
If OpenLibrary(0, "kernel32.dll")
	*Lang = GetFunction(0, "GetUserDefaultUILanguage")
	If *Lang
		UserIntLang = CallFunctionFast(*Lang)
	EndIf
	CloseLibrary(0)
EndIf

#CountStrLang = 10
Global Dim Lng.s(#CountStrLang)
Lng(0) = "Drag the cursor to the window"
Lng(1) = "Unable to open Oleacc.dll"
Lng(2) = "Size"
Lng(3) = "Client x,y"
Lng(4) = "Styles"
Lng(5) = "Styles2"
Lng(6) = "Property"
Lng(7) = "Value"
Lng(8) = "About"
Lng(9) = "Exit"
Lng(10) = "Author AZJIO"

If UserIntLang = 1049 ; ru
	Lng(0) = "Перетащи курсор на окно"
	Lng(1) = "Не удалось открыть Oleacc.dll"
	Lng(2) = "Размер"
	Lng(3) = "Клиент x,y"
	Lng(4) = "Стили"
	Lng(5) = "Стили2"
	Lng(6) = "Свойство"
	Lng(7) = "Значение"
	Lng(8) = "О программе"
	Lng(9) = "Выход"
	Lng(10) = "Автор AZJIO"
EndIf

; XIncludeFile "ToolTip.pb"

;- # Constants
#Menu = 0

Enumeration
	#Window
	#WinRed
EndEnumeration

Enumeration
	#LIG
	#imgCursor
	#imgClose
	#txt1
	#Edit
	#btnCM
; 	#btnLIG
	#btnCCB
	#btnLB
	#Splitter
EndEnumeration

Structure Table
	b.i
	style.s
EndStructure


;- ● Global
Global hWin_0, hWndCur, hWndParent, hHeader, tmp
Global p.POINT
Global NewList LstExStyle.Table()
Global NewList LstExStyleLIG.Table()
Global NewList LstStyle.Table()
Global NewList LstStyleLIG.Table()


AddElement(LstStyle()) : LstStyle()\b = $800000 : LstStyle()\style = "WS_BORDER"
AddElement(LstStyle()) : LstStyle()\b = $80000000 : LstStyle()\style = "WS_POPUP"
AddElement(LstStyle()) : LstStyle()\b = $C00000 : LstStyle()\style = "WS_CAPTION"
AddElement(LstStyle()) : LstStyle()\b = $2000000 : LstStyle()\style = "WS_CLIPCHILDREN"
AddElement(LstStyle()) : LstStyle()\b = $4000000 : LstStyle()\style = "WS_CLIPSIBLINGS"
AddElement(LstStyle()) : LstStyle()\b = $8000000 : LstStyle()\style = "WS_DISABLED"
AddElement(LstStyle()) : LstStyle()\b = $400000 : LstStyle()\style = "WS_DLGFRAME"
AddElement(LstStyle()) : LstStyle()\b = $100000 : LstStyle()\style = "WS_HSCROLL"
AddElement(LstStyle()) : LstStyle()\b = $1000000 : LstStyle()\style = "WS_MAXIMIZE"
AddElement(LstStyle()) : LstStyle()\b = $10000 : LstStyle()\style = "WS_MAXIMIZEBOX, WS_TABSTOP"
AddElement(LstStyle()) : LstStyle()\b = $20000000 : LstStyle()\style = "WS_MINIMIZE"
AddElement(LstStyle()) : LstStyle()\b = $20000 : LstStyle()\style = "WS_MINIMIZEBOX, WS_GROUP"
AddElement(LstStyle()) : LstStyle()\b = $80000 : LstStyle()\style = "WS_SYSMENU"
AddElement(LstStyle()) : LstStyle()\b = $40000 : LstStyle()\style = "WS_SIZEBOX, WS_THICKFRAME"
AddElement(LstStyle()) : LstStyle()\b = $200000 : LstStyle()\style = "WS_VSCROLL"
AddElement(LstStyle()) : LstStyle()\b = $10000000 : LstStyle()\style = "WS_VISIBLE"
AddElement(LstStyle()) : LstStyle()\b = $40000000 : LstStyle()\style = "WS_CHILD"
AddElement(LstStyle()) : LstStyle()\b = $80 : LstStyle()\style = "DS_MODALFRAME"
AddElement(LstStyle()) : LstStyle()\b = $200 : LstStyle()\style = "DS_SETFOREGROUND"
AddElement(LstStyle()) : LstStyle()\b = $2000 : LstStyle()\style = "DS_CONTEXTHELP"


AddElement(LstExStyle()) : LstExStyle()\b = $10 : LstExStyle()\style = "WS_EX_ACCEPTFILES"
AddElement(LstExStyle()) : LstExStyle()\b = $40000 : LstExStyle()\style = "WS_EX_APPWINDOW"
AddElement(LstExStyle()) : LstExStyle()\b = $2000000 : LstExStyle()\style = "WS_EX_COMPOSITED"
AddElement(LstExStyle()) : LstExStyle()\b = $200 : LstExStyle()\style = "WS_EX_CLIENTEDGE"
AddElement(LstExStyle()) : LstExStyle()\b = $400 : LstExStyle()\style = "WS_EX_CONTEXTHELP"
AddElement(LstExStyle()) : LstExStyle()\b = $1 : LstExStyle()\style = "WS_EX_DLGMODALFRAME"
AddElement(LstExStyle()) : LstExStyle()\b = $40 : LstExStyle()\style = "WS_EX_MDICHILD"
AddElement(LstExStyle()) : LstExStyle()\b = $300 : LstExStyle()\style = "WS_EX_OVERLAPPEDWINDOW"
AddElement(LstExStyle()) : LstExStyle()\b = $20000 : LstExStyle()\style = "WS_EX_STATICEDGE"
AddElement(LstExStyle()) : LstExStyle()\b = $8 : LstExStyle()\style = "WS_EX_TOPMOST"
AddElement(LstExStyle()) : LstExStyle()\b = $20 : LstExStyle()\style = "WS_EX_TRANSPARENT"
AddElement(LstExStyle()) : LstExStyle()\b = $80 : LstExStyle()\style = "WS_EX_TOOLWINDOW"
AddElement(LstExStyle()) : LstExStyle()\b = $100 : LstExStyle()\style = "WS_EX_WINDOWEDGE"
AddElement(LstExStyle()) : LstExStyle()\b = $80000 : LstExStyle()\style = "WS_EX_LAYERED"
AddElement(LstExStyle()) : LstExStyle()\b = $10000 : LstExStyle()\style = "WS_EX_CONTROLPARENT"
AddElement(LstExStyle()) : LstExStyle()\b = $400000 : LstExStyle()\style = "WS_EX_LAYOUTRTL"
AddElement(LstExStyle()) : LstExStyle()\b = $4000 : LstExStyle()\style = "WS_EX_LEFTSCROLLBAR"
AddElement(LstExStyle()) : LstExStyle()\b = $8000000 : LstExStyle()\style = "WS_EX_NOACTIVATE"
AddElement(LstExStyle()) : LstExStyle()\b = $100000 : LstExStyle()\style = "WS_EX_NOINHERITLAYOUT"
AddElement(LstExStyle()) : LstExStyle()\b = $4 : LstExStyle()\style = "WS_EX_NOPARENTNOTIFY"
AddElement(LstExStyle()) : LstExStyle()\b = $200000 : LstExStyle()\style = "WS_EX_NOREDIRECTIONBITMAP"
AddElement(LstExStyle()) : LstExStyle()\b = $1000 : LstExStyle()\style = "WS_EX_RIGHT"
AddElement(LstExStyle()) : LstExStyle()\b = $2000 : LstExStyle()\style = "WS_EX_RTLREADING"


AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $20 : LstExStyleLIG()\style = "LVS_EX_FULLROWSELECT "
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $1 : LstExStyleLIG()\style = "LVS_EX_GRIDLINES"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $10 : LstExStyleLIG()\style = "LVS_EX_HEADERDRAGDROP"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $8 : LstExStyleLIG()\style = "LVS_EX_TRACKSELECT"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $4 : LstExStyleLIG()\style = "LVS_EX_CHECKBOXES"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $8000 : LstExStyleLIG()\style = "LVS_EX_BORDERSELECT"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $10000 : LstExStyleLIG()\style = "LVS_EX_DOUBLEBUFFER"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $100 : LstExStyleLIG()\style = "LVS_EX_FLATSB"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $2000 : LstExStyleLIG()\style = "LVS_EX_MULTIWORKAREAS"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $80000 : LstExStyleLIG()\style = "LVS_EX_SNAPTOGRID"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $2 : LstExStyleLIG()\style = "LVS_EX_SUBITEMIMAGES"
AddElement(LstExStyleLIG()) : LstExStyleLIG()\b = $400 : LstExStyleLIG()\style = "LVS_EX_INFOTIP"

;- ● Define
Define tmp$, OldText$
Define cross, close
Define dragging
Define name.string, value.string
; Define handcursor   = LoadCursor_(0,#IDC_CROSS)
Define normalcursor = LoadCursor_(0, #IDC_ARROW)
; Define nocursor = LoadCursor_(0,#IDC_NO)
; LoadImage(1, "close.ico")
 ; LoadImage(0, "icon.ico")
CatchImage(#imgCursor, ?cross)
; CatchImage(#imgClose, ?close)
cross = ImageID(#imgCursor)
; close = ImageID(#imgClose)

Define rect.RECT
SystemParametersInfo_(#SPI_GETWORKAREA, 0, rect, 0)
Define Xwin = 0
Define Ywin = 0
Define Xc = rect\right / 2
Define Yc = rect\bottom / 2
Define Xtip, Ytip

;- ● Declare
Declare Menu_Capture()
Declare ComboBox_Capture()
Declare ListBox_Capture()
Declare HideButton()
Declare SizeWindowHandler()


;- ● Prototype
Prototype.l ProtoAccessibleObjectFromPoint(ptScreen.q, *ppacc, *pvarChild)
Global AccessibleObjectFromPoint.ProtoAccessibleObjectFromPoint
Define hdll.i

; Приложения должны инициализировать библиотеку COM, прежде чем они смогут вызывать функции библиотеки COM
CoInitialize_(0)
hdll = OpenLibrary(#PB_Any, "Oleacc.dll")
If hdll
	AccessibleObjectFromPoint = GetFunction(hdll, "AccessibleObjectFromPoint")
Else
	MessageRequester("", Lng(1))
	End
EndIf

; RASHAD
; https://www.purebasic.fr/english/viewtopic.php?p=552990#p552990
Procedure GetColor()
	Protected hDC, Color;, p.POINT
; 	GetCursorPos_(@p.POINT)
	hDC = GetDC_(0)
	If hDC
		Color = GetPixel_(hDC, p\x, p\y)
		Color = ((Color & $00FF00) | ((Color & $0000FF) << 16) | ((Color & $FF0000) >> 16))
		ReleaseDC_(0, hDC)
		ProcedureReturn Color
	EndIf
EndProcedure

Procedure FindFlag(List Style.Table(), x.q)
	ForEach Style()
		If x = Style()\b
			AddGadgetItem(#LIG, - 1, "" + #LF$ + "        " + Hex(x) + "    (" + Style()\style + ")")
			ProcedureReturn 0
		EndIf
	Next
	ProcedureReturn 1
EndProcedure


Procedure.s BitFlag(flg_bin.q, Class$, Type)
	Protected i, x.q, not_find, tmp$
	For i = 0 To 63
		If flg_bin >> i & 1
			x = 1 << i
			tmp$ + Hex(x) + ", "

			not_find = 1
			If Type
				Select Class$
					Case "SysListView32"
						not_find = FindFlag(LstExStyleLIG(), x)
					Default
						not_find = FindFlag(LstExStyle(), x)
				EndSelect
			Else
				Select Class$
					Case "SysListView32"
						not_find = FindFlag(LstStyleLIG(), x)
					Default
						not_find = FindFlag(LstStyle(), x)
				EndSelect
			EndIf


			If not_find
				AddGadgetItem(#LIG, - 1, "" + #LF$ + "        " + Hex(x))
			EndIf
		EndIf
	Next
	ProcedureReturn tmp$
EndProcedure

Procedure RedRect()
	Protected iPenWidth = 2
	Protected rgn, rgn2, hWin_1, Color = -1, ColorOld, ExStyle, Style
	Protected Rect.RECT
	Protected Rect2.RECT
; 	Protected p.POINT
	Protected w, h
	Static hWinOld
	Protected text${#MAX_PATH}
	Protected Class${#MAX_PATH}

; 	GetCursorPos_(@p.POINT)
	Color = GetColor()
	If Color <> ColorOld
		ColorOld = Color
		SetGadgetText(#txt1, RSet(Hex(Color, #PB_Long), 6, "0"))
	EndIf
	If hWinOld = hWndCur ; Or hWndCur = __tip_hwnd
		ProcedureReturn
	EndIf
	hWinOld = hWndCur
	If GetWindowRect_(hWndCur, @Rect)
; 		#WinRed это красная кайма вокруг окна
		If IsWindow(#WinRed)
			CloseWindow(#WinRed)
		EndIf

		; 		Info
		ClearGadgetItems(#LIG)
; 		hWndParent = GetParent_(hWndCur)
		If hWndParent
			GetWindowText_(hWndParent, @text$, #MAX_PATH)
			AddGadgetItem(#LIG, - 1, "ParentTitle" + #LF$ + text$)
			GetClassName_(hWndParent, @text$, #MAX_PATH)
			AddGadgetItem(#LIG, - 1, "ParentClass" + #LF$ + text$)
			AddGadgetItem(#LIG, - 1, "ParentWnd" + #LF$ + hWndParent + ", Hex: " + Hex(hWndParent))
		EndIf
		GetWindowText_(hWndCur, @text$, #MAX_PATH)
		AddGadgetItem(#LIG, - 1, "Title" + #LF$ + text$)
		GetClassName_(hWndCur, @Class$, #MAX_PATH)
		AddGadgetItem(#LIG, - 1, "Class" + #LF$ + Class$)
		AddGadgetItem(#LIG, - 1, "hWnd" + #LF$ + hWndCur + ", Hex: " + Hex(hWndCur))

;- ██ AddGadgetItem ██
		w = Rect\right - Rect\left
		h = Rect\bottom - Rect\top
		AddGadgetItem(#LIG, - 1, Lng(2) + #LF$ + Str(w) + ", " + Str(h))
		AddGadgetItem(#LIG, - 1, "x,y" + #LF$ + Str(Rect\left) + ", " + Str(Rect\top))
; 		AddGadgetItem(#LIG, - 1, "x,y,w,h" + #LF$ + Str(Rect\left) + ", " + Str(Rect\top) + ", " + Str(w) + ", " + Str(h))
		If GetWindowRect_(hWndParent, Rect2)
			Rect2\left = Rect\left - Rect2\left
			Rect2\top = Rect\top - Rect2\top
			; 		CopyStructure(Rect, Rect2, RECT)
			; 		GetClientRect_(hWndCur, @Rect2)
			; 		ScreenToClient_(hWndCur, Rect2)
			; 		ScreenToClient_(hWndParent, Rect)
			; 		ClientToScreen_(hWndParent, Rect)
			AddGadgetItem(#LIG, - 1, Lng(3) + #LF$ + Str(Rect2\left) + ", " + Str(Rect2\top))
		EndIf
; 		AddGadgetItem(#LIG, - 1, "pixel color" + #LF$ + Color$)
		Style = GetWindowLongPtr_(hWndCur, #GWL_STYLE) ; Стили
		ExStyle = GetWindowLongPtr_(hWndCur, #GWL_EXSTYLE)
; 		Debug GetWindowLongPtr_(hWndCur, #GWL_HINSTANCE)
; 		Debug GetWindowLongPtr_(hWndCur, #GWL_ID)




		If Style
			AddGadgetItem(#LIG, - 1, Lng(4) + #LF$ + Hex(Style))
			BitFlag(Style, Class$, 0)
		EndIf
		If ExStyle
			AddGadgetItem(#LIG, - 1, Lng(5) + #LF$ + Hex(ExStyle))
			BitFlag(ExStyle, Class$, 1)
		EndIf

		hWin_1 = OpenWindow(#WinRed, Rect\left, Rect\top, w, h, "", #WS_POPUP, WindowID(#Window))
		SetWindowColor(#WinRed, RGB(255, 0 , 0))
		rgn = CreateRoundRectRgn_(0, 0, w, h, 0, 0)
		rgn2 = CreateRoundRectRgn_(iPenWidth, iPenWidth, w - iPenWidth, h - iPenWidth, 0, 0)
		CombineRgn_(rgn, rgn, rgn2, #RGN_DIFF)
		DeleteObject_(rgn2)
		SetWindowRgn_(hWin_1, rgn, #True)
		StickyWindow(#WinRed, #True)
		HideWindow(#WinRed, #False, #PB_Window_NoActivate)
		DisableWindow(#WinRed, 1)
	EndIf
EndProcedure

; Получает текст под курсором
Procedure TextFromWindowPosition(*Name.String, *Value.String)
	Define vt.VARIANT, *pIAcc.IAccessible, *pName
	GetCursorPos_(@p)
	hWndCur = WindowFromPoint_(PeekQ(@p))
	If hWndCur = hWin_0
		ProcedureReturn
	EndIf
; 	hWndParent = GetWindowLongPtr_(hWndCur, #GWL_HWNDPARENT)
	hWndParent = GetParent_(hWndCur)
	If hWndParent = hWin_0 Or hWndParent = GadgetID(#Splitter) Or hWndCur = hHeader
		ProcedureReturn
	EndIf
	; 	PeekQ(@p)
	If AccessibleObjectFromPoint(p\y << 32 | p\x, @*pIAcc, @vt) = #S_OK
		*Name\s = ""
		If *pIAcc\get_accName(vt, @*pName) = #S_OK
			If *pName
				*Name\s = PeekS(*pName)
				SysFreeString_(*pName)
			EndIf
		EndIf
		*Value\s = ""
		If *pIAcc\get_accValue(vt, @*pName) = #S_OK
			If *pName
				*Value\s = PeekS(*pName, - 1, #PB_Unicode)
				SysFreeString_(*pName)
			EndIf
		EndIf
		*pIAcc\Release()
	EndIf
	RedRect()
	ProcedureReturn #True
EndProcedure


;-┌──GUI──┐
hWin_0 = OpenWindow(#Window, Xwin, Ywin, 600, 600, Lng(0),
                    #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
If hWin_0

	ImageGadget(#imgCursor, 10, 4, 16, 16, cross)
; 	ImageGadget(#imgCursor,0,0, 16, 16,GetClassLongPtr_(hWin_0, #GCL_HICON))
; 	ImageGadget(#imgClose,16,0, 16, 16,close)
	TextGadget(#txt1, 30, 0, 90, 23, "", #SS_CENTERIMAGE | #SS_CENTER)
	ButtonGadget(#btnCM, 130, 0, 90 , 23, "Menu")
; 	ButtonGadget(#btnLIG, 210, 0, 70 , 23, "ListV")
	ButtonGadget(#btnLB, 135, 0, 90 , 23, "ListBox")
	ButtonGadget(#btnCCB, 140, 0, 90 , 23, "ComboBox")

	HideGadget(#btnCM, #True)
	HideGadget(#btnLB, #True)
	HideGadget(#btnCCB, #True)

	EditorGadget(#Edit, 5, 25, 590, 100)

	ListIconGadget(#LIG, 5, 135, 590, 460, Lng(6), 100, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
	AddGadgetColumn(#LIG, 1, Lng(7), 460)
	hHeader = SendMessage_(GadgetID(#LIG), #LVM_GETHEADER, 0, 0)

	SplitterGadget(#Splitter, 5, 25, 590, 570, #Edit, #LIG, #PB_Splitter_Separator | #PB_Splitter_SecondFixed)
	SetGadgetAttribute(#Splitter, #PB_Splitter_FirstMinimumSize, 30)
	SetGadgetAttribute(#Splitter, #PB_Splitter_SecondMinimumSize, 30)
	SetGadgetState(#Splitter, 150)

	If CreatePopupImageMenu(#Menu)
		MenuItem(0, Lng(8))
	EndIf

	BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())
	
	
	If #Black_theme
		SetWindowColor(#Window, $222222)
		SetGadgetColor(#txt1, #PB_Gadget_FrontColor, $AAAAAA)
		SetGadgetColor(#txt1, #PB_Gadget_BackColor, $3F3F3F)
		SetGadgetColor(#Edit, #PB_Gadget_FrontColor, $AAAAAA)
		SetGadgetColor(#Edit, #PB_Gadget_BackColor, $3F3F3F)
		SetGadgetColor(#LIG, #PB_Gadget_FrontColor, $AAAAAA)
		SetGadgetColor(#LIG, #PB_Gadget_BackColor, $3F3F3F)
	EndIf

;-┌──Loop──┐
	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_RightClick
				DisplayPopupMenu(#Menu,WindowID(#Window))
;- ├ WM_MOUSEMOVE
			Case #WM_MOUSEMOVE
				If dragging = #True
					TextFromWindowPosition(@name, @value)
					; 					RedRect()
					If Asc(name\s) Or Asc(value\s)
						tmp$ = name\s + #CRLF$ + value\s
						If OldText$ <> tmp$
							OldText$ = tmp$
; 							If p\x > Xc
; 								Xtip = 0
; 							Else
; 								Xtip = Xc
; 							EndIf
; 							If p\y > Yc
; 								Ytip = 0
; 							Else
; 								Ytip = Yc
; 							EndIf
; 							If Len(tmp$) > 100
; 								tmp$ = LSet(tmp$, 100) + #CRLF$ + "..."
; 							EndIf
; 							ToolTip(tmp$, Xtip, Ytip)
							SetGadgetText(#Edit, tmp$)
						EndIf
; 					Else
; 						ToolTip("")
					EndIf
				EndIf
;- ├ WM_LBUTTONUP
			Case #WM_LBUTTONUP
				If dragging = #True
					ReleaseCapture_()
					SetCursor_(normalcursor)
					; 					SetGadgetState(#imgCursor,ImageID(#picHand))
					dragging = #False
					SetClipboardText(name\s + #CRLF$ + value\s)
					If IsWindow(#WinRed)
						CloseWindow(#WinRed)
					EndIf

					; 					ToolTip("")
					HideButton()
				EndIf
;- ├ Gadget
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #btnCM
						Menu_Capture()
					Case #btnCCB
						ComboBox_Capture()
					Case #btnLB
						ListBox_Capture()
					Case #imgCursor
						If EventType() = #PB_EventType_LeftClick
							SetGadgetText(#Edit, "")
							SetCapture_(WindowID(#Window))
							SetCursor_(cross)
							; 							SetGadgetState(#imgCursor,ImageID(#picNo))
							dragging = #True
						EndIf
				EndSelect
;- ├ Menu
			Case #PB_Event_Menu
				Select EventMenu()
					Case 0
						MessageRequester("", Lng(10))
					Case 1 ; выход
						FreeMenu(#Menu)
						CloseWindow(#Window)
						End
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				End

		EndSelect
	ForEver
;-└──Loop──┘
EndIf


Procedure Menu_Capture()
	Protected *m
	Protected Res$
	Protected i, Count, MenuID, hMenu, iItemCount, menuiteminfo.MENUITEMINFO, j, iID, Style

	If Not hWndCur
		ProcedureReturn
	EndIf

	Style = GetWindowLongPtr_(hWndCur, #GWL_STYLE)
	If Not (Style & #WS_CAPTION And style & #WS_SYSMENU)
		ProcedureReturn
	EndIf

	hMenu = GetMenu_(hWndCur)
	If Not hMenu
		ProcedureReturn
	EndIf
	Count = GetMenuItemCount_(hMenu)
	If Not Count
		ProcedureReturn
	EndIf

	For i = 0 To Count - 1
		MenuID = GetSubMenu_(hMenu, i)
		*m = AllocateMemory(4096)
		GetMenuString_(hMenu, i, *m, 4096, #MF_BYPOSITION)
		Res$ + #CRLF$ + #CRLF$ + "_________  " + Str(MenuID) + #TAB$ + #TAB$ + ReplaceString(PeekS(*m), "&", "") + "  _________" + #TAB$ + #CRLF$ + #CRLF$ + #CRLF$
		iItemCount = GetMenuItemCount_(MenuID)
		menuiteminfo\cbSize = SizeOf(MENUITEMINFO)
		#MIIM_DATAMASK = $3F
		menuiteminfo\fMask = #MIIM_DATAMASK
		For j = 0 To iItemCount - 1
			GetMenuItemInfo_(MenuID, j, #MF_BYPOSITION, @menuiteminfo)
			iID = menuiteminfo\wID
			If menuiteminfo\fType = #MFT_SEPARATOR
				Res$ + "------------------------------------------------------" + #CRLF$
			Else
				If Not iID
					Continue
				EndIf
				GetMenuString_(hMenu, j, *m, 4096, #True)
				Res$ + Str(iID) + #TAB$ + " - " + #TAB$ + ReplaceString(PeekS(*m), "&", "") + #CRLF$
			EndIf
		Next
		FreeMemory(*m)
	Next
	SetGadgetText(#Edit, Res$)
EndProcedure

Procedure ComboBox_Capture()
	Protected *m
	Protected Res$
	Protected i, Count

	If Not hWndCur
		ProcedureReturn
	EndIf

	*m = AllocateMemory(4096)
	If *m

		GetClassName_(hWndCur, *m, 256)
		If PeekS(*m) = "ComboBox"

			Count = SendMessage_(hWndCur, #CB_GETCOUNT, 0, 0)
			If Not Count
				ProcedureReturn
			EndIf

			Res$ + "[" + Str(Count) + "]" + #CRLF$
			For i = 0 To Count - 1
				SendMessage_(hWndCur, #CB_GETLBTEXT, i, *m)
				Res$ + PeekS(*m) + #CRLF$
			Next
		EndIf
		FreeMemory(*m)
	EndIf
	SetGadgetText(#Edit, Res$)
EndProcedure

Procedure ListBox_Capture()
	Protected *m
	Protected Res$
	Protected i, Count

	If Not hWndCur
		ProcedureReturn
	EndIf

	*m = AllocateMemory(4096)
	If *m

		GetClassName_(hWndCur, *m, 256)
		If PeekS(*m) = "ListBox"

			Count = SendMessage_(hWndCur, #LB_GETCOUNT, 0, 0)
			If Not Count
				ProcedureReturn
			EndIf

			Res$ + "[" + Str(Count) + "]" + #CRLF$
			For i = 0 To Count - 1
				SendMessage_(hWndCur, #LB_GETTEXT, i, *m)
				Res$ + PeekS(*m) + #CRLF$
			Next
		EndIf
		FreeMemory(*m)
	EndIf
	SetGadgetText(#Edit, Res$)
EndProcedure

Procedure HideButton()
	Protected *m, Res$, style

	If Not hWndCur
		ProcedureReturn
	EndIf

	style = GetWindowLongPtr_(hWndCur, #GWL_STYLE)
	If style & #WS_CAPTION And style & #WS_SYSMENU And GetMenu_(hWndCur)
		HideGadget(#btnCM, #False)
		HideGadget(#btnLB, #True)
		HideGadget(#btnCCB, #True)
	Else

		*m = AllocateMemory(256)
		If *m
			GetClassName_(hWndCur, *m, 256)
			Res$ = PeekS(*m)
			Select Res$
				Case "ListBox"
					HideGadget(#btnCM, #True)
					HideGadget(#btnLB, #False)
					HideGadget(#btnCCB, #True)
				Case "ComboBox"
					HideGadget(#btnCM, #True)
					HideGadget(#btnLB, #True)
					HideGadget(#btnCCB, #False)
				Default
					HideGadget(#btnCM, #True)
					HideGadget(#btnLB, #True)
					HideGadget(#btnCCB, #True)
			EndSelect
			FreeMemory(*m)
		EndIf
	EndIf
EndProcedure


Procedure SizeWindowHandler()
	ResizeGadget(#Splitter, #PB_Ignore, #PB_Ignore, WindowWidth(#Window) - 10, WindowHeight(#Window) - 30)
EndProcedure



;- ● DataSection
DataSection
	cross:
    ; size : 1150 bytes
    Data.q $1010000100010000,$0468002000010000,$0028000000160000,$0020000000100000,$0000002000010000
    Data.q $0000000004400000,$0000000000000000,$0000000000000000,$0000000000000000,$0000000000000000
    Data.q $0000000000000000,$0000000000000000,$0000000000000000,$0000000000000000,$0000000000000000
    Data.q $0000000000000000,$0000000000000000,$FFFF000000000000,$FFFF7BFFFFFF2DFF,$FFFFFFFF0000AFFF
    Data.q $FFFF7BFFFFFFAFFF,$0000000000002DFF,$0000000000000000,$0000000000000000,$FFFF000000000000
    Data.q $00008DFFFFFF0EFF,$00008CFF00001EFF,$0000FFFF0000E2FF,$00008CFF0000E2FF,$FFFF8DFFFFFF1EFF
    Data.q $0000000000000EFF,$0000000000000000,$FFFF0EFFFFFF0000,$000071FF0000AFFF,$000031FF0000C4FF
    Data.q $0000FFFF000003FF,$000031FF000003FF,$FFFF71FF0000C4FF,$00000EFFFFFFAFFF,$0000000000000000
    Data.q $00008DFFFFFF0000,$FFFF86FF000071FF,$FFFF00FFFFFF00FF,$FFFFFFFF000000FF,$FFFF00FFFFFF00FF
    Data.q $000086FF000000FF,$00008DFFFFFF71FF,$FFFF000000000000,$00001EFF00002DFF,$FFFF00FFFFFFC4FF
    Data.q $FFFF00FFFFFFFFFF,$FFFF00FFFFFF00FF,$FFFF00FFFFFF00FF,$000000FFFFFFFFFF,$FFFF1EFF0000C4FF
    Data.q $FFFF000000002DFF,$00008CFF00007BFF,$FFFF00FFFFFF31FF,$FFFFFFFFFFFF00FF,$FFFF00FFFFFF00FF
    Data.q $FFFFFFFFFFFF00FF,$000000FFFFFF00FF,$FFFF8CFF000031FF,$FFFF000000007BFF,$0000E2FF0000AFFF
    Data.q $FFFF00FFFFFF03FF,$FFFF00FFFFFF00FF,$FFFFFFFF0000FFFF,$FFFF00FFFFFFFFFF,$000000FFFFFF00FF
    Data.q $FFFFE2FF000003FF,$000000000000AFFF,$0000FFFF0000FFFF,$FFFFFFFF0000FFFF,$000000FFFFFF00FF
    Data.q $0000FFFF0000FFFF,$FFFF00FFFFFFFFFF,$0000FFFF000000FF,$0000FFFF0000FFFF,$FFFF00000000FFFF
    Data.q $0000E2FF0000AFFF,$FFFF00FFFFFF03FF,$FFFF00FFFFFF00FF,$FFFFFFFF0000FFFF,$FFFF00FFFFFFFFFF
    Data.q $000000FFFFFF00FF,$FFFFE2FF000003FF,$FFFF00000000AFFF,$00008CFF00007BFF,$FFFF00FFFFFF31FF
    Data.q $FFFFFFFFFFFF00FF,$FFFF00FFFFFF00FF,$FFFFFFFFFFFF00FF,$000000FFFFFF00FF,$FFFF8CFF000031FF
    Data.q $FFFF000000007BFF,$00001EFF00002DFF,$FFFF00FFFFFFC4FF,$FFFF00FFFFFFFFFF,$FFFF00FFFFFF00FF
    Data.q $FFFF00FFFFFF00FF,$000000FFFFFFFFFF,$FFFF1EFF0000C4FF,$0000000000002DFF,$00008DFFFFFF0000
    Data.q $FFFF86FF000071FF,$FFFF00FFFFFF00FF,$FFFFFFFF000000FF,$FFFF00FFFFFF00FF,$000086FF000000FF
    Data.q $00008DFFFFFF71FF,$0000000000000000,$FFFF0EFFFFFF0000,$000071FF0000AFFF,$000031FF0000C4FF
    Data.q $0000FFFF000003FF,$000031FF000003FF,$FFFF71FF0000C4FF,$00000EFFFFFFAFFF,$0000000000000000
    Data.q $FFFF000000000000,$00008DFFFFFF0EFF,$00008CFF00001EFF,$0000FFFF0000E2FF,$00008CFF0000E2FF
    Data.q $FFFF8DFFFFFF1EFF,$0000000000000EFF,$0000000000000000,$0000000000000000,$FFFF000000000000
    Data.q $FFFF7BFFFFFF2DFF,$FFFFFFFF0000AFFF,$FFFF7BFFFFFFAFFF,$0000000000002DFF,$0000000000000000
    Data.q $FFFF000000000000,$07C000001FF00000,$0380000003800000,$0100000001000000,$0100000001000000
    Data.q $0100000001000000,$0380000001000000,$07C0000003800000
    Data.b $00,$00,$F0,$1F,$00,$00
	crossend:
EndDataSection

Re: [IDE tool] WinInfo

Posted: Wed Sep 03, 2025 5:13 pm
by SPH
[18 :11 :56] Attente du démarrage du programme...
[18 :11 :56] Type d'exécutable: Windows - x64 (64bit, Unicode)
[18 :11 :56] Exécutable démarré.
[18 :11 :56] [ERREUR] Ligne: 183
[18 :11 :56] [ERREUR] Accès mémoire invalide. (erreur de lecture à l'adresse 18446744073448411040)
[18 :12 :06] Le programme a été arrêté.
W11, PB6.21

Re: [IDE tool] WinInfo

Posted: Wed Sep 03, 2025 6:53 pm
by AZJIO
This is part of the code from the WinAPI Library archive.
I'm using PB 6.04, and everything works fine.

I found the problem, please fix it.

Code: Select all

Define hdll.i
This is almost the original code, I just translated the lines into Russian. It didn't work initially, so I had to fix it.

Code: Select all

; Автор: fizban

EnableExplicit

;-Gadgets
Enumeration
  #txtValue
  #txtName
  #edValue
  #edName
  #imgCursor
  #frmOptions
  #txtDrag
  #chkCopy
  #chkHide
  #chkAlwaysTop
EndEnumeration

;-Images
Enumeration
  #picHand
  #picNo
EndEnumeration

;-Prototypes
Prototype.l ProtoAccessibleObjectFromPoint(x.l,y.l,*ia,*var)
Global AccessibleObjectFromPoint.ProtoAccessibleObjectFromPoint
Define hdll.l

; Приложения должны инициализировать библиотеку COM, прежде чем они смогут вызывать функции библиотеки COM
CoInitialize_(0)
hdll=OpenLibrary(#PB_Any,"Oleacc.dll")
AccessibleObjectFromPoint=GetFunction(hdll,"AccessibleObjectFromPoint")

Procedure SetWindowTopMost(hWnd.i,TopMost.l)
  Define After.l
  If Topmost : After=#HWND_TOPMOST : Else : After=#HWND_NOTOPMOST :EndIf
  SetWindowPos_( hWnd, After, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE )
EndProcedure

Procedure TextFromWindowPosition(*Name.String, *Value.String)
  Define CursorPos.point,vt.VARIANT,*pIAcc.IAccessible,pName.l,len.l
  GetCursorPos_(@CursorPos)
  If AccessibleObjectFromPoint(CursorPos\x,CursorPos\y,@*pIAcc,@vt)=#S_OK
    *Name\s=""
    If *pIAcc\get_accName(vt, @pName) = #S_OK
      len = SysStringLen_(pName)
      *Name\s = Space(len)
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Name\s, len, 0, 0)
      SysFreeString_(pName)
    EndIf
    *Value\s=""
    If *pIAcc\get_accValue(vt, @pName) = #S_OK
      len = SysStringLen_(pName)
      *Value\s = Space(len)
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Value\s, len, 0, 0)
      SysFreeString_(pName)
    EndIf
    *pIAcc\Release()
  EndIf
  ProcedureReturn #True
EndProcedure

;-Main
Define dragging.b,Btn.l,ev.l,hdc.l,PositionBeforeMove.Point
Define name.string,value.string,SystemPath.s
Define handcursor   = LoadCursor_(0,#IDC_HAND)
Define normalcursor = LoadCursor_(0,#IDC_ARROW)
Define nocursor = LoadCursor_(0,#IDC_NO)


If OpenWindow(0, 0, 0, 540, 408, "Захват текста", #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_MinimizeGadget)
  TextGadget(#txtName,14,14,46,16,"Имя:")
  EditorGadget(#edName, 14, 30, 516, 110)
  TextGadget(#txtValue,14,148,44,16,"Значение:")
  EditorGadget(#edValue, 14, 164, 516, 160)
  CreateImage(#picHand,40,40)
  ; Гаджеты-изображения неправильно обрабатывают монохромные значки. Таким образом, мы используем изображение, чтобы нарисовать иконку
  ; Смотрите http://www.purebasic.fr/english/viewtopic.php?t=33943
  hdc=StartDrawing(ImageOutput(#picHand))
    Box(0,0,40,40,GetSysColor_(#COLOR_3DFACE))
    DrawImage (handcursor,0,0)
  StopDrawing()
  CreateImage(#picNo,40,40)
  hdc=StartDrawing(ImageOutput(#picNo))
    Box(0,0,40,40,GetSysColor_(#COLOR_3DFACE))
    DrawImage (nocursor,0,0)
  StopDrawing()
  ImageGadget(#imgCursor,140,334,40,40,ImageID(#picHand))
  TextGadget(#txtDrag,54,346,80,40,"Тащите меня:")
  FrameGadget(#frmOptions,38,324,460,76,"")
  CheckBoxGadget(#chkCopy,240,336,240,20,"Копир. в буфер при наведении мыши")
  CheckBoxGadget(#chkHide,240,356,240,20,"Скрыть окно при перетаскивании")
  CheckBoxGadget(#chkAlwaysTop,240,376,240,20,"Поверх всех окон")
  ; Установите значок для окна, используя один из стандартных значков
  SystemPath=Space(255)
  GetSystemDirectory_(SystemPath,255)
  SendMessage_(WindowID(0),#WM_SETICON,#False,ExtractIcon_(0,SystemPath+"\shell32.dll",73))
;--Основной цикл
  Repeat
  Ev = WaitWindowEvent()
    Select Ev
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #imgCursor
            If EventType()=#PB_EventType_LeftClick
              SetCapture_(WindowID(0))
              SetCursor_(handcursor)
              SetGadgetState(#imgCursor,ImageID(#picNo))
              dragging=#True
              If GetGadgetState(#chkHide)
                PositionBeforeMove\x=WindowX(0)
                PositionBeforeMove\y=WindowY(0)
                ExamineDesktops()
                ResizeWindow(0,DesktopWidth(0),DesktopHeight(0),#PB_Ignore ,#PB_Ignore )
              EndIf
            EndIf
          Case #chkAlwaysTop
            SetWindowTopMost(WindowID(0),GetGadgetState(#chkAlwaysTop))
        EndSelect
      Case #WM_MOUSEMOVE
        If dragging=#True
          TextFromWindowPosition(@name,@value)
          SetGadgetText(#edName,name\s)
          SetGadgetText(#edValue,value\s)
        EndIf
      Case  #WM_LBUTTONUP
        If dragging=#True
          ReleaseCapture_()
          SetCursor_(normalcursor)
          SetGadgetState(#imgCursor,ImageID(#picHand))
          dragging=#False
          If GetGadgetState(#chkCopy)
            SetClipboardText(name\s + #CRLF$ + value\s)
          EndIf
        EndIf
        If GetGadgetState(#chkHide)
          ResizeWindow(0,PositionBeforeMove\x,PositionBeforeMove\y,#PB_Ignore ,#PB_Ignore )
        EndIf
    EndSelect
  Until Ev = #PB_Event_CloseWindow
EndIf
CoUninitialize_()
CloseLibrary(hdll)

Re: [IDE tool] WinInfo

Posted: Wed Sep 03, 2025 7:24 pm
by SPH
AZJIO wrote: Wed Sep 03, 2025 6:53 pm This is part of the code from the WinAPI Library archive.
I'm using PB 6.04, and everything works fine.

I found the problem, please fix it.

Code: Select all

Define hdll.i
This is almost the original code, I just translated the lines into Russian. It didn't work initially, so I had to fix it.

Code: Select all

; Автор: fizban

EnableExplicit

;-Gadgets
Enumeration
  #txtValue
  #txtName
  #edValue
  #edName
  #imgCursor
  #frmOptions
  #txtDrag
  #chkCopy
  #chkHide
  #chkAlwaysTop
EndEnumeration

;-Images
Enumeration
  #picHand
  #picNo
EndEnumeration

;-Prototypes
Prototype.l ProtoAccessibleObjectFromPoint(x.l,y.l,*ia,*var)
Global AccessibleObjectFromPoint.ProtoAccessibleObjectFromPoint
Define hdll.l

; Приложения должны инициализировать библиотеку COM, прежде чем они смогут вызывать функции библиотеки COM
CoInitialize_(0)
hdll=OpenLibrary(#PB_Any,"Oleacc.dll")
AccessibleObjectFromPoint=GetFunction(hdll,"AccessibleObjectFromPoint")

Procedure SetWindowTopMost(hWnd.i,TopMost.l)
  Define After.l
  If Topmost : After=#HWND_TOPMOST : Else : After=#HWND_NOTOPMOST :EndIf
  SetWindowPos_( hWnd, After, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE )
EndProcedure

Procedure TextFromWindowPosition(*Name.String, *Value.String)
  Define CursorPos.point,vt.VARIANT,*pIAcc.IAccessible,pName.l,len.l
  GetCursorPos_(@CursorPos)
  If AccessibleObjectFromPoint(CursorPos\x,CursorPos\y,@*pIAcc,@vt)=#S_OK
    *Name\s=""
    If *pIAcc\get_accName(vt, @pName) = #S_OK
      len = SysStringLen_(pName)
      *Name\s = Space(len)
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Name\s, len, 0, 0)
      SysFreeString_(pName)
    EndIf
    *Value\s=""
    If *pIAcc\get_accValue(vt, @pName) = #S_OK
      len = SysStringLen_(pName)
      *Value\s = Space(len)
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Value\s, len, 0, 0)
      SysFreeString_(pName)
    EndIf
    *pIAcc\Release()
  EndIf
  ProcedureReturn #True
EndProcedure

;-Main
Define dragging.b,Btn.l,ev.l,hdc.l,PositionBeforeMove.Point
Define name.string,value.string,SystemPath.s
Define handcursor   = LoadCursor_(0,#IDC_HAND)
Define normalcursor = LoadCursor_(0,#IDC_ARROW)
Define nocursor = LoadCursor_(0,#IDC_NO)


If OpenWindow(0, 0, 0, 540, 408, "Захват текста", #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_MinimizeGadget)
  TextGadget(#txtName,14,14,46,16,"Имя:")
  EditorGadget(#edName, 14, 30, 516, 110)
  TextGadget(#txtValue,14,148,44,16,"Значение:")
  EditorGadget(#edValue, 14, 164, 516, 160)
  CreateImage(#picHand,40,40)
  ; Гаджеты-изображения неправильно обрабатывают монохромные значки. Таким образом, мы используем изображение, чтобы нарисовать иконку
  ; Смотрите http://www.purebasic.fr/english/viewtopic.php?t=33943
  hdc=StartDrawing(ImageOutput(#picHand))
    Box(0,0,40,40,GetSysColor_(#COLOR_3DFACE))
    DrawImage (handcursor,0,0)
  StopDrawing()
  CreateImage(#picNo,40,40)
  hdc=StartDrawing(ImageOutput(#picNo))
    Box(0,0,40,40,GetSysColor_(#COLOR_3DFACE))
    DrawImage (nocursor,0,0)
  StopDrawing()
  ImageGadget(#imgCursor,140,334,40,40,ImageID(#picHand))
  TextGadget(#txtDrag,54,346,80,40,"Тащите меня:")
  FrameGadget(#frmOptions,38,324,460,76,"")
  CheckBoxGadget(#chkCopy,240,336,240,20,"Копир. в буфер при наведении мыши")
  CheckBoxGadget(#chkHide,240,356,240,20,"Скрыть окно при перетаскивании")
  CheckBoxGadget(#chkAlwaysTop,240,376,240,20,"Поверх всех окон")
  ; Установите значок для окна, используя один из стандартных значков
  SystemPath=Space(255)
  GetSystemDirectory_(SystemPath,255)
  SendMessage_(WindowID(0),#WM_SETICON,#False,ExtractIcon_(0,SystemPath+"\shell32.dll",73))
;--Основной цикл
  Repeat
  Ev = WaitWindowEvent()
    Select Ev
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #imgCursor
            If EventType()=#PB_EventType_LeftClick
              SetCapture_(WindowID(0))
              SetCursor_(handcursor)
              SetGadgetState(#imgCursor,ImageID(#picNo))
              dragging=#True
              If GetGadgetState(#chkHide)
                PositionBeforeMove\x=WindowX(0)
                PositionBeforeMove\y=WindowY(0)
                ExamineDesktops()
                ResizeWindow(0,DesktopWidth(0),DesktopHeight(0),#PB_Ignore ,#PB_Ignore )
              EndIf
            EndIf
          Case #chkAlwaysTop
            SetWindowTopMost(WindowID(0),GetGadgetState(#chkAlwaysTop))
        EndSelect
      Case #WM_MOUSEMOVE
        If dragging=#True
          TextFromWindowPosition(@name,@value)
          SetGadgetText(#edName,name\s)
          SetGadgetText(#edValue,value\s)
        EndIf
      Case  #WM_LBUTTONUP
        If dragging=#True
          ReleaseCapture_()
          SetCursor_(normalcursor)
          SetGadgetState(#imgCursor,ImageID(#picHand))
          dragging=#False
          If GetGadgetState(#chkCopy)
            SetClipboardText(name\s + #CRLF$ + value\s)
          EndIf
        EndIf
        If GetGadgetState(#chkHide)
          ResizeWindow(0,PositionBeforeMove\x,PositionBeforeMove\y,#PB_Ignore ,#PB_Ignore )
        EndIf
    EndSelect
  Until Ev = #PB_Event_CloseWindow
EndIf
CoUninitialize_()
CloseLibrary(hdll)
[20 :22 :57] Attente du démarrage du programme...
[20 :22 :57] Type d'exécutable: Windows - x64 (64bit, Unicode)
[20 :22 :58] Exécutable démarré.
[20 :22 :58] [ERREUR] Ligne: 33
[20 :22 :58] [ERREUR] Accès mémoire invalide. (erreur de lecture à l'adresse 1566064896)

Re: [IDE tool] WinInfo

Posted: Wed Sep 03, 2025 7:38 pm
by AZJIO
You don't need to use this code, it's broken. You need to fix the code in the first message. I've already fixed it.

Re: [IDE tool] WinInfo

Posted: Wed Sep 03, 2025 7:41 pm
by SPH
The first post is ok now.
Thx :idea:

Re: [IDE tool] WinInfo

Posted: Wed Sep 03, 2025 7:46 pm
by AZJIO
If you select "ComboBox" or "ListBox", buttons will appear to capture all the rows in the list. If you select a window with a title, a "Menu" button will appear to capture the window's main menu.

Re: [IDE tool] WinInfo

Posted: Thu Sep 04, 2025 8:17 am
by dige
Nice tool! thx AZJIO