(687)  S'inscrire

Français
Comprend

Eisenbahn Trafo contrôle

 
merci à Georg.

Schaut s'il te plaît qui Kommentare im Code à...
KompilierenMarqueSéparation
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 effacer
FreeDll hdll&
dispose string#
dispose image#
dispose iobuffer#
 
13.07.2006  ▲
 




GDL
allô Michael,

quelques Kommentare sommes aucun Kommentare, mais geremte Befehle et Proc Aufrufe.ici dans diesem partie doit qui Anwender ihren eigenen partie ergänzen, là cette de qui Angeschlossenen Hardware dépendant ist.

si intérêt besteht, werde je une Aider pour mon Contrôle écrivons, là cet partie seulement zum Testen dient.

Es sollte seulement un Ideengeber son.là ici iF qui Hardwareecke trop vite losch volonté Baupläne et Hex Fichiers ensuite pour et pour sur meiner le chasseur erscheinen.

salut
Georg
 
Windows7 Xprofan 8,9,10 [...]  [...] 
13.07.2006  ▲
 



répondre


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

4.302 Views

Untitledvor 0 min.
rafl21.06.2022
Langer29.01.2022
rquindt15.08.2017
Heli9824.06.2017
plus...

Themeninformationen

cet Thema hat 2 participant:

unbekannt (1x)
GDL (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie