XProfan

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
@CloseCom2>(id%)

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%2>)
Waitinput

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

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
Closecoma>H%)

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&
disponer cadena#
disponer image#
disponer iobuffer#
deleteobject font&