XProfan

Source wurde am 13.07.2006 in die Babyklappe auf XProfan.Com abgelegt:
GDL 2006  (falls jemand mit RS232 und DCC NMRA Gedöns zu tun hat)
Nutzt Sebastian Königs SKControl
Trafopanel für DCC NMRA extended Format mit langen Adressen und 28 Fahrstufen
benötigt nur einen GDL Umformer zum Booster
Testprogrammmodul aus meiner Steuerung
declare comi&,erfolg%,fehler%,name$,daten$,text&[100],trafo&[20],x%,y%,num%,stop&[20]
declare lok&[255],loktext&[20],licht&[255],f1&[255],f2&[255],f3&[255],f4&[255],hdll&
declare richtung&[255],speed&[255],lichtk&[25],f1k&[25],f2k&[25],f3k&[25],f4k&[25]
declare string#,image#,astart$,speedfenster&[20],lende%,lokadr$[255],nummer%,licht%[255]
declare funktion%[1200],funktion%,bis20&,bis30&,bis40&,bis50&,bis60&,bis70&,bis80&
declare bis90&,bis100&,starttrafos&,fehlerbyte%,byte1%,byte2%,byte3%,testlok&
declare zusatz%,schnittstelle%,umrechnung%[28]
Def GetSysColor(1) !USER32,GetSysColor
dim string#,255
dim image#,255
schnittstelle%=0
umrechnung%[00]=0		Halt
umrechnung%[01]=2		Stufe 1
umrechnung%[02]=18		Stufe 2
umrechnung%[03]=3		Stufe 3
umrechnung%[04]=19		Stufe 4
umrechnung%[05]=4		Stufe 5
umrechnung%[06]=20		Stufe 6
umrechnung%[07]=5		Stufe 7
umrechnung%[08]=21		Stufe 8
umrechnung%[09]=6		Stufe 9
umrechnung%[10]=22		Stufe 10
umrechnung%[11]=7		Stufe 11
umrechnung%[12]=23		Stufe 12
umrechnung%[13]=8		Stufe 13
umrechnung%[14]=24		Stufe 14
umrechnung%[15]=9		Stufe 15
umrechnung%[16]=25		Stufe 16
umrechnung%[17]=10		Stufe 17
umrechnung%[18]=26		Stufe 18
umrechnung%[19]=11		Stufe 19
umrechnung%[20]=27		Stufe 20
umrechnung%[21]=12		Stufe 21
umrechnung%[22]=28		Stufe 22
umrechnung%[23]=13		Stufe 23
umrechnung%[24]=29		Stufe 24
umrechnung%[25]=14		Stufe 25
umrechnung%[26]=30		Stufe 26
umrechnung%[27]=15		Stufe 27
umrechnung%[28]=31		Stufe 28
zusatz%=128					Grundstellung für Licht,F1 bis F4
astart$=$ProgDir
case left$(astart$,7)=C:Prog : astart$=C:Steuerung\
chdir astart$
 $I SKCONTROL.INC
let hdll& = UseDll(SKControl.dll)        Farb DLL laden
SKCtrl_InitDll()
SetTrueColor 1
windowstyle 31
window 0,0 - %maxx,%maxy
windowtitle Trafopanel
cls getsyscolor(15)
x%=10
num%=0

whilenot num% > 10

    trafo&[num%]=@Create(VScroll,%hwnd,,x%,40,20,400)
    SetScrollRange trafo&[num%],0,400
    SetScrollPos trafo&[num%],200
    string string#,0 = STOP
    stop&[num%]=SKCtrl_CreateClrBlinkButton(%hwnd,string#,70,RGB(255,0,0),x%,460,40,20,%hInstance)
    loktext&[num%]=create(text,%hwnd,Lok +right$(00+str$(num%),3),x%,20,60,20)
    lokadr$[num%]=Lok +right$(00+str$(num%),3)
    string string#,0 = LI
    lichtk&[num%]=SKCtrl_createcolorbutton(%hwnd,string#,rgb(255,255,255),0,x%+25,90,28,20,%hinstance)
    string string#,0 = F1
    f1k&[num%]=SKCtrl_createcolorbutton(%hwnd,string#,0,RGB(0,214,0),x%+25,120,28,20,%hinstance)
    string string#,0 = F2
    f2k&[num%]=SKCtrl_createcolorbutton(%hwnd,string#,0,RGB(0,214,0),x%+25,150,28,20,%hinstance)
    string string#,0 = F3
    f3k&[num%]=SKCtrl_createcolorbutton(%hwnd,string#,0,RGB(0,214,0),x%+25,180,28,20,%hinstance)
    string string#,0 = F4
    f4k&[num%]=SKCtrl_createcolorbutton(%hwnd,string#,0,RGB(0,214,0),x%+25,210,28,20,%hinstance)
    string string#,0 = Vor 000
    speedfenster&[num%]=SKCtrl_createcoloredit(%hwnd,string#,0,RGB(0,188,232),x%,485,70,20,%hinstance)
    x%=x%+95
    inc num%

wend

bis20&=create(button,%hwnd,11-20,10,570,50,20)
bis30&=create(button,%hwnd,21-30,70,570,50,20)
bis40&=create(button,%hwnd,31-40,130,570,50,20)
bis50&=create(button,%hwnd,41-50,190,570,50,20)
bis60&=create(button,%hwnd,51-60,250,570,50,20)
bis70&=create(button,%hwnd,61-70,310,570,50,20)
bis80&=create(button,%hwnd,71-80,370,570,50,20)
bis90&=create(button,%hwnd,81-90,430,570,50,20)
bis100&=create(button,%hwnd,91-100,490,570,50,20)
starttrafos&=create(button,%hwnd,Start 1-10,580,570,100,20)
testlok&=create(Text,%hwnd,Testlok = ganz linker Trafo ,700,570,250,20)
=================================================================

proc empfangen

    name$=@ReadCom$(comi&,1)
    @ComError(comi&)
    casenot name$=:return

    WhileNot name$ =

        name$=@ReadCom$(comi&,1)

    EndWhile

endproc

==================================================================

proc senden

    fehler%=WriteCom(comi&,daten$)
    ComError(comi&)
    sleep 30
    fehler%=WriteCom(comi&,daten$)
    ComError(comi&)

endproc

===================================================================

proc text

    text&[1]=create(text,%hwnd,COM2 nicht geöffnet,10,%maxy-120,200,20)
    text&[2]=create(text,%hwnd,Kein DCC Sender vorhanden !,10,%maxy-100,200,20)
    text&[3]=create(text,%hwnd,Trafos wechseln,10,%maxy-230,200,20)
    text&[4]=create(text,%hwnd,Übertragung,400,%maxy-100,200,20)

endproc

=================================================================

proc speed

    adresse_ermitteln
    speed&[nummer%]=@GetScrollPos(trafo&[num%])-201

    if (speed&[nummer%] < 200) and (speed&[nummer%] > -1)

        settext speedfenster&[num%],Rück +right$(00+str$(speed&[nummer%]),3)
        SKCtrl_SetColor(speedfenster&[num%],2,RGB(204,84,21))
        richtung&[nummer%]=1

    else

        speed&[nummer%]=speed&[nummer%]*-1
        settext speedfenster&[num%],Vor +right$(00+str$(speed&[nummer%]),3)
        SKCtrl_SetColor(speedfenster&[num%],2,RGB(0,188,232))
        richtung&[nummer%]=0

    endif

    speedausgabe

endproc

============================================================

proc stoppen

    adresse_ermitteln
    speed&[nummer%]=96
    SetScrollPos trafo&[num%],200
    settext speedfenster&[num%],Vor 000
    SKCtrl_SetColor(speedfenster&[num%],2,RGB(0,188,232))
    fehlerbyte%=2
    fehlerbyte%=xor(fehlerbyte%,1)
    fehlerbyte%=xor(fehlerbyte%,192)
    fehlerbyte%=xor(fehlerbyte%,nummer%)
    fehlerbyte%=xor(fehlerbyte%,speed&[nummer%])
    fehlerbyte%=xor(fehlerbyte%,0)
    daten$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)+chr$(speed&[nummer%])+chr$(0)+chr$(fehlerbyte%)+chr$(255)
    senden
    quittung

endproc

==========================================================

proc adresse_ermitteln

    nummer%=val(right$(lokadr$[num%],3))
    case nummer% > 0 : nummer%=nummer%+1

endproc

=======================================================

proc licht

    adresse_ermitteln

    if licht%[num%]=0

        licht%[num%]=1
        zusatz%=zusatz%+16
        licht&[nummer%]=zusatz%
        SKCtrl_SetColor(lichtk&[num%],2,RGB(255,255,0))
        SKCtrl_SetColor(lichtk&[num%],1,0)

    else

        clear licht%[num%]
        zusatz%=zusatz%-16
        licht&[nummer%]=zusatz%
        SKCtrl_SetColor(lichtk&[num%],2,0)
        SKCtrl_SetColor(lichtk&[num%],1,rgb(255,255,255))

    endif

    fehlerbyte%=2
    fehlerbyte%=xor(fehlerbyte%,1)
    fehlerbyte%=xor(fehlerbyte%,192)
    fehlerbyte%=xor(fehlerbyte%,nummer%)
    fehlerbyte%=xor(fehlerbyte%,licht&[nummer%])
    fehlerbyte%=xor(fehlerbyte%,0)
    daten$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)+chr$(licht&[nummer%])+chr$(0)+chr$(fehlerbyte%)+chr$(255)
    senden
    daten$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)+chr$(speed&[nummer%])+chr$(0)+chr$(fehlerbyte%)+chr$(255)+chr$(255)
    senden
    quittung

endproc

======================================================

proc funktionstasten

    adresse_ermitteln

    if name$ = f1

        if funktion%[num%]=1

            clear funktion%[num%]
            Funktionsausgabe
            SKCtrl_SetColor(f1k&[num%],2,RGB(0,214,0))

        else

            funktion%[num%]=1
            Funktionsausgabe
            SKCtrl_SetColor(f1k&[num%],2,RGB(255,0,0))

        endif

    elseif name$ = f2

        funktion%=funktion%[num%]*2

        if funktion%[funktion%]=1

            clear funktion%[funktion%]
            Funktionsausgabe
            SKCtrl_SetColor(f2k&[num%],2,RGB(0,214,0))

        else

            funktion%[funktion%]=1
            Funktionsausgabe
            SKCtrl_SetColor(f2k&[num%],2,RGB(255,0,0))

        endif

    elseif name$ = f3

        funktion%=funktion%[num%]*3

        if funktion%[funktion%]=1

            clear funktion%[funktion%]
            Funktionsausgabe
            SKCtrl_SetColor(f3k&[num%],2,RGB(0,214,0))

        else

            funktion%[funktion%]=1
            Funktionsausgabe
            SKCtrl_SetColor(f3k&[num%],2,RGB(255,0,0))

        endif

    elseif name$ = f4

        funktion%=funktion%[num%]*4

        if funktion%[funktion%]=1

            clear funktion%[funktion%]
            Funktionsausgabe
            SKCtrl_SetColor(f4k&[num%],2,RGB(0,214,0))

        else

            funktion%[funktion%]=1
            Funktionsausgabe
            SKCtrl_SetColor(f4k&[num%],2,RGB(255,0,0))

        endif

    endif

endproc

================================================================

proc trafos

    declare nm%
    num%=1

    whilenot num% > 10

        nm%=num%+nummer%
        settext loktext&[num%],Lok +right$(00+str$(nm%),3)
        inc num%

    wend

endproc

==================================================================

proc funktionausgabe

    fehlerbyte%=2
    fehlerbyte%=xor(fehlerbyte%,1)
    fehlerbyte%=xor(fehlerbyte%,192)
    fehlerbyte%=xor(fehlerbyte%,nummer%)
    daten$=chr$(254)+chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)

endproc

===================================================================

proc speedausgabe

    speed&[nummer%]=speed&[nummer%]*28/200			Speed umformen  nach 28 Stufen  DCC extended Format
    speed&[nummer%]=umrechnung%[speed&[nummer%]]

    if left$(gettext$(speedfenster&[num%]),3)=Vor

        speed&[nummer%]=speed&[nummer%]+96

    else

        speed&[nummer%]=speed&[nummer%]+64

    endif

    case speed&[nummer%] > 127 : return
    fehlerbyte%=2
    fehlerbyte%=xor(fehlerbyte%,1)
    fehlerbyte%=xor(fehlerbyte%,192)
    fehlerbyte%=xor(fehlerbyte%,nummer%)
    fehlerbyte%=xor(fehlerbyte%,speed&[nummer%])
    fehlerbyte%=xor(fehlerbyte%,0)
    daten$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)+chr$(speed&[nummer%])+chr$(0)+chr$(fehlerbyte%)+chr$(255)+chr$(255)
    senden
    quittung

endproc

================================================================

proc quittung

    WhileLoop 50

        empfangen
        case name$=chr$(233):settext text&[4],Übertragung fehlgeschlagen

        if name$=chr$(244)

            settext text&[4],Übertragung erfolgreich
            beep

        endif

    endwhile

    sleep 300
    settext text&[4],Übertragung

endproc

=============================================================
text
comi&=opencom(Com2:,4096,4096)
erfolg%=SetCom(COM2:9600,N,8,1)
case erfolg% = 0: settext text&[1],COM2 erfolgreich geöffnet.
daten$=chr$(255);chr$(255);
senden
sleep 50
empfangen
case name$=chr$(255):settext text&[2],DCC Sender connectiert
case name$=CHR$(255):schnittstelle%=1

ifnot schnittstelle%=1

    closecom(comi&)
    comi&=opencom(Com1:,4096,4096)
    erfolg%=SetCom(COM1:9600,N,8,1)
    case erfolg% = 0: settext text&[1],COM1 erfolgreich geöffnet.
    daten$=chr$(255);chr$(255);
    senden
    sleep 50
    empfangen
    case name$=chr$(255):settext text&[2],DCC Sender connectiert
    case name$=CHR$(255):schnittstelle%=1

endif

whilenot lende%

    setfocus(%hwnd)
    waitinput
    num%=0

    whilenot num% > 10

        if getfocus(trafo&[num%])

            speed

        elseif getfocus(stop&[num%])

            stoppen

        elseif getfocus(lichtk&[num%])

            licht

        elseif getfocus(f1k&[num%])

            name$=f1
            funktionstasten

        elseif getfocus(f2k&[num%])

            name$=f2
            funktionstasten

        elseif getfocus(f3k&[num%])

            name$=f3
            funktionstasten

        elseif getfocus(f4k&[num%])

            name$=f4
            funktionstasten

        elseif getfocus(starttrafos&)

            nummer%=0
            trafos

        elseif getfocus(bis20&)

            nummer%=10
            trafos

        elseif getfocus(bis30&)

            nummer%=20
            trafos

        elseif getfocus(bis40&)

            nummer%=30
            trafos

        elseif getfocus(bis50&)

            nummer%=40
            trafos

        elseif getfocus(bis60&)

            nummer%=50
            trafos

        elseif getfocus(bis70&)

            nummer%=60
            trafos

        elseif getfocus(bis80&)

            nummer%=70
            trafos

        elseif getfocus(bis90&)

            nummer%=80
            trafos

        elseif getfocus(bis100&)

            nummer%=90
            trafos

        elseif getfocus(testlok&)

            settext loktext&[1],Lok 000

        endif

        inc num%

    wend

wend

closecom(comi&)
aufräumen
SKCtrl_DeInitDll()        Farb DLL delete
FreeDll hdll&
dispose string#
dispose image#
dispose iobuffer#