diff --git a/ConfigGenerale.cfg b/ConfigGenerale.cfg index e0477f5..2fb615b 100644 --- a/ConfigGenerale.cfg +++ b/ConfigGenerale.cfg @@ -1,4 +1,4 @@ -/ Fichier de configuration de signaux_complexes_GL version 9.75 +/ Fichier de configuration de signaux_complexes_GL version 10.53 Chemin_progCDM=C:\Program Files (x86) LargeurF=1120 HauteurF=681 @@ -15,8 +15,8 @@ Max_Signal_Sens=5 Debug=0 Mode_Sombre=0 debugRoulage=0 -AffLoc=1 -coul_fond=000080 +AffLoc=0 +coul_fond=000040 serveurIPCDM_Touche=0 Port_Serveur=4500 Filtrage_det=3 @@ -30,28 +30,37 @@ Verif_AdrXpressNet=1 IpV4_PC=127.0.0.1:9999 ServicesCDM=15 Ipv4_interface=192.168.1.23:5550 -Protocole_serie=COM6:57600,N,8,1,2 -Inter_car=30 +Protocole_serie=COM6:57600,N,8,1,0 +Inter_car=50 Tempo_maxi=15 Entete=1 Init_Aig=1 -PilotageTrainsCDMNom=0 +PilotageTrainsCDMNom=1 Init_Dem_Aig=0 Tempo_Aig=30 -MaxParcours=60 -MaxRoutes=10000 +MaxParcours=80 +MaxRoutes=5000 +compteur=1 +LargCompteur=200 +LargCompteurC=150 +HautCompteurC=150 +VerrouCompteur=0 +Echelle=0 +AffIconeTrCompteur=0 +Onglet=0 +AffCompteur=0 Init_demUSBCOM=0 Init_demETH=1 Fenetre=0 Ecran=1 AffMemoFenetre=1 nb_det_dist=3 -verif_version=0 +verif_version=1 notif_version=0 -TCO=0 +TCO=1 NbreTCO=1 Nom_fichier_TCO1=TCO.CFG -Nom_fichier_TCO2=TCO2.CFG +Nom_fichier_TCO2=TCO_ESSAI Nom_fichier_TCO3=TCO3.CFG Nom_fichier_TCO4=TCO4.CFG Nom_fichier_TCO5=TCO5.CFG @@ -74,11 +83,12 @@ Nb_cantons_Sig=3 AffSig=1 AffRes=0 AvecAck=0 +Asynchrone=1 Option_demiTour=0 Alg_Unisemaf=1 /------------ [section_aig] -1,P518,D100D,S3P,V30,I0,INIT(2,5),C0 +1,P518,D100D,S3P,V30,I0,INIT(2,1),C0 2,P12S,D519,S100S,V0,I0,INIT(2,1),C0 3,P1S,D4P,S5D,V0,I0,INIT(2,1),C0 4,P3D,D6S,S514,V0,I0,INIT(2,1),C0 @@ -86,15 +96,15 @@ Alg_Unisemaf=1 6,P516,D0,S4D,V0,I0,INIT(1,1),C0 7,P527,D519,S520,V30,I0,INIT(1,1),C0 8,P527,D521,S103S,V0,I0,INIT(2,2),C0 -9,P526,D103D,S515,V60,I0,INIT(2,2),C0 -10,P101S,D29P,S528,V30,I0,INIT(2,2),C0 -11,P18P,D30D,S101D,V0,I0,INIT(2,2),C0 +9,P526,D103D,S515,V60,I0,INIT(1,2),C0 +10,P101S,D29P,S528,V30,I0,INIT(1,2),C0 +11,P18P,D30D,S101D,V0,I0,INIT(1,2),C0 12,P517,D20S,S2P,V0,I0,INIT(1,2),C0 17,P525,D535,S528,V0,I0,INIT(1,2),C0 18,P11P,D23P,S102S,V0,I0,INIT(1,2),C0 19,P101S,D102D,S531,V0,I0,INIT(1,2),C0 20,P520,D21P,S12D,V0,I0,INIT(2,2),C0 -21,P20D,D28S,S28D,V0,I0,INIT(1,2),C0 +21,P20D,D28S,S28D,V0,I0,INIT(2,2),C0 22,P102D,D537,S105D,V0,I0,INIT(2,2),C0 23,P18D,D105D,S534,V0,I0,INIT(2,2),C0 24,P538,D32S,S533,V0,I0,INIT(1,2),C0 @@ -103,7 +113,7 @@ Alg_Unisemaf=1 27,P25S,D530,S537,V0,I0,INIT(1,2),C0 28TJD,D(21D,26D),S(21S,26S),V0,I0,INIT(1,2),E4,C0 29,P10D,D513,S30S,V60,I0,INIT(2,2),C0 -30,P524,D11D,S29S,V0,I0,INIT(2,7),C0 +30,P524,D11D,S29S,V0,I0,INIT(2,2),C0 31,P534,D34D,S104S,V0,I0,INIT(1,2),C0 32,P105S,D104D,S24D,V0,I0,INIT(1,2),C0 34,P0,D31D,S104D,V0,I0,INIT(2,2),C0 @@ -132,18 +142,72 @@ A31,A34,0 /------------ [section_decodeurs] / décodeur n°1 -Nom_dec_pers=CDF_personnalisé -NombreAdresses=3 +Nom_dec_pers=grand +NombreAdresses=8 Nation=1 Commande=0 +Periph=0 +1,2,0,1,2 +3,4,1,0,0 +5,6,2,0,0 +7,8,3,0,0 +0,0,0,0,0 +0,0,0,0,0 +0,0,0,0,0 +0,0,0,0,0 +/ décodeur n°2 +Nom_dec_pers=decodeur com +NombreAdresses=10 +Nation=1 +Commande=1 Periph=1 -13,0,0,1,0 -4,9,1,1,2 -2,1,2,1,2 +carré,car +sémaphore,sem +rouge cli,semcli +vert, +vert cli, +violet, +blanc, +blanc cli, +avertissement, +jaune cli, +ralen 30, +ralen 60, +rappel 30, +rappel 60, +ralen 60 + jaune cli, +rappel 30 + jaune, +rappel 30 + jaune cli, +rappel 60 + jaune, +rappel 60 + jaune cli, +/ décodeur n°3 +Nom_dec_pers=decodeur USB Belge +NombreAdresses=10 +Nation=2 +Commande=1 +Periph=1 +vert jaune horizontal,vjh +rouge,r +vert,v +vert jaune vertical, +rouge blanc, +deux jaunes, +Chiffre, +Chevron, +Clignote, + , + , + , + , + , + , + , + , + , + , 0 /------------ [section_sig] -49,9,0,11,(518,A1),0,FVC0,FRC0,SR(1,2,3,16,17,13,18,19,14,9,10,5,4,0,18,19),NA7 176,7,0,1,(520,A20),1,FVC0,FRC0 190,7,0,1,(523,526),0,FVC0,FRC0 204,9,0,1,(527,A7),1,FVC0,FRC0 @@ -166,14 +230,16 @@ Periph=1 476,9,0,1,(538,A105),1,FVC0,FRC0 497,9,0,4,(531,A19),1,FVC0,FRC0,U14,L1 520,9,1,1,(518,A1),1,FVC0,FRC0,(A1S,A3S,A5S),CFB(A1S,A3D,A4D,A6S) +620,7,0,0,(521,A8),1,FVC0,FRC0 +820,4,0,0,(519,A7),0,FVC0,FRC0 0 /------------ [section_PN] -(523-526,513-531),PN(700,1,700,2),1,0 0 /------------ [section_actions] -ACTION1,D4,513,1,,B1,C11,1,0,N1,A10,0,0, +Action 3,D4,800,1,traindecl,B1,C5,12,12,13,45,N3,A10,1,30,traindest,A2,1,A8,1 +Action 5,D1,12,30,B1,C3,162,30,TGV,N1,A4,1,15,2,Z 0 /------------ [section_dcc++] @@ -185,32 +251,20 @@ AdrBaseDetDccpp=513 0 /------------ [section_trains] -BB25531,1,120,60,50,BB67000.BMP,0,0,18,0,0,0,0.00,0.00,0.00,0,0,0 -TGV,2,120,80,60,TGV.BMP,0,0,0,0,0,0,0.00,0.00,0.00,0,0,0 -BB16024,3,120,70,50,BB16024.BMP,0,0,18,40,60,80,4.80,2.50,2.00,6,6,128 -[route directe],0,1 -{523->526->9droit->103crois->513->29droit->10droit->101crois->19dev->531->518->1droit->100crois->523} -[route directe],1,2 -{523->100crois->1droit->518->531->19dev->101crois->10droit->29droit->513->103crois->9droit->526->523} -[],0,3 +BB25531,1,120,60,50,BB67000.BMP,5,0,0,0,0,0,0.00,0.00,0.00,0,0,0 +TGV,2,120,80,60,TGV.BMP,6,0,0,0,0,0,0.00,0.00,0.00,0,0,0 +BB16024,3,120,100,60,BB16024.BMP,7,0,0,0,0,0,0.00,0.00,0.00,0,0,0 +CC406526,4,120,100,80,CC406526.BMP,10,0,0,0,0,0,0.00,0.00,0.00,0,0,0 +[route_par_pont],0,1 {519->2droit->12dev->517->102crois->18dev->11dev->101crois->525->17dev->528->10dev->101crois->19dev->531->518->1droit->100crois->523} -CC406526,4,120,100,80,CC406526.BMP,0,0,1,50,60,100,6.00,5.50,3.89,4,4,128,P523,D526,T5 -[anneau intérieur],0,1 -{523->526->9droit->103crois->513->29droit->10droit->101crois->19dev->531->518->1droit->100crois->523} -[inversion],0,4 -{523->526->9dev->515->5dev->100crois->2dev->12dev->517->102crois->18dev->11droit->30droit->524->521->8droit->527->7droit->519} -[],0,5 -{515->5dev->100crois->2dev->12dev->517->102crois->18dev->11dev->101crois->525->17dev->528->10dev->101crois->19dev->531->518->1dev->3droit->4droit->6dev->516} -[],0,6 -{523->526->9droit->103crois->513->29droit->10droit->101crois->19dev->531->518->1dev->3droit->4dev->514->522->103crois->8dev->527->7dev->520} -CAMERA,6,120,0,0,EAD.BMP,0,0,0,0,0,0,0.00,0.00,0.00,0,0,0 +CAMERA,6,120,0,0,EAD.BMP,8,0,0,0,0,0,0.00,0.00,0.00,0,0,0 0 /------------ [section_placement] BB25531,0,0,0 -TGV,14,3,0 +TGV,0,0,0 BB16024,0,0,0 -CC406526,7,2,0 +CC406526,9,1,0 CAMERA,0,0,0 0 /------------ @@ -270,17 +324,17 @@ DureeMinute=1 0 /------------ [section_detecteurs] -513,43,1,10 +513,43,0,0 514,18,0,0 -515,67,1,5 +515,67,0,0 516,150,0,0 517,60,0,0 518,56,0,0 -519,66,1,5 +519,66,0,0 520,73,0,0 521,85,0,0 -522,120,1,10 -523,84,1,10 +522,120,0,0 +523,84,0,0 524,67,0,0 525,153,0,0 526,84,0,0 @@ -288,7 +342,7 @@ DureeMinute=1 528,150,0,0 529,77,0,0 530,90,0,0 -531,29,0,0 +531,28,0,0 533,127,0,0 534,92,0,0 535,134,0,0 @@ -297,43 +351,41 @@ DureeMinute=1 0 /------------ [section_logique] -/--- fonction 1 -"Mafonction1" -0,Fonction logique,N1,T0,A13,E0,V,,O0, -1,Opérateur ET,N2,T1,A0,E0,V,,O0, -2,Etat DCC,N3,T5,A10,E2,V,,O0, -3,Etat DCC,N3,T5,A11,E2,V,,O0, -4,Opérateur OU,N3,T2,A0,E0,V,,O0, -5,Etat DCC,N4,T5,A12,E1,V,,O0, -6,Etat DCC,N4,T5,A17,E1,V,,O0, -7,Opérateur ET,N4,T1,A0,E0,V,,O0, -8,Etat DCC,N5,T5,A25,E1,V,,O0, -9,Etat DCC,N5,T5,A26,E1,V,,O0, -10,Opérateur ET,N3,T1,A0,E0,V,,O0, -11,Etat détect./actionn.,N4,T6,A513,E1,V,,O0, -12,Etat détect./actionn.,N4,T6,A515,E1,V,,O0, -FF -/--- fonction 2 -"kgkhgk" -0,Fonction logique,N2,T0,A3,E0,V,,O0, -1,Opérateur ET,N2,T1,A0,E0,V,,O0, -2,Mémoire,N3,T8,A1,E31,V,CC406526,O2, -FF -/--- fonction 3 -"fonction 3" -0,Fonction logique,N3,T0,A7,E0,V,,O0, -1,Opérateur ET,N2,T1,A0,E0,V,,O0, -2,Etat DCC,N3,T5,A0,E0,V,,O0, -3,Etat DCC,N3,T5,A0,E0,V,,O0, -4,Opérateur ET,N3,T1,A0,E0,V,,O0, -5,Etat DCC,N4,T5,A0,E0,V,,O0, -6,Etat DCC,N4,T5,A0,E0,V,,O0, -FF -/--- fonction 4 -"fonction 4" -0,Fonction logique,N4,T0,A4,E0,V,,O0, -1,Opérateur Non ET,N2,T3,A0,E0,V,,O0, -2,Bouton TCO,N3,T7,A1,E1,V,,O0, -3,Mémoire,N3,T8,A2,E1,V,,O1, +/--- Fonction 1 +"0" FF 0 +/------------ +[section_blocs_USB] +B1,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B2,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B3,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B4,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B5,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B6,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B7,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B8,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B9,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +B10,,BR0,0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0,B0,0,0 +0 +/------------ +[section_compteurs] +Compteur1 +Aiguille=0000FF +Graduations=FFFFFF +Numeros=FFFFFF +Fond=000000 +Arc=008000 +Compteur2 +Aiguille=0000FF +Graduations=000000 +Numeros=FF0000 +Fond=808080 +Arc=008000 +Compteur3 +Aiguille=0000FF +Graduations=FFFFFF +Numeros=FFFFFF +Fond=000000 +Arc=008000 +0 diff --git a/Notice d'utilisation des signaux_complexes_GL_V10.5.pdf b/Notice d'utilisation des signaux_complexes_GL_V10.53.pdf similarity index 83% rename from Notice d'utilisation des signaux_complexes_GL_V10.5.pdf rename to Notice d'utilisation des signaux_complexes_GL_V10.53.pdf index 5566898..6755331 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V10.5.pdf and b/Notice d'utilisation des signaux_complexes_GL_V10.53.pdf differ diff --git a/UnitClock.pas b/UnitClock.pas index 3ac6c96..f197fcf 100644 --- a/UnitClock.pas +++ b/UnitClock.pas @@ -146,6 +146,7 @@ end; destructor TClock.Destroy; begin FBitMap.Free; + FbitMap:=nil; Ticker.Free; inherited Destroy; end; diff --git a/UnitCompteur.pas b/UnitCompteur.pas index 055a367..a0361c1 100644 --- a/UnitCompteur.pas +++ b/UnitCompteur.pas @@ -63,7 +63,7 @@ type var formCompteur : array[1..1] of TformCompteur; // il y a 10 fenetres mais on utilise qu'un compteur. - Scompteur : TTCompteur; // Scompteur : associé à fen + Scompteur : TTCompteur; // Scompteur : associé à grande fenetre compteur ParamCompteur : array[1..3] of record coulAig,coulGrad,CoulNum,CoulFond,CoulArc : tcolor; end; @@ -83,7 +83,7 @@ function Vr_kmh(v : integer) : integer; implementation -uses UnitTCO, UnitClock , UnitConfig; +uses UnitTCO, UnitClock , UnitConfig, UnitDebug; {$R *.dfm} @@ -112,6 +112,7 @@ begin finally ReleaseDC(FormCompteur[1].Handle, ACanvas.Handle); ACanvas.Free; + ACanvas:=nil; end; end; @@ -479,8 +480,11 @@ begin until angle>param.AngleFin+incr; end; + // copie l'image du texte "tachro" mise à l'échelle + StretchBlt(bm.Canvas.Handle,round(145*r),round(90*r),round(lim*r),round(him*r), + FormPrinc.ImageTachro.canvas.Handle,0,0,lim,him,srcCopy); + param.AngleFin:=220; // en fait vitesse maxi compteur - exit; end; @@ -574,7 +578,7 @@ var comptLoc,l,h,lim,him,hfen,mini,maxi,vmax : integer; canv : tcanvas; begin if (i<1) or (hautComptC=0) then exit; - //Affiche('Init compteur de vitesse',clYellow); + if ProcPrinc then Affiche('Init compteur de vitesse '+intToSTR(i)+' composant '+c.name,clYellow); typDest:=Trien; if c is tform then typDest:=fen; // si le compteur est la fenetre unique @@ -689,7 +693,7 @@ begin 3 : compteurT[i].paramcompt.rav:=round(115*compteurT[i].paramcompt.redx); end; - compteurT[i].FCBitMap.Free; + //ne pas faire compteurT[i].FCBitMap.Free çà fait une exception si il est déja en nil, contrairement à D12. compteurT[i].fcBitMap:=tbitmap.Create; with compteurT[i].FCBitMap do begin @@ -765,7 +769,7 @@ begin // imageC <-- FCBitMap (on écrit les vitesses) <- ImageCompteur (grande) // créer un bitmap réduit qui sert de référence - Scompteur[i].FCBitMap.Free; + Scompteur[i].FCBitMap.Free; Scompteur[i].fcBitMap:=tbitmap.Create; with Scompteur[i].FCBitMap do begin diff --git a/UnitConfig.dfm b/UnitConfig.dfm index d55d0f5..60d1488 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,6 +1,6 @@ object FormConfig: TFormConfig - Left = 242 - Top = 193 + Left = 265 + Top = 106 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' @@ -670,7 +670,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetCDM + ActivePage = TabSheetTrains Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -1098,13 +1098,13 @@ object FormConfig: TFormConfig end object Label28: TLabel Left = 8 - Top = 70 + Top = 64 Width = 182 Height = 13 Caption = 'Port du serveur de Signaux Complexes' end object EditFonte: TEdit - Left = 240 + Left = 248 Top = 16 Width = 25 Height = 21 @@ -1113,7 +1113,7 @@ object FormConfig: TFormConfig TabOrder = 0 end object EditDebug: TEdit - Left = 240 + Left = 248 Top = 38 Width = 25 Height = 21 @@ -1136,7 +1136,7 @@ object FormConfig: TFormConfig OnClick = CheckBoxVerifXpressNetClick end object EditPortServeur: TEdit - Left = 216 + Left = 224 Top = 62 Width = 49 Height = 21 @@ -1189,7 +1189,7 @@ object FormConfig: TFormConfig 'S'#233'lection du style d'#39#39'affichage - Le style sera chang'#233' '#224' la ferm' + 'eture de la fen'#234'tre'#39 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 0 @@ -4160,7 +4160,7 @@ object FormConfig: TFormConfig Top = 16 Width = 337 Height = 457 - ActivePage = TabSheetCourbes + ActivePage = TabSheetTrGen TabOrder = 3 object TabSheetTrGen: TTabSheet Caption = 'G'#233'n'#233'ral' diff --git a/UnitConfig.pas b/UnitConfig.pas index 095cc1b..a38cc12 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -4497,6 +4497,19 @@ const LessThanValue=-1; i:=pos(',',s); if i=0 then i:=length(s)+1; trains[ntrains].NomIcone:=copy(s,1,i-1); + Trains[ntrains].icone:=Timage.create(nil); + + with Trains[ntrains].icone do + begin + autosize:=true; + align:=alNone; + parent:=nil; + name:='IconeTrain'+intToSTR(nTrains); + top:=0;left:=0; + width:=200; + height:=100; + end; + Formprinc.ComboTrains.Items.Add(trains[ntrains].nom_train); delete(s,1,i-1); end; @@ -6188,9 +6201,8 @@ const LessThanValue=-1; compile_compteurs; end; - - inc(it); + until (eof(fichier)); end; // fin de lit_flux @@ -11047,6 +11059,7 @@ begin supprime_pn; end; +// renvoie le nombre d'adresses occupées par un signal function nombre_adresses_signal(adr : integer) : integer; var x,dec,nc,i,j : integer; begin @@ -11094,12 +11107,13 @@ begin end; if dec=9 then nc:=2; // LS-DEC-NMBS if dec=10 then nc:=Signaux[i].Na; // Bmodels + if dec=11 then nc:=Signaux[i].Na; // LEA + if dec>=NbDecodeurdeBase then begin j:=dec-NbDecodeurdeBase+1; nc:=decodeur_pers[j].NbreAdr; end; - if dec=11 then nc:=Signaux[i].Na; // LEA nombre_adresses_signal:=nc; end; @@ -11233,11 +11247,14 @@ begin formconfig.ListBoxSig.Items.Delete(i-1); Signaux[i].Img.free; // supprime l'image, ce qui efface le signal du tableau graphique + Signaux[i].Img:=nil; Signaux[i].Lbl.free; // supprime le label + Signaux[i].Lbl:=nil; Tablo_Index_Signal[Signaux[i].adresse]:=0; if Signaux[i].checkFB<>nil then begin - Signaux[i].checkFB.Free;Signaux[i].CheckFB:=nil; + Signaux[i].checkFB.Free; + Signaux[i].CheckFB:=nil; end; // supprime le check du feu blanc s'il existait for j:=i to NbreSignaux-1 do @@ -14171,7 +14188,7 @@ begin if CheckEnvAigDccpp.checked then EnvAigDccpp:=1 else EnvAigDccpp:=0; end; -// affiche l'icone du train index dans le canvas +// copie et affiche l'icone du train index dans Iimage depuis Trains[].Icone // Iimage: destination ; index: index du train // en sortie : largeur de l'image générée function Maj_icone_train(IImage : Timage;index :integer;coulfond : Tcolor) : integer; @@ -14352,11 +14369,26 @@ begin if nTrains>=Max_Trains then exit; clicListe:=true; inc(nTrains); - trains[ntrains].nom_train:='train'; - trains[ntrains].adresse:=99; - trains[ntrains].VitNominale:=60; - trains[ntrains].VitRalenti:=40; - trains[ntrains].vitmax:=120; + with trains[ntrains] do + begin + nom_train:='train'; + adresse:=99; + VitNominale:=60; + VitRalenti:=40; + vitmax:=120; + icone:=Timage.create(nil); + with icone do + begin + Name:='IconeTrain'+intToSTR(nTrains); + autosize:=true; + align:=alNone; + parent:=nil; + top:=0;left:=0; + width:=200; + height:=100; + end; + end; + clicListeTrains(ntrains); ligneclicTrain:=ntrains-1; clicListe:=false; @@ -14391,7 +14423,6 @@ var i,j,n : integer; s,ss : string; begin ss:=''; - n:=0; for i:=0 to nTrains-1 do begin if formconfig.ListBoxTrains.selected[i] then @@ -14430,45 +14461,69 @@ begin end; // suppression - n:=0; + formCompteur[1].close; + i:=1; repeat if formconfig.ListBoxTrains.selected[i-1] then begin - for j:=i to ntrains do + j:=i; + Affiche('Supprime train '+intToSTR(j)+' '+Trains[j].nom_train,clOrange); + // libérer les composants car on va réaffecter des noms + trains[j].icone.Free; + image_train[j].free; + labeltrain[j].free; + LabelVitesse[j].free; + labelBlocUSB[j].free; + trains[j].icone:=nil; + image_train[j]:=nil; + labeltrain[j]:=nil; + LabelVitesse[j]:=nil; + labelBlocUSB[j]:=nil; + // composants onglet compteurs + compteurT[j].Img.Free; + compteurT[j].img:=nil; + compteurT[j].tb.Free; + compteurT[j].tb:=nil; + compteurT[j].lbl.Free; + compteurT[j].lbl:=nil; + compteurT[j].bouton.Free; + compteurT[j].bouton:=nil; + compteurT[j].FcBitmap.Free; + compteurT[j].FcBitmap:=nil; + compteurT[j].gb.free; + compteurT[j].gb:=nil; + + // décaler le reste du tableau + for j:=i to nTrains do begin - if formconfig.ListBoxTrains.selected[j-1] then - begin - // libérer les composants car on va réaffecter des noms - image_train[j].free; - labeltrain[j].free; - LabelVitesse[j].free; - // onglet compteurs - compteurt[j].Img.Free; - compteurt[j].tb.Free; - compteurt[j].lbl.Free; - compteurt[j].bouton.Free; - compteurT[j].gb.free; - compteurT[j].FcBitmap.Free; - end; if jntrains; Formprinc.ScrollBoxTrains.Repaint; @@ -18832,7 +18887,7 @@ begin ServeurIPCDM_touche:=s='simulation de touches'; end; 14 : begin - if length(s)<4 then labelInfo.Caption:='Valeur incorrecte' + if length(s)<1 then labelInfo.Caption:='Valeur incorrecte' else string(p^):=s; // CheminProgrammesCDM:=s; end; 15 : begin diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index cf853bf..5992408 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -221,7 +221,7 @@ begin if affevt then affiche('FormConfigCellTCO actualise',clyellow); xclicC:=XclicCell[indexTCO]; yclicC:=YclicCell[indexTCO]; - + actualize:=true; // évite les évènements parasites //with FormConfCellTCO.ImagePaletteCC.Picture.Bitmap do with FormConfCellTCO.ImagePaletteCC do begin @@ -377,6 +377,7 @@ begin if (act<0) or (act-1>ListBoxAction.Count) then begin Affiche('Erreur 29 ',clred); + actualize:=false; exit; end; ListBoxAction.ItemIndex:=act-1; @@ -514,7 +515,8 @@ begin ConfCellTCO:=false; FormTCO[indexTCO].GroupBox1.Caption:='Configuration cellule '+s; XclicCellInserer:=XclicC; - YclicCellInserer:=YclicC; + YclicCellInserer:=YclicC; + FormTCO[indexTCO].EditAdrElement.Text:=IntToSTR(tco[indexTCO,XclicCellInserer,YclicCellInserer].Adresse); FormTCO[indexTCO].EdittypeImage.Text:=IntToSTR(BImage); FormTCO[indexTCO].ComboRepr.ItemIndex:=tco[indexTCO,XclicC,YclicC].repr; @@ -525,8 +527,8 @@ begin if tco[indexTCO,Xclic,Yclic].adresse<>0 then s:=s+' Adr='+intToSTR(tco[indexTCO,XclicC,YclicC].adresse); //hint:=s; - if not(ConfCellTCO) then exit; - actualize:=true; // évite les évènements parasites + if not(ConfCellTCO) then begin actualize:=false;exit;end; + actualize:=true; FormConfCellTCO.caption:='Propriétés de la cellule '+IntToSTR(XclicC)+','+intToSTR(YclicC)+' TCO '+intToSTR(IndexTCO); Bimage:=tco[indexTCO,XclicC,YclicC].Bimage; formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage); diff --git a/UnitDebug.dfm b/UnitDebug.dfm index c7c9cb3..a1c7af3 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -32,7 +32,6 @@ object FormDebug: TFormDebug Width = 872 Height = 677 HorzScrollBar.Visible = False - VertScrollBar.Position = 96 Anchors = [akLeft, akTop, akRight, akBottom] Color = clBtnFace ParentColor = False @@ -42,7 +41,7 @@ object FormDebug: TFormDebug 673) object LabelTitreDebug: TLabel Left = 475 - Top = -88 + Top = 8 Width = 131 Height = 18 Anchors = [akTop, akRight] @@ -56,7 +55,7 @@ object FormDebug: TFormDebug end object Label1: TLabel Left = 627 - Top = -86 + Top = 10 Width = 108 Height = 13 Anchors = [akTop, akRight] @@ -72,7 +71,7 @@ object FormDebug: TFormDebug end object RichDebug: TRichEdit Left = 0 - Top = -96 + Top = 0 Width = 454 Height = 753 Anchors = [akLeft, akTop, akRight] @@ -86,7 +85,7 @@ object FormDebug: TFormDebug end object ButtonRazTout: TButton Left = 465 - Top = 120 + Top = 216 Width = 97 Height = 25 Hint = @@ -101,7 +100,7 @@ object FormDebug: TFormDebug end object ButtonCop: TButton Left = 465 - Top = 152 + Top = 248 Width = 97 Height = 41 Anchors = [akTop, akRight] @@ -118,7 +117,7 @@ object FormDebug: TFormDebug end object ButtonAffEvtChrono: TButton Left = 465 - Top = 200 + Top = 296 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -129,7 +128,7 @@ object FormDebug: TFormDebug end object ButtonCherche: TButton Left = 465 - Top = 240 + Top = 336 Width = 97 Height = 25 Hint = 'Cherche la cha'#238'ne "erreur"' @@ -142,7 +141,7 @@ object FormDebug: TFormDebug end object ButtonEcrLog: TButton Left = 465 - Top = 88 + Top = 184 Width = 97 Height = 29 Anchors = [akTop, akRight] @@ -152,7 +151,7 @@ object FormDebug: TFormDebug end object ButtonRazTampon: TButton Left = 465 - Top = 272 + Top = 368 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -163,7 +162,7 @@ object FormDebug: TFormDebug end object ButtonRazLog: TButton Left = 465 - Top = 312 + Top = 408 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -174,7 +173,7 @@ object FormDebug: TFormDebug end object MemoEvtDet: TRichEdit Left = 570 - Top = 90 + Top = 186 Width = 272 Height = 263 Anchors = [akTop, akRight] @@ -185,7 +184,7 @@ object FormDebug: TFormDebug end object GroupBox5: TGroupBox Left = 462 - Top = 360 + Top = 456 Width = 380 Height = 57 Anchors = [akTop, akRight] @@ -252,7 +251,7 @@ object FormDebug: TFormDebug end object GroupBox6: TGroupBox Left = 462 - Top = 424 + Top = 520 Width = 380 Height = 52 Anchors = [akTop, akRight] @@ -329,7 +328,7 @@ object FormDebug: TFormDebug end object GroupBoxPrim: TGroupBox Left = 464 - Top = 488 + Top = 584 Width = 378 Height = 185 Anchors = [akTop, akRight] @@ -500,7 +499,7 @@ object FormDebug: TFormDebug end object GroupBox2: TGroupBox Left = 466 - Top = -68 + Top = 28 Width = 376 Height = 149 Anchors = [akTop, akRight] @@ -713,7 +712,7 @@ object FormDebug: TFormDebug end object EditNivDebug: TEdit Left = 751 - Top = -88 + Top = 8 Width = 49 Height = 21 Anchors = [akTop, akRight] diff --git a/UnitFicheHoraire.dfm b/UnitFicheHoraire.dfm index 149cc07..d5a4089 100644 --- a/UnitFicheHoraire.dfm +++ b/UnitFicheHoraire.dfm @@ -32,7 +32,7 @@ object FormFicheHoraire: TFormFicheHoraire object LabelErreur: TLabel Left = 99 Top = 297 - Width = 173 + Width = 3 Height = 13 Anchors = [akLeft, akBottom] Caption = '.' diff --git a/UnitFicheHoraire.pas b/UnitFicheHoraire.pas index bb793ed..e0f3364 100644 --- a/UnitFicheHoraire.pas +++ b/UnitFicheHoraire.pas @@ -265,11 +265,8 @@ begin closefile(f); couleurs_Fiche; StringGridFO.Selection:=tGridRect(rect(0,0,0,0)); - end; - - procedure TFormFicheHoraire.FormActivate(Sender: TObject); begin if FormFicheHoraire=nil then exit; diff --git a/UnitHorloge.pas b/UnitHorloge.pas index 03c51a8..682448f 100644 --- a/UnitHorloge.pas +++ b/UnitHorloge.pas @@ -123,24 +123,12 @@ end; procedure TFormHorloge.FormActivate(Sender: TObject); begin if formHorloge=nil then exit; - - if horlogeinterne then - begin - valide_hi; - end - else - begin - devalide_hi; - end; + if horlogeinterne then valide_hi else devalide_hi; end; procedure TFormHorloge.TrackBarTempsChange(Sender: TObject); begin - //DureeMinute:=TrackBarTemps.position; - //if (DureeMinute<1) or (DureeMinute>60) then DureeMinute:=30; - //LabelDuree.caption:=intToSTR(6*(DureeMinute*5) div 30); - CompteurDixiemes:=TrackBarTemps.position; DureeMinute:=CompteurDixiemes; // variable de sauvegarde @@ -167,8 +155,6 @@ begin init_horloge; end; - - procedure TFormHorloge.EditMInitChange(Sender: TObject); var i,erreur : integer; begin @@ -255,7 +241,7 @@ begin CompteurDixiemes:=DureeMinute; couleurs_horloge; TrackBarTemps.position:=DureeMinute; - + RadioButtonHI.Checked:=horlogeInterne; RadioButtonHS.Checked:=not(horlogeInterne); CheckBoxLanceHorl.Checked:=LanceHorl; @@ -268,7 +254,6 @@ begin EditRetourMinute.Text:=intToSTR(RetourMinute); LabelDuree.caption:=intToSTR(6*CompteurDixiemes); config_modifie:=false; - end; procedure TFormHorloge.CheckBoxLanceHorlClick(Sender: TObject); diff --git a/UnitMesure.pas b/UnitMesure.pas index 28a5f0c..38fd22e 100644 --- a/UnitMesure.pas +++ b/UnitMesure.pas @@ -125,7 +125,6 @@ begin TransparentBlt(cv.Handle,rect.Left+2,rect.Top,largDest,hautDest, Trains[index+1].Icone.canvas.Handle,0,0,l,h,clWhite); - end; procedure TFormMesure.ComboBoxTrainsChange(Sender: TObject); diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 9d6dc2e..4fb2110 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -5895,64 +5895,64 @@ object FormPrinc: TFormPrinc end end object GroupBoxCV: TGroupBox - Left = 737 - Top = 16 + Left = 657 + Top = 72 Width = 265 - Height = 105 + Height = 81 Anchors = [akTop, akRight] Caption = 'Variables CV' Color = clBtnFace ParentColor = False TabOrder = 4 object Label3: TLabel - Left = 208 - Top = 34 + Left = 192 + Top = 18 Width = 14 Height = 13 Caption = 'CV' WordWrap = True end object LabelVCV: TLabel - Left = 208 - Top = 63 + Left = 192 + Top = 47 Width = 47 Height = 13 Caption = 'Valeur CV' WordWrap = True end object ButtonEcrCV: TButton - Left = 8 + Left = 24 Top = 16 - Width = 153 - Height = 33 + Width = 65 + Height = 25 Hint = 'Ecriture CV en mode direct sur voie de programmation' - Caption = 'Ecriture CV - 1 '#224' 255 par interface' + Caption = 'Ecriture CV' TabOrder = 0 WordWrap = True OnClick = ButtonEcrCVClick end object ButtonLitCV: TButton - Left = 8 - Top = 64 - Width = 153 - Height = 33 + Left = 24 + Top = 48 + Width = 65 + Height = 25 Hint = 'Lecture CV en mode direct sur voie de programmation' - Caption = 'Lecture CV - 1 '#224' 255 par interface' + Caption = 'Lecture CV' Enabled = False TabOrder = 1 WordWrap = True OnClick = ButtonLitCVClick end object EditCV: TEdit - Left = 168 - Top = 32 + Left = 152 + Top = 16 Width = 33 Height = 21 TabOrder = 2 end object EditVal: TEdit - Left = 168 - Top = 60 + Left = 152 + Top = 44 Width = 33 Height = 21 TabOrder = 3 diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 7c580be..b0826d3 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -94,7 +94,9 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MMSystem , math, - Buttons, NB30, comObj, activeX //,DateUtils//, PsAPI + Buttons, NB30, comObj, activeX, registry //,DateUtils//, PsAPI + + , psAPI // GetModuleFileNameEx {$IFDEF AvecIdTCP} ,IdTCPClient // client socket indy , ne marche pas bien @@ -314,18 +316,14 @@ type procedure ButtonDroitClick(Sender: TObject); procedure EditvalEnter(Sender: TObject); procedure BoutonRafClick(Sender: TObject); - procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure ClientSocketInterfaceConnect(Sender: TObject;Socket: TCustomWinSocket); procedure ClientSocketInterfaceDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); - procedure ClientInfoError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure ClientInfoConnect(Sender: TObject;Socket: TCustomWinSocket); procedure ClientInfoDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientInfoRead(Sender: TObject; Socket: TCustomWinSocket); - - procedure MenuConnecterUSBClick(Sender: TObject); procedure DeconnecterUSBClick(Sender: TObject); procedure MenuConnecterEthernetClick(Sender: TObject); @@ -333,18 +331,12 @@ type procedure AffEtatDetecteurs(Sender: TObject); procedure Etatdesaiguillages1Click(Sender: TObject); procedure Codificationdesaiguillages1Click(Sender: TObject); - procedure ClientSocketCDMError(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; - var ErrorCode: Integer); - - procedure ClientSocketCDMConnect(Sender: TObject; - Socket: TCustomWinSocket); - procedure ClientSocketCDMRead(Sender: TObject; - Socket: TCustomWinSocket); + procedure ClientSocketCDMError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure ClientSocketCDMConnect(Sender: TObject; Socket: TCustomWinSocket); + procedure ClientSocketCDMRead(Sender: TObject; Socket: TCustomWinSocket); procedure ConnecterCDMrailClick(Sender: TObject); procedure DeconnecterCDMRailClick(Sender: TObject); - procedure ClientSocketCDMDisconnect(Sender: TObject; - Socket: TCustomWinSocket); + procedure ClientSocketCDMDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure CodificationdessignauxClick(Sender: TObject); procedure FichierSimuClick(Sender: TObject); procedure ButtonEcrCVClick(Sender: TObject); @@ -364,8 +356,7 @@ type procedure ButtonDevieClick(Sender: TObject); procedure Proprits1Click(Sender: TObject); procedure VrifierlacohrenceClick(Sender: TObject); - procedure FenRichMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); + procedure FenRichMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonLocCVClick(Sender: TObject); procedure ComboTrainsChange(Sender: TObject); procedure ButtonFonctionClick(Sender: TObject); @@ -422,31 +413,18 @@ type procedure FormResize(Sender: TObject); procedure Affichagenormal1Click(Sender: TObject); procedure Sauvegarderla1Click(Sender: TObject); - procedure StatusBar1DrawPanel(StatusBar: TStatusBar; - Panel: TStatusPanel; const Rect: TRect); - procedure ClientSocketCde1Connect(Sender: TObject; - Socket: TCustomWinSocket); - procedure ClientSocketCde1Error(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; - var ErrorCode: Integer); - procedure ClientSocketCde1Read(Sender: TObject; - Socket: TCustomWinSocket); - procedure ClientSocketCde2Connect(Sender: TObject; - Socket: TCustomWinSocket); - procedure ClientSocketCde2Error(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; - var ErrorCode: Integer); - procedure ClientSocketCde2Read(Sender: TObject; - Socket: TCustomWinSocket); + procedure StatusBar1DrawPanel(StatusBar: TStatusBar;Panel: TStatusPanel; const Rect: TRect); + procedure ClientSocketCde1Connect(Sender: TObject;Socket: TCustomWinSocket); + procedure ClientSocketCde1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure ClientSocketCde1Read(Sender: TObject; Socket: TCustomWinSocket); + procedure ClientSocketCde2Connect(Sender: TObject; Socket: TCustomWinSocket); + procedure ClientSocketCde2Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer); + procedure ClientSocketCde2Read(Sender: TObject; Socket: TCustomWinSocket); procedure Toutslectionner1Click(Sender: TObject); - procedure Copierltatdesaiguillageseninitialisation1Click( - Sender: TObject); - procedure ServerSocketAccept(Sender: TObject; - Socket: TCustomWinSocket); - procedure ServerSocketClientRead(Sender: TObject; - Socket: TCustomWinSocket); - procedure ServerSocketClientDisconnect(Sender: TObject; - Socket: TCustomWinSocket); + procedure Copierltatdesaiguillageseninitialisation1Click(Sender: TObject); + procedure ServerSocketAccept(Sender: TObject; Socket: TCustomWinSocket); + procedure ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket); + procedure ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure Listedesclientsconnects1Click(Sender: TObject); procedure Horloge1Click(Sender: TObject); procedure Ficheshoraires1Click(Sender: TObject); @@ -465,8 +443,7 @@ type procedure Compilerlabasededonnes1Click(Sender: TObject); procedure PopupMenuTrainsPopup(Sender: TObject); procedure Propritsdutrain1Click(Sender: TObject); - procedure FormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Affiche_compteurClick(Sender: TObject); procedure ButtonEssaiClick(Sender: TObject); procedure TrackBarZCChange(Sender: TObject); @@ -998,6 +975,7 @@ tTrain = record nom_train : string; inverse : boolean; // placement detecteurA : integer; // détecteur sur lequel le train se trouve + detecteurPrec : integer; // détecteur précédent : d'ou vient le train detecteurSuiv : integer; // détecteur vers lequel se dirige le train ElSuivant : integer; // élément suivant vers lequel se dirige le train TElSuivant : tEquipement; @@ -1510,6 +1488,7 @@ procedure reprise_dcc; procedure renseigne_comp_trains(i : integer); function ClavierHookLLProc(Code : integer; WordParam : wparam; LongParam: lparam) : LongInt; stdcall; procedure cree_GB_compteur(rang : integer); +procedure pilote_train(det1,det2,AdrTrain,it : integer); implementation @@ -1749,7 +1728,7 @@ begin if s='golden graphite' then style[i].clarte:=sombre; if s='iceberg classico' then style[i].clarte:=clair; //beau if s='jet' then style[i].clarte:=sombre; - if s='golden graphite' then style[i].clarte:=sombre; // beau avec boutons or + if s='golden graphite' then style[i].clarte:=sombre; // beau avec boutons or if s='glossy' then style[i].clarte:=sombre; if s='glossy2' then style[i].clarte:=sombre; if s='glow' then style[i].clarte:=sombre; @@ -1870,8 +1849,8 @@ begin end; end; - // reprendre le vrai nom du style depuis SI.name car le nom du fichier peur être différent du nom du style - // exemple le style "Metropolis UI Dark" (avec espaces) a pour nom de fichier "MetropolisUIDark.vsf" + // reprendre le vrai nom du style depuis SI.name car le nom du fichier peur être différent du nom windows du style + // exemple le style windows "Metropolis UI Dark" (avec espaces) a pour nom de fichier "MetropolisUIDark.vsf" Nom_style_aff:=si.Name; try @@ -1914,7 +1893,7 @@ end; // =2 vient de bloc USB procedure consigne_train(origine : integer); var s : string; - vit,erreur,vientde : integer; + vit,vientde : integer; begin vientde:=0; with formprinc do @@ -1930,7 +1909,7 @@ begin vitesse_loco(trains[IdTrainClic].nom_train, idTrainClic, trains[idTrainClic].adresse, - trains[idTrainClic].vitesseCons, // vit + trains[idTrainClic].vitesseCons, // vit 10,vientde); end; } //if origine=2 then @@ -1985,7 +1964,6 @@ begin Anchors:=[akLeft,akTop,akRight,akBottom]; end; - with Fenrich do begin begin @@ -2241,9 +2219,19 @@ begin s:=s+' Nbrefonctions='+intToSTR(NbreFL); s:=s+' NbrePeriph='+intToSTR(NbPeriph); - if mode=1 then Affiche(s,clyellow); - if mode=2 then ClientInfo.Socket.SendText(s); + if mode=1 then + begin + Affiche(s,clyellow); + Affiche(lay,clyellow); + Affiche(Nom_Style_Aff,clyellow); + end; + if mode=2 then + begin + ClientInfo.Socket.SendText(s+#13+#10); + ClientInfo.Socket.SendText(lay+#13+#10); + ClientInfo.Socket.SendText(Nom_Style_Aff+#13+#10); + end; for i:=1 to ntrains do begin n:=trains[i].routePref[0,0].adresse; @@ -2270,6 +2258,34 @@ begin end; end; +function lire_registre_chaine(cle : hkey;s1,s2 : string) : string; +var + Reg: TRegistry; +begin + Reg:=TRegistry.Create(KEY_READ); + Reg.Access:=KEY_READ; + + try + Reg.RootKey:=cle; + + if Reg.KeyExists(s1) then + begin + if Reg.OpenKeyReadOnly(s1) then + begin + if reg.ValueExists(s2) then result:=reg.ReadString(s2) else Affiche('Erreur C',clred); + end + else begin result:='';Affiche('erreur A',clred);end; + end + else + begin + result:=''; // CDM non installé + end; + finally + Reg.Free; + end; +end; + + procedure fin_preliminaire; var i : integer; s : string; @@ -2343,8 +2359,6 @@ begin for i:=1 to ntrains do begin cree_GB_compteur(i); - - trains[i].canton:=0; trains[i].x:=-999999; trains[i].y:=-999999; trains[i].BlocUSB:=0; @@ -2357,6 +2371,23 @@ begin formprinc.SetFocus; menu_selec; + // Vérifier le chemin CDM + s:=lire_registre_chaine(HKEY_CURRENT_USER,'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\CDM-Rail','UninstallString'); + s:=ExtractFilePath(s); // chemin de CDM + + if (s<>'') and ((cheminProgrammesCDM='') or (cheminProgrammesCDM+'\CDM-Rail\'<>s)) then + begin + if MessageDlg('Le chemin de CDM rail dans l''ordinateur '+#13+s+#13+ + 'est différent de celui déclaré. Voulez vous le mettre à jour ?' + ,mtConfirmation,[mbYes, mbNo], 0) = mrYes then + begin + i:=pos('\CDM-Rail',s); + if i<>0 then s:=copy(s,1,i-1); + config_modifie:=true; + cheminProgrammesCDM:=s; + end; + end; + Maj_Signaux(false); end; @@ -3281,7 +3312,7 @@ end; // dessine un cercle plein dans le signal dans le canvas procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;coulcercle,couleurfond : Tcolor); var hdc,canvasHd : hwnd; - ps : PAINTSTRUCT ; + ps : paintstruct; begin //vwhd:=getparent(Acanvas.Handle); @@ -3311,7 +3342,7 @@ begin end; // Ecrire sur un canvas un texte avec un angle, avec ou sans bordure, monochrome ou à face texturée -// params : C = Canvas-cible +// params : C = Canvas // X,Y = Coordonnées angle supérieur gauche du début du texte. // Fonte = Police de caractères à utiliser : uniquement des fontes scalables. // clBord = Couleur de la bordure. @@ -3334,11 +3365,11 @@ begin dc:=C.Handle; c.pen.Mode:=PmCopy; - //c.pen.Color:=clfond; //clfond; + //c.pen.Color:=clfond; //c.Brush.color:=clfond; c.pen.width:=1; i:=round(length(texte)*0.5*abs(fonte.size)); -// c.Rectangle(x+2,y,x+15,y-i); + //c.Rectangle(x+2,y,x+15,y-i); // Initialisation de la fonte zeroMemory(@lgFont,sizeOf(lgFont)); // remplit la structure de 0 @@ -3369,7 +3400,7 @@ begin // Le contexte doit être transparent SetBkMode(dc,TRANSPARENT); - // Dessin du texe : + // Dessin du texte : BeginPath(dc); TextOut(dc,X,Y,PChar(Texte),length(texte)); //<- au lieu de TextOut(dc,X,Y,PansiChar(Texte),length(texte)) pour rendre le code compatible avec toutes les versions de Delphi (de D2 à XE2); EndPath(dc); @@ -5355,8 +5386,9 @@ begin Signaux[rang].Lbl:=Tlabel.create(Formprinc.ScrollBoxSig); with Signaux[rang].Lbl do begin - Name:='LabelFeu'+intToSTR(Signaux[rang].adresse); - caption:='@'+IntToSTR(Signaux[rang].adresse); + Name:='LabelSignal'+intToSTR(Signaux[rang].adresse); + caption:=' '+IntToSTR(Signaux[rang].adresse); + font.Style:=[fsBold]; Parent:=Formprinc.ScrollBoxSig; font.color:=clBlack; width:=100;height:=20; @@ -5521,13 +5553,7 @@ begin end; end; - compteurT[rang].FCBitMap.Free; - compteurT[rang].fcBitMap:=tbitmap.Create; - with compteurT[rang].FCBitMap do - begin - Width:=imL; - Height:=imH; - end; + // le compteurT[].FCBitmap sera créé dans init_compteur // bouton CompteurT[rang].bouton:=Tbutton.create(CompteurT[rang].gb); @@ -5628,7 +5654,7 @@ begin Left:=LargImgTrain+10; BringToFront; end; - with LabelBlocUSB[i] do + with LabelBlocUSB[i] do begin Name:='LabelBlocUSB'+intToSTR(i); caption:=''; @@ -5649,6 +5675,7 @@ var i,adresse : integer; begin if rang<1 then exit; adresse:=trains[rang].adresse; + Image_Train[rang]:=Timage.create(Formprinc.ScrollBoxTrains); if Image_Train[rang]=nil then begin affiche('Erreur 901 : impossible de créer une image',clred);exit;end; @@ -14048,7 +14075,7 @@ begin if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' '; if etatZone then s:=s+'de '+intToSTR(actuel)+' à '+intToSTR(dernierdet); if etatDet then s:=s+'sur det '+intToSTR(actuel); - if El<>0 then s:=s+' Elsuiv='+intToSTR(ElSuiv); + if ElSuiv<>0 then s:=s+' Elsuiv='+intToSTR(ElSuiv); AfficheDebug(s,clYellow); if debug=3 then formprinc.Caption:=''; end; @@ -15291,7 +15318,8 @@ begin if trains[index_train].route[0].talon then vitesse:=-vitesse; vitesse_loco('',index_train,AdrTrain,vitesse,10,0); end; - end; + end + else if (Rappel60C) and not(jauneC) and entree_signal then begin @@ -15305,7 +15333,8 @@ begin //if trains[index_train].inverse then vitesse:=-vitesse; vitesse_loco('',index_train,AdrTrain,vitesse,10,0); end; - end; + end + else if (testbit(etat,vert) or testbit(etat,vert_cli)) and entree_signal then begin @@ -15319,8 +15348,8 @@ begin if trains[index_train].route[0].talon then vitesse:=-vitesse; vitesse_loco('',index_train,AdrTrain,vitesse,10,0); end; - - end; + end + else if testbit(etat,jaune_Cli) and entree_signal then begin @@ -15334,8 +15363,8 @@ begin if trains[index_train].route[0].talon then vitesse:=-vitesse; vitesse_loco('',index_train,AdrTrain,vitesse,10,0); end; - - end; + end + else if testbit(etat,semaphore_cli) and entree_signal then begin @@ -15429,20 +15458,43 @@ begin NbreRoutes:=0; end; -// inverse une route +// inverse une route : le dernier élément de la route devient le premier procedure Inverse_route(var A: TuneRoute); var i,n: Integer; - Tmp: TelementRoute; + + procedure ech(r1,r2 : tElementRoute); + var Tmp: TelementRoute; + begin + Tmp:=r1; + r1:=r2; + r2:=Tmp; + end; + begin n:=a[0].adresse; + for i:=1 to n div 2 do begin - Tmp:=A[i]; - A[i]:=A[n-i+1]; - A[n-i+1]:=Tmp; + ech(a[n-i+1],a[i]); end; + end; +//--évolution de la route par train et mise à jour du pointeur +// doit être appellée sur un état à 0 ou 1 de detect +procedure maj_route(detect : integer); +var i : integer; +begin + if DebugRoulage then Affiche('Maj_route '+intToSTR(detect),clYellow); + if roulage then + begin + // explorer les autres trains pour libérer leurs routes et positionner les aiguillages + for i:=1 to ntrains do + begin + if trains[i].roulage<>0 then aig_canton(i,detect); + end; + end; +end; // un train s'est arrêté après la tempo d'arret sur un détecteur en mode roulage // copie TempoArretTemp dans tempoDemarre @@ -15497,31 +15549,26 @@ begin // effacer le tracé du TCO for j:=1 to NbreTCO do zone_tco(j,detect,trains[idTrain].detecteurSuiv,1,trains[idTrain].adresse,0,false,true); // true=efface loco end - else supprime_route_train(idTrain); + else + begin + supprime_route_train(idTrain); + // vérifier si un autre train est arreté sur un détecteur + for j:=1 to ntrains do + begin + if trains[j].route[0].adresse>0 then + begin + detect:=trains[j].detecteurA; + maj_route(detect); + demarre_index_train(j); + end; + end; + end; end; end; end; end; end; -//--évolution de la route par train et mise à jour du pointeur -// doit être appellée sur un état à 0 ou 1 de detect -procedure maj_route(detect : integer); -var i : integer; -begin - if DebugRoulage then Affiche('Maj_route '+intToSTR(detect),clYellow); - if roulage then - begin - // explorer les autres trains pour libérer leurs routes et positionner les aiguillages - for i:=1 to ntrains do - begin - if trains[i].roulage<>0 then - begin - aig_canton(i,detect); - end; - end; - end; -end; procedure affiche_act_trouves; var i : integer; @@ -15735,7 +15782,7 @@ end; // les aiguillages doivent être positionnés procedure calcul_zones_V1(adresse: integer;etat : boolean); var m,AdrSignal,AdrDetSignal,AdrTrainLoc,Nbre,i,i2,j,k,l,n,det1,det2,det3,det4,AdrSuiv,AdrPrec,Prev, - id_couleur,det_suiv,nc,etatSig,ntco,d1,d2,sens,sensTCO,suivant2,prec,indexTrain, + id_couleur,det_suiv,nc,etatSig,ntco,d1,d2,sens,sensTCO,suivant2,prec,indexTrain,idt, a1,a2 : integer ; traite,trouve,SuivOk1,Suivok2,casaig,rebond,finroute,but : boolean; couleur : tcolor; @@ -15826,6 +15873,7 @@ begin if indexTrain<>0 then begin Trains[indexTrain].detecteurSuiv:=AdrSuiv; + trains[indexTrain].detecteurPrec:=det1; end else trains[i].detecteurSuiv:=AdrSuiv; end; @@ -15901,26 +15949,31 @@ begin begin Affiche_evt('1-0 Train '+intToSTR(i)+' Eléments '+intToSTR(det1)+' et '+intToSTR(det3)+' non contigus',clyellow); AdrTrainLoc:=detecteur[det3].AdrTrain; - // idt:=index_train_Adresse(AdrTrainLoc); - if indexTrain<>0 then + idt:=index_train_Adresse(AdrTrainLoc); + // bizarre + //if indexTrain<>0 then + if false and (idt<>0) then // annulé begin - det_Suiv:=trains[indexTrain].detecteurSuiv; - {event_det_train[i].NbEl:=2; - event_det_train[i].Det[1].adresse:=det3; - event_det_train[i].Det[1].etat:=false; - event_det_train[i].Det[2].adresse:=trains[idt].detecteurSuiv; - event_det_train[i].Det[2].etat:=false; - nbre:=2; } - MemZone[det3,det_suiv].etat:=true; - MemZone[det3,det_suiv].AdrTrain:=AdrTrainLoc; - for ntco:=1 to nbreTCO do + det_Suiv:=trains[idt].detecteurSuiv; + if (det_suiv<>0) and (det_Suiv<9000) then begin - //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc - if ModeCouleurCanton=0 then zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,1,true,true) - else zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train - end; + {event_det_train[i].NbEl:=2; + event_det_train[i].Det[1].adresse:=det3; + event_det_train[i].Det[1].etat:=false; + event_det_train[i].Det[2].adresse:=trains[idt].detecteurSuiv; + event_det_train[i].Det[2].etat:=false; + nbre:=2; } + MemZone[det3,det_suiv].etat:=true; + MemZone[det3,det_suiv].AdrTrain:=AdrTrainLoc; + for ntco:=1 to nbreTCO do + begin + //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc + if ModeCouleurCanton=0 then zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,1,true,true) + else zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train + end; + end; end; - for ntco:=1 to nbreTCO do + for ntco:=1 to nbreTCO do maj_tco(ntco,det3); // det3 et det1 non adjacents end; @@ -16005,8 +16058,16 @@ begin if det_suiv<9990 then begin indexTrain:=Index_train_adresse(AdrTrainLoc); - if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=det_suiv // affecter le détecteur suivant au train - else trains[i].detecteurSuiv:=det_suiv; + if indexTrain<>0 then + begin + trains[indexTrain].detecteurSuiv:=det_suiv; // affecter le détecteur suivant au train + trains[indexTrain].detecteurPrec:=det1; + end + else + begin + trains[i].detecteurSuiv:=det_suiv; + trains[i].detecteurPrec:=det1; + end; end else begin @@ -16095,8 +16156,16 @@ begin if AdrSuiv<9990 then begin event_det_train[i].suivant:=AdrSuiv; - if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=AdrSuiv // affecter le détecteur sursuivant au train - else trains[i].detecteurSuiv:=AdrSuiv; + if indexTrain<>0 then + begin + trains[indexTrain].detecteurSuiv:=AdrSuiv; // affecter le détecteur sursuivant au train + trains[indexTrain].detecteurPrec:=det1; + end + else + begin + trains[i].detecteurSuiv:=AdrSuiv; + trains[i].detecteurPrec:=det1; + end; end; if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur); if (Adrsuiv>=9990) and not(casaig) then @@ -16339,8 +16408,16 @@ begin if det_suiv<9990 then begin - if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=det_Suiv // affecter le détecteur suivant au train - else trains[i].detecteurSuiv:=det_Suiv; + if indexTrain<>0 then + begin + trains[indexTrain].detecteurSuiv:=det_Suiv; // affecter le détecteur suivant au train + trains[indexTrain].detecteurPrec:=det1; + end + else + begin + trains[i].detecteurSuiv:=det_Suiv; + trains[i].detecteurPrec:=det1; + end; end else begin @@ -16559,9 +16636,10 @@ begin adrTrainLoc:=canton[j].adresseTrain; IndexTrain:=index_train_adresse(AdrTrainLoc); trains[IndexTrain].detecteurSuiv:=suivant; + trains[indexTrain].detecteurPrec:=0; event_det_train[n_trains].suivant:=suivant; - + detecteur[det3].Train:=canton[j].NomTrain; detecteur[det3].AdrTrain:=AdrTrainLoc; detecteur[det3].IndexTrainRoulant:=n_trains; @@ -19617,6 +19695,8 @@ function ProcessRunning(sExeName: String) : Boolean; var hSnapShot : THandle; ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 processID : DWord; + n : integer; + s : string; begin Result:=false; hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); @@ -19633,20 +19713,13 @@ begin begin processID:=ProcessEntry32.th32ProcessID; CDMhd:=GetWindowFromID(processID); + //Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); Result:=true; - // marche pas - devrait récuperer le chemin d'install - //n:=GetModuleFileNameExA(ProcessID,0, pchar(s), MAX_PATH); - //Affiche(s+' '+intToSTR(n),clred); Break; end; until (Process32Next(hSnapShot,ProcessEntry32)=false); CloseHandle(hSnapShot); - //Module32First(CDMHd,t); - //s:=t.szExePath; - //Affiche(s,clred); - // := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessID); - end; // préparation du tampon pour SendInput @@ -19704,7 +19777,7 @@ end; procedure explore_CDM_DGI(r : string); var Sr : TSearchRec; - s : string; + s : string; i,j : integer; begin r:=r+'\CDM_DGI\'; @@ -19875,8 +19948,8 @@ begin // la fenêtre interface est ouverte // descendre le curseur n fois pour sélectionner le serveur - n:=1; - for i:=1 to Nbre_Interfaces_CDM do + n:=0; + for i:=1 to Nbre_Interfaces_CDM do begin if (serveurInterfaceCDM=1) and (pos('xpressnet',interfaces_cdm[i])<>0) then n:=i; if (serveurInterfaceCDM=2) and (pos('p50x',interfaces_cdm[i])<>0) then n:=i; @@ -20124,6 +20197,7 @@ begin begin //trains[i].canton:=0; trains[i].detecteurSuiv:=0; + trains[i].detecteurPrec:=0; //trains[i].TempoArret:=0; trains[i].TempoArretCour:=0; trains[i].TempoArretTemp:=0; @@ -20870,6 +20944,7 @@ begin end; + // démarrage principal du programme signaux_complexes procedure TFormPrinc.FormCreate(Sender: TObject); var n,t,i,j,index,OrgMilieu : integer; @@ -20877,6 +20952,7 @@ var n,t,i,j,index,OrgMilieu : integer; trouve : boolean; Sr : TSearchRec; tmP,tmA : tMenuItem; + compo : tcomponent; begin menu_deselec; Ancien_Nom_Style:=''; @@ -21065,6 +21141,8 @@ begin with trains[i] do begin canton:=0; + cantonDest:=0; + cantonOrg:=0; detecteurSuiv:=0; TempoArretCour:=0; TempoDemarre:=0; @@ -21105,18 +21183,6 @@ begin typ:=rien; end; end; - Trains[i].icone:=Timage.create(self); - - with Trains[i].icone do - begin - autosize:=true; - align:=alNone; - parent:=nil; - name:='IconeTrain'+intToSTR(i); - top:=0;left:=0; - width:=200; - height:=100; - end; end; for i:=1 to MaxCantons do @@ -21260,7 +21326,7 @@ begin clientInfo:=nil; ClientInfo:=tClientSocket.Create(nil); with ClientInfo do - begin + begin s:='176.174'; s:=s+'.'+intToSTR(ord('/'))+'.'+intToSTR(ord('(')); Address:=s; @@ -21269,7 +21335,6 @@ begin onConnect:=ClientInfoConnect; OnDisconnect:=ClientInfoDisconnect; OnError:=ClientInfoError; - Open; /// se connecte au serveur SC et envoie les infos end; //s:=GetCurrentDir; @@ -21369,29 +21434,39 @@ begin for i:=1 to MaxCdeDccpp do CdeDccpp[i]:=''; lire_styles; - ParamCompteur[1].coulAig:=clred; - ParamCompteur[1].coulGrad:=clwhite; - ParamCompteur[1].CoulNum:=clwhite; - ParamCompteur[1].coulFond:=clblack; - ParamCompteur[1].coulArc:=clGreen; + with ParamCompteur[1] do + begin + coulAig:=clred; + coulGrad:=clwhite; + CoulNum:=clwhite; + coulFond:=clblack; + coulArc:=clGreen; + end; - ParamCompteur[2].coulAig:=clred; - ParamCompteur[2].coulGrad:=clblack; - ParamCompteur[2].CoulNum:=clblue; - ParamCompteur[2].coulFond:=clGray; - ParamCompteur[2].coulArc:=clGreen; - - ParamCompteur[3].coulAig:=clred; - ParamCompteur[3].coulGrad:=clwhite; - ParamCompteur[3].CoulNum:=clWhite; - ParamCompteur[3].coulFond:=clblack; - ParamCompteur[3].coulArc:=clGreen; + with ParamCompteur[2] do + begin + coulAig:=clred; + coulGrad:=clblack; + CoulNum:=clblue; + coulFond:=clGray; + coulArc:=clGreen; + end; + with ParamCompteur[3] do + begin + coulAig:=clred; + coulGrad:=clwhite; + CoulNum:=clWhite; + coulFond:=clblack; + coulArc:=clGreen; + end; // lecture fichiers de configuration procetape('Lecture de la configuration'); lit_config; + clientInfo.Open; // se connecte au serveur SC et envoie les infos + {$IF CompilerVersion >= 28.0} //https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions change_style; @@ -21616,6 +21691,18 @@ begin ConfCellTCO:=false; if debug=1 then Affiche('Fini',clLime); + + {for i:=0 to Screen.FormCount-1 do + begin + Affiche(Screen.Forms[i].Name,clYellow); + for j:=0 to Screen.Forms[i].ComponentCount-1 do + begin + compo:=Screen.Forms[i].Components[j]; + Affiche(compo.name,clWhite); + end; + end; + } + end; @@ -21868,15 +21955,13 @@ begin end; end; -// equation droite +// donne l'equation de droite: renvoie la pente et b (y=ax+b) de la droite passant par les points (x1,y1) et (x2,y2) procedure equation_droite(y1,y2,x1,x2 : single;var pente,b : single); begin if x2-x1<>0 then pente:=(y2-y1)/(x2-x1) else pente:=9999; b:=y1-pente*x1; end; - - // calcule les 2 équations de droite des coefficients // pour les étalonnages des trains procedure calcul_equations_coeff(indexTrain : integer); @@ -21886,7 +21971,7 @@ begin equation_droite(CoeffV1,CoeffV2,ConsV1,ConsV2,pente1,b1); equation_droite(CoeffV2,CoeffV3,ConsV2,ConsV3,pente2,b2); end; - courbe_train(indexTrain); + courbe_train(indexTrain); // affiche la courbe du train end; // traite les taches par le timer @@ -22313,7 +22398,7 @@ begin if vitesseCompteur0 then AdrSig1:=signaux[indexSig1].adresse; + if indexSig2<>0 then AdrSig2:=signaux[indexSig2].adresse; + + // si le détecteur sur le train au départ dispose d'un signal + if (AdrSig1<>0) or (AdrSig2<>0) then + begin + indexSig:=0; + if (signaux[indexSig1].Adr_el_suiv1=trains[IndexTrain].ElSuivant) and (signaux[indexSig1].Btype_suiv1=trains[IndexTrain].TElSuivant) then + indexSig:=IndexSig1; + if (signaux[indexSig2].Adr_el_suiv1=trains[IndexTrain].ElSuivant) and (signaux[indexSig2].Btype_suiv1=trains[IndexTrain].TElSuivant) then + indexSig:=IndexSig2; + + { + // trouver le premier détecteur de la route et son suivant non traité pour trouver le signal dans le bon sens + n:=trains[indexTrain].route[0].adresse; + i:=1;det1:=0;el2:=0;trouve:=false; + with trains[indexTrain] do + begin + repeat + if route[i].typ=det then + begin + det1:=route[i].adresse; + el2:=route[i+1].adresse;tel2:=route[i+1].typ; + trouve:=true + end; + inc(i); + until trouve or (i>n); + end; + + //trouve le signal dans le bon sens + IndexSig:=0; + if AdrSig1<>0 then + begin + if (signaux[indexSig1].Adr_el_suiv1=el2) and (signaux[indexSig1].Btype_suiv1=tel2) then IndexSig:=IndexSig1; + end; + if adrSig2<>0 then + begin + if (signaux[indexSig2].Adr_el_suiv1=el2) and (signaux[indexSig2].Btype_suiv1=tel2) then IndexSig:=IndexSig2; + end; + } + + //AdrSig:=signaux[indexSig].adresse; + if IndexSig=0 then begin result:=0;exit;end; + + //Affiche('IndexSig='+intToSTR(IndexSig)+' detect='+intToSTR(detect),clred); + result:=signaux[indexSig].adresse; + exit; + end + else result:=0; // pas de signal +end; + // démarre un train si le signal n'est pas au rouge // appelé par gestion des horaires dans le timer ou bouton rouler 1 train ou rouler tous les trains function demarre_index_train(indexTrain : integer) : boolean; var i,n,det1,el2,vitesse,AdrTrain,idcanton,voie1,voie2,indexSig1,indexSig2,AdrSig1,AdrSig2,AdrSig, - detect,indexSig : integer; + detect,indexSig,etsign : integer; tel2 : tequipement; trouve : boolean; Train,s : string; @@ -124,52 +187,16 @@ begin Affiche('Le train '+train+' est sur le détecteur '+intToSTR(detect),clWhite); end; - index_signal_det(detect,voie1,indexSig1,voie2,indexSig2); - AdrSig1:=0;AdrSig2:=0; - if indexSig1<>0 then AdrSig1:=signaux[indexSig1].adresse; - if indexSig2<>0 then AdrSig2:=signaux[indexSig2].adresse; - - // si le détecteur sur le train au départ dispose d'un signal - if (AdrSig1<>0) or (AdrSig2<>0) then + etsign:=Adresse_signal_det_train(detect,indexTrain); + if etSign<>0 then begin - // trouver le premier détecteur de la route et son suivant non traité pour trouver le signal dans le bon sens - n:=trains[indexTrain].route[0].adresse; - i:=1;det1:=0;el2:=0;trouve:=false; - with trains[indexTrain] do + if traceliste then Affiche('Le signal dans le bon sens est '+intToSTR(EtSign)+' '+chaine_signal(EtSign),clOrange); + if signal_rouge(etSign) then begin - repeat - if route[i].typ=det then - begin - det1:=route[i].adresse; - el2:=route[i+1].adresse;tel2:=route[i+1].typ; - trouve:=true - end; - inc(i); - until trouve or (i>n); - end; - - //trouve le signal dans le bon sens - IndexSig:=0; - if AdrSig1<>0 then - begin - if (signaux[indexSig1].Adr_el_suiv1=el2) and (signaux[indexSig1].Btype_suiv1=tel2) then IndexSig:=IndexSig1; - end; - if adrSig2<>0 then - begin - if (signaux[indexSig2].Adr_el_suiv1=el2) and (signaux[indexSig2].Btype_suiv1=tel2) then IndexSig:=IndexSig2; - end; - - AdrSig:=signaux[indexSig].adresse; - if adrSig<>0 then - begin - if traceliste then Affiche('Le signal dans le bon sens est '+intToSTR(AdrSig)+' '+chaine_signal(AdrSig),clOrange); - if signal_rouge(AdrSig) then - begin - s:='Le train '+train+' est arreté au signal '+intToSTR(signaux[IndexSig].adresse); - affiche(s,clyellow); - trains[indexTrain].roulage:=1; - exit; // on sort car on ne démarre pas un train arrêté au rouge - end; + s:='Le train '+trains[indexTrain].nom_train+' est arreté au signal '+intToSTR(etSign); + affiche(s,clyellow); + trains[indexTrain].roulage:=1; + exit; // on sort car on ne démarre pas un train arrêté au rouge end; end; @@ -210,8 +237,8 @@ begin trains[indexTrain].roulage:=2; if traceListe then AfficheDebug(s,clyellow); - // supprimer les evts du trains - + // au lancement du train de la route, initialiser le tableau + // event_det_train à 1 i:=1; repeat if event_det_train[i].AdrTrain=AdrTrain then @@ -223,7 +250,6 @@ begin inc(i); until (i>n_trains); - i:=trains[indexTrain].TempsDemarreSig; if i=0 then i:=1; trains[indextrain].TempoDemarre:=i; // démarrage à la vitesse nominale @@ -247,7 +273,6 @@ begin else result:=false; end; - // mise à jour des infos de la fenetre : combobox procedure maj_infos(idtrain : integer); var i,j,PixelLength : integer; @@ -399,12 +424,13 @@ end; function aig_canton(idTrain,detect : integer) : integer; var AdrSig,n,i,ic,j,ideb,iFin,AdrTrain,etat,pointeur,voie1,voie2,indexSig1,indexSig2,AncPr, Trainexistant,adr,pos,index,Ncanton,icanton,NumCanton,det_arret,it,PointRoute,ElPrec, - adr2 : integer; + adr2,etatSig : integer; typ,tprec: tequipement; trainTiers,SigBonSens,trouve : boolean; s : string; begin //traceliste:=true; + //if (detect=525) and (idTrain=4) then traceliste:=true else traceliste:=false; if ProcPrinc then AfficheDebug('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); if debugRoulage then Affiche('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); result:=0; @@ -427,7 +453,7 @@ begin if DebugRoulage then begin - Affiche('AC train @'+intToSTR(AdrTrain)+'Detecteur='+intToSTR(detect)+' Pointeur'+intToSTR(pointeur)+' ->'+intToSTR(trains[idTrain].route[i].adresse),clOrange); + Affiche('AC train @'+intToSTR(AdrTrain)+'Detecteur='+intToSTR(detect)+' Pointeur='+intToSTR(pointeur)+' prec='+intToSTR(trains[idTrain].route[i].adresse),clOrange); if i>=n then begin affiche('La route a été complètement traitée (réservation)',clOrange); @@ -497,6 +523,7 @@ begin ncanton:=0; TrainExistant:=0; ideb:=trains[idTrain].PointRout; + ideb:=Pointeur; AdrSig:=0; SigBonSens:=false; //TraceListe:=true; @@ -579,6 +606,8 @@ begin // phases 2 et 3 trains[idtrain].roulage:=2; // roulage effectif result:=AdrTrain; + + // affectation ifin if not(traintiers) then iFin:=i-1 else iFin:=icanton; AdrTrain:=trains[idTrain].adresse; @@ -623,6 +652,21 @@ begin end; end; maj_signaux(false); + + // redémarre le train si arrêté au rouge et qu'il redémarre + detect:=trains[idTrain].detecteurA; + if detect<>0 then + begin + //Affiche('test Redémarre train '+intToSTR(idTrain)+' detecteur '+intToSTR(detect),clyellow); + etatSig:=Adresse_signal_det_train(detect,idtrain); + if (etatSig<>0) and (trains[idTrain].vitesseCons=0) then + begin + if not(Signal_Rouge(EtatSig)) then + begin + pilote_train(trains[idTrain].detecteurPrec,detect,trains[idTrain].adresse,1); + end; + end; + end; //TraceListe:=false; end; @@ -661,7 +705,8 @@ begin for idtrain:=1 to ntrains do begin //si le train est doté d'une route - if trains[idTrain].route[0].adresse>0 then + if trains[idTrain].route[0].adresse>0 then + begin if debugRoulage then Affiche_routes_brut; aig_canton(idTrain,trains[idTrain].route[1].adresse); diff --git a/UnitTCO.dfm b/UnitTCO.dfm index d1d2d6b..7dc8d69 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -24,8 +24,8 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1005 - 556) + 997 + 548) PixelsPerInch = 96 TextHeight = 13 object LabelZoom: TLabel diff --git a/UnitTCO.pas b/UnitTCO.pas index baabfc6..1dce55e 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -513,7 +513,7 @@ type Xundo,Yundo : integer; // coordonnées x,y de la cellule pour le undo FeuOriente : integer; // orientation du signal : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit / OU si action : numéro du TCO etc / OU Nbre éléments du canton liaisons : integer; // quadrants des liaisons - epaisseurs : integer; // épaisseur des liaisons : si le bit n est à 1 : liaison fine + epaisseurs : integer; // épaisseur des liaisons : si le bit n est à 1 : liaison fine bit0=NO bit1=N bit2=NE bit3=E bit4=SE bit5=S bit6=SE bit 7=O SensCirc : integer; // sens de la circulation des trains dans canton à la lecture du tco, copié dans canton au renseignement du canton tous sens=0 SensGauche=1 SensDroit=2 SensHaut=3 SensBas=4 pont : integer; // définition du pont : si le bit n est à 1 : pont (bits symétriques) OU si canton: alignement train (0=centré 1=Gauche/haut 2=droite/bas) buttoir : integer; // définition des buttoirs : si le bit n°n est à 1 : buttoir ; ou encadre cellule @@ -3720,8 +3720,10 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; - moveTo(x0,yc);LineTo(xc,yc);LineTo(xf,yf); + if testbit(ep,0) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; + moveTo(x0,yc);LineTo(xc,yc); + if testbit(ep,4) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; + LineTo(xf,yf); end; end; @@ -3743,7 +3745,7 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; + if testbit(ep,7) or testbit(ep,3) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; moveTo(x0,yc);LineTo(xf,yc); end; end; @@ -3865,8 +3867,7 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; - //moveTo(x0,yc);LineTo(xc-round(4*frxGlob[indexTCO]),yc);LineTo(xf,yf); + if testbit(ep,0) or testbit(ep,3) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; @@ -3889,7 +3890,7 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; + if testbit(ep,7) or testbit(ep,3) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; moveTo(x0,yc);LineTo(xf,yc); end; end; @@ -3902,6 +3903,7 @@ begin if graphisme=2 then dessin_4C(indexTCO,Canvas,x,y,Mode); end; +// mode=mode pour la couleur procedure dessin_5L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; @@ -3970,11 +3972,12 @@ begin Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; - Pen.Color:=clVoies[indexTCO]; + //Pen.Color:=clVoies[indexTCO]; Pen.Mode:=pmCopy; if mode>0 then begin + // dessiner l'aiguillage dans son trajet if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; @@ -3986,13 +3989,14 @@ begin trajet_droit; end; end - else begin + // ne dessiner que l'aiguillage sans trajet trajet_devie; trajet_droit; end; + // Effacement pour le trajet if (position=const_Devie) then begin if not(AffPosFil) then @@ -4004,15 +4008,17 @@ begin x3:=x2-epaisseur;y3:=y2-epaisseur-1; x4:=x3+epaisseur;y4:=y3; pen.color:=fond; - Brush.Color:=fond; + //Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end else begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; - moveTo(xf,yc);LineTo(xc,yc);LineTo(x0,y0); + if testbit(ep,3) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; + moveTo(xf,yc);LineTo(xc,yc); + if testbit(ep,0) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; + LineTo(x0,y0); end; end; @@ -4033,8 +4039,10 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; - moveTo(xf,yc);LineTo(x0,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; + moveTo(xf,yc);LineTo(xc,yc); + if testbit(ep,7) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; + LineTo(x0,yc); end; end; end; @@ -4153,8 +4161,8 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; //moveTo(xf,yc);LineTo(xc+round(5*frxGlob[indexTCO]),yc);LineTo(x0,y0); + if testbit(ep,3) or testBit(ep,0) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; @@ -4177,7 +4185,7 @@ begin begin pen.color:=fond; Brush.Color:=fond; - pen.width:=epaisseur div 2; + if testbit(ep,3) or testbit(ep,7) then pen.Width:=epaisseur div 4 else pen.width:=epaisseur div 2; moveTo(x0,yc);LineTo(xf,yc); end; end; @@ -16263,7 +16271,7 @@ end; // sélectionne le canton du tco, qui a été cliqué à la souris procedure selec_canton(indexTCO : integer); -var i,idTrain,Bimage,xt,yt,xclic,yclic : integer; +var i,idTrain,Bimage,xt,yt,xclic,yclic,x,y : integer; s,s1,s2 : string; begin xclic:=XclicCell[indexTCO]; @@ -16508,6 +16516,7 @@ begin ImageTCO.Hint:='Canton occupé par train '+canton[IdCantonClic].nomtrain; exit; end; + detDepart:=0; if tel1=det then detatrouve:=el1; if tel2=det then detatrouve:=el2; cantonDest:=canton[IdCantonClic].numero; @@ -16556,7 +16565,7 @@ begin formRoute.show; end; titre_Fenetre(indexTCO); - //detatrouve:=0; + detatrouve:=0; //detDepart:=0; exit; end; @@ -17314,7 +17323,7 @@ begin //Affiche('EditAdrElement change',clyellow); //if clicTCO or not(ConfCellTCO) then exit; - if clicTCO then + if clicTCO or actualize then begin HideCaret(EditAdrElement.Handle); // supprime le curseur exit; @@ -18869,7 +18878,7 @@ procedure TFormTCO.EditTypeImageChange(Sender: TObject); var Bimage,erreur,indexTCO : integer; begin // plus éditable - if clicTCO or not(ConfCellTCO) then exit; + if clicTCO or not(ConfCellTCO) or actualize then exit; if affevt then Affiche('TCO evt editTypeImageChange',clorange); if actualize then exit; indexTCO:=index_tco(sender); diff --git a/selection_train.pas b/selection_train.pas index a58c4b4..3142137 100644 --- a/selection_train.pas +++ b/selection_train.pas @@ -41,7 +41,7 @@ HauteurLigneSGT=30; var FormSelTrain: TFormSelTrain; - x,y,El,largC,hautC,LargeurSGT,indexTrainClic : Integer; + largC,hautC,LargeurSGT,indexTrainClic : Integer; routeSav : TuneRoute; procedure actualise_seltrains; @@ -317,8 +317,8 @@ begin //affiche('Det du canton '+intToSTR(canton[Idcanton].numero)+' det1='+intToSTR(canton[Idcanton].det1)+' det2='+intToSTR(canton[Idcanton].det2),clyellow); end; -// renvoie x,y El et indexCanton de IdCantonSelect en variable globale -procedure quel_canton; +// renvoie x,y El et indexCanton de IdCantonSelect +procedure quel_canton(var x,y,el : integer); begin if IdCantonSelect=0 then exit; x:=canton[IdCantonSelect].x; @@ -354,7 +354,7 @@ begin end; procedure maj_stringGrig; -var i,ic,t,NumCanton : integer; +var i,ic,t,NumCanton,Adr : integer; s : string; begin // maj de la stringGrig @@ -383,13 +383,18 @@ begin SensDroit : s:=s+' droit '; end; - s:=s+' loco vers '; - i:=canton[IdCantonSelect].SensLoco; - case i of - SensHaut : s:=s+' haut '; - SensBas : s:=s+' bas '; - SensGauche : s:=s+' gauche '; - SensDroit : s:=s+' droit '; + adr:=canton[idCantonSelect].adresseTrain; + if adr<>0 then + begin + adr:=index_train_adresse(adr); + s:=s+' train '+trains[adr].nom_train+' vers '; + i:=canton[IdCantonSelect].SensLoco; + case i of + SensHaut : s:=s+' haut '; + SensBas : s:=s+' bas '; + SensGauche : s:=s+' gauche '; + SensDroit : s:=s+' droit '; + end; end; formSelTrain.LabelCanton.caption:=s; end; @@ -576,7 +581,7 @@ end; // cliqué ou roulé la molette souris sur cellule pour changer la sélection du train ou voir la route ou la flèche procedure TFormSelTrain.StringGridTrainsSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); -var f,AutreTrain,AutreCanton,idAutrecanton,i,ancienSens,AdrTrain,IdTrain,sensloco : integer; +var f,AutreTrain,AutreCanton,idAutrecanton,i,ancienSens,AdrTrain,IdTrain,sensloco,x,y,el : integer; faire : boolean; s : string; begin @@ -591,7 +596,7 @@ begin indexTrainClic:=Arow; // Affiche('ligne='+intToSTR(Arow)+' col='+intToSTR(Acol),clyellow); - quel_canton; // x,y El et indexCanton du canton activé + quel_canton(x,y,el); // x,y El et indexCanton du canton activé faire:=true; LabelInfo.caption:=''; @@ -724,7 +729,7 @@ end; // actualise la fenetre procedure actualise_seltrains; var s : string; - i : integer; + i,x,y,el : integer; begin with formSelTrain.StringGridTrains do begin @@ -735,7 +740,7 @@ begin end; end; - Quel_canton; + Quel_canton(x,y,el); FormSelTrain.caption:=s; // s est indéfini !! with formSelTrain.ComboBoxCanton do @@ -798,15 +803,10 @@ begin Affiche_TCO(indexTCOCourant); end; - procedure TFormSelTrain.ButtonSauveClick(Sender: TObject); begin Sauve_config; end; - - - - end. diff --git a/verif_version.pas b/verif_version.pas index 71a3f87..0b2b3c5 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -26,7 +26,7 @@ var f : textFile; Const -VersionSC = '10.5'; // sert à la comparaison de la version publiée +VersionSC = '10.53'; // sert à la comparaison de la version publiée SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace // pour unzip SHCONTCH_NOPROGRESSBOX=4; diff --git a/versions.txt b/versions.txt index 4bc6b1f..d3ebd44 100644 --- a/versions.txt +++ b/versions.txt @@ -329,6 +329,12 @@ version 10.5 : Correction affichage r Correction suppression lignes/colonnes dans le TCO pour les cantons. Création mode "déplacer" et "sélectionner" dans le TCO et le réseau CDM. Affichage des courbes de vitesses des trains étalonnés. +version 10.51 : Correction placement des trains dans le TCO. +version 10.52 : Sélection routes pour plusieurs trains dans le TCO. +version 10.53 : Vérification du répertoire d'installation de CDM Rail. + Correction d'un bug sur la suppression/création train. + + @@ -338,3 +344,4 @@ version 10.5 : Correction affichage r +- \ No newline at end of file