XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Tastaturabfrage: NUMLOCK, Capslock und Scrollin der Statuszeile anzeigen
---------------------------------------------------------------------------
Keyboardstatus-Anzeige mit Profan                (P)Fairware, Freeware....
(c) 1998 Richard Maurukas
bearbeitet von Dietmar Horn
---------------------------------------------------------------------------
Definitionen für die Keyboardstatusanzeige.
Def GetKeyboardState(1) ! USER32.DLL,GetKeyboardState
Def SetKeyboardState(1) ! USER32.DLL,SetKeyboardState
Declare Keyboardstate#
Dim Keyboardstate#,256
Statusbar und Felder----
declare Statusbar1&,Statbarfeld1&,Statbarfeld2&,Statbarfeld3&,Statbarfeld4&
declare Statbarfeld5&,Statbarfeld6&,Statbarfeld7&
Declare Ende%
--------------------------------PROC STATUSBAR BEGIN--------------------------

PROC STATUSBAR

    declare Statusbar1&,Statbarfeld1&,Statbarfeld2&,Statbarfeld3&,Statbarfeld4&
    declare Statbarfeld#,Trect#
    dim Statbarfeld#,30
    dim Trect#,16
    let Statusbar1&=@control(msctls_statusbar32,,
     $50800000,40,20,150,40,%Hwnd,201,%Hinstance)
    long Statbarfeld#,0=150                der rechte Rand des ersten Parts
    long Statbarfeld#,4=250                der rechte Rand des zweiten Parts
    long Statbarfeld#,8=390                der rechte Rand des dritten Parts
    long Statbarfeld#,12=440               der rechte Rand des dritten Parts
    long Statbarfeld#,16=480
    long Statbarfeld#,20=520
    long Statbarfeld#,24=560
    sendmessage(Statusbar1&,$0404,7,Statbarfeld#) felder aufteilen
    sendmessage(Statusbar1&,$040A,0,Trect#) Rectanglestruct aus 0 holen
    let statbarfeld1&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,401,%HInstance)
    sendmessage(Statusbar1&,$040A,1,Trect#)
    let statbarfeld2&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,402,%HInstance)
    sendmessage(Statusbar1&,$040A,2,Trect#)
    let statbarfeld3&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,403,%HInstance)
    sendmessage(Statusbar1&,$040A,3,Trect#)
    let statbarfeld4&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,404,%HInstance)
    sendmessage(Statusbar1&,$040A,4,Trect#)
    let statbarfeld5&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,405,%HInstance)
    sendmessage(Statusbar1&,$040A,5,Trect#)
    let statbarfeld6&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,406,%HInstance)
    sendmessage(Statusbar1&,$040A,6,Trect#)
    let statbarfeld7&=@control(STATIC,,$50000001,
    add(long(TRect#,0),1),Add(long(Trect#,4),1),
    sub(sub(long(Trect#,8),2),long(Trect#,0)),
    sub(long(Trect#,12),4),Statusbar1&,407,%HInstance)
    settext statbarfeld1&,R.Maurukas
    settext statbarfeld2&,KeybStatus
    settext Statbarfeld3&,Anzahl
    settext Statbarfeld4&,SOSO
    Dispose Statbarfeld#
    Dispose Trect#

ENDPROC

--------------------------------PROC STATUSBAR ENDE---------------------------
-------------------------------PROC KEYBOARDSTATUS BEGIN----------------------

PROC KEYBOARDSTATUS

    Tastaturzustand in keyboardstate# kopieren.
    GetKeyboardState(keyboardstate#)
    Num Lock Taste Abfragen und in der Statuszeile anzeigen

    if equ(byte(keyboardstate#,144),1)

        Settext Statbarfeld5&,NUM
        enablemenu 405,0
        enablemenu 406,1

    else

        Settext Statbarfeld5&,
        enablemenu 405,1
        enablemenu 406,0

    ENDIF

    Caps-Lock (Umschalt-Taste) abfragen und Ergebnis in der Statuszeile zeigen

    if equ(byte(keyboardstate#,20),1)

        Settext Statbarfeld6&,Caps

    else

        Settext Statbarfeld6&,

    ENDIF

    Scroll-Lock abfragen und Ergebnis in der Statuszeile anzeigen

    if equ(byte(keyboardstate#,145),1)

        Settext Statbarfeld7&,Scroll

    else

        Settext Statbarfeld7&,

    ENDIF

ENDPROC

-------------------------------PROC KEYBOARDSTATUS ENDE-----------------------
Window 0,0-640,480
Windowtitle KeyboardStatus Anzeige mit Profan, (c) 1998 Richard Maurukas
cls rgb(0,0,128)
POPUP Datei
Appendmenu 101,Num ein
Appendmenu 102,Num aus
Separator
Appendmenu 103,Caps ein
Appendmenu 104,Caps aus
Separator
Appendmenu 105,Scroll ein
Appendmenu 106,Scroll aus
Separator
Appendmenu 199,Beenden
STATUSBAR
KEYBOARDSTATUS
Drawtext 10,10, Zeigt NUMLOCK, Capslock und Scrollin der Statuszeile an

Whilenot ENDE%

    getmessage

    If menuitem(199)

        let Ende%=1

    elseif Menuitem(101)                 Numlock ein

        byte keyboardstate#,144=1
        setkeyboardstate(keyboardstate#)

    elseif Menuitem(102)                 Numlock aus

        byte keyboardstate#,144=0
        setkeyboardstate(keyboardstate#)

    elseif Menuitem(103)

        byte keyboardstate#,20=1           Caps Lock ein
        setkeyboardstate(keyboardstate#)

    elseif Menuitem(104)

        byte keyboardstate#,20=0           Caps Lock aus
        setkeyboardstate(keyboardstate#)

    elseif Menuitem(105)

        byte keyboardstate#,145=0          Scroll Lock ein
        setkeyboardstate(keyboardstate#)

    elseif Menuitem(106)

        byte keyboardstate#,145=0          Scroll Lock aus
        setkeyboardstate(keyboardstate#)

    Endif

    KEYBOARDSTATUS
    setmenuitem 0

wend

disponer Keyboardstate#
end