XProfan

' (W) 2003 Frank Abbing
'
Declare sx&,sy&,bereich#,be#,erg&,erg2&,x&,y&,text$,handl&
Dim be#,8
Dim bereich#,1024
DEF GetCursorPos(1) !"USER32","GetCursorPos"
DEF WindowFromPoint(2) !"USER32","WindowFromPoint"
DEF ChildWindowFromPoint(3) !"USER32","ChildWindowFromPoint"
Def GetSysColor(1) !"USER32","GetSysColor"
Def ScreenToClient(2) !"USER32","ScreenToClient"
Def GetClassName(3) !"USER32","GetClassNameA"
Def GetWindowText(3) !"USER32","GetWindowTextA"
DEF NewWindowPos(7) !"USER32","SetWindowPos"
DEF AllocConsole(0) !"KERNEL32","AllocConsole"

Proc DText

    Parameters xx&,yy&,ttext$
    Drawtext xx&,yy&,ttext$

EndProc

Windowtitle "Fensterhandles..."
windowstyle 26
window (%maxx/2-112),(%maxy/2-80)-444,164
settruecolor 1
cls GetSysColor(15)
NewWindowPos(%hwnd,-1,0,0,0,0,$13)
Usefont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1

whilenot %mousepressed=2

    Sleep 10
    GetCursorPos(be#)
    x&=Long(be#,0)
    y&=Long(be#,4)
    erg&=@WindowFromPoint(x&,y&)

    If erg&<>0

        ScreenToClient(erg&,be#)
        x&=Long(be#,0)
        y&=Long(be#,4)
        erg2&=@ChildWindowFromPoint(erg&,x&,y&)

    EndIf

    TextColor 0,GetSysColor(15)
    handl&=@GetActiveWindow()
    DText 8,8, "Maus Position X = "+Str$(x&)+"          "
    DText 8,21,"Maus Position Y = "+Str$(y&)+"          "
    DText 8,38,"Handle eigenes Fenster = $"+@Hex$(%hwnd)+"                    "
    DText 8,55,"Handle unter Mauszeiger = $"+@Hex$(erg&)+"                    "
    DText 8,68,"Handle unter Mauszeiger (Child) = $"+@Hex$(erg2&)+"                    "
    GetClassname(erg&,bereich#,128)Declare sx&,sy&,text$,x&,y&,bereich#
    text$=String$(bereich#,0)
    DText 8,85,handl&'"Klassenname = "+text$+"                                                      "
    GetWindowText(erg&,bereich#,128)
    text$=String$(bereich#,0)
    DText 8,98,"Fenstername = "+text$+"                                                      "
    @SendMessage(erg&,13,128,bereich#)
    text$=String$(bereich#,0)
    DText 8,111,"Fenstertext = "+text$+"                                                      "

wend

Dispose be#
Dispose bereich#
end

cls

while 1

    waitinput 2500
    sendkey(0,65)

wend