XProfan

Italia

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Maustasten und Tastatur abfragen (per Subclassing)
von Frank Abbing
Probiert mal die Maustasten aus und drückt ein paar Tasten.
Diese Code basiert auf Andreas Miethes Vorarbeit. Auf seiner XProfan-Seite findet ihr
tiefer gehende Subclassing-Sources.
 $H Windows.ph
 $H Messages.ph
Def Hiword(1) And(&(1)>>16,$Ffff)
Def Loword(1) And(&(1),$Ffff)
Declare Ende&,Button&,Oldwindowproc&,Text$

Proc Windowproc

    Parameters Wnd&, Msg&, Wparam&, Lparam&

    If Msg& = ~Wm_close

        ~Postquitmessage(0)Programm-Ende

    Endif

    Text$=Controlhandle: +Str$(Wnd&)+
    ~Textout(%Hdc,0,20,Addr(Text$),Len(Text$))
    Text$=Message: +Str$(Msg&)+
    ~Textout(%Hdc,0,40,Addr(Text$),Len(Text$))
    Text$=WParam: +Str$(Wparam&)+
    ~Textout(%Hdc,0,60,Addr(Text$),Len(Text$))
    Text$=LParam: +Str$(Lparam&)+
    ~Textout(%Hdc,0,80,Addr(Text$),Len(Text$))

    If Msg& = ~Wm_lbuttondown

        Text$=Linker Knopf wird gerade gedrückt.
        ~Textout(%Hdc,0,120,Addr(Text$),Len(Text$))

    Elseif Msg& = ~Wm_lbuttonup

        Text$=Linker Knopf wurde losgelassen.
        ~Textout(%Hdc,0,120,Addr(Text$),Len(Text$))

    Elseif Msg& = ~Wm_rbuttondown

        Text$=Rechter Knopf wird gerade gedrückt.
        ~Textout(%Hdc,0,140,Addr(Text$),Len(Text$))

    Elseif Msg& = ~Wm_rbuttonup

        Text$=Rechter Knopf wurde losgelassen.
        ~Textout(%Hdc,0,140,Addr(Text$),Len(Text$))

    Elseif Msg& = ~Wm_keydown

        Text$=Taste mit Tastencode +Str$(Wparam&)+ wird gerade gedrückt.
        ~Textout(%Hdc,0,160,Addr(Text$),Len(Text$))

    Elseif Msg& = ~Wm_keyup

        Text$=
        ~Textout(%Hdc,0,160,Addr(Text$),Len(Text$))

    Endif

    alle Messages die nicht behandelt wurden an die Original-Prozedur weiterleiten
    Return ~Callwindowproc(Oldwindowproc&,Wnd&, Msg&, Wparam&, Lparam&)

Endproc

Set(FastMode,1)
Cls
Window-Prozedur austauschen und die Original-Prozedur in
OldWindowproc sichern
Oldwindowproc& = ~Setwindowlong(%Hwnd,~Gwl_wndproc, Procaddr(Windowproc,4))

Whilenot Ende&

    Waitinput

Endwhile