XProfan

Deutsch

Herbert
N.

Hallo

Hab das problem das ich die serielle 8-fach Relaiskarte von Conrad nicht ansprechen kann
in Qbasic klakerts

Ich verwende Prf 5.0 / Winme / P700 ( net lachen der is gut genug für solche Sachen grins )

hier ein bischen programm zum studieren was ich falsch mache:
Kompilieren Markieren Separieren

Declare h%,e%,a$,b$,c$,d$,e$,f$,g$
Declare Init$,Kanal1$,id%,Pause&
@CloseCom(COM1)

proc Pause

    let Pause& = &GetTickCount
    Let Pause& = @ADD(Pause&,100)

    while @GT(Pause&,&GetTickCount)

    wend

endproc

Font 1
let id% = COM1
LET h% = @OpenCom(id%,1024,1024)
@SetCom(id%:19200,N,8,1)
@SetComExt(id%,10,0,0,$0001,0,0)
LET f$ = @ReadCom$(id%,4)
Pause
LET g$ = @ComError(id%)
Pause
let Init$=CHR$(1),CHR$(5)CHR$(2),CHR$(6)
let Kanal1$=CHR$(3),CHR$(5),CHR$(8),CHR$(14)
print  Fehler  : ;@ComError(COM1)
@WriteCom(h%,Init$)
pause
@ReadCom$(id%,4)
Pause
@WriteCom(h%,Kanal1$)
Pause
print Init$
Print id%
LET f$ = @ReadCom$(id%,4)
Pause
print  Fehler  : ;@ComError(id%)
print  Gelesen : ;f$
Pause
print  Gelesen : ;@ReadCom$(id%,4)
Pause
@CloseCom(id%)

Danke im voraus

26.02.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

- Seite 2 -

Herbert
N.

Hab das problem Dank mehrfacher Hilfe gelöst. Code folgt demnächst , muss noch ein bischen was umschreiben , sind ein haufen Sachen dabei welche nichts mit dem eigentlichen problem zu tun haben.

Danke an alle für eure rasche Hilfe

Wegen dem Display schau mal unter www.distrelec.de vielleicht findest da was

Gruss Herbert N.

07.03.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Herbert
N.

So hier noch der Klick Klack Code.
Die Relais werden der reihe nach durch geschaltet
Kompilieren Markieren Separieren

Für die serielle 8-fach Relaiskarte von Conrad
Schaltet Relais eines nach dem anderen hin- und her
ProfanVersion 5.0a-32
Declare H%,E%,F$,G$,A$,z%
Declare Init$,Kanal1$,Pause&,Daten$,ende%
Declare Bit0%,Bit1%,Bit2%,Bit3%
Def Bit3%(3) @Xor(Bit0%,@Xor(Bit1%,Bit2%))Könnte man direkt reinschreiben

Proc Pause

    Let Pause& = &Gettickcount
    Let Pause& = @Add(Pause&,500)

    While @Gt(Pause&,&Gettickcount)

    Wend

Endproc

Font 1 Ist nur für die Anzeige braucht es nicht wirklich
Let H% = @Opencom(COM1,1024,1024)
@Setcom(Com1:19200,N,8,1)
Let F$ = @Readcom$(H%,4)
Print  Gelesen 1  : ;F$
Pause
Let G$ = @Comerror(COM1)
Print  ComError 1 : ;G$
Pause
Let Bit0%=1
Let Bit1%=1
Let Bit2%=0
Let Init$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(Bit3%(Bit0%,Bit1%,Bit2%))
let Daten$=Init$
@Writecom(H%,Daten$)
Print  Daten$  1  : ;Daten$
pause
Let G$ = @Comerror(COM1)

proc Schalten

    Let Bit0%=3
    Let Bit1%=1
    Let Bit2%=z%
    Let Kanal1$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(Bit3%(Bit0%,Bit1%,Bit2%))
    @Writecom(H%,Kanal1$)
    Print  Daten$  2  : ;Kanal1$
    Pause
    Let F$ = @Readcom$(H%,4)
    Print  Gelesen 2  : ;F$
    Print  ComError 2 : ;@Comerror(H%)

endproc

proc Schleife1

    Schalten
    Let z%=@Mul(z%,2)

endproc

proc Schleife2

    Schalten
    Let z%=@Div(z%,2)

endproc

WhileNot ende%

    Let a$ = @inkey$()    Tastatur abfragen

    If @Equ$(a$,§)      Ende mit SHIFT-3

        Let ende%=1

    Endif

    let z%=1

    whilenot  @Equ(z%,256)

        Schleife1

    endwhile

    print z%

    whilenot  @Equ(z%,0)

        Schleife2

    endwhile

Wend

@Closecom(H%)
Waitinput

Gruss Herbert N.

07.03.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Schau mal, hier:
Kompilieren Markieren Separieren

Let Kanal1$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(Bit3%(Bit0%,Bit1%,Bit2%))

stecken viele Fehler welche sich im Source widerholen.

Strings musst Du mit + verknüpfen, also kanal$=chr$(1)+chr$(2)

Nochwas: Chr$(Bit3%(Bit0%,Bit1%,Bit2%))

Mir ist unklar was Du damit ausdrücken möchtest - es ist aber syntaktisch falsch denn es fehlen Operatoren und das Komma als Operator gibt es nicht.

Ist also wohl eher ein Zufall das es funktioniert.

07.03.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Peter
Max
Müller

Hallo,
Er schreibt mit Profan 5. Da war , so glaube ich mich erinnern zu können , das , (Komma) erlaubt.

XProfan X3, X4ß, Win 10.1

08.03.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Herbert
N.

Hallo

Wie richtig gesagt ich verwende immer noch Profan 5.0 .( profan 9.1 ist eh schon bestellt )

Let Init$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(Bit3%(Bit0%,Bit1%,Bit2%))

Bit3% soll eine Funktion darstellen

Def Bit3%(3) @Xor(Bit0%,@Xor(Bit1%,Bit2%))

in welcher ich die Werte Bit0%,Bit1%,Bit2% übergebe (Was wahrscheinlich auf das selbe rauskommt wenn ich es direkt reinschreiben, siehe unten

Let Init$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(@Xor(Bit0%,@Xor(Bit1%,Bit2%)))

Ich weiss das vom programmieren keine Ahnung hab drum freue ich mich über jede Kritik ( nur so lernt man dazu grins )

Grüsschen Herbert N.

09.03.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Ganz grob erklärt:

Es gibt Prozeduren, Funktionen und Kontrollstrukturen.

Alle haben eines gemeinsam: eine Parameterdefinition.

Dieser Definition ist zu entnehmen welche Parameter mit welchen Typ zu übergeben sind, bzw. ob überhaupt Parameter zu übergeben sind.

Die Anzahl der zu übergebenen Parameter, ebenso wie der Typ eines jeden Parameters, ist entweder starr oder dynamisch.

Jeder Aufruf erhält damit also seine Syntax.

Wenn die Syntax eines Quelltextes eindeutig richtig ist, dann geschieht 1:1 das Programmierte, andernfalls erhält man zumeist Abweichende (unerwüschte?/schwer kalkulierbare?) Ergebnisse.

Ich bin mir nicht mehr sicher ob es in Profan5 vorgesehen war, Strings durch bloßes Aneinanderschreiben zu verknüpfen. Ich persönlich würde warscheinlich die Funktion add$(s1$,s2$) vorziehen.

10.03.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Detlef
Tussing

ich habe auch die Relaiskarte, das Programm funktioniert auch, mit einer Ausnahme
ich kann nicht alle Relais ausschalten. Wenn ich BIT2% auf 0 setze bekomme ich eine Fehlermeldung von der Relaiskarte
nun meine abwandlung des Programm
Kompilieren Markieren Separieren

Declare H%,E%,F$,G$,A$,Z%,x%
Declare Init$,Kanal1$,Pause&,Daten$,Ende%,kanal2$
Declare Bit0%,Bit1%,Bit2%,Bit3%
Def Bit3%(3) @Xor(Bit0%,@Xor(Bit1%,Bit2%))Könnte man direkt reinschreiben
H% = @Opencom(COM1,2048,2048)
Setcom(Com1:19200,N,8,1)
F$ = @Readcom$(H%,4)
sleep 200
Comerror(h%)
Bit0%=1
Bit1%=1
Bit2%=0
Init$=Chr$(Bit0%)+Chr$(Bit1%)+Chr$(Bit2%)+Chr$(Bit3%(Bit0%,Bit1%,Bit2%))
Daten$=Init$
Writecom(H%,Daten$)
sleep 200
Comerror(h%)

Proc Senden

    Bit0%=3
    Bit1%=1
    Bit2%=Z%
    Kanal1$=Chr$(Bit0%)+Chr$(Bit1%)+Chr$(Bit2%)+Chr$(Bit3%(Bit0%,Bit1%,Bit2%))
    Writecom(H%,Kanal1$)
    Comerror(h%)
    sleep 400

Endproc

Z%= 12
Senden
Z%=1
Senden
Closecom(H%)

weis jemand Hilfe

Gruß Detlef Tussing
Windows XP, XProfan 10

13.01.2007 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Sowas sollte Georg (GDL) klären können...

13.01.2007 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

GDL

Hallo,
da brauch ich genaueres von deiner Relaiskarte.

Hast du skype ?

Muss man sich ausführlicher unterhalten.

Servus
Georg

P.S.
Ich bereite meinen Sendevorgang immer so vor
(Du musst natürlich deine Werte eingeben)

fehlerbyte%=2 die 2 Entspräche bei dir bit0%
fehlerbyte%=xor(fehlerbyte%,1) die 1 Entspräche bei dir bit1%
fehlerbyte%=xor(fehlerbyte%,192) die 192 entspräche bei dir bit2%
fehlerbyte%=xor(fehlerbyte%,nummer%)
fehlerbyte%=xor(fehlerbyte%,licht&[nummer%])
fehlerbyte%=xor(fehlerbyte%,0)
Du musst natürlich hier deine Werte eingeben
chr$(254) und chr$(0) und chr$(255) sind auch nur Festwerte für mich
daten$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)+chr$(licht&[nummer%])+chr$(0)+chr$(fehlerbyte%)+chr$(255)

Windows7 Xprofan 8,9,10 [...]

[...]

13.01.2007 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

GDL

Nochmal ich,

da ich ja deine Relaiskartenparameter nicht weiss, gugg mal dieses.
Dieses Programm kommuniziert mit ca, 60 Atmelcontroler auf meheren Modellbahnanlagen.
Kompilieren Markieren Separieren

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
ja
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&,bf%
declare zusatz%,schnittstelle%,umrechnung%[28],t$,n$,iobuffer#,cnum&,cnum1&,num&
declare comi1&,comi2&,realspeed%[150],cstart%,comwert$,font&,inhalt%[10],result%
declare cpunkt%,clok%,cbit%,rspeed&,cspeed&,funktionwert%,inhalt$,onummer&,rect#
declare bf_01![150,255],bf_02![150,255],bf_03![150,255],bf_04![150,255],bf_05![150,255]
declare bf_06%[150,255],bf_07%[150,255],bf_08%[150,255],bf_09%[150,255],bf_10%[150,255]
declare rectpt#,lang&,alt%,neu%,zeige&,bild&
usermessages 16
astart$=$ProgDir
case left$(astart$,14)="C:ProgrammeX" : astart$="C:Steuerung\"
case left$(astart$,14)="C:PROGRAMMEX" : astart$="C:Steuerung\"
Def @Getcursorpos(1) !"USER32","GetCursorPos"
Def @Screentoclient(2) !"USER32","ScreenToClient"
Def PtInRect(3) !"USER32","PtInRect"
font&=@Create("Font","Courier",0,0,1,0,0)
===============

proc vorbereiten

    chdir astart$+"\daten\speed\"

    if findfirst$("speed.dbf")="speed.dbf"

        num&=dbopen(#5,"speed.dbf")
        dbuse(#5)
        cnum&=1
        clear cnum1&

        whilenot cnum& > num&

            dbgo(cnum&)
            realspeed%[cnum&]=val(dbget$("speed"))
            cnum&=cnum&+1

        wend

        dbclose(#5)

    endif

endproc

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

proc quittieren

    clearclip
    case inhalt%[5]=253:name$="Bahnhof "+right$("0"+str$(bf%),2)+" Taste "+right$("0"+str$(bf%),2)+" Stellung 1"
    case inhalt%[5]=254:name$="Bahnhof "+right$("0"+str$(bf%),2)+" Punkt "+right$("0"+str$(bf%),2)+" Stellung 1"
    putclip name$
    drawtext 10,300,name$+str$(inhalt%[4])

endproc

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

proc auswerten

    ja

    if inhalt%[2] > 0

        settext text&[8],"Lok      : "+right$("00"+str$(inhalt%[4]),3)
        settext text&[9],"Bahnhof  : "+right$("00"+str$(inhalt%[2]),3)
        settext text&[10],"Punkt    : "+right$("00"+str$(inhalt%[3]),3)

    endif

    bf%=inhalt%[2]
    cpunkt%=inhalt%[3]
    clok%=inhalt%[4]
    cbit%=xor(bf% ,cpunkt%)
    cbit%=xor(cbit%,clok%)
    cbit%=xor(cbit%,inhalt%[5])

    if inhalt%[5]=253			Taster wird von Betrieb.exe ausgewertet

        return

    elseif inhalt%[5]=254			Besetztmelder/Speed

        quittieren

    endif

    if cbit% = inhalt%[5]

        Speed aus array lesen

        if bf% = 1

            cspeed&=bf_01![clok%],[cpunkt%]

        elseif bf% = 2

            cspeed&=bf_02![clok%],[cpunkt%]

        elseif bf% = 3

            cspeed&=bf_03![clok%],[cpunkt%]

        elseif bf% = 4

            cspeed&=bf_04![clok%],[cpunkt%]

        elseif bf% = 5

            cspeed&=bf_05![clok%],[cpunkt%]

        elseif bf% =6

            cspeed&=bf_06%[clok%],[cpunkt%]

        elseif bf% =7

            cspeed&=bf_07%[clok%],[cpunkt%]

        elseif bf% =8

            cspeed&=bf_08%[clok%],[cpunkt%]

        elseif bf% =9

            cspeed&=bf_09%[clok%],[cpunkt%]

        elseif bf% =10

            cspeed&=bf_10%[clok%],[cpunkt%]

        endif

        aktuelle Speed aus array lesen
        rspeed&=realspeed%[clok%]
        Start(Signal Grün) oder ändern(Signal rot) abfragen

        ifnot inhalt%[4] = 250

            if rspeed& > 96			Vorwärts

                cspeed&=96+cspeed&

            elseif rspeed& < 96		Rückwärts

                cspeed&=64+cspeed&

            endif

        else

            cspeed&=rspeed&			Bei Grün mit Realspeed wieder starten

        endif

        Senden
        fehlerbyte%=2
        fehlerbyte%=xor(fehlerbyte%,1)
        fehlerbyte%=xor(fehlerbyte%,192)
        fehlerbyte%=xor(fehlerbyte%,clok%)
        fehlerbyte%=xor(fehlerbyte%,cspeed&)
        fehlerbyte%=xor(fehlerbyte%,0)
        daten$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(clok%)+chr$(cspeed&)+chr$(0)+chr$(fehlerbyte%)+chr$(255)+chr$(255)
        writecom(comi2&,daten$)
        @ComError(comi2&)

    endif

    ja

endproc

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

proc lesen

    clear cstart%
    comwert$=@ReadCom$(comi1&,1)
    @ComError(comi1&)
    case str$(ord(comwert$))="255":cstart%=1

    whilenot comwert$=""

        whilenot cstart% > 5

            comwert$=@ReadCom$(comi1&,1)
            @ComError(comi1&)
            case str$(ord(comwert$))="255":cstart%=1
            inc cstart%
            inhalt%[cstart%]=ord(comwert$)

        wend

        auswerten
        clear cstart%

    wend

endproc

=============================================
ja
===================================================================

proc bildzeige

    onummer&=0
    clear result%

    whilenot onummer& > 10

        CheckMouse trafo&[onummer&],1,1,20,400

        If result% = 1

            clear result%
            neu%=onummer&

            ifnot neu%=alt%

                destroywindow(zeige&)
                windowstyle 64
                zeige&=create("window",%hwnd,"",250,%maxy-140,350,100)
                alt%=neu%
                nummer%=val(right$(gettext$(loktext&[neu%]),3))
                chdir astart$+"\Daten\zuege\"
                name$="zug"+str$(nummer%)+".bmp"

                ifnot findfirst$(name$)="zug"+str$(nummer%)+".bmp"

                    name$="keine lok.bmp"

                endif

                startpaint zeige&
                LoadBmp name$,10,10;0
                endpaint
                chdir astart$+"\Daten\"

            endif

        endif

        inc onummer&

    wend

endif

endproc

ja
====================================================================

proc schnittstelle

comi2&=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 100
empfangen
case name$=chr$(255):settext text&[2],"DCC Sender connectiert"
case name$=CHR$(255):schnittstelle%=1
comi1&=opencom("Com1:",4096,4096)
erfolg%=SetCom("COM1:9600,N,8,1")
case erfolg% = 0: settext text&[5],"COM1 erfolgreich geöffnet."
daten$=chr$(255);chr$(255);
senden
sleep 100
empfangen
case name$=chr$(255):settext text&[6],"BMelder vorhanden"
case name$=CHR$(255):schnittstelle%=1
ja

endproc

===================================================================
Def GetSysColor(1) !"USER32","GetSysColor"
dim string#,255
dim image#,255
dim iobuffer#,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
 $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)
bild&=create("button",%hwnd,"Bilder zuordnen",250,530,150,20)
=================================================================

proc empfangen

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

WhileNot name$ = ""

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

EndWhile

endproc

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

proc senden

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

endproc

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

proc text

text&[1]=create("text",%hwnd,"COM2 nicht geöffnet",10,%maxy-160,200,20)
text&[2]=create("text",%hwnd,"Kein DCC Sender vorhanden !",10,%maxy-140,200,20)
text&[3]=create("text",%hwnd,"Trafos wechseln",10,%maxy-230,200,20)
text&[4]=create("text",%hwnd,"Übertragung",300,%maxy-100,200,20)
text&[5]=create("text",%hwnd,"COM1 nicht geöffnet",10,%maxy-110,200,20)
text&[6]=create("text",%hwnd,"Keine BMelder angeschlossen !",10,%maxy-90,210,20)
text&[7]=create("text",%hwnd,"Empfange :",600,%maxy-160,200,20)
setfont text&[7],font&
text&[8]=create("text",%hwnd,"Lok      :",600,%maxy-140,200,20)
setfont text&[8],font&
text&[9]=create("text",%hwnd,"Bahnhof  :",600,%maxy-120,200,20)
setfont text&[9],font&
text&[10]=create("text",%hwnd,"Punkt    :",600,%maxy-100,200,20)
setfont text&[10],font&
ja

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
chdir astart$+"\daten\speed\"

if findfirst$("speed.dbf")="speed.dbf"

    dbopen(#1,"speed.dbf")
    dbuse(#1)
    dbgo(nummer%)
    dbput("speed",str$(speed&[nummer%]))
    dbputrec(nummer%)
    dbclose(#1)

endif

chdir astart$
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$(gettext$(loktext&[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%]
        SKCtrl_SetColor(f1k&[num%],2,RGB(0,214,0))
        zusatz%=zusatz%+8
        f1&[nummer%]=zusatz%
        funktionwert%=zusatz%
        funktionausgabe

    else

        funktion%[num%]=1
        zusatz%=zusatz%-8
        f1&[nummer%]=zusatz%
        funktionwert%=zusatz%
        funktionausgabe
        SKCtrl_SetColor(f1k&[num%],2,RGB(255,0,0))

    endif

elseif name$ = "f2"

    funktion%=funktion%[num%]*2

    if funktion%[funktion%]=1

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

    else

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

    endif

elseif name$ = "f3"

    funktion%=funktion%[num%]*3

    if funktion%[funktion%]=1

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

    else

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

    endif

elseif name$ = "f4"

    funktion%=funktion%[num%]*4

    if funktion%[funktion%]=1

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

    else

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

    endif

endif

endproc

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

proc trafos

declare nm%
num%=1
clear alt%			Damit beim Umschalten Bilderlesen für denselben Vscroll geht

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%)
fehlerbyte%=xor (fehlerbyte%,funktionwert%)
daten$=chr$(254)+chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(nummer%)+chr$(funktionwert%)+chr$(0)+chr$(fehlerbyte%)+chr$(255)
senden

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
chdir astart$+"\daten\speed\"

if findfirst$("speed.dbf")="speed.dbf"

    dbopen(#1,"speed.dbf")
    dbuse(#1)
    dbgo(nummer%)
    dbput("speed",str$(speed&[nummer%]))
    dbputrec(nummer%)
    dbclose(#1)

endif

chdir astart$
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 CheckMouse

Parameters hw&,x%,y%,lang&,breit&
Dim rect#,16
Dim rectpt#,8
Long rect#,0=x%
Long rect#,4=y%
Long rect#,8=lang&
Long rect#,12=breit&
GetCursorPos(rectpt#)
ScreenToClient(hw&,rectpt#)

If Neq(PtInRect(rect#,Long(rectpt#,0),Long(rectpt#,4)),0)

    result%=1

EndIf

Dispose rect#
Dispose rectpt#

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

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

proc bild

declare bildfenster&,bildende%,bilder&[161],bknopf&[10],banzahl&,bx%,by%,bnum%
declare wahlknopf&[10],regler&,bok&,auf&,ab&,faktor%,bnm%,tt%,tb%
windowstyle 12
bildfenster&=create("window",%hwnd,"",50,10,950,680)
text&[20]=create("text",bildfenster&,"Reglernummer wählen",10,10,250,20)
text&[21]=create("text",bildfenster&,"Mit dem Zahlenknopf Bild auswählen und dann für",10,70,350,20)
text&[22]=create("text",bildfenster&,"Regler 1  das Bild 1",10,100,350,20)
bok&=create("button",bildfenster&,"Übernehmen",10,150,100,20)
auf&=create("button",bildfenster&,">",400,600,20,20)
setfont regler&,auf&
ab&=create("button",bildfenster&,"<",375,600,20,20)
setfont regler&,ab&
regler&=create("choicebox",bildfenster&,1,10,35,52,200)
setfont regler&,font&
bnum%=1

whilenot bnum% > 100

    addstring(regler&,right$("00"+str$(bnum%),3))
    inc bnum%

wend

sendmessage(regler&,334,0,0)
faktor%=0
bx%=500
by%=0
chdir astart$+"\Daten\zuege\container\"
bnum%=1
bilder&[bnum%]=@Create("hPic",-1,FindFirst$("*.bmp"))

WhileNot %IOResult

    inc bnum%
    name$=@FindNext$()
    casenot name$="":bilder&[bnum%]=@Create("hPic",-1,name$)

EndWhile

bilder&[151]=Create("hPic",-1,astart$+"\Daten\zuege\keine lok.bmp")
dec bnum%

whilenot bnum% > 160

    bilder&[bnum%]=Create("hPic",-1,astart$+"\Daten\zuege\keine lok.bmp")
    inc bnum%

wend

bnum%=1

whilenot bnum% > 10

    bknopf&[bnum%]=@Create("picButton",bildfenster&,bilder&[bnum%],bx%,by%,350,60)
    wahlknopf&[bnum%]=create("button",bildfenster&,str$(bnum%),bx%+360,by%+15,40,20)
    settext bknopf&[bnum%],str$(bnum%)
    setfont wahlknopf&[bnum%],font&
    by%=by%+65
    inc bnum%

wend

whilenot bildende%

    waitinput

    if %umessage = 16

        bildende%=1
        destroywindow(bildfenster&)

    elseif getfocus(auf&)

        inc faktor%
        case faktor% > 15:faktor%=15
        bnum%=1

        whilenot bnum% > 10

            bnm%=bnum%+(faktor%*10)
            settext wahlknopf&[bnum%],str$(bnm%)
            Sendmessage(bknopf&[bnum%],$00F7,0,bilder&[bnm%])
            inc bnum%

        wend

    elseif getfocus(ab&)

        dec faktor%
        case faktor% < 0:faktor%=0
        bnum%=1

        whilenot bnum% > 10

            bnm%=bnum%+(faktor%*10)
            settext wahlknopf&[bnum%],str$(bnm%)
            Sendmessage(bknopf&[bnum%],$00F7,0,bilder&[bnm%])
            inc bnum%

        wend

        tt%,tb%

    elseif getfocus(bok&)

        tt%=val(gettext$(regler&))
        case tt%=0:tt%=1
        case tb%=0:tb%=1
        copy astart$+"\Daten\zuege\container\zug"+right$("00"+str$(tb%),3)+".bmp" > astart$+"\Daten\zuege\zug"+str$(tt%)+".bmp"

    endif

    bnum%=1
    tb%=1

    whilenot bnum% > 10

        if getfocus(wahlknopf&[bnum%])

            tb%=bnum%
            tb%=val(gettext$(wahlknopf&[bnum%]))

        endif

        inc bnum%

    wend

    settext text&[22],"Regler "+ gettext$(regler&)+"     Bild   "+str$(tb%)

wend

chdir astart$+"\Daten\"

endproc

==========================================================
windowstyle 64
zeige&=create("window",%hwnd,"",300,%maxy-140,200,100)
text
schnittstelle
vorbereiten

whilenot lende%

setfocus(%hwnd)
settimer 1
waitinput
killtimer
lesen
bildzeige
case %umessage = 16:lende%=1
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"

    elseif getfocus(bild&)

        bild

    endif

    inc num%

wend

wend

closecom(comi&)
aufräumen
SKCtrl_DeInitDll()        Farb DLL löschen
FreeDll hdll&
dispose string#
dispose image#
dispose iobuffer#
deleteobject font&