
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