Forum | | | | | | - page 1 - |
| 
Herbert
N. | allô
Hab cela problem le moi qui serielle 8-matière Relaiskarte de Conrad pas ansprechen peux
dans Qbasic klakerts
je verwende Prf 5.0 / Winme / P700 ( net rire qui is bien genug pour solche Sachen grins )
ici un un peu programm zum étudier quoi je faux fais:
KompilierenMarqueSéparationDeclare 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%)
merci d'avance |
| | | | | | |
| | | | | | - page 2 - |
| |
Herbert
N. | Hab cela problem Dank mehrfacher Aider gelöst. Code folgt bientôt , muss encore un un peu quoi paraphraser , sommes un haufen Sachen dabei quelle rien avec dem réel problem trop 1faire avons.
merci à alle pour eure rasche Aider
à cause de dem Display exposition la fois sous www.distrelec.de peut-être findest là quoi
Gruss Herbert N. |
| | | | | | |
| |
Herbert
N. | So ici encore qui Klick Klack Code.
qui Relais volonté qui reihe pour par geschaltet
KompilierenMarqueSéparationFü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
Gruss Herbert N. |
| | | | | | |
| |  | exposition la fois, ici:
KompilierenMarqueSéparationstecken viele faute quelle sich im Source widerholen.
Cordes musst Du avec + verknüpfen, alors canal$=chr$(1)+chr$(2)
Nochwas: Chr$(Bit3%(Bit0%,Bit1%,Bit2%))
Mir ist unklar quoi Du avec cela ausdrücken vouloir - c'est mais syntaktisch faux car es manquer Operatoren et cela Komma comme Operator gibt es pas.
Ist alors wohl plutôt un Zufall cela es funktioniert.  |
| | | | | | |
| | 
Peter
Max
Müller | Salut,
on écrit avec Profan 5. là était , so glaube je mich erinnern trop peut , cela , (Komma) erlaubt. |
| | | | | | |
| |
Herbert
N. | allô
comment richtig dit je verwende toujours Profan 5.0 .( profan 9.1 ist eh déjà bestellt )
Laisser Init$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(Bit3%(Bit0%,Bit1%,Bit2%))
Bit3% soll une Funktion représenter
Def Bit3%(3) @Xor(Bit0%,@Xor(Bit1%,Bit2%))
dans quel je qui Werte Bit0%,Bit1%,Bit2% übergebe (quoi wahrscheinlich sur cela selbe rauskommt si je es direct reinschreiben, siehe unten
Laisser Init$=Chr$(Bit0%)Chr$(Bit1%)Chr$(Bit2%)Chr$(@Xor(Bit0%,@Xor(Bit1%,Bit2%)))
je weiss cela vom programmieren je n'en sais rien hab tambour suis je mich sur chacun Kritik ( seulement so lernt on en supplément grins )
Grüsschen Herbert N. |
| | | | | | |
| | | entier grob erklärt:
il y a Prozeduren, Funktionen et Kontrollstrukturen.
Alle avons eines gemeinsam: une Parameterdefinition.
cette définition ist trop entnehmen quelle paramètre avec welchen Typ trop transfert sommes, bzw. si überhaupt paramètre trop transfert sommes.
qui Nombre de trop übergebenen paramètre, aussi que qui Typ eines jeden Paramètres, ist entweder starr ou bien dynamisch.
chacun Aufruf erhält avec cela alors sa Syntax.
si qui Syntax eines Quelltextes sans équivoque richtig ist, ensuite geschieht 1:1 cela Programmierte, andernfalls erhält on zumeist Abweichende (unerwüschte?/schwer kalkulierbare?) Ergebnisse.
je suis Je ne plus sûrement si es dans Profan5 vorgesehen était, Cordes par bloßes Aneinanderschreiben trop verknüpfen. je personnelle serait warscheinlich qui Funktion add$(s1$,s2$) préférer.
|
| | | | | | |
| | 
Detlef
Tussing | j'ai aussi qui Relaiskarte, cela Programme funktioniert aussi, avec einer Ausnahme
je peux pas alle Relais ausschalten. si je BIT2% sur 0 mets bekomme je une Fehlermeldung de qui Relaiskarte
eh bien mon abwandlung des Programme
KompilierenMarqueSéparationDeclare 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 quelqu'un Aider |
| | | | | | |
| | | | Quelque chose comme sollte Georg (GDL) klären peut... |
| | | | | | |
| | 
GDL | Salut,
là coutume je genaueres de deiner Relaiskarte.
la hâte du skype ?
Muss on sich ausführlicher unterhalten.
salut
Georg
P.S.
je bereite meinen Sendevorgang toujours so avant
(Du musst naturellement deine Werte eingeben)
fehlerbyte%=2 qui 2 Entspräche chez dir bit0%
fehlerbyte%=xor(fehlerbyte%,1) qui 1 Entspräche chez dir bit1%
fehlerbyte%=xor(fehlerbyte%,192) qui 192 entspräche chez dir bit2%
fehlerbyte%=xor(fehlerbyte%,numéro%)
fehlerbyte%=xor(fehlerbyte%,licht&[numéro%])
fehlerbyte%=xor(fehlerbyte%,0)
Du musst naturellement ici deine Werte eingeben
chr$(254) et chr$(0) et chr$(255) sommes aussi seulement Festwerte pour mich
données$=chr$(254)+chr$(2)+chr$(1)+chr$(192)+chr$(numéro%)+chr$(licht&[numéro%])+chr$(0)+chr$(fehlerbyte%)+chr$(255) |
| | | | | | |
| |
GDL | Nochmal je,
là je oui deine Relaiskartenparameter pas weiss, gugg la fois cet.
cet Programme kommuniziert avec ca, 60 Atmelcontroler sur meheren Modellbahnanlagen.
KompilierenMarqueSéparationGDL 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 effacer
FreeDll hdll&
dispose string#
dispose image#
dispose iobuffer#
deleteobject font&
mais comment dit, mir währe ici dans diesem le cas Skype lieber. |
| | | | | | |
| |
Detlef
Tussing | quoi ist Skype ??
j'ai dein Programme encore pas testen könnem, mais erstmal vielen Dank |
| | | | | | |
| |
GDL | Salut,
tu es aussi justement ici, kommste dans den Chat ? |
| | | | | | |
|
répondreOptions du sujet | 9.017 Views |
Themeninformationencet Thema hat 10 participant: |
(453)
Deutsch
English
Français
Español
Italia