Forum | | | | | | - Page 1 - |
| 
Herbert
N. | Hello
Have the trouble that I The serial 8-case Relay Card of Conrad not address can
in Qbasic klakerts
I use Prf 5.0 / Winme / P700 ( net laugh the is well enough for such things grins )
here little Program to that study I wrong make:
CompileMarkSeparationDeclare 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%)
thanks beforehand |
| | | | | | |
| | | | | | - Page 2 - |
| |
Herbert
N. | Have the trouble Thanks mehrfacher Help resolved. code follows soon , must another little what paraphrase , are a bunch things thereby which nothing with the actual trouble concern.
thanks all for eure rapid Help
because of the display look times under www.distrelec.de Perhaps find there what
greeting Herbert n. |
| | | | | | |
| |
Herbert
N. | so here yet the Click Klack code.
The Relais go the row to through geschaltet
CompileMarkSeparationFü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
greeting Herbert n. |
| | | | | | |
| |  | look time, here:
CompileMarkSeparationstick many Error which itself in the Source widerholen.
Strings must You with + link, means channel$=chr$(1)+chr$(2)
Nochwas: Chr$(bit3%(bit0%,bit1%,bit2%))
i'm unclear what You so squeeze out want - its but syntaktisch wrong because it are missing Operators and the comma as Operator there not.
So well sooner one chance the it functions.  |
| | | | | | |
| | 
Peter
Max
Müller | Hi,
it writes with Profan 5. there was , so faith I remind to , the , (comma) allows. |
| | | | | | |
| |
Herbert
N. | Hello
How correctly. said I use still Profan 5.0 .( profane 9.1 is eh already order )
Let Init$=Chr$(bit0%)Chr$(bit1%)Chr$(bit2%)Chr$(bit3%(bit0%,bit1%,bit2%))
bit3% should a function present
Def bit3%(3) @Xor(bit0%,@Xor(bit1%,bit2%))
in which I The values bit0%,bit1%,bit2% commit (what probably the same rauskommt if I it directly reinschreiben, see under
Let Init$=Chr$(bit0%)Chr$(bit1%)Chr$(bit2%)Chr$(@Xor(bit0%,@Xor(bit1%,bit2%)))
I knows the of program no idea Have thatswhy freue I over each review ( only so learn one moreover grins )
Grüsschen Herbert n. |
| | | | | | |
| | | integrally roughly declared:
there's Procedures, functions and Kontrollstrukturen.
any having one together: a Parameterdefinition.
this Definition is To entnehmen which Parameter with whom type To transfer are, or. whether at all Parameter To transfer are.
The Number of To übergebenen Parameter, likewise How the type one each Parameters, is either starr or dynamic.
eachone appeal sustain so means its Syntax.
If the Syntax one Quelltextes eindeutig correctly. is, then happens 1:1 the programmed, otherwise sustain one chiefly Abweichende (unerwüschte?/heavy kalkulierbare?) Results.
i'm I do not More sure whether it in Profan5 vorgesehen was, Strings through bloßes Aneinanderschreiben To link. I personally would warscheinlich The function add$(s1$,s2$) vorziehen.
|
| | | | | | |
| | 
Detlef
Tussing | I have too The Relay Card, the program functions too, with of/ one exception
I can't any Relais switch off. If I BIT2% on 0 set I get a Error Message from the Relay Card
now my abwandlung the Program
CompileMarkSeparationDeclare 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
Closecomon>H%)
wisely someone Help |
| | | | Gruß Detlef Tussing
Windows XP, XProfan 10 | 01/13/07 ▲ |
| | |
| | | | Something like ought to Georg (GDL) clarify can... |
| | | | | | |
| | 
GDL | Hi,
there custom I genaueres of your Relay Card.
have you got skype ?
must one itself detail talk.
Hello
Georg
P.s.
I bound my Sendevorgang always so to
(You must naturally your values prompt)
fehlerbyte%=2 The 2 Entspräche with you bit0%
fehlerbyte%=xor(fehlerbyte%,1) The 1 Entspräche with you bit1%
fehlerbyte%=xor(fehlerbyte%,192) The 192 entspräche with you bit2%
fehlerbyte%=xor(fehlerbyte%,number%)
fehlerbyte%=xor(fehlerbyte%,licht&[number%])
fehlerbyte%=xor(fehlerbyte%,0)
You must naturally here your values prompt
chr$(254) and chr$(0) and chr$(255) are too only Festwerte for me
data$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(number%)+chr$(licht&[number%])+chr$(0)+chr$(fehlerbyte%)+chr$(255) |
| | | | | | |
| |
GDL | Nochmal I,
I Yes your Relaiskartenparameter not knows, gugg time this.
this Program kommuniziert with ca, 60 Atmelcontroler on meheren Modellbahnanlagen.
CompileMarkSeparationGDL 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&)
straighten up
SKCtrl_DeInitDll() Farb DLL delete
FreeDll hdll&
dispose string#
dispose image#
dispose iobuffer#
deleteobject font&
but How said, me true here in this drop Skype rather. |
| | | | | | |
| |
Detlef
Tussing | What is Skype ??
I have your Program not yet testing könnem, but first many Thanks |
| | | | Gruß Detlef Tussing
Windows XP, XProfan 10 | 01/14/07 ▲ |
| | |
| |
GDL | Hi,
you are too straight here, kommste into Chat ? |
| | | | | | |
|
AnswerThemeninformationenthis Topic has 10 subscriber: |
(454)
Deutsch
English
Français
Español
Italia