Files
SignauxComplexes/UnitPrinc.pas
f1iwq2 1a25d29116 V5.4
2023-01-08 18:53:18 +01:00

13302 lines
468 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
Unit UnitPrinc;
(********************************************
programme signaux complexes Graphique Lenz
Delphi 7 + activeX Tmscomm + clientSocket
ou RadStudio
option de compilations: options du debugger/exception du langage : décocher "arreter sur execeptions delphi"
sinon une exception surgira au moment de l'ouverture du com
Dans projet/option/fiches : fiches disponibles : formtco uniquement
********************************************
Pilotage des accessoires:
raquette octet sortie
+ 2 = aiguillage droit = sortie 2 de l'adresse d'accessoire
- 1 = aiguillage dévié = sortie 1 de l'adresse d'accessoire
port com lenz=57600
*)
// en mode simulation run:
// CDM ne renvoie pas les détecteurs au départ du RUN.
// il ne renvoie pas non plus le nom des trains sur les actionneurs
// les noms des trains sont bien renvoyés sur les détecteurs à 1
//
// En mode RUN:
// CDM renvoie le nom des trains sur les actionneurs à 1, jamais à 0
// et quelquefois (pas toujours!) sur les détecteurs à 1, jamais à 0
//
// En simulation:
// CDM Rail ne renvoie pas les états des aiguillages en début de simu
// Les aiguillages sont renvoyés quand on clique dessus
// Les actionneurs fonctionnent. Les détecteurs ne sont pas renvoyés.
//
// En mode centrale connectée à signaux complexes (autonome)
// si on bouge un aiguillage à la raquette, on récupère bien sa position par XpressNet.
// Une loco sur un détecteur au lancement ne renvoie pas son état. Seuls les changements
// d'état sont renvoyés par la centrale.
{$Q-} // pas de vérification du débordement des opérations de calcul
{$R-} // pas de vérification des limites d'index du tableau et des variables
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32,
ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB, MMSystem , registry,
Buttons ;
type
TFormPrinc = class(TForm)
Timer1: TTimer;
LabelTitre: TLabel;
ScrollBox1: TScrollBox;
ClientSocketInterface: TClientSocket;
GroupBox1: TGroupBox;
EditAdresse: TEdit;
Label2: TLabel;
MainMenu1: TMainMenu;
Interface1: TMenuItem;
MenuConnecterUSB: TMenuItem;
DeconnecterUSB: TMenuItem;
N2: TMenuItem;
MenuConnecterEthernet: TMenuItem;
MenuDeconnecterEthernet: TMenuItem;
StatusBar1: TStatusBar;
MSCommUSBLenz: TMSComm;
Afficher1: TMenuItem;
Etatdesdtecteurs1: TMenuItem;
Etatdesaiguillages1: TMenuItem;
N3: TMenuItem;
Codificationdesaiguillages1: TMenuItem;
Image9feux: TImage;
Image7feux: TImage;
Image5feux: TImage;
Image4feux: TImage;
Image3feux: TImage;
Image2feux: TImage;
N4: TMenuItem;
ConnecterCDMrail: TMenuItem;
DeconnecterCDMRail: TMenuItem;
Image2Dir: TImage;
Image3Dir: TImage;
Image4Dir: TImage;
Image5Dir: TImage;
Image6Dir: TImage;
Codificationdessignaux: TMenuItem;
Divers1: TMenuItem;
ClientSocketCDM: TClientSocket;
FichierSimu: TMenuItem;
OpenDialog: TOpenDialog;
N1: TMenuItem;
LireunfichierdeCV1: TMenuItem;
SaveDialog: TSaveDialog;
N5: TMenuItem;
Quitter1: TMenuItem;
Config: TMenuItem;
Codificationdesactionneurs1: TMenuItem;
OuvrirunfichiertramesCDM1: TMenuItem;
Panel1: TPanel;
BoutonRaf: TButton;
ButtonArretSimu: TButton;
ButtonDroit: TButton;
LabelEtat: TLabel;
ButtonAffTCO: TButton;
ButtonLanceCDM: TButton;
Affichefentredebug1: TMenuItem;
StaticText: TStaticText;
FenRich: TRichEdit;
PopupMenuFenRich: TPopupMenu;
Copier1: TMenuItem;
Etatdessignaux1: TMenuItem;
N6: TMenuItem;
Apropos1: TMenuItem;
ButtonDevie: TButton;
GroupBox2: TGroupBox;
ButtonEcrCV: TButton;
ButtonLitCV: TButton;
EditCV: TEdit;
Label3: TLabel;
LabelVCV: TLabel;
EditVal: TEdit;
PopupMenuFeu: TPopupMenu;
Proprits1: TMenuItem;
N8: TMenuItem;
Vrifierlacohrence: TMenuItem;
GroupBox3: TGroupBox;
loco: TButton;
ButtonLocCV: TButton;
EditAdrTrain: TEdit;
Label4: TLabel;
Label5: TLabel;
EditVitesse: TEdit;
ComboTrains: TComboBox;
LabelFonction: TLabel;
EditNumFonction: TEdit;
ButtonFonction: TButton;
EditFonc01: TEdit;
Label6: TLabel;
Etatdeszonespartrain1: TMenuItem;
N7: TMenuItem;
Demanderversiondelacentrale1: TMenuItem;
Demanderlaversiondelacentrale1: TMenuItem;
RepriseDCC1: TMenuItem;
BoutonRazTrains: TButton;
Demandetataccessoires1: TMenuItem;
LancerCDMrail1: TMenuItem;
TrackBarVit: TTrackBar;
ButtonEnv: TButton;
EditEnvoi: TEdit;
Roulage1: TMenuItem;
Placerlestrains1: TMenuItem;
Demandetatdtecteurs1: TMenuItem;
Informationsdusignal1: TMenuItem;
Button1: TButton;
Evenementsdetecteurspartrain1: TMenuItem;
RazResa: TMenuItem;
SBMarcheArretLoco: TSpeedButton;
Label1: TLabel;
LabelNbTrains: TLabel;
procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure ButtonDroitClick(Sender: TObject);
procedure EditvalEnter(Sender: TObject);
procedure BoutonRafClick(Sender: TObject);
procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket);
procedure MenuConnecterUSBClick(Sender: TObject);
procedure DeconnecterUSBClick(Sender: TObject);
procedure MenuConnecterEthernetClick(Sender: TObject);
procedure MenuDeconnecterEthernetClick(Sender: TObject);
procedure locoClick(Sender: TObject);
procedure AffEtatDetecteurs(Sender: TObject);
procedure Etatdesaiguillages1Click(Sender: TObject);
procedure Codificationdesaiguillages1Click(Sender: TObject);
procedure ClientSocketCDMError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocketInterfaceConnect(Sender: TObject;
Socket: TCustomWinSocket);
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 CodificationdessignauxClick(Sender: TObject);
procedure ClientSocketInterfaceDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FichierSimuClick(Sender: TObject);
procedure ButtonEcrCVClick(Sender: TObject);
procedure LireunfichierdeCV1Click(Sender: TObject);
procedure Quitter1Click(Sender: TObject);
procedure ConfigClick(Sender: TObject);
procedure ButtonLitCVClick(Sender: TObject);
procedure Codificationdesactionneurs1Click(Sender: TObject);
procedure ButtonArretSimuClick(Sender: TObject);
procedure OuvrirunfichiertramesCDM1Click(Sender: TObject);
procedure ButtonAffTCOClick(Sender: TObject);
procedure ButtonLanceCDMClick(Sender: TObject);
procedure Affichefentredebug1Click(Sender: TObject);
procedure FenRichChange(Sender: TObject);
procedure Copier1Click(Sender: TObject);
procedure Etatdessignaux1Click(Sender: TObject);
procedure Apropos1Click(Sender: TObject);
procedure ButtonDevieClick(Sender: TObject);
procedure Proprits1Click(Sender: TObject);
procedure VrifierlacohrenceClick(Sender: TObject);
procedure FenRichMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ButtonLocCVClick(Sender: TObject);
procedure ComboTrainsChange(Sender: TObject);
procedure ButtonFonctionClick(Sender: TObject);
procedure Etatdeszonespartrain1Click(Sender: TObject);
procedure Demanderlaversiondelacentrale1Click(Sender: TObject);
procedure Demandetatdesaiguillages1Click(Sender: TObject);
procedure RepriseDCC1Click(Sender: TObject);
procedure BoutonRazTrainsClick(Sender: TObject);
procedure Demandetataccessoires1Click(Sender: TObject);
procedure LancerCDMrail1Click(Sender: TObject);
procedure TrackBarVitChange(Sender: TObject);
procedure EditVitesseChange(Sender: TObject);
procedure ButtonEnvClick(Sender: TObject);
procedure Placerlestrains1Click(Sender: TObject);
procedure Demandetatdtecteurs1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Informationsdusignal1Click(Sender: TObject);
procedure Evenementsdetecteurspartrain1Click(Sender: TObject);
procedure RazResaClick(Sender: TObject);
procedure SBMarcheArretLocoClick(Sender: TObject);
private
{ Déclarations privées }
procedure DoHint(Sender : Tobject);
public
{ Déclarations publiques }
Procedure ImageOnClick(Sender : TObject);
procedure proc_checkBoxFB(Sender : Tobject);
procedure proc_checkBoxFV(Sender : Tobject);
procedure proc_checkBoxFR(Sender : Tobject);
end;
const
titre='Signaux complexes GL ';
MaxAcc=2048; // adresse maxi d'accessoire XpressNet
NbMaxDet=100; // nombre maximal de détecteurs d'un réseau
NbMemZone=2048; // adresse maximale des détecteurs
Max_Trains=100;
MaxZones=250;
MaxTrainZone=40;
Max_event_det=400;
MaxBranches=100;
MaxElBranches=200;
LargImg=50;HtImg=91; // Dimensions image des feux
const_droit=2; // positions aiguillages transmises par la centrale LENZ
const_devie=1; // positions aiguillages transmises par la centrale LENZ
const_devieG_CDM=3; // positions aiguillages transmises par cdm
const_devieD_CDM=2; // positions aiguillages transmises par cdm
const_droit_CDM=0; // positions aiguillages transmises par cdm
const_inconnu=9; // position inconnue
NbCouleurTrain=8;
MaxCdeDccpp=20;
ClBleuClair=$FF7070 ;
clRose=$AAAAFF;
Cyan=$FF6060;
clviolet=$FF00FF;
GrisF=$414141;
clOrange=$0077FF;
couleurTrain : array[0..NbCouleurTrain] of Tcolor = (clRose,clYellow,clLime,clOrange,clAqua,clFuchsia,clLtGray,clred,clWhite);
Max_Simule=10000;
Max_Event_det_tick=30000;
EtatSign : array[0..13] of string[20] =('carré','sémaphore','sémaphore cli','vert','vert cli','violet',
'blanc','blanc cli','jaune','jaune cli','ral 30','ral 60','rappel 30','rappel 60');
NbDecodeur = 8;
decodeur : array[0..NbDecodeur-1] of string[20] =('rien','Digital Bahn','CDF','LDT','LEB','Digikeijs 4018','Unisemaf Paco','SR');
Etats : array[0..19] of string[30]=('Non commandé',
'carré','sémaphore','sémaphore cli','vert','vert cli','violet','blanc','blanc cli','jaune','jaune cli',
'ralen 30','ralen 60','ralen 60 + jaune cli','rappel 30','rappel 60','rappel 30 + jaune','rappel 30 + jaune cli','rappel 60 + jaune','rappel 60 + jaune cli');
type
Taccessoire = (aigP,feu); // aiguillage ou feu
TMA = (valide,devalide);
TEquipement = (rien,aig,tjd,tjs,triple,det,buttoir,voie,crois,act); // voie uniquement pour le tco
TBranche = record
BType : Tequipement ; // ne prend que les valeurs suivantes: dét aig Buttoir
Adresse : integer ; // adresse du détecteur ou de l'aiguillage
end;
Taiguillage = record
Adresse : integer; // adresse de l'aiguillage
modele : TEquipement; // rien, aig, tjd ...
position, // position actuelle : 1=dévié 2=droit (centrale LENZ)
posInit, // position d'initialisation 1=dévié 2=droit 9=non positionné
Adrtriple, // 2eme adresse pour un aiguillage triple
temps, // temps de pilotage (durée de l'impulsion en x 100 ms
InversionCDM : integer ; // pour les aiguillages déclarés inversés dans CDM, utilisé en mode autonome (paramètre I1)
vitesse : integer; // vitesse de franchissement de l'aiguillage en position déviée (60 ou 90)
AdrTrain : integer; // adresse du train qui a réservé l'aiguillage
ADroit : integer ; // (TJD:identifiant extérieur) connecté sur la position droite en talon
ADroitB : char ; // P D S Z
ADevie : integer ; // (TJD:identifiant extérieur) adresse de l'élément connecté en position déviée
ADevieB : char; // caractère (D ou S)si aiguillage de l'élément connecté en position déviée
APointe : integer; // adresse de l'élément connecté en position droite ;
APointeB : char;
DDroit : integer; // destination de la TJD en position droite
DDroitB : char ;
DDevie : integer; // destination de la TJD en position déviée
DDevieB : char ;
tjsint : integer; // pour TJS
tjsintb : char ;
// éléments connectés sur la branche déviée 2 (cas d'un aiguillage triple)
Adevie2 : integer;
Adevie2B : char ;
// états d'une TJD (2 ou 4, 4 par défaut)
EtatTJD : integer;
// si modifié en mode config
modifie : boolean ;
end;
TFeu = record
adresse, aspect : integer; // adresse du feu, aspect (2 feux..9 feux 12=direction 2 feux .. 16=direction 6 feux)
Img : TImage; // Pointeur sur structure TImage du feu
Lbl : TLabel; // pointeur sur structure Tlabel du feu
checkFB : TCheckBox; // pointeur sur structure Checkbox "demande feu blanc"
checkFR : boolean; // demande feu rouge cli
checkFV : boolean; // demande feu vert cli
FeuVertCli : boolean ; // avec checkbox ou pas
FeuRougeCli : boolean ; // avec checkbox ou pas
FeuBlanc : boolean ; // avec checkbox ou pas
decodeur : integer; // type du décodeur // 'rien','Digital Bahn','CDF','LDT','LEB','Digikeijs','Unisemaf','SR'
Adr_det1 : integer; // adresse du détecteur1 sur lequel il est implanté
Adr_det2 : integer; // adresse du détecteur2 sur lequel il est implanté (si un signal est pour plusieurs voies)
Adr_det3 : integer; // adresse du détecteur3 sur lequel il est implanté (si un signal est pour plusieurs voies)
Adr_det4 : integer; // adresse du détecteur4 sur lequel il est implanté (si un signal est pour plusieurs voies)
Adr_el_suiv1 : integer; // adresse de l'élément1 suivant
Adr_el_suiv2 : integer; // adresse de l'élément2 suivant (si un signal est pour plusieurs voies)
Adr_el_suiv3 : integer; // adresse de l'élément3 suivant (si un signal est pour plusieurs voies)
Adr_el_suiv4 : integer; // adresse de l'élément4 suivant (si un signal est pour plusieurs voies)
Btype_suiv1 : TEquipement ; // type de l'élément suivant ne prend que les valeurs rien, det ou aig
Btype_suiv2 : TEquipement ; //
Btype_suiv3 : TEquipement ; //
Btype_suiv4 : TEquipement ; //
VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal
VerrouilleCarre : boolean ; // si vrai, le feu est verrouillé au carré
modifie : boolean; // feu modifié
EtatSignal : word ; // état du signal
AncienEtat : word ; // ancien état du signal
UniSemaf : integer ; // définition supplémentaire de la cible pour les décodeurs UNISEMAF ou du préréglage pour digikeijs
AigDirection : array[1..7] of array of record // pour les signaux directionnels : contient la liste des aiguillages associés
Adresse : integer; // 6 feux max associés à un tableau dynamique décrivant les aiguillages +1 position 0
posAig : char;
end;
CondCarre : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le carré
// attention les données sont stockées en adresse 1 du tableau dynamique
Adresse : integer; // aiguillage
posAig : char;
end;
SR : array[1..19] of record // configuration du décodeur Stéphane Ravaut : 8 valeurs maxi
sortie1,sortie0 : integer;
end;
Na : integer; // nombre d'adresses du feu occupées par le décodeur CDF
end;
var
maxaiguillage,detecteur_chgt,Temps,Tempo_init,Suivant,ntrains,MaxPortCom,
N_Cv,index_simule,NDetecteurs,N_Trains,N_routes,espY,Tps_affiche_retour_dcc,
NbreImagePligne,NbreBranches,Index2_det,Index2_aig,branche_det,ntrains_cdm,
I_simule,maxTablo_act,NbreVoies,El_suivant,N_modules_dcc,NbDet1,
tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre,Tempo_Aig,Tempo_feu,etat_init_interface,
NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant,
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur,
ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB,
etape,idEl,avecRoulage,intervalle_courant,filtrageDet0,SauvefiltrageDet0 : integer;
ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc,
Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO,
Srvc_PosTrain,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif,
Hors_tension,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,doubleclic,
NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,Option_demarrage,AffTiers,AvecDemandeAiguillages,
TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM,AvecInitAiguillages,
AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro,
retEtatDet,roulage,init_aig_cours,affevt,placeAffiche : boolean;
tick,Premier_tick : longint;
CDMhd : THandle;
FormPrinc: TFormPrinc;
Enregistrement,chaine_Envoi,chaine_recue,Id_CDM,Af,version_Interface,entete,suffixe,Lay
: string;
Ancien_detecteur : array[0..NbMemZone] of boolean; // anciens état des détecteurs et adresses des détecteurs et leur état
detecteur : array[0..NbMemZone] of // détecteurs indexés par l'adresse
record
etat : boolean; // état 0/1 du déecteur
train : string; // nom du train ayant enclenché le détecteur (CDM - pas fiable)
AdrTrain : integer; // adresse du train "train"
tempo0 : integer; // tempo de retombée à 0 du détecteur (filtrage)
IndexTrain : integer; // index du train
end;
TypeGen : TEquipement;
Adresse_detecteur : array[0..NbMaxDet] of integer; // adresses des détecteurs par index
// Historique des zones d'occupation par train
TrainZone : array[1..MaxTrainZone] of // train, index
record
train : string;
adrTrain : integer; // adresse du train
Nbre : integer; // nombre de zones (ci dessous)
Zone : array[1..MaxZones] of record det1,det2 : integer; end;
end;
// tableau des évènements détecteurs , aiguillages, actionneurs
event_det_tick : array[0..Max_Event_det_tick] of
record
tick : longint;
adresse : integer ;
train : integer; // numéro du train si détecteur
modele : Tequipement ; // détecteur, aiguillage, actionneur
etat : integer ; // état du détecteur de l'aiguillage ou de l'actionneur
reaffecte : integer ; // =1 réaffecté au bon train dans le cas de 2 détecteurs contigus qui ne s'enchainent pas bien =2 réaffecté par changement aiguillage
end;
// tableau des croisement rencontrés par la fonction suivant_alg3
croisement : array[1..20] of
record
adresse, // adresse du croisement
entree,sortie, // point d'entrée et de sortie
affect_train : integer; // numéro du train affecté
end;
ncrois : integer;
// Prévision des zones suivantes (en fonction de la position aiguillages)
TrainPrevZone : array[1..20] of array[1..5] of integer; // non utilisé
// Zones d'occupations actuelles
MemZone : array[0..NbMemZone,0..NbMemZone] of
record
etat : boolean; // mémoires de zones des détecteurs
train : string;
NumTrain,AdrTrain : integer;
end;
Tablo_actionneur : array[1..100] of
record
loco,act,son: boolean; // destinataire loco acessoire ou son
adresse,adresse2, // adresse: adresse de base ; adresse2=cas d'une Zone
etat,fonction,tempo,TempoCourante,
accessoire,sortie,
typdeclenche : integer; // déclencheur: 0=actioneur 1=MemZone 2=evt aig
Raz : boolean;
det : boolean; // le déclencheur est un détecteur
FichierSon,trainDecl,TrainDest,TrainCourant : string;
end;
KeyInputs: array of TInput;
Tablo_PN : array[1..20] of
record
AdresseFerme : integer; // adresse de pilotage DCC pour la fermeture
commandeFerme : integer; // commande de fermeture (1 ou 2)
AdresseOuvre : integer; // adresse de pilotage DCC pour l'ouverture
commandeOuvre : integer; // commande d'ouverture (1 ou 2)
NbVoies : integer; // Nombre de voies du PN
Pulse : integer; // 0=commande maintenue 1=Impulsionnel
Voie : array [1..10] of record
ActFerme,ActOuvre : integer ; // actionneurs provoquant la fermeture et l'ouverture
detZ1F,detZ2F,detZ1O,detZ2O : integer; // Zones de détection
PresTrain : boolean; // mémoire de présence de train sur la voie
end;
end;
Tablo_Simule : array[0..Max_Simule] of
record
tick : longint;
modele : Tequipement;
Adresse,etat : integer ;
end;
tablo_CV : array [1..255] of integer;
couleur : Tcolor;
// modélisations des fichiers config
branche : array [1..100] of string;
// l'indice du tableau aiguillage n'est pas son adresse
aiguillage : array[0..MaxAcc] of Taiguillage;
// signaux - L'index du tableau n'est pas son adresse
CdeDccpp : array[1..MaxCdeDccpp] of string;
feux : array[0..MaxAcc] of Tfeu;
trains_cdm : array[1..Max_Trains] of record
nom_train : string;
adresse,vitmax : integer;
end;
trains : array[1..Max_Trains] of record
nom_train : string;
adresse,vitmax,VitNominale,VitRalenti : integer;
TempoArret : integer; // tempo d'arret pour le timer
TempoDemarre : integer;
index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train
end;
// éléments verrouillés
elements : array[1..20] of record
adresse : integer;
typ : Tequipement;
end;
Placement : array[1..10] of record
train : string;
detecteur,detdir : integer;
inverse : boolean;
end;
event_det : array[1..Max_event_det] of record
adresse : integer;
etat : boolean;
end;
event_det_train : array[0..Max_Trains] of record
NbEl,AdrTrain : integer;
signal_rouge : integer ; // si le train est arreté sur un signal au rouge
nom_train : string; // nom du train
suivant : integer; // suivant prévisionnel à det1 et det2
Det : array[1..2] of record
adresse : integer; // tableau des evts détecteurs par train
etat : boolean;
end;
end;
Feu_supprime,Feu_sauve : Tfeu;
Aig_supprime,Aig_sauve : TAiguillage;
Fimage : Timage;
BrancheN : array[1..MaxBranches,1..MaxElBranches] of TBranche;
{$R *.dfm}
// utilisation des procédures et fonctions dans les autres unités
function Index_feu(adresse : integer) : integer;
function Index_Aig(adresse : integer) : integer;
procedure dessine_feu2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
procedure dessine_feu3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
procedure dessine_feu5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
procedure dessine_feu7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
procedure dessine_feu9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer);
procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,N : integer);
procedure Maj_Etat_Signal(adresse,aspect : integer);
procedure Affiche(s : string;lacouleur : TColor);
procedure envoi_signal(Adr : integer);
procedure pilote_direction(Adr,nbre : integer);
procedure connecte_USB;
procedure deconnecte_usb;
function IsWow64Process: Boolean;
procedure Dessine_feu_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer);
procedure Pilote_acc0_X(adresse : integer;octet : byte);
Function pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire) : boolean;
function etat_signal_suivant(Adresse,rang : integer;var AdrSignalsuivant : integer) : integer;
function suivant_alg3(prec : integer;typeELprec : TEquipement;actuel : integer;typeElActuel : TEquipement;alg : integer) : integer;
function detecteur_suivant_El(el1: integer;TypeDet1 : TEquipement;el2 : integer;TypeDet2 : TEquipement;alg : integer) : integer ;
function test_memoire_zones(adresse : integer) : boolean;
function PresTrainPrec(Adresse,NbCtSig : integer;var AdrTr : integer) : boolean;
function cond_carre(adresse : integer) : boolean;
function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean) : boolean;
procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string);
procedure Event_act(adr,adr2,etat : integer;trainDecl : string);
function verif_UniSemaf(adresse,UniSem : integer) : integer;
function Select_dessin_feu(TypeFeu : integer) : TBitmap;
procedure cree_image(rang : integer);
procedure trouve_aiguillage(adresse : integer);
procedure trouve_detecteur(detecteur : integer);
function ProcessRunning(sExeName: String) : Boolean;
Procedure Raz_tout;
Function chaine_CDM_Acc(adresse,etat : integer) : string;
Function Checksum(s : string) : string;
function envoi(s : string) : boolean;
procedure init_dccpp;
procedure init_aiguillages;
function index_adresse_detecteur(de : integer) : integer;
function index_train_adresse(adr : integer) : integer;
procedure vitesse_loco(nom_train :string;loco : integer;vitesse : integer;sens : boolean);
procedure Maj_Feux;
procedure Det_Adj(adresse : integer);
procedure reserve_canton(detecteur1,detecteur2,adrtrain : integer);
function signal_detecteur(detecteur : integer) : integer;
implementation
uses UnitDebug, UnitPilote, UnitSimule, UnitTCO, UnitConfig,
Unitplace,
verif_version;
{
procedure menu_interface(MA : TMA);
var val : boolean;
begin
val:=MA=valide;
with formprinc do
begin
MenuConnecterUSB.enabled:=val;
DeConnecterUSB.enabled:=val;
MenuConnecterEthernet.enabled:=val;
MenuDeConnecterEthernet.enabled:=val;
end;
end;
}
procedure procetape(s : string);
begin
if debug<>2 then exit;
MessageDlg('Etape '+intToSTR(etape)+' '+s,mtInformation,[mbOk],0);
inc(etape);
end;
procedure Tformprinc.DoHint(Sender : Tobject);
begin
StatusBar1.Simpletext:=Application.Hint;
end;
// fonctions sur les bits
function testBit(n : word;position : integer) : boolean;
begin
testBit:=n and (1 shl position) = (1 shl position);
end;
Function RazBit(n : word;position : integer) : word;
begin
RazBit:=n and not(1 shl position);
end;
Function SetBit(n : word;position : integer) : word;
begin
SetBit:=n or (1 shl position);
end;
// renvoie le 1er numéro de bit à 1 du mot
// PremBitNum(1)=0
// PremBitNum(4)=2
// si pas de bit à 1, renvoie -1
Function PremBitNum(n : word) : integer;
var i : integer;
trouve : boolean;
begin
i:=0;
repeat
trouve:=(n and 1)=1 ;
if not(trouve) then inc(i);
n:=n shr 1;
until (i=16) or trouve;
if trouve then PremBitNum:=i else PremBitNum:=-1;
end;
// conversion du motif de bits (codebin) de la configuration du signal complexe en deux mots:
// en sortie :
// premierBit : code de la signalisation
// Combine = code de la signalisation combinée
// Exemple code_to_aspect(10001000000000) renvoie premierBit=jaune_cli (9) et Combine=rappel 60 (13)
// si pas de combinaison, renvoie -1
procedure code_to_aspect(codebin : word;var aspect,combine : integer) ;
begin
aspect:=PremBitNum(CodeBin and $3ff);
combine:=PremBitNum(CodeBin and $fc00);
end;
// conversion d'un état signal binaire en état unique de 1 à 19
// exemple code_to_etat(10001000000000) (jaune_cli et rappel 60) renvoie 19
function code_to_etat(code : word) : integer;
var aspect,combine : integer;
begin
code_to_aspect(code,aspect,combine);
result:=9999;
if combine=-1 then
begin
if aspect=0 then result:=1; // carré
if aspect=1 then result:=2; // sémaphore
if aspect=2 then result:=3; // sémaphore cli
if aspect=3 then result:=4; // vert
if aspect=4 then result:=5; // vert cli
if aspect=5 then result:=6; // violet
if aspect=6 then result:=7; // blanc
if aspect=7 then result:=8; // blanc cli
if aspect=8 then result:=9; // jaune
if aspect=9 then result:=10; // jaune cli
end;
if aspect=-1 then
begin
if combine=10 then result:=11; // ralen 30
if combine=11 then result:=12; // ralen 60
if combine=12 then result:=14; // rappel 30
if combine=13 then result:=15; // rappel 60
end;
if (aspect=9) and (combine=11) then result:=13; //ralen 60 + jaune cli
if (aspect=8) and (combine=12) then result:=16; //rappel 30 + jaune
if (aspect=9) and (combine=12) then result:=17; //rappel 30 + jaune cli
if (aspect=8) and (combine=13) then result:=18; //rappel 60 + jaune
if (aspect=9) and (combine=13) then result:=19; //rappel 60 + jaune cli
code_to_etat:=result;
{'Non commandé','carré','sémaphore','sémaphore cli','vert','vert cli','violet',
'blanc','blanc cli','jaune','jaune cli','ralen 30','ralen 60','ralen 60 + jaune cli','rappel 30','rappel 60',
7 8 9 10 11 12 13 14 15
'rappel 30 + jaune','rappel 30 + jaune cli','rappel 60 + jaune','rappel 60 + jaune cli');
16 17 18 19 }
end;
// dessine un cercle plein dans le feu
procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor);
begin
with Acanvas do
begin
brush.Color:=couleur;
Pen.Color:=clBlack;
Ellipse(x-rayon,y-rayon,x+rayon,y+rayon);
end;
end;
// dessine les feux sur une cible à 2 feux dans le canvas spécifié
// x,y : offset en pixels du coin supérieur gauche du feu
// Acanvas : canvas de destination
// x,y : point d'origine de destination
// frX, frY : facteurs de réduction (pour agrandissement)
// EtatSignal : état du signal
// orientation à donner au signal : 1= vertical 2=90° à gauche 3=90° à droite
procedure dessine_feu2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
var Temp,rayon,xViolet,YViolet,xBlanc,yBlanc,
LgImage,HtImage,code,combine : integer;
ech : real;
begin
code_to_aspect(Etatsignal,code,combine);
rayon:=round(6*frX);
// récupérer les dimensions de l'image d'origine du feu
LgImage:=Formprinc.Image2feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image2feux.Picture.Bitmap.Height;
XBlanc:=13; YBlanc:=11;
xViolet:=13; yViolet:=23;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yViolet;YViolet:=XViolet;XViolet:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux
// calcul des facteurs de réduction pour la rotation
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-XBlanc;Xblanc:=Yblanc;Yblanc:=Temp;
Temp:=LgImage-Xviolet;Xviolet:=Yviolet;Yviolet:=Temp;
end;
XBlanc:=round(xBlanc*Frx)+x; YBlanc:=round(Yblanc*Fry)+Y;
XViolet:=round(XViolet*FrX)+x; YViolet:=round(YViolet*FrY)+Y;
// extinctions
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,rayon,GrisF);
cercle(ACanvas,xViolet,yViolet,rayon,GrisF);
// allumages
if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite);
if code=violet then cercle(ACanvas,xViolet,yViolet,rayon,clviolet);
end;
// dessine les feux sur une cible à 3 feux
procedure dessine_feu3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xvert,Yvert,
LgImage,HtImage,code,combine : integer;
ech : real;
begin
code_to_aspect(Etatsignal,code,combine);
rayon:=round(6*frX);
LgImage:=Formprinc.Image3feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image3feux.Picture.Bitmap.Height;
Xvert:=13; Yvert:=11;
xSem:=13; ySem:=22;
xJaune:=13; yJaune:=33;
if (orientation=2) then
begin
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
end;
XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y;
Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y;
XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y;
// extinctions
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,GrisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,xVert,yVert,rayon,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,GrisF);
// allumages
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xVert,yVert,rayon,clGreen);
if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(Acanvas,xJaune,yJaune,rayon,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xSem,ySem,rayon,clRed);
end;
// dessine les feux sur une cible à 4 feux
// orientation=1 vertical
procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xcarre,Ycarre,Xvert,Yvert,
LgImage,HtImage,code,combine : integer;
ech : real;
begin
code_to_aspect(Etatsignal,code,combine); // et aspect
rayon:=round(6*frX);
LgImage:=Formprinc.Image4feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image4feux.Picture.Bitmap.Height;
Xcarre:=13; ycarre:=11;
Xvert:=13; Yvert:=22;
xSem:=13; ySem:=33;
xJaune:=13; yJaune:=44;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yjaune; YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-ycarre; Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem; YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert; Yvert:=Xvert;Xvert:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux
// calcul des facteurs de réduction pour la rotation
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp;
end;
XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y;
Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y;
XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y;
Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y;
//extinctions
cercle(ACanvas,Xcarre,yCarre,rayon,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,Xsem,Ysem,rayon,GrisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,Xvert,yvert,rayon,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,Xjaune,YJaune,rayon,GrisF);
// allumages
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xVert,yVert,rayon,clGreen);
if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(Acanvas,Xjaune,yJaune,rayon,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xSem,ySem,rayon,clRed);
if code=carre then
begin
cercle(ACanvas,xSem,Ysem,rayon,clRed);
cercle(ACanvas,xCarre,yCarre,rayon,clRed);
end;
end;
// dessine les feux sur une cible à 5 feux
procedure dessine_feu5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
var XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,
Temp,rayon,LgImage,HtImage,code,combine : integer;
ech : real;
begin
code_to_aspect(Etatsignal,code,combine); // et aspect
rayon:=round(6*frX);
XBlanc:=13; YBlanc:=22;
xJaune:=13; yJaune:=55;
Xcarre:=13; Ycarre:=11;
XSem:=13; Ysem:=44;
XVert:=13; YVert:=33;
LgImage:=Formprinc.Image5feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image5feux.Picture.Bitmap.Height;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux
// calcul des facteurs de réduction pour la rotation
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux
// calcul des facteurs de réduction pour la rotation
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp;
Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp;
end;
XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y;
Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y;
Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y;
XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y;
Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y;
// extinctions
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,rayon,GrisF);
cercle(ACanvas,xcarre,ycarre,rayon,GrisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,xvert,yvert,rayon,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xjaune,yjaune,rayon,GrisF);
//allumages
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xsem,ysem,rayon,clRed);
if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,xblanc,yblanc,rayon,clWhite);
if (code=violet) then cercle(ACanvas,xblanc,yblanc,rayon,clViolet);
if code=carre then
begin
cercle(ACanvas,xcarre,ycarre,rayon,clRed);
cercle(ACanvas,xsem,ysem,rayon,clRed);
end;
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xvert,yVert,rayon,clGreen);
if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(ACanvas,xJaune,yjaune,rayon,clorange);
end;
// dessine les feux sur une cible à 7 feux
procedure dessine_feu7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
var XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2,
Temp,rayon,LgImage,HtImage,code,combine : integer;
ech : real;
begin
code_to_aspect(Etatsignal,code,combine); // et combine
rayon:=round(6*frX);
XBlanc:=13; YBlanc:=23;
Xral1:=13; YRal1:=11;
Xral2:=37; YRal2:=11;
xJaune:=13; yJaune:=66;
Xcarre:=13; Ycarre:=35;
XSem:=13; Ysem:=56;
XVert:=13; YVert:=45;
LgImage:=Formprinc.Image7feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image7feux.Picture.Bitmap.Height;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux
// calcul des facteurs de réduction pour la rotation
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp;
Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp;
Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux
// calcul des facteurs de réduction pour la rotation
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp;
Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp;
Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp;
Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp;
end;
XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y;
Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y;
XRal1:=round(XRal1*FrX)+x; YRal1:=round(YRal1*FrY)+Y;
XRal2:=round(XRal2*FrX)+x; YRal2:=round(YRal2*FrY)+Y;
Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y;
XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y;
Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y;
// effacements
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,rayon,grisF);
if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then
begin
cercle(ACanvas,Xral1,Yral1,rayon,grisF);cercle(ACanvas,Xral2,Yral2,rayon,GrisF);
end;
if not((code=vert_cli) and clignotant) then cercle(ACanvas,xVert,yVert,rayon,GrisF);
cercle(ACanvas,xcarre,yCarre,rayon,GrisF);cercle(ACanvas,xSem,ySem,rayon,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,GrisF);
// Allumages
if (code=ral_30) or (combine=ral_30) or ((code=ral_60) or (combine=ral_60)) and clignotant then
begin
cercle(ACanvas,xRal1,yRal1,rayon,clOrange);cercle(ACanvas,xRal2,yRal2,Rayon,clOrange);
end;
if (code=jaune) or ((code=jaune_cli) and clignotant) then cercle(Acanvas,xjaune,yjaune,rayon,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xsem,ysem,rayon,clRed);
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xVert,yVert,rayon,clGreen);
if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite);
if (code=violet) then cercle(ACanvas,xblanc,yblanc,rayon,clViolet);
if code=carre then
begin
cercle(ACanvas,xCarre,yCarre,rayon,clRed);
cercle(ACanvas,xSem,ySem,rayon,clRed);
end;
end;
// dessine les feux sur une cible à 9 feux
procedure dessine_feu9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer);
var rayon,
XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2,
Xrap1,Yrap1,Xrap2,Yrap2,Temp : integer;
LgImage,HtImage,xt,yt,code,combine : integer;
ech : real;
begin
rayon:=round(6*frX);
code_to_aspect(Etatsignal,code,combine); // et aspect
// mise à l'échelle des coordonnées des feux en fonction du facteur de réduction frX et frY et x et y (offsets)
XBlanc:=13; YBlanc:=36;
Xral1:=13; YRal1:=24;
Xral2:=37; YRal2:=24;
xJaune:=13; yJaune:=80;
xRap1:=37; yRap1:=12;
xrap2:=37; yRap2:=37;
Xcarre:=13; Ycarre:=47;
XSem:=13; Ysem:=69;
XVert:=13; YVert:=58;
LgImage:=Formprinc.Image9feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image9feux.Picture.Bitmap.Height;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux : échange des coordonnées X et Y et translation sur HtImage
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp;
Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp;
Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
Temp:=HtImage-yRap1;YRap1:=XRap1;XRap1:=Temp;
Temp:=HtImage-yRap2;YRap2:=XRap2;XRap2:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux : échange des coordonnées X et Y et translation sur LgImage
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp;
Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp;
Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp;
Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp;
Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp;
Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp;
end;
XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y;
Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y;
XRal1:=round(XRal1*FrX)+x; YRal1:=round(YRal1*FrY)+Y;
XRal2:=round(XRal2*FrX)+x; YRal2:=round(YRal2*FrY)+Y;
Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y;
XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y;
Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y;
XRap1:=round(XRap1*FrX)+x; YRap1:=round(YRap1*FrY)+Y;
XRap2:=round(XRap2*FrX)+x; YRap2:=round(YRap2*FrY)+Y;
// extinctions
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,Rayon,grisF);
if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then
begin
cercle(ACanvas,Xral1,Yral1,rayon,grisF);cercle(ACanvas,xRal2,yRal2,rayon,grisF);
end;
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,grisF);
if not((code=rappel_60) and clignotant) or not((combine=rappel_60) and clignotant) then
begin
cercle(ACanvas,xrap1,yrap1,rayon,grisF);cercle(ACanvas,xrap2,yrap2,rayon,grisF);
end;
cercle(ACanvas,xcarre,Ycarre,rayon,grisF); // carré supérieur
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,grisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,xvert,yvert,rayon,grisF);
// allumages
if ((code=ral_60) and clignotant) or (code=ral_30) or
((combine=ral_60) and clignotant) or (combine=ral_30) then
begin
cercle(ACanvas,Xral1,yRal1,rayon,clOrange);cercle(ACanvas,xral2,yral2,rayon,clOrange);
end;
if ((code=rappel_60) and clignotant) or (code=rappel_30) or
((combine=rappel_60) and clignotant) or (combine=rappel_30) then
begin
cercle(ACanvas,xrap1,yrap1,rayon,clOrange);cercle(ACanvas,xrap2,yrap2,rayon,clOrange);
end;
if ((code=jaune_cli) and clignotant) or (code=jaune) then cercle(Acanvas,xjaune,yjaune,rayon,clOrange);
if ((code=semaphore_cli) and clignotant) or (code=semaphore) then cercle(ACanvas,Xsem,ySem,rayon,clRed);
if ((code=vert_cli) and clignotant) or (code=vert) then cercle(ACanvas,xvert,yvert,rayon,clGreen);
if ((code=blanc_cli) and clignotant) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite);
if (code=violet) then cercle(ACanvas,xblanc,yblanc,rayon,clViolet);
if code=carre then
begin
cercle(ACanvas,xcarre,yCarre,rayon,clRed);
cercle(ACanvas,xsem,ysem,rayon,clRed);
end;
end;
// dessine les feux sur une cible directionnelle à N feux
procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,N : integer);
var rayon,x1,x2,x3,y1,y2,y3,x4,y4,x5,y5,x6,y6,LgImage,HtImage,temp : integer;
ech : real;
begin
if (n<2) or (n>6) then n:=2;
rayon:=round(6*frX);
if n=2 then x2:=25 else x2:=22;
x1:=11;x3:=33;x4:=43;x5:=53;x6:=63;
y1:=13;y2:=13;y3:=13;y4:=13;y5:=13;y6:=13;
case N of
2 : with Formprinc.Image2Dir.Picture.Bitmap do
begin
LgImage:=Width;
HtImage:=Height;
end;
3 : with Formprinc.Image3Dir.Picture.Bitmap do
begin
LgImage:=Width;
HtImage:=Height;
end;
4 : with Formprinc.Image4Dir.Picture.Bitmap do
begin
LgImage:=Width;
HtImage:=Height;
end;
5 : with Formprinc.Image5Dir.Picture.Bitmap do
begin
LgImage:=Width;
HtImage:=Height;
end;
6 : with Formprinc.Image6Dir.Picture.Bitmap do
begin
LgImage:=Width;
HtImage:=Height;
end;
end;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux : échange des coordonnées X et Y et translation sur HtImage
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-y1;y1:=X1;X1:=Temp;
Temp:=HtImage-y2;y2:=X2;X2:=Temp;
Temp:=HtImage-y3;y3:=X3;X3:=Temp;
Temp:=HtImage-y4;y4:=X4;X4:=Temp;
Temp:=HtImage-y5;y5:=X5;X5:=Temp;
Temp:=HtImage-y6;y6:=X6;X6:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux : échange des coordonnées X et Y et translation sur LgImage
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-X1;X1:=Y1;Y1:=Temp;
Temp:=LgImage-X2;X2:=Y2;Y2:=Temp;
Temp:=LgImage-X3;X3:=Y3;Y3:=Temp;
Temp:=LgImage-X4;X4:=Y4;Y4:=Temp;
Temp:=LgImage-X5;X5:=Y5;Y5:=Temp;
Temp:=LgImage-X6;X6:=Y6;Y6:=Temp;
end;
X1:=round(X1*Frx)+x; Y1:=round(Y1*Fry)+Y;
X2:=round(X2*FrX)+x; Y2:=round(Y2*FrY)+Y;
X3:=round(X3*FrX)+x; Y3:=round(Y3*FrY)+Y;
X4:=round(X4*Frx)+x; Y4:=round(Y4*Fry)+Y;
X5:=round(X5*FrX)+x; Y5:=round(Y5*FrY)+Y;
X6:=round(X6*FrX)+x; Y6:=round(Y6*FrY)+Y;
if EtatSignal=0 then
begin
cercle(ACanvas,x1,y1,rayon,GrisF);
cercle(ACanvas,x2,y2,rayon,GrisF);
if N>2 then cercle(ACanvas,x3,y3,rayon,GrisF);
if N>3 then cercle(ACanvas,x4,y4,rayon,GrisF);
if N>4 then cercle(ACanvas,x5,y5,rayon,GrisF);
if N>5 then cercle(ACanvas,x6,y6,rayon,GrisF);
end;
if EtatSignal=1 then
begin
cercle(ACanvas,x1,y1,rayon,clWhite);
cercle(ACanvas,x2,y2,rayon,GrisF);
if N>2 then cercle(ACanvas,x3,y3,rayon,GrisF);
if N>3 then cercle(ACanvas,x4,y4,rayon,GrisF);
if N>4 then cercle(ACanvas,x5,y5,rayon,GrisF);
if N>5 then cercle(ACanvas,x6,y6,rayon,GrisF);
end;
if EtatSignal=2 then
begin
cercle(ACanvas,x1,y1,rayon,clWhite);
cercle(ACanvas,x2,y2,rayon,clWhite);
if N>2 then cercle(ACanvas,x3,y3,rayon,GrisF);
if N>3 then cercle(ACanvas,x4,y4,rayon,GrisF);
if N>4 then cercle(ACanvas,x5,y5,rayon,GrisF);
if N>5 then cercle(ACanvas,x6,y6,rayon,GrisF);
end;
if EtatSignal=3 then
begin
cercle(ACanvas,x1,y1,rayon,clWhite);
cercle(ACanvas,x2,y2,rayon,clWhite);
if N>2 then cercle(ACanvas,x3,y3,rayon,clWhite);
if N>3 then cercle(ACanvas,x4,y4,rayon,GrisF);
if N>4 then cercle(ACanvas,x5,y5,rayon,GrisF);
if N>5 then cercle(ACanvas,x6,y6,rayon,GrisF);
end;
if EtatSignal=4 then
begin
cercle(ACanvas,x1,y1,rayon,clWhite);
cercle(ACanvas,x2,y2,rayon,clWhite);
if N>2 then cercle(ACanvas,x3,y3,rayon,clWhite);
if N>3 then cercle(ACanvas,x4,y4,rayon,clWhite);
if N>4 then cercle(ACanvas,x5,y5,rayon,GrisF);
if N>5 then cercle(ACanvas,x6,y6,rayon,GrisF);
end;
if EtatSignal=5 then
begin
cercle(ACanvas,x1,y1,rayon,clWhite);
cercle(ACanvas,x2,y2,rayon,clWhite);
if N>2 then cercle(ACanvas,x3,y3,rayon,clWhite);
if N>3 then cercle(ACanvas,x4,y4,rayon,clWhite);
if N>4 then cercle(ACanvas,x5,y5,rayon,clWhite);
if N>5 then cercle(ACanvas,x6,y6,rayon,GrisF);
end;
if EtatSignal=6 then
begin
cercle(ACanvas,x1,y1,rayon,clWhite);
cercle(ACanvas,x2,y2,rayon,clWhite);
if N>2 then cercle(ACanvas,x3,y3,rayon,clWhite);
if N>3 then cercle(ACanvas,x4,y4,rayon,clWhite);
if N>4 then cercle(ACanvas,x5,y5,rayon,clWhite);
if N>5 then cercle(ACanvas,x6,y6,rayon,clWhite);
end;
end;
// transforme le type TEquipement en chaine
// rien,aig,tjd,tjs,triple,det,buttoir,voie,crois,act
function BTypeToChaine(BT : TEquipement) : string;
begin
case BT of
rien : result:='rien';
det : result:='det';
aig : result:='aig';
voie : result:='voie';
buttoir : result:='buttoir';
triple : result:='triple';
tjd : result:='tjd';
tjs : result:='tjs';
crois : result:='crois';
act : result:='act';
else result:='???';
end;
end;
procedure Affiche(s : string;lacouleur : TColor);
begin
with formprinc do
begin
FenRich.lines.add(s);
RE_ColorLine(FenRich,FenRich.lines.count-1,lacouleur);
end;
end;
procedure Affiche_suivi(s : string;lacouleur : TColor);
var i : integer;
begin
with formprinc.FenRich do
begin
i:=lines.Count-1;
s:=lines.Strings[i]+s;
lines.Strings[i]:=s;
RE_ColorLine(Formprinc.FenRich,i,lacouleur);
end;
end;
// trouve l'index d'un train par son nom
function index_train_nom(nom : string) : integer;
var i : integer;
trouve : boolean;
begin
i:=1;
repeat
trouve:=trains[i].nom_train=nom;
if not(trouve) then inc(i);
until (trouve) or (i>Ntrains);
if trouve then Index_train_nom:=i else Index_train_nom:=0 ;
end;
// trouve l'index d'un train par son adresse dans le tableau trains
function index_train_adresse(adr : integer) : integer;
var i : integer;
trouve : boolean;
begin
i:=1;
repeat
trouve:=trains[i].adresse=adr;
if not(trouve) then inc(i);
until (trouve) or (i>Ntrains);
if trouve then index_train_adresse:=i else index_train_adresse:=0 ;
end;
// renvoie l'index du feu dans le tableau feux[] en fonction de son adresse
// si pas trouvé renvoie 0
function Index_feu(adresse : integer) : integer;
var i : integer;
trouve : boolean;
begin
i:=1;
repeat
trouve:=feux[i].adresse=adresse;
if not(trouve) then inc(i);
until (trouve) or (i>NbreFeux);
if trouve then Index_feu:=i else Index_feu:=0 ;
end;
// renvoie l'index de l'aiguillage dans le tableau aiguillages[] en fonction de son adresse
// si pas trouvé renvoie 0
function Index_Aig(adresse : integer) : integer;
var i : integer;
trouve : boolean;
begin
i:=1;
repeat
trouve:=aiguillage[i].adresse=adresse;
if not(trouve) then inc(i);
until (trouve) or (i>MaxAiguillage);
if trouve then Index_Aig:=i else Index_Aig:=0 ;
end;
// dessine l'aspect du feu en fonction de son adresse dans la partie droite de droite
procedure Dessine_feu_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer);
var i,aspect : integer;
begin
i:=Index_feu(adresse);
if i<>0 then
begin
aspect:=feux[i].aspect ;
case aspect of
// feux de signalisation
2 : dessine_feu2(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation);
3 : dessine_feu3(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation);
4 : dessine_feu4(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation);
5 : dessine_feu5(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation);
7 : dessine_feu7(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation);
9 : dessine_feu9(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation);
// indicateurs de direction
12..16 : dessine_dirN(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation,aspect-10);
end;
end;
end;
// procédure activée quand on clique gauche sur l'image d'un feu
Procedure TFormprinc.ImageOnClick(Sender : Tobject);
var s : string;
P_image_pilote : Timage;
i,erreur : integer;
begin
P_image_pilote:=Sender as TImage; // récupérer l'objet image du feu qu'on a cliqué de la forme pilote
s:=P_Image_pilote.Hint; // récupérer son hint qui contient l'adresse du feu cliqué
//Affiche(s,clyellow);
i:=pos('@',s); if i<>0 then delete(s,1,i);
i:=pos('=',s); if i<>0 then delete(s,i,1);
i:=pos(' ',s);
if i<>0 then s:=copy(s,1,i-1);
val(s,AdrPilote,erreur);
if adrPilote=0 then exit;
i:=Index_feu(AdrPilote);
if i=0 then exit;
with Formpilote do
begin
TFormPilote.Create(Self); // rajouté
show;
ImagePilote.Parent:=FormPilote;
ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto;
ImagePilote.Picture.Bitmap.TransparentColor:=clblue;
ImagePilote.Transparent:=true;
ImagePilote.Picture.BitMap:=Feux[i].Img.Picture.Bitmap;
LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(AdrPilote);
feux[0].EtatSignal:=feux[i].EtatSignal;
if feux[i].aspect>10 then
begin
GroupBox1.Visible:=false;
GroupBox2.Visible:=false;
LabelNbFeux.Visible:=true;
EditNbreFeux.Visible:=true;
EditNbreFeux.Text:='1';
end
else
begin
LabelNbFeux.Visible:=False;
EditNbreFeux.Visible:=false;
GroupBox1.Visible:=true;
GroupBox2.Visible:=true;
end;
end;
end;
function Select_dessin_feu(TypeFeu : integer) : TBitmap;
var Bm : TBitMap;
begin
case TypeFeu of // charger le bit map depuis le fichier
2 : Bm:=Formprinc.Image2feux.picture.Bitmap;
3 : Bm:=Formprinc.Image3feux.picture.Bitmap;
4 : Bm:=Formprinc.Image4feux.picture.Bitmap;
5 : Bm:=Formprinc.Image5feux.picture.Bitmap;
7 : Bm:=Formprinc.Image7feux.picture.Bitmap;
9 : Bm:=Formprinc.Image9feux.picture.Bitmap;
12 : Bm:=Formprinc.Image2Dir.picture.Bitmap;
13 : Bm:=Formprinc.Image3Dir.picture.Bitmap;
14 : Bm:=Formprinc.Image4Dir.picture.Bitmap;
15 : Bm:=Formprinc.Image5Dir.picture.Bitmap;
16 : Bm:=Formprinc.Image6Dir.picture.Bitmap;
end;
Select_dessin_feu:=bm;
end;
// créée une image dynamiquement pour un nouveau feu déclaré dans le fichier de config
// rang commence à 1
procedure cree_image(rang : integer);
var adresse,TypeFeu : integer;
s : string;
T_BP : TBitMap;
begin
TypeFeu:=feux[rang].aspect;
if typeFeu<=0 then exit;
adresse:=feux[rang].adresse;
Feux[rang].Img:=Timage.create(Formprinc.ScrollBox1);
if feux[rang].Img=nil then begin affiche('Erreur 900 : impossible de créer une image',clred);exit;end;
with Feux[rang].Img do
begin
if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime);
//canvas.Create;
Parent:=Formprinc.ScrollBox1; // dire que l'image est dans la scrollBox1
//formprinc.ScrollBox1.Color:=ClGreen;
Name:='ImageFeu'+IntToSTR(adresse); // nom de l'image - sert à identifier le composant si on fait clic droit.
Top:=(HtImg+espY+20)*((rang-1) div NbreImagePLigne); // détermine les points d'origine
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne));
width:=LargImg;
Height:=HtImg;
s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+intToSTR(feux[rang].Decodeur)+
' Adresse détecteur associé='+intToSTR(feux[rang].Adr_det1)+
' Adresse élement suivant='+intToSTR(feux[rang].Adr_el_suiv1);
if feux[rang].Btype_suiv1=aig then s:=s+' (aig)';
Hint:=s;
onClick:=Formprinc.Imageonclick; // affectation procédure clique sur image
PopUpMenu:=Formprinc.PopupMenuFeu; // affectation popupmenu sur clic droit
// affecter le type d'image de feu dans l'image créée
T_BP:=Select_dessin_feu(TypeFeu);
picture.Bitmap:=T_Bp;
picture.BitMap.TransparentMode:=tmfixed; // tmauto (la couleur transparente est déterminée par pixel le plus en haut à gauche du bitmap)
// tmfixed (la couleur transparente est explicitement assignée et stockée dans le bitmap)
Picture.Bitmap.TransparentColor:=clblue; // la couleur de transparence est bleue
Transparent:=true;
// mettre rouge par défaut
if TypeFeu=2 then feux[rang].EtatSignal:=violet_F;
if TypeFeu=3 then feux[rang].EtatSignal:=semaphore_F;
if (TypeFeu>3) and (TypeFeu<10) and feux[rang].VerrouCarre then feux[rang].EtatSignal:=carre_F;
if (TypeFeu>3) and (TypeFeu<10) and not(feux[rang].VerrouCarre) then feux[rang].EtatSignal:=semaphore_F;
if TypeFeu>10 then feux[rang].EtatSignal:=0;
dessine_feu_mx(Feux[rang].Img.Canvas,0,0,1,1,feux[rang].adresse,1);
//if feux[rang].aspect=5 then cercle(Picture.Bitmap.Canvas,13,22,6,ClYellow);
end;
// créée le label pour afficher son adresse
Feux[rang].Lbl:=Tlabel.create(Formprinc.ScrollBox1);
with Feux[rang].Lbl do
begin
caption:='@'+IntToSTR(Feux[rang].adresse);
Parent:=Formprinc.ScrollBox1;
width:=100;height:=20;
Top:=HtImg+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne));
BringToFront;
end;
// créée le checkBox si un feu blanc est déclaré sur ce feu
if feux[rang].FeuBlanc then
begin
if debug=1 then affiche('Création CheckBox feu blanc '+intToSTR(rang),clLime);
Feux[rang].checkFB:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu
with Feux[rang].CheckFB do
begin
onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus
Hint:='Feu blanc';
Name:='CheckBoxFB'+intToSTR(adresse); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure
caption:='dem FB';
Parent:=Formprinc.ScrollBox1;
width:=100;height:=15;
Top:=HtImg+15+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne));
BringToFront;
end;
end
else Feux[rang].checkFB:=nil;
end;
// ajoute en bout de chaine le checksum d'une trame
Function Checksum(s : string) : string;
var i : integer;
check : byte;
begin
check:=0;
for i:=1 to length(s) do
begin
check:=check xor ord(s[i]);
end;
checksum:=s+char(check);
end;
// renvoie une chaine ASCI Hexa affichable à partir d'une chaîne
function chaine_HEX(s: string) : string;
var i : integer;
sa_hex: string;
begin
sa_hex:='';
for i:=1 to length(s) do
begin
sa_hex:=sa_hex+IntToHex(ord(s[i]),2)+' ';
end;
chaine_HEX:=sa_hex;
end;
// Affiche une chaîne en Hexa Ascii
procedure affiche_chaine_hex(s : string;couleur : Tcolor);
begin
if traceTrames then AfficheDebug(chaine_HEX(s),couleur);
end;
// temporisation en x 100 ms (0,1 s)
procedure Tempo(ValTemps : integer);
begin
temps:=Valtemps;
repeat
Application.ProcessMessages;
until (temps<=0);
end;
// envoi d'une chaîne à la centrale par USBLenz ou socket, n'attend pas l'ack
// ici on envoie pas à CDM
procedure envoi_ss_ack(s : string);
var i,timeout,valto : integer;
begin
if protocole=1 then
begin
s:=entete+s+suffixe;
if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClLime);
end;
if (protocole=2) and TraceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+s,ClLime);
// par port com-usb
if portCommOuvert then
begin
if (prot_serie=4) then // le protocole 4 contrôle simplement la ligne CTS avant de transmettre et temporise octet par octet
begin
i:=1;
valto:=10;
//Affiche('envoi en tenant compte cts',clyellow);
repeat
timeout:=0;
repeat
//Application.ProcessMessages;
inc(timeout);
Sleep(20);
until (Formprinc.MSCommUSBLenz.CTSHolding=true) or (timeout>valto);
if timeout<=valto then
begin
//if formprinc.MSCommUSBLenz.CTSHolding then sa:='CTS=1 ' else sa:='CTS=0 ';
FormPrinc.MSCommUSBLenz.Output:=s[i];
if terminal then Affiche(chaine_hex(s[i]),clyellow);
inc(i);
end;
until (i=length(s)+1) or (timeout>valto);
if timeout>valto then affiche('Erreur attente interface trop longue',clred);
end;
// protocole Rts Cts ou sans temporisation
if (prot_serie=2) or (tempoOctet=0) then
begin
FormPrinc.MSCommUSBLenz.Output:=s;
exit;
end;
// procotole xon xoff ou xon-rts
if (prot_serie=1) or (prot_serie=3) then
begin
for i:=1 to length(s) do
begin
FormPrinc.MSCommUSBLenz.Output:=s[i];
//Affiche(s[i],clyellow);// else Affiche(chaine_hex(s[i]),clyellow);
Sleep(TempoOctet);
end;
end;
if (prot_serie=0) then FormPrinc.MSCommUSBLenz.Output:=s;
end;
// par socket (ethernet)
if parSocketLenz or (etat_init_interface>=11) then Formprinc.ClientSocketInterface.Socket.SendText(s);
end;
// envoi d'une chaîne à l'interface par USB ou socket, puis attend l'ack ou le nack
function envoi(s : string) : boolean;
var tempo : integer;
begin
envoi_ss_ack(s);
// attend l'ack
ack:=false;nack:=false;
if portCommOuvert or parSocketLenz then
begin
tempo:=0;
repeat
Application.processMessages;
inc(tempo);Sleep(50);
until ferme or ack or nack or (tempo>(TimoutMaxInterface*3)); // l'interface répond < 5s en mode normal et 1,5 mn en mode programmation
if not(ack) or nack then
begin
s:='Pas de réponse de l''interface';
Affiche(s,clRed);
if traceTrames then AfficheDebug(s,clred);
inc(pasreponse);
end;
if ack then begin pasreponse:=0;hors_tension:=false;end;
end;
envoi:=ack;
end;
// chaîne pour une fonction F à un train via CDM
Function chaine_CDM_Func(fonction,etat : integer;train : string) : string;
var so,sx,s : string;
begin
{ exemple de commande envoyée au serveur pour une fonction
C-C-00-0002-CMDTRN-DCCSF|029|02|NAME=nomdutrain;FXnumfonction=etat;
C-C-00-0002-CMDTRN-DCCSF|029|02|NAME=train;FX0=0;
C-C-00-0002-CMDTRN-DCCSF|029|02|NAME=train;FX1=0;
C-C-00-0002-CMDTRN-DCCSF|047|02|NAME=train;FX0=1;FX1=1;FX2=1;FX3=1;
maxi=C-C-00-0002-CMDTRN-DCCSF|111|15|NAME=train;FX0=1;FX1=1;FX2=1;FX3=1;FX4=0;FX5=0;FX6=0;FX7=0;FX8=0;FX9=0;FX10=0;FX11=0;FX12=0;FX13=0;
}
so:=place_id('C-C-01-0004-CMDTRN-DCCSF');
s:=s+'NAME='+train+';';
s:=s+'FX'+intToSTR(fonction)+'='+intToSTR(etat)+';';
sx:=format('%.*d',[2,2])+'|'; // 2 paramètres
so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx;
chaine_CDM_Func:=so+s;
end;
// chaîne pour vitesse train par son nom string
function chaine_CDM_vitesseST(vitesse:integer;train:string) : string;
var s,so,sx: string;
begin
{ C-C-00-0002-CMDTRN-SPEED|0xx|02|NAME=nomdutrain;UREQ=vitesse; }
so:=place_id('C-C-01-0004-CMDTRN-SPEED');
s:=s+'NAME='+train+';';
s:=s+'UREQ='+intToSTR(vitesse)+';';
sx:=format('%.*d',[2,2])+'|'; // 2 paramètres
so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx;
chaine_CDM_vitesseST:=so+s;
end;
// chaîne pour vitesse train INT par son adresse
function chaine_CDM_vitesseINT(vitesse:integer;train:integer) : string;
var s,so,sx: string;
begin
{ C-C-00-0002-CMDTRN-SPEED|0xx|02|NAME=nomdutrain;UREQ=vitesse; }
so:=place_id('C-C-01-0004-CMDTRN-SPEED');
s:=s+'AD='+intToSTR(train)+';';
s:=s+'UREQ='+intToSTR(vitesse)+';';
sx:=format('%.*d',[2,2])+'|'; // 2 paramètres
so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx;
chaine_CDM_vitesseINT:=so+s;
end;
// chaîne pour un accessoire via CDM
Function chaine_CDM_Acc(adresse,etat : integer) : string;
var so,sx,s : string;
begin
{ exemple de commande envoyée au serveur pour manoeuvrer un accessoire
C-C-00-0004-CMDACC-DCCAC|018|02|AD=100;STATE=1;
" AD: adresse (DCC) de l'aiguille
" AD2: adresse #2 (DCC) de l'aiguille (TJD bi-moteurs ou aiguille triples)
" STATE: état de l'aiguille
o 0: position droite (non déviée)
o 1: dévié (TJD, bretelles doubles)
o 2: dévié droit
o 3: dévié gauche
o 4: pos. droite #2 (TJD 4 états)
o 5: pos. déviée #2 (TJD 4 états)
}
so:=place_id('C-C-01-0004-CMDACC-DCCAC');
s:=s+'AD='+format('%.*d',[1,adresse])+';';
s:=s+'STATE='+format('%.*d',[1,etat])+';';
sx:=format('%.*d',[2,2])+'|'; // 2 paramètres
so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx;
chaine_CDM_Acc:=so+s;
end;
procedure envoie_fonction_CDM(fonction,etat : integer;train : string);
var s : string;
begin
s:=chaine_CDM_Func(fonction,etat,train);
envoi_cdm(s);
end;
// active ou désactive une sortie par xpressnet (mode autonome, donc connecté à la centrale)
// Une adresse comporte deux sorties identifiées par "octet"
// Adresse : adresse de l'accessoire
// octet : numéro (1-2) de la sortie à cette adresse
// etat : false (désactivé) true (activé)
procedure pilote_direct(adresse:integer;octet : byte;etat : boolean);
var groupe : integer ;
fonction : byte;
s : string;
begin
if protocole=1 then
begin
groupe:=(adresse-1) div 4;
fonction:=((adresse-1) mod 4)*2 + (octet-1);
// pilotage
if etat then
s:=#$52+Char(groupe)+char(fonction or $80)
else
s:=#$52+Char(groupe)+char(fonction or $88);
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack
end;
if protocole=2 then Affiche('D1: Commande DCC++ pas encore implantée',clred);
end;
procedure pilote_direct01(adresse:integer;octet:integer);
var groupe : integer ;
fonction : byte;
s : string;
begin
if protocole=1 then
begin
if octet=0 then octet:=2;
groupe:=(adresse-1) div 4;
fonction:=((adresse-1) mod 4)*2 + (octet-1);
// pilotage
if octet=2 then
s:=#$52+Char(groupe)+char(fonction or $80)
else
s:=#$52+Char(groupe)+char(fonction or $88);
s:=checksum(s);
if envoi(s) then exit else envoi(s); // envoi de la trame et attente Ack sinon renvoyer
end;
if protocole=2 then Affiche('D2: Commande DCC++ pas encore implantée',clred);
end;
procedure demande_etat_loco(loco : integer);
var ah,al,i : integer;
s : string;
begin
if portCommOuvert or parSocketLenz then
begin
if protocole=1 then
begin
if loco<99 then begin Ah:=0;Al:=loco;end
else begin ah:=((loco and $FF00) + $C000) shr 8;al:=loco and 255;end;
s:=#$E3+#0+char(ah)+char(al);
s:=checksum(s);
fa:=256;fb:=256;
envoi(s);
i:=0;
repeat
inc(i);
Sleep(100);
Application.ProcessMessages;
until (fa<>256) or (i=10);
end;
if protocole=2 then Affiche('D3: Commande DCC++ pas encore implantée',clred);
end;
end;
// loco=adresse de la loco fonction de 0 à 20 état 0/1
procedure Fonction_Loco_Operation(loco,fonction,etat : integer);
var s : string ;
ah,al : integer;
b,c : byte ;
begin
if (fonction<0) or (fonction>28) or (loco<0) or (loco>9999) then exit;
if portCommOuvert or parSocketLenz then
begin
if protocole=1 then
begin
demande_etat_loco(loco); // récupère les états des fonctions Fa=F0 à 4 Fb=F5 à F12 AdrTrain
//Affiche('Train='+IntToSTR(AdrTrain)+' '+IntToHex(fa,2)+' '+IntToHex(fb,2),clyellow);
// en fonction du décodeur, on n'a pas le bon train!!
if (fa<>256) then
begin
s:=#$E4;
if fonction<=4 then s:=s+#$20;
if (fonction>=5) and (fonction<=8) then s:=s+#$21;
if (fonction>=9) and (fonction<=12) then s:=s+#$22;
if (fonction>=13) and (fonction<=20) then s:=s+#$23; // 23 non doc
if (fonction>=21) and (fonction<=28) then s:=s+#$28; // 28 non doc
// codification de l'adresse de la loco : doc Xpressnet page 40 (§2.1.15)
if loco<99 then begin Ah:=0;Al:=loco;end
else begin ah:=((loco or $C000) shr 8);al:=loco and 255;end;
s:=s+char(ah)+char(al);
// codification de la fonction : doc Xpressnet page 64 {§2.2.20.5)
if etat<>0 then
begin
case fonction of
0 : b:=fa or setbit(0,4);
1,2,3,4 : b:=fa or setbit(0,fonction-1); // fa est aligné avec l'octet de demande
5,6,7,8 : b:=fb or setbit(0,fonction-5); // fa est aligné avec l'octet de demande
9,10,11,12 : b:=(fb shr 4) or setbit(0,fonction-9); // fa est décalé à gauche de 4 avec l'octet de demande
end;
if (fonction>=13) and (fonction<=20) then b:=(fb shr 8) or setbit(0,fonction-13); // non doc
if (fonction>=21) and (fonction<=28) then b:=(fb shr 8) or setbit(0,fonction-21); // non doc
end
else
begin
case fonction of
0 : b:=fa and razbit(255,4); // fa est aligné avec l'octet de demande
1,2,3,4 : b:=fa and razbit(255,fonction-1); // fa est aligné avec l'octet de demande
5,6,7,8 : b:=fb and razbit(255,fonction-5);
9,10,11,12 : b:=(fb shr 4) and razbit(255,fonction-9);
end;
if (fonction>=13) and (fonction<=20) then b:=(fb shr 8) or razbit(255,fonction-13); // non doc
if (fonction>=21) and (fonction<=28) then b:=(fb shr 8) or razbit(255,fonction-21); // non doc
end;
s:=s+char(b);
s:=checksum(s);
envoi(s);
end;
end;
if protocole=2 then
begin
c:=0;
if fonction<=4 then
begin
b:=128;
if etat=1 then
case fonction of
0 : b:=b+16;
1 : b:=b+1;
2 : b:=b+2;
3 : b:=b+4;
4 : b:=b+8;
end;
end;
if (fonction>=5) and (fonction<=8) then
begin
b:=176;
if etat=1 then
case fonction of
5 : b:=b+1;
6 : b:=b+2;
7 : b:=b+4;
8 : b:=b+8;
end;
end;
if (fonction>=9) and (fonction<=12) then
begin
b:=160;
if etat=1 then
case fonction of
9 : b:=b+1;
10 : b:=b+2;
11 : b:=b+4;
12 : b:=b+8;
end;
end;
if (fonction>=13) and (fonction<=20) then
begin
b:=222;
if etat=1 then
case fonction of
13 : c:=1;
14 : c:=2;
15 : c:=4;
16 : c:=8;
17 : c:=16;
18 : c:=32;
19 : c:=64;
20 : c:=128;
end;
end;
if (fonction>=21) and (fonction<=28) then
begin
b:=223;
if etat=1 then
case fonction of
21 : c:=1;
22 : c:=2;
23 : c:=4;
24 : c:=8;
25 : c:=16;
26 : c:=32;
27 : c:=64;
28 : c:=128;
end;
end;
s:='<'+intToSTR(loco)+' '+intToSTR(b);
if c<>0 then s:=s+' '+inttostr(c);
s:=s+'>';
envoi_ss_ack(s); // pas d'ack sur les fonctions F
end;
end;
end;
// loco=adresse de la loco fonction de 0 à 12 état 0/1
procedure Fonction_Loco_state(loco,fonction,etat : integer);
var s : string ;
ah,al : integer;
b : byte ;
begin
if (fonction<0) or (fonction>28) or (loco<0) or (loco>9999) then exit;
if portCommOuvert or parSocketLenz then
begin
if protocole=1 then
begin
s:=#$E4;
case fonction of
0,1,2,3,4 : s:=s+#$24;
5,6,7,8 : s:=s+#$25;
9,10,11,12 : s:=s+#$26;
13,14,15,16 : s:=s+#$27; // non doc
end;
// codification de l'adresse de la loco : doc Xpressnet page 40 (§2.1.15)
if loco<99 then begin Ah:=0;Al:=loco;end
else begin ah:=((loco and $FF00) + $C000) shr 8;al:=loco and 255;end;
s:=s+char(ah)+char(al);
// codification de la fonction : doc Xpressnet page 64 {§2.2.20.5)
case fonction of
0 : b:=setbit(0,4);
1,2,3,4 : b:=setbit(0,fonction-1);
5,6,7,8 : b:=setbit(0,fonction-5);
9,10,11,12 : b:=setbit(0,fonction-9);
13,14,15,16 : b:=setbit(0,fonction-13); // non doc
end;
s:=s+char(b);
s:=checksum(s);
envoi(s);
end;
if protocole=2 then Affiche('D5: Commande DCC++ pas encore implantée',clred);
end;
end;
// envoie une vitesse à une loco par XpressNet/Dcc++ ou par CDM
procedure vitesse_loco(nom_train :string;loco : integer;vitesse : integer;sens : boolean);
var s : string;
begin
if not(hors_tension) and ((portCommOuvert or parSocketLenz)) then
begin
if protocole=1 then
begin
//Affiche('X9 train '+inttostr(loco)+' '+inttostr(vitesse),clOrange);
//AfficheDebug('X9 train '+inttostr(loco)+' '+inttostr(vitesse),clOrange);
if vitesse>127 then vitesse:=127;
if sens then vitesse:=vitesse or 128;
s:=#$e4+#$13+#$0+char(loco)+char(vitesse);
s:=checksum(s);
envoi(s);
end;
if protocole=2 then
begin
s:='<t 1 '+intToSTR(loco)+' '+intToSTR(vitesse)+' ';
if sens then s:=s+'1>' else s:=s+'0>';
envoi(s);
end;
end;
if cdm_connecte then
begin
s:=chaine_CDM_vitesseST(vitesse,nom_train); // par nom du train
//s:=chaine_CDM_vitesseINT(vitesse,loco); // par adresse du train
envoi_CDM(s);
//affiche(s,clLime);
end;
end;
// renvoie la chaîne de l'état du signal
function chaine_signal(etat : word) : string;
var aspect,combine : integer;
s : string;
begin
code_to_aspect(etat,aspect,combine);
s:='';
if (aspect=16) then s:='' else begin if aspect<>-1 then s:=etatSign[aspect];end;
if combine<>16 then
begin
if (aspect<>16) and (combine<>-1) then
begin
if aspect<>-1 then s:=s+'+';
s:=s+etatSign[combine];
end;
end;
chaine_signal:=s;
end;
// mise à jour état signal complexe dans le tableau de bits du signal EtatSignalCplx */
// adresse : adresse du signal complexe
// Aspect : code représentant l'état du signal de 0 à 15
procedure Maj_Etat_Signal(adresse,aspect : integer);
var i : integer;
begin
// ('0carré','1sémaphore','2sémaphore cli','3vert','4vert cli','5violet',
// '6blanc','7blanc cli','8jaune','9jaune cli','10ral 30','11ral 60','12rappel 30','13rappel 60');
if debug=3 then formprinc.Caption:='Maj_Etat_Signal '+IntToSTR(adresse);
i:=index_feu(adresse);
if testBit(feux[i].EtatSignal,aspect)=false then // si le bit dans l'état du signal n'est pas allumé, procéder.
begin
// effacement du motif de bits en fonction du nouvel état demandé suivant la règle des signaux complexes
if (aspect<=blanc_cli) then
begin
feux[i].EtatSignal:=0; //Tout aspect <=7 efface les autres
end;
if (aspect=jaune) then // jaune
begin
feux[i].EtatSignal:=RazBit(feux[i].EtatSignal,jaune_cli); // cas du jaune: efface le bit du jaune clignotant (bit 9)
feux[i].EtatSignal:=RazBit(feux[i].EtatSignal,ral_30); // cas du jaune: efface le bit du ral_30 (bit 10)
feux[i].EtatSignal:=RazBit(feux[i].EtatSignal,ral_60); // cas du jaune: efface le bit du ral_60 (bit 11)
feux[i].EtatSignal:=feux[i].EtatSignal and not($00FF); // et effacer les bits 0 à 7
end;
if (aspect=jaune_cli) then // jaune clignotant
begin
feux[i].EtatSignal:=RazBit(feux[i].EtatSignal,jaune); // cas du jaunecli: efface le bit du jaune (bit 8)
feux[i].EtatSignal:=feux[i].EtatSignal and $FF00; // et effacer les bits 0 à 7
end;
if (aspect=ral_30) then // ralentissement 30
begin
feux[i].EtatSignal:=feux[i].EtatSignal and not($3BFF); // cas du ral 30: efface les bits 0 1 2 3 4 5 6 7 8 9 11 12 et 13 : 11 1000 1111 1111
end;
if (aspect=ral_60) then // ralentissement 60
begin
feux[i].EtatSignal:=feux[i].EtatSignal and not($35FF); // cas du ral 60: efface les bits 8 10 12 et 13 et de 0 à 7 : 11 0100 1111 1111
end;
if (aspect=rappel_30) then // rappel 30
begin
feux[i].EtatSignal:=feux[i].EtatSignal and not($2cff); // cas du rappel 30: efface les bits 0 1 2 3 4 5 6 7 10 11 et 13 : 10 1100 1111 0000
end;
if (aspect=rappel_60) then // rappel 60
begin
feux[i].EtatSignal:=feux[i].EtatSignal and not($1Cff); // cas du rappel 60: efface les bits 0 1 2 3 4 5 6 7 10 11 et 12 1 1100 1111 0000
end;
if (aspect=aspect8) then // ral_60_jaune_cli décodeur LDT
begin
feux[i].EtatSignal:=jaune_cli_F or ral_60_F; // cas du ralentissement 60 + avertissement clignotant : efface les bits 10 11 et 12
end;
if (aspect<>aspect8) then
begin
feux[i].EtatSignal:=SetBit(feux[i].EtatSignal,aspect); // allume le numéro du bit de la fonction du signal
end;
end;
if debug=3 then formprinc.Caption:='';
end;
{=============================================
envoie les données au décodeur digital bahn équipé du logiciel "led_schalten"
sur un panneau directionnel - adresse : adresse du signal - code de 1 à 3 pour allumer
; le panneau directionnel à 1, 2 ou 3 leds.
============================================== }
procedure envoi_directionBahn(adr : integer;code : integer);
var i : integer;
begin
i:=index_feu(adr);
if (feux[i].EtatSignal<>code) then
begin
if (traceSign) then Affiche('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange);
if AffSignal then AfficheDebug('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange);
case code of
0 : begin pilote_acc(adr,1,feu); // sortie 1 à 0
sleep(tempo_Feu);
pilote_acc(adr+1,1,feu); // sortie 2 à 0
sleep(Tempo_feu);
pilote_acc(adr+2,1,feu); // sortie 3 à 0
sleep(Tempo_Feu);
end;
1 : begin pilote_acc(adr,2,feu); // sortie 1 à 1
sleep(tempo_Feu);
pilote_acc(adr+1,1,feu); // sortie 2 à 0
sleep(Tempo_feu);
pilote_acc(adr+2,1,feu); // sortie 3 à 0
sleep(Tempo_Feu);
end;
2 : begin pilote_acc(adr,2,feu); // sortie 1 à 1
sleep(tempo_Feu);
pilote_acc(adr+1,2,feu); // sortie 2 à 1
sleep(Tempo_feu);
pilote_acc(adr+2,1,feu); // sortie 3 à 0
sleep(Tempo_Feu);
end;
3 : begin pilote_acc(adr,2,feu); // sortie 1 à 1
sleep(tempo_Feu);
pilote_acc(adr+1,2,feu); // sortie 2 à 1
sleep(Tempo_feu);
pilote_acc(adr+2,2,feu); // sortie 3 à 1
sleep(Tempo_Feu);
end;
end;
feux[i].EtatSignal:=code;
Dessine_feu_mx(Feux[Index_Feu(adr)].Img.Canvas,0,0,1,1,adr,1);
end;
end;
{ =============================================
envoie les données au signal de direction pour un décodeur CDF
adresse : adresse du signal - code de 1 à 3 pour allumer
le panneau directionnel à 1, 2, 3 ou 4 leds.
============================================== }
procedure envoi_directionCDF(adr : integer;code : integer);
var i : integer;
begin
i:=index_feu(adr);
if (feux[i].EtatSignal<>code) then
begin
if traceSign then Affiche('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
if AffSignal then AfficheDebug('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
case code of
// éteindre toutes les leds
0 :
begin
pilote_acc(adr,1,feu) ;
sleep(200);
end;
// code 1 : allume le feu le plus à gauche
1 :
begin
pilote_acc(adr,2,feu) ;
sleep(200);
end;
2 : //allume 2 feux
begin
pilote_acc(adr+1,1,feu) ;
sleep(200);
end;
// code 3 : allume 3 feux
3 :
begin
pilote_acc(adr+1,2,feu) ;
sleep(200);
end;
end;
feux[i].EtatSignal:=code;
end;
end;
procedure Envoi_DirectionLEB(Adr : integer;code : integer);
var i : integer;
begin
i:=index_feu(i);
if feux[i].EtatSignal<>code then
begin
if traceSign then Affiche('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
if aFFsIGNAL then AfficheDebug('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
case code of
0 : begin pilote_acc(adr+5,2,feu) ; pilote_acc(adr+6,2,feu) ;end; //00
1 : begin pilote_acc(adr+5,1,feu) ; pilote_acc(adr+6,2,feu) ;end; //10
2 : begin pilote_acc(adr+5,2,feu) ; pilote_acc(adr+6,1,feu) ;end; //01
3 : begin pilote_acc(adr+5,1,feu) ; pilote_acc(adr+6,1,feu) ;end; //11
end;
feux[i].EtatSignal:=code;
end;
end;
{==========================================================================
envoie les données au décodeur CDF
===========================================================================*}
procedure envoi_CDF(adresse : integer);
var
combine,aspect,code : integer;
i,nombre : integer;
s : string;
procedure ecrire(v : integer);
var j : integer;
begin
// bit 0
if nombre>0 then
begin
if (v and 1)=0 then j:=1 else j:=2;
pilote_acc(adresse,j,feu);
end;
// bit 1
if nombre>1 then
begin
if (v and 2)=0 then j:=1 else j:=2;
pilote_acc(adresse+1,j,feu);
end;
// bit 2
if nombre>2 then
begin
if (v and 4)=0 then j:=1 else j:=2;
pilote_acc(adresse+2,j,feu);
end;
// bit 3
if nombre>3 then
begin
if (v and 8)=0 then j:=1 else j:=2;
pilote_acc(adresse+3,j,feu);
end;
end;
procedure ecrire_2(v : integer);
var bit2 : integer;
begin
// bit 0-1 (adresse)
if nombre>0 then
begin
bit2:=v and 3;
if bit2=0 then
begin
// raz les 2 bits
Pilote_acc0_X(adresse,1);Pilote_acc0_X(adresse,2);
end;
if bit2=1 then pilote_acc(adresse,1,feu);
if bit2=2 then pilote_acc(adresse,2,feu);
end;
// bit 2-3 (adresse+1)
if nombre>1 then
begin
inc(adresse);
bit2:=v and $c; // 1100
if bit2=0 then
begin
// raz les 2 bits
Pilote_acc0_X(adresse,1);Pilote_acc0_X(adresse,2);
end;
if bit2=4 then pilote_acc(adresse,1,feu);
if bit2=8 then pilote_acc(adresse,2,feu);
end;
// bit 4-5 (adresse+2)
if nombre>2 then
begin
inc(adresse);
bit2:=v and $30; // 11 0000
if bit2=0 then
begin
// raz les 2 bits
Pilote_acc0_X(adresse,1);Pilote_acc0_X(adresse,2);
end;
if bit2=16 then pilote_acc(adresse,1,feu);
if bit2=32 then pilote_acc(adresse,2,feu);
end;
// bit 6-7 (adresse+3)
if nombre>3 then
begin
inc(adresse);
bit2:=v and $c0; // 1100 0000
if bit2=0 then
begin
// raz les 2 bits
Pilote_acc0_X(adresse,1);Pilote_acc0_X(adresse,2);
end;
if bit2=64 then pilote_acc(adresse,1,feu);
if bit2=128 then pilote_acc(adresse,2,feu);
end;
end;
procedure ecrire_3(v : integer);
var bit2 : integer;
begin
// adresse+0
if (nombre>0) then
begin
bit2:=v and 3; //0000 0011
if bit2<>0 then
begin
pilote_acc(adresse,bit2,feu);
exit;
end;
end;
// adresse+1
if (nombre>1) then
begin
bit2:=v and $c; //0000 1100
if bit2<>0 then
begin
pilote_acc(adresse+1,bit2 shr 2,feu);
exit;
end;
end;
// adresse+2
if (nombre>2) then
begin
bit2:=v and $30; //0011 0000
if bit2<>0 then
begin
pilote_acc(adresse+2,bit2 shr 4,feu);
exit;
end;
end;
// adresse+3
if (nombre>3) then
begin
bit2:=v and $c0; //1100 0000
if bit2<>0 then
begin
pilote_acc(adresse+3,bit2 shr 6,feu);
end;
end;
end;
begin
i:=index_feu(adresse);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[i].EtatSignal;
nombre:=feux[i].Na; // nombre d'adresses occupées par le signal
code_to_aspect(code,aspect,combine);
s:='Signal CDF: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
if combine=-1 then
case aspect of
carre : ecrire_3(Feux[i].SR[1].sortie1);
semaphore : ecrire_3(Feux[i].SR[2].sortie1);
semaphore_cli : ecrire_3(Feux[i].SR[3].sortie1);
vert : ecrire_3(Feux[i].SR[4].sortie1);
vert_cli : ecrire_3(Feux[i].SR[5].sortie1);
violet : ecrire_3(Feux[i].SR[6].sortie1);
blanc : ecrire_3(Feux[i].SR[7].sortie1);
blanc_cli : ecrire_3(Feux[i].SR[8].sortie1);
jaune : ecrire_3(Feux[i].SR[9].sortie1);
jaune_cli : ecrire_3(Feux[i].SR[10].sortie1);
end;
if aspect=-1 then
case combine of
ral_30 : ecrire_3(Feux[i].SR[11].sortie1);
ral_60 : ecrire_3(Feux[i].SR[12].sortie1);
rappel_30 : ecrire_3(Feux[i].SR[14].sortie1);
rappel_60 : ecrire_3(Feux[i].SR[15].sortie1);
end;
if (aspect<>-1) and (combine<>-1) then
begin
if (Combine=ral_60) and (aspect=jaune_cli) then ecrire_3(Feux[i].SR[13].sortie1);
if (Combine=rappel_30) and (aspect=jaune) then ecrire_3(Feux[i].SR[16].sortie1);
if (Combine=rappel_30) and (aspect=jaune_cli) then ecrire_3(Feux[i].SR[17].sortie1);
if (Combine=rappel_60) and (aspect=jaune) then ecrire_3(Feux[i].SR[18].sortie1);
if (Combine=rappel_60) and (aspect=jaune_cli) then ecrire_3(Feux[i].SR[19].sortie1);
end;
end;
end;
{==========================================================================
envoie les données au décodeur SR
===========================================================================*}
procedure envoi_SR(adresse : integer);
var
code : word;
index,i,etat : integer;
s : string;
begin
index:=index_feu(adresse);
if (feux[index].AncienEtat<>feux[index].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[index].EtatSignal;
//code_to_aspect(code,aspect,combine);
s:='Signal SR: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
etat:=code_to_etat(code);
//Affiche('Code a chercher='+IntToSTR(etat),clyellow);
if index<>0 then
begin
i:=0;
// trouve l'index dans la configuration du feu correspondant à son état demandé
repeat
inc(i);
until (feux[index].SR[i].sortie1=etat) or (feux[index].SR[i].sortie0=etat) or (i=8);
if (feux[index].SR[i].sortie1=etat) then
begin
//affiche('trouvé en sortie1 index '+IntToSTR(i),clyellow);
Pilote_acc(adresse+i-1,2,feu);
end;
if (feux[index].SR[i].sortie0=etat) then
begin
//affiche('trouvé en sortie0 index '+IntToSTR(i),clyellow);
Pilote_acc(adresse+i-1,1,feu);
end;
end;
end;
end;
{==========================================================================
envoie les données au décodeur LEB
===========================================================================*}
procedure envoi_LEB(adresse : integer);
var code,aspect,combine : integer;
index : integer;
s : string;
procedure envoi5_LEB(selection :byte);
var i : integer;
octet : byte;
begin
s:='';
for i:=0 to 4 do
begin
if (testBit(selection,i)) then begin octet:=1;s:=s+'1';end
else begin octet:=2 ; s:=s+'0';end;
Pilote_acc(adresse+i,octet,feu);
// le décodeur LEB nécessite qu'on envoie 0 après son pilotage ; si on est en mode usb ou ethernet
if (portCommOuvert or parSocketLenz) then Pilote_acc0_X(adresse+i,octet);
end;
//Affiche(inttoStr(selection),clOrange);
//Affiche(s,clOrange);
end;
begin
index:=index_feu(adresse);
if (feux[index].AncienEtat<>feux[index].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[index].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal LEB: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
Sleep(60); // si le feu se positionne à la suite d'un positionnement d'aiguillage, on peut avoir le message station occupée
//Affiche(IntToSTR(aspect)+' '+inttoSTR(combine),clOrange);
if (aspect<>-1) and (combine=-1) then
begin
if (aspect=carre) then envoi5_LEB(0);
if (aspect=violet) then envoi5_LEB(1);
if (aspect=blanc_cli) then envoi5_LEB(2);
if (aspect=blanc) then envoi5_LEB(3);
if (aspect=semaphore) then envoi5_LEB(4);
if (aspect=semaphore_cli) then envoi5_LEB(5);
if (aspect=jaune) then envoi5_LEB(8);
if (aspect=jaune_cli) then envoi5_LEB($a);
if (aspect=vert_cli) then envoi5_LEB($c);
if (aspect=vert) then envoi5_LEB($d);
if (aspect=rappel_30) then envoi5_LEB(6);
if (aspect=rappel_60) then envoi5_LEB(7);
if (aspect=ral_30) then envoi5_LEB(9);
if (aspect=ral_60) then envoi5_LEB($b);
end;
if (combine<>-1) and (aspect=-1) then
begin
if (Combine=rappel_30) then envoi5_LEB(6);
if (Combine=rappel_60) then envoi5_LEB(7);
if (Combine=ral_30) then envoi5_LEB(9);
if (Combine=ral_60) then envoi5_LEB($b);
end;
if ((Combine=rappel_30) and (aspect=jaune)) then envoi5_LEB($e);
if ((Combine=rappel_30) and (aspect=jaune_cli)) then envoi5_LEB($f);
if ((Combine=rappel_60) and (aspect=jaune)) then envoi5_LEB($10);
if ((Combine=rappel_60) and (aspect=jaune_cli)) then envoi5_LEB($11);
if ((Combine=ral_60) and (aspect=jaune_cli)) then envoi5_LEB($12);
end;
end;
(*==========================================================================
envoie les données au décodeur NMRA étendu
adresse=adresse sur le BUS DCC
code=code d'allumage :
0. Carré
1. Sémaphore
2. Sémaphore clignotant
3. Vert
4. Vert clignotant
5. Carré violet
6. Blanc
7. Blanc clignotant
8. Avertissement
9. Avertissement clignotant
10. Ralentissement 30
11. Ralentissement 60
12. Ralentissement 60 + avertissement clignotant
13. Rappel 30
14. Rappel 60
15. Rappel 30 + avertissement
16. Rappel 30 + avertissement clignotant
17. Rappel 60 + avertissement
18. rappel 60 + avertissement clignotant
/*===========================================================================*)
procedure envoi_NMRA(adresse: integer);
var valeur,i : integer ;
aspect,combine,code : integer;
s : string;
begin
i:=index_feu(adresse);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then
begin
code:=feux[i].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal NMRA: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
// attention: impossible d'envoyer des octets en XpressNet!!
// NMRA ne focntionnera pas..
case aspect of
carre : valeur:=0;
semaphore : valeur:=1;
semaphore_cli : valeur:=2;
vert : valeur:=3;
vert_cli : valeur:=4;
violet : valeur:=5;
blanc : valeur:=6;
blanc_cli : valeur:=7;
jaune : valeur:=8;
jaune_cli : valeur:=9;
end;
case combine of
ral_30 : valeur:=10;
ral_60 : valeur:=11;
rappel_30 : valeur:=13;
rappel_60 : valeur:=14;
end;
if (Combine=ral_60) and (aspect=jaune_cli) then valeur:=12;
if (Combine=rappel_30) and (aspect=jaune) then valeur:=15;
if (Combine=rappel_30) and (aspect=jaune_cli) then valeur:=16;
if (Combine=rappel_60) and (aspect=jaune) then valeur:=17;
if (Combine=rappel_60) and (aspect=jaune_cli) then valeur:=18;
pilote_acc(adresse,valeur,feu);
end;
end;
// décodeur unisemaf (paco)
procedure envoi_UniSemaf(adresse: integer);
var modele,index: integer ;
s : string;
code,aspect,combine : integer;
begin
index:=Index_feu(adresse); // tranforme l'adresse du feu en index tableau
if (feux[index].AncienEtat<>feux[index].EtatSignal) then
begin
code:=feux[index].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal Unisemaf: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
// pour Unisemaf, la cible est définie dans le champ Unisemaf de la structure feux
modele:=feux[index].Unisemaf;
if modele=0 then Affiche('Erreur 741 : spécification unisemaf signal '+intToSTR(adresse)+' non défini',clred);
//Affiche('Adresse='+intToSTR(Adresse)+' code='+intToSTR(code)+' combine'+intToSTR(combine),clyellow);
// pilotage qui marche chez JEF
if algo_Unisemaf=1 then
begin
if modele=2 then // 2 feux
begin
if aspect=blanc then pilote_acc(adresse,1,feu);
if aspect=blanc_cli then pilote_acc(adresse,1,feu);
if aspect=violet then pilote_acc(adresse,2,feu);
end;
if modele=3 then // 3 feux
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=semaphore then pilote_acc(adresse,2,feu);
if aspect=semaphore_cli then pilote_acc(adresse,2,feu);
if aspect=jaune then pilote_acc(adresse+1,1,feu);
if aspect=jaune_cli then pilote_acc(adresse+1,1,feu);
end;
if modele=4 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
carre : pilote_acc(adresse+1,2,feu);
end;
end;
// 51=carré + blanc
if modele=51 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
carre : pilote_acc(adresse+1,2,feu);
blanc : pilote_acc(adresse+2,1,feu);
blanc_cli : pilote_acc(adresse+2,1,feu);
end;
end;
// 52=VJR + blanc + violet
if modele=52 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
violet : pilote_acc(adresse+2,1,feu);
blanc : pilote_acc(adresse+1,2,feu);
blanc_cli : pilote_acc(adresse+1,2,feu);
end;
end;
// 71=VJR + ralentissement 30
if modele=71 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
end;
if combine=ral_30 then pilote_acc(adresse+1,2,feu);
end;
// 72=VJR + carré + ralentissement 30
if modele=72 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
carre : pilote_acc(adresse+1,2,feu);
end;
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
end;
// 73=VJR + carré + ralentissement 60
if modele=73 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
carre : pilote_acc(adresse+1,2,feu);
end;
if combine=ral_60 then pilote_acc(adresse+2,1,feu);
end;
// 91=VJR + carré + rappel 30
if modele=91 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
carre : pilote_acc(adresse+1,2,feu);
end;
if combine=rappel_30 then pilote_acc(adresse+2,1,feu);
end;
// 92=VJR + carré + rappel 60
if modele=92 then
begin
case aspect of
vert : pilote_acc(adresse,1,feu);
vert_cli : pilote_acc(adresse,1,feu);
jaune : pilote_acc(adresse,2,feu);
jaune_cli : pilote_acc(adresse,2,feu);
semaphore : pilote_acc(adresse+1,1,feu);
semaphore_cli : pilote_acc(adresse+1,1,feu);
carre : pilote_acc(adresse+1,2,feu);
end;
if combine=rappel_60 then pilote_acc(adresse+2,1,feu);
end;
// 93=VJR + carré + ral30 + rappel 30
if modele=93 then
begin
if combine=-1 then //pas de sig combinée
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=carre then pilote_acc(adresse+1,2,feu);
end;
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
if combine=rappel_30 then pilote_acc(adresse+2,2,feu);
if (aspect=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu);
end;
// 94=VJR + carré + ral60 + rappel60
if modele=94 then
begin
if combine=-1 then
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=carre then pilote_acc(adresse+1,2,feu);
end;
if combine=ral_60 then pilote_acc(adresse+2,1,feu);
if combine=rappel_60 then pilote_acc(adresse+2,2,feu);
if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu);
end;
// 95=VJR + carré + ral30 + rappel 60
if modele=95 then
begin
if combine=-1 then
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=carre then pilote_acc(adresse+1,2,feu);
end;
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
if combine=rappel_60 then pilote_acc(adresse+2,2,feu);
if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu);
end;
// 96=VJR + blanc + carré + ral30 + rappel30
if modele=96 then
begin
if combine=-1 then
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=carre then pilote_acc(adresse+1,2,feu);
if aspect=blanc then pilote_acc(adresse+3,2,feu);
if aspect=blanc_cli then pilote_acc(adresse+3,2,feu);
end;
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
if combine=rappel_30 then pilote_acc(adresse+2,2,feu);
if (aspect=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu);
end;
// 97=VJR + blanc + carré + ral30 + rappel60
if modele=97 then
begin
if combine=-1 then
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=carre then pilote_acc(adresse+1,2,feu);
if aspect=blanc then pilote_acc(adresse+3,2,feu);
if aspect=blanc_cli then pilote_acc(adresse+3,2,feu);
end;
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
if combine=rappel_60 then pilote_acc(adresse+2,2,feu);
if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu);
end;
// 98=VJR + blanc + violet + ral30 + rappel30
if modele=98 then
begin
if combine=-1 then
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=violet then pilote_acc(adresse+1,2,feu);
if aspect=blanc then pilote_acc(adresse+3,2,feu);
if aspect=blanc_cli then pilote_acc(adresse+3,2,feu);
end;
if (aspect=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu);
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
if combine=rappel_30 then pilote_acc(adresse+2,2,feu);
end;
// 99=VJR + blanc + violet + ral30 + rappel60
if modele=99 then
begin
if combine=-1 then
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=jaune then pilote_acc(adresse,2,feu);
if aspect=jaune_cli then pilote_acc(adresse,2,feu);
if aspect=semaphore then pilote_acc(adresse+1,1,feu);
if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu);
if aspect=violet then pilote_acc(adresse+1,2,feu);
if aspect=blanc then pilote_acc(adresse+3,2,feu);
if aspect=blanc_cli then pilote_acc(adresse+3,2,feu);
end;
if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu);
if combine=ral_30 then pilote_acc(adresse+2,1,feu);
if combine=rappel_60 then pilote_acc(adresse+2,2,feu);
end;
end;
// algo de la doc qui ne marche pas chez JEF
if algo_Unisemaf=2 then
begin
if modele=2 then // 2 feux
begin
if (aspect=blanc) or (aspect=blanc_cli) then pilote_acc(adresse,1,feu);
if aspect=violet then pilote_acc(adresse,2,feu);
end;
if modele=3 then // 3 feux
begin
if aspect=vert then pilote_acc(adresse,1,feu);
if aspect=vert_cli then pilote_acc(adresse,1,feu);
if aspect=semaphore then pilote_acc(adresse,2,feu);
if aspect=semaphore_cli then pilote_acc(adresse,2,feu);
if aspect=jaune then pilote_acc(adresse+1,1,feu);
if aspect=jaune_cli then pilote_acc(adresse+1,1,feu);
end;
if modele=4 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,1,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,1,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,1,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
end;
// 51=carré + blanc
if modele=51 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
blanc,blanc_cli : pilote_acc(adresse+2,1,feu);
end;
end;
// 52=VJR + blanc + violet
if modele=52 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,2,feu);end;
blanc,blanc_cli : pilote_acc(adresse+1,2,feu);
violet : pilote_acc(adresse+2,1,feu);
end;
end;
// 71=VJR + ralentissement 30
if modele=71 then
begin
case aspect of
vert,vert_cli : pilote_acc(adresse+1,1,feu);
jaune,jaune_cli : pilote_acc(adresse,1,feu);
semaphore,semaphore_cli: pilote_acc(adresse,2,feu);
end;
if combine=ral_30 then pilote_acc(adresse+1,2,feu);
end;
// 72=VJR + carré + ralentissement 30
if modele=72 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=ral_30 then pilote_acc(adresse+2,1,feu); //pilote_acc(adresse+2,2,feu); impossible en lenz
end;
// 73=VJR + carré + ralentissement 60
if modele=73 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=ral_60 then pilote_acc(adresse+2,1,feu); //pilote_acc(adresse+2,2,feu); impossible en lenz
end;
// 91=VJR + carré + rappel 30
if modele=91 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=rappel_30 then pilote_acc(adresse+2,1,feu);//pilote_acc(adresse+2,2,feu); impossible en lenz
end;
// 92=VJR + carré + rappel 60
if modele=92 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+2,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+2,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=rappel_60 then pilote_acc(adresse+2,1,feu);//pilote_acc(adresse+2,2,feu); impossible en lenz
end;
// 93=VJR + carré + ral30 + rappel 30
if modele=93 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,1,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,1,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,1,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=ral_30 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,1,feu);end;
if combine=rappel_30 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,1,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_30) then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,1,feu);end;
end;
// 94=VJR + carré + ral60 + rappel60
if modele=94 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,1,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,1,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,1,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=ral_60 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,1,feu);end;
if combine=rappel_60 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,1,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_60) then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,1,feu);end;
end;
// 95=VJR + carré + ral30 + rappel 60
if modele=95 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,1,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,1,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,1,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
end;
if combine=ral_30 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,1,feu);end;
if combine=rappel_60 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,1,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_60)
then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,1,feu);end;
end;
// 96=VJR + blanc + carré + ral30 + rappel30
if modele=96 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
blanc,blanc_cli : pilote_acc(adresse+3,1,feu);
end;
if combine=ral_30 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,2,feu);end;
if combine=rappel_30 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_30)
then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
end;
// 97=VJR + blanc + carré + ral30 + rappel60
if modele=97 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,2,feu);end;
carre : begin pilote_acc(adresse,2,feu);pilote_acc(adresse+1,2,feu);end;
blanc,blanc_cli : pilote_acc(adresse+3,1,feu);
end;
if combine=ral_30 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,2,feu);end;
if combine=rappel_60 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_60)
then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
end;
// 98=VJR + blanc + violet + ral30 + rappel30
if modele=98 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,2,feu);end;
blanc,blanc_cli : pilote_acc(adresse+1,2,feu);
violet : pilote_acc(adresse+3,1,feu);
end;
if combine=ral_30 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,2,feu);end;
if combine=rappel_30 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_30)
then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
end;
// 99=VJR + blanc + violet + ral30 + rappel60
if modele=99 then
begin
case aspect of
vert,vert_cli : begin pilote_acc(adresse+1,1,feu);pilote_acc(adresse+3,2,feu);end;
jaune,jaune_cli : begin pilote_acc(adresse,1,feu);pilote_acc(adresse+3,2,feu);end;
semaphore,semaphore_cli: begin pilote_acc(adresse,2,feu);pilote_acc(adresse+3,2,feu);end;
blanc,blanc_cli : pilote_acc(adresse+1,2,feu);
violet : pilote_acc(adresse+3,1,feu);
end;
if combine=ral_30 then begin pilote_acc(adresse+2,1,feu);pilote_acc(adresse+3,2,feu);end;
if combine=rappel_60 then begin pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
if ((aspect=jaune) or (aspect=jaune_cli)) and (combine=rappel_60)
then begin pilote_acc(adresse,1,feu);pilote_acc(adresse+2,2,feu);pilote_acc(adresse+3,2,feu);end;
end;
end;
end;
end;
{==========================================================================
envoie les données au décodeur LDT
adresse=adresse sur le BUS DCC
code=code d'allumage selon l'adressage (ex carre, vert, rappel_30 ..).
mode=mode du décodeur adressé, de 1 à 2
un décodeur occupe 8 adresses
Le mode 1 permet la commande des signaux de 2, 3 et 4 feux
Le mode 2 permet la commande de signaux de plus de 4 feux
===========================================================================}
procedure envoi_LDT(adresse : integer);
var code,aspect,combine,mode : integer;
i : integer;
s : string;
begin
i:=index_feu(adresse);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[i].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal LDT: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
if (aspect=semaphore) or (aspect=vert) or (aspect=carre) or (aspect=jaune) then mode:=1 else mode:=2;
if aspect>carre then mode:=2 else mode:=1;
case mode of
// pour les décodeurs en mode 0, il faut écrire la routine vous même car le pilotage dépend du cablage
// sauf pour le sémaphore, vert et jaune fixe
1 : // mode 1: feux 2 3 & 4 feux
begin
if (aspect=semaphore) then pilote_acc(adresse,1,feu);
if (aspect=vert) then pilote_acc(adresse,2,feu);
if (aspect=carre) then pilote_acc(adresse+1,1,feu);
if (aspect=jaune) then pilote_acc(adresse+1,2,feu);
end;
2 : // mode 2: plus de 4 feux
begin
if (aspect=semaphore) then begin pilote_acc(adresse+2,1,feu);sleep(tempo_Feu);pilote_acc(adresse,1,feu);end;
if (aspect=vert) then begin pilote_acc(adresse+2,1,feu);sleep(tempo_Feu);pilote_acc(adresse,2,feu);end;
if (aspect=carre) then begin pilote_acc(adresse+2,1,feu);sleep(tempo_Feu);pilote_acc(adresse+1,1,feu);end;
if (aspect=jaune) then begin pilote_acc(adresse+2,1,feu);sleep(tempo_Feu);pilote_acc(adresse+1,2,feu);end;
if (aspect=violet) then begin pilote_acc(adresse+2,2,feu);sleep(tempo_Feu);pilote_acc(adresse,1,feu);end;
if (aspect=blanc) then begin pilote_acc(adresse+2,2,feu);sleep(tempo_Feu);pilote_acc(adresse,2,feu);end;
if (aspect=semaphore) then begin pilote_acc(adresse+2,2,feu);sleep(tempo_Feu);pilote_acc(adresse+1,1,feu);end;
if (combine=aspect8) then begin pilote_acc(adresse+2,2,feu);sleep(tempo_Feu);pilote_acc(adresse+1,2,feu);end;
if (combine=ral_60) and (aspect=jaune_cli)
then begin pilote_acc(adresse+3,1,feu);sleep(tempo_Feu);pilote_acc(adresse,1,feu);end; // demande groupe 3
if (aspect=vert_cli) then begin pilote_acc(adresse+3,1,feu);sleep(tempo_Feu);pilote_acc(adresse,2,feu);end; // demande groupe 3
if (combine=Disque_D) then begin pilote_acc(adresse+3,1,feu);sleep(tempo_Feu);pilote_acc(adresse+1,1,feu);end;// demande groupe 3
if (aspect=jaune_cli) then begin pilote_acc(adresse+3,1,feu);sleep(tempo_Feu);pilote_acc(adresse+1,2,feu);end;
if (combine=ral_30) then begin pilote_acc(adresse+3,2,feu);sleep(tempo_Feu);pilote_acc(adresse,1,feu);end;
if (combine=ral_60) then begin pilote_acc(adresse+3,2,feu);sleep(tempo_Feu);pilote_acc(adresse,2,feu);end;
if (combine=rappel_30) then begin pilote_acc(adresse+3,2,feu);sleep(tempo_Feu);pilote_acc(adresse+1,1,feu);end;
if (combine=rappel_60) then begin pilote_acc(adresse+3,2,feu);sleep(tempo_Feu);pilote_acc(adresse+1,2,feu);end;
end;
end;
end;
end;
procedure envoi_virtuel(adresse : integer);
var
combine,aspect,code : integer;
i : integer;
s : string;
begin
i:=index_feu(adresse);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[i].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal virtuel: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
end;
end;
// inverse l'ordre des bits dans un octet
function inverse(b : byte) : byte;
var r : byte;
begin
r:= ((b and $80) shr 7);
r:=r or ((b and $40) shr 5);
r:=r or ((b and $20) shr 3);
r:=r or ((b and $10) shr 2);
r:=r or ((b and $08) shl 1);
r:=r or ((b and $04) shl 3);
r:=r or ((b and $02) shl 5);
r:=r or ((b and $01) shl 7);
inverse:=r;
end;
// envoie les données au décodeur digikeijs 4018
procedure digi_4018(adresse : integer);
var
combine,nombre,aspect,code : integer;
i : integer;
s : string;
procedure ecrire(v : integer);
var j,k : integer;
begin
//if InverseMotif then
//v:=inverse(v);
// bits 7 6
k:=0;
if nombre>=5 then
begin
if (v and $c0)=$80 then j:=2 else j:=1;
pilote_acc(adresse,j,feu);
inc(k);
end;
// bit 5 4
if nombre>=3 then
begin
if (v and $30)=$20 then j:=2 else j:=1;
pilote_acc(adresse+k,j,feu);
inc(k);
end;
// bit 3 2 // bit 5 4
if nombre>=2 then
begin
if (v and $c)=$8 then j:=2 else j:=1;
pilote_acc(adresse+k,j,feu);
inc(k);
end;
if nombre>=1 then
begin
if (v and $3)=$2 then j:=2 else j:=1;
if k=3 then k:=4; // saut d'adresse
pilote_acc(adresse+k,j,feu);
inc(adresse);
end;
end;
begin
i:=index_feu(adresse);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[i].EtatSignal;
nombre:=feux[i].Na; // nombre d'adresses occupées par le signal
code_to_aspect(code,aspect,combine);
s:='Signal digikeijs 4018: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
if combine=-1 then
case aspect of
carre : ecrire(Feux[i].SR[1].sortie1);
semaphore : ecrire(Feux[i].SR[2].sortie1);
semaphore_cli : ecrire(Feux[i].SR[3].sortie1);
vert : ecrire(Feux[i].SR[4].sortie1);
vert_cli : ecrire(Feux[i].SR[5].sortie1);
violet : ecrire(Feux[i].SR[6].sortie1);
blanc : ecrire(Feux[i].SR[7].sortie1);
blanc_cli : ecrire(Feux[i].SR[8].sortie1);
jaune : ecrire(Feux[i].SR[9].sortie1);
jaune_cli : ecrire(Feux[i].SR[10].sortie1);
end;
if aspect=-1 then
case combine of
ral_30 : ecrire(Feux[i].SR[11].sortie1);
ral_60 : ecrire(Feux[i].SR[12].sortie1);
rappel_30 : ecrire(Feux[i].SR[14].sortie1);
rappel_60 : ecrire(Feux[i].SR[15].sortie1);
end;
if (aspect<>-1) and (combine<>-1) then
begin
if (Combine=ral_60) and (aspect=jaune_cli) then ecrire(Feux[i].SR[13].sortie1);
if (Combine=rappel_30) and (aspect=jaune) then ecrire(Feux[i].SR[16].sortie1);
if (Combine=rappel_30) and (aspect=jaune_cli) then ecrire(Feux[i].SR[17].sortie1);
if (Combine=rappel_60) and (aspect=jaune) then ecrire(Feux[i].SR[18].sortie1);
if (Combine=rappel_60) and (aspect=jaune_cli) then ecrire(Feux[i].SR[19].sortie1);
end;
end;
end;
(*==========================================================================
envoie les données au décodeur digitalbahn équipé du logiciel "led_signal_10"
adresse=adresse sur le bus
codebin=motif de bits représentant l'état des feux L'allumage est fait en
adressant l'une des 14 adresses pour les 14 leds possibles du feu.
Ici on met le bit 1 à 1 (état "vert" du programme hexmanipu
===========================================================================*)
procedure envoi_signalBahn(adresse : integer);
var aspect,code,combine : integer;
ralrap, jau ,Ancralrap,Ancjau,connecte : boolean;
i : integer;
s : string;
begin
connecte:=cdm_connecte or portCommOuvert or parSocketLenz;
i:=index_feu(adresse);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then //; && (stop_cmd==FALSE))
begin
code:=feux[i].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal Bahn: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal or traceListe then afficheDebug(s,clOrange);
//Affiche(IntToSTR(aspect)+' '+inttoSTR(combine),clOrange);
// spécifique au décodeur digital bahn:
// si le signal affichait un signal combiné, il faut éteindre le signal avec un sémaphore
// avant d'afficher le nouvel état non combiné
Ancralrap:=(TestBit(feux[i].AncienEtat,ral_30)) or (TestBit(feux[i].AncienEtat,ral_60)) or
(TestBit(feux[i].AncienEtat,rappel_30)) or (TestBit(feux[i].AncienEtat,rappel_60)) ;
// si ancien état du signal=jaune ou jaune cli
Ancjau:=(TestBit(feux[i].AncienEtat,jaune)) or (TestBit(feux[i].AncienEtat,jaune_cli)) ;
// si état demandé du signal=ralentissement ou rappel
ralrap:=(TestBit(code,ral_30)) or (TestBit(code,ral_60)) or
(TestBit(code,rappel_30)) or (TestBit(code,rappel_60)) ;
// si état demandé du signal=jaune ou cli
jau:=TestBit(code,jaune) or TestBit(code,jaune_cli) ;
// effacement du signal combiné par sémaphore suivant condition
if (((Ancralrap and not(ralrap)) or (Ancjau and not(jau))) and (combine<>0)) then
begin
if connecte then
begin
Sleep(40);
pilote_acc(adresse+semaphore,2,feu) ;
end;
// dessine_feu(adresse);
end;
if connecte then sleep(40); // les commandes entre 2 feux successifs doivent être séparées au minimum de 100 ms
// affichage du premier aspect du signal(1er bit à 1 dans codebin
if aspect<>-1 then pilote_acc(adresse+aspect,2,feu) ;
// affichage de la signalisation combinée
if (Combine<>-1) and connecte then
begin
sleep(40);
pilote_ACC(adresse+Combine,2,feu) ;
end;
end;
end;
// renvoie l'adresse du détecteur suivant des deux éléments contigus
// TypeElprec/actuel: 1= détecteur 2= aiguillage 4=Buttoir
// algo= type d'algorithme pour suivant_alg3
function detecteur_suivant(prec : integer;TypeElPrec : TEquipement;actuel : integer;TypeElActuel : TEquipement;algo : integer) : integer ;
var actuelCalc,PrecCalc,j,AdrSuiv ,indexCalc : integer;
TypeprecCalc,TypeActuelCalc : TEquipement;
begin
if NivDebug>=2 then
AfficheDebug('Proc Detecteur_suivant '+IntToSTR(prec)+','+BTypeToChaine(typeElPrec)+'/'+intToSTR(actuel)+','+
BTypeToChaine(TypeElActuel)+
' Alg='+IntToSTR(algo),clyellow);
j:=0;
PrecCalc:=prec;
TypeprecCalc:=TypeElprec;
ActuelCalc:=actuel;
TypeActuelCalc:=TypeELActuel;
// étape 1 trouver le sens
repeat
inc(j);
AdrSuiv:=suivant_alg3(precCalc,TypeprecCalc,actuelCalc,TypeActuelCalc,algo);
indexCalc:=index_aig(actuelCalc);
if (typeGen=tjd) and false then // si le précédent est une TJD/S et le suivant aussi
begin
if ((aiguillage[index_aig(AdrSuiv)].modele=tjd) or (aiguillage[index_aig(AdrSuiv)].modele=tjs)) and
((aiguillage[indexCalc].modele=tjd) or (aiguillage[indexCalc].modele=tjs)) then
begin
if nivDebug=3 then AfficheDebug('501 - Détection Précédent=TJD/S Suivant=TJD/S',clyellow);
// subsituer la pointe
actuelCalc:=aiguillage[indexCalc].APointe;
end;
end;
precCalc:=actuelCalc;
TypeprecCalc:=TypeActuelCalc;
actuelCalc:=AdrSuiv;
TypeActuelCalc:=typeGen;
//Affiche('Suivant signalaig='+IntToSTR(AdrSuiv),clyellow);
until (j=10) or (typeGen=det) or (AdrSuiv=0) or (AdrSuiv>=9990); // arret si détecteur
// si trouvé le sens, trouver le suivant
if AdrSuiv=actuel then
begin
AdrSuiv:=suivant_alg3(prec,TypeElPrec,actuel,TypeElActuel,1); // suivant immédiat
end;
if (NivDebug=3) and (AdrSuiv<9990) then AfficheDebug('618 : Le suivant est le '+intToSTR(AdrSuiv),clYellow);
detecteur_suivant:=AdrSuiv;
end;
// pilotage d'un signal, et mise à jour du graphisme du feu dans les 3 fenetres
procedure envoi_signal(Adr : integer);
var i,it,j,index_train,adresse,detect,detsuiv,a,b,aspect,x,y,TailleX,TailleY,Orientation,AdrTrain : integer;
ImageFeu : TImage;
frX,frY : real;
s : string;
begin
i:=index_feu(Adr);
if i=0 then
begin
s:='Erreur 75: index signal '+intToSTR(adr)+' nul';
Affiche(s,clred);
AfficheDebug(s,clred);
exit;
end;
//Affiche(intToSTR(Adr)+' '+intToSTR(i),clWhite);
if (feux[i].AncienEtat<>feux[i].EtatSignal) then
begin
if feux[i].aspect<10 then // si signal non directionnel
begin
// envoie la commande au décodeur
case feux[i].decodeur of
0 : envoi_virtuel(Adr);
1 : envoi_signalBahn(Adr);
2 : envoi_CDF(Adr);
3 : envoi_LDT(Adr);
4 : envoi_LEB(Adr);
5 : digi_4018(Adr);
6 : envoi_UniSemaf(Adr);
7 : envoi_SR(Adr);
end;
// Gestion démarrage temporisé des trains si on quitte le rouge : ne fonctionne qu'avec CDM rail connecté ou roulage
if (Option_demarrage and cdm_connecte) or roulage then
begin
a:=feux[i].AncienEtat;
b:=feux[i].EtatSignal;
if ((a=semaphore_F) or (a=carre_F) or (a=violet_F)) and ((b<>semaphore_F) and (b<>carre_F) and (b<>violet_F)) then
begin
// y a t il un train en face du signal
detect:=feux[i].Adr_det1;
if detect<>0 then
begin
// test si train sur le détecteur det
if detecteur[detect].etat then
begin
AdrTrain:=detecteur[detect].AdrTrain;
if AdrTrain<>0 then
begin
s:='Le train @'+intToSTR(AdrTrain)+' va démarrer du signal '+intToSTR(adr);
Affiche(s,clWhite);
if TraceListe then AfficheDebug(s,clWhite);
index_train:=index_train_adresse(adrtrain);
if index_train<>0 then it:=trains[index_train].index_event_det_train;
if it<>0 then event_det_train[it].signal_rouge:=0;
// faire la réservation du canton
if feux[i].Btype_suiv1<>det then detSuiv:=detecteur_suivant(detect,det,feux[i].Adr_el_suiv1,feux[i].Btype_suiv1,1)
else detSuiv:=feux[i].Adr_el_suiv1;
if detSuiv<9990 then reserve_canton(detect,detSuiv,Adrtrain);
// démarrage d'un train
j:=index_train_adresse(adrtrain);
trains[j].tempoDemarre:=20; // armer la tempo à 2s
// annuler la demande d'arret éventuelle
trains[j].TempoArret:=0;
// arreter le train
//s:=detecteur[det].train;
//detecteur[det].train:=s;
//Affiche('et son détecteur '+IntToSTR(det)+'=1 tempo démarrage ; train '+s,clYellow);
//if cdm_connecte then
//begin
// s:=chaine_CDM_vitesseST(0,s); // 0%
// envoi_cdm(s);
//end;
end;
end;
end;
end;
end;
end
else
begin
pilote_direction(Adr,feux[i].etatSignal)
end;
feux[i].AncienEtat:=feux[i].EtatSignal;
// allume les signaux du feu dans la fenêtre de droite
Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adr,1);
// allume les signaux du feu dans le TCO
if TCOouvert then
begin
for y:=1 to NbreCellY do
for x:=1 to NbreCellX do
begin
if TCO[x,y].Bimage=30 then
begin
adresse:=TCO[x,y].adresse; // vérifie si le feu existe dans le TCO
aspect:=feux[index_feu(adresse)].Aspect;
case aspect of
2 : ImageFeu:=Formprinc.Image2feux;
3 : ImageFeu:=Formprinc.Image3feux;
4 : ImageFeu:=Formprinc.Image4feux;
5 : ImageFeu:=Formprinc.Image5feux;
7 : ImageFeu:=Formprinc.Image7feux;
9 : ImageFeu:=Formprinc.Image9feux;
12 : ImageFeu:=Formprinc.Image2Dir;
13 : ImageFeu:=Formprinc.Image3Dir;
14 : ImageFeu:=Formprinc.Image4Dir;
15 : ImageFeu:=Formprinc.Image5Dir;
16 : ImageFeu:=Formprinc.Image6Dir;
else ImageFeu:=Formprinc.Image3feux;
end;
TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale)
TailleX:=ImageFeu.picture.BitMap.Width;
Orientation:=TCO[x,y].FeuOriente;
// réduction variable en fonction de la taille des cellules
calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY);
// décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G
Dessine_feu_mx(PCanvasTCO,tco[x,y].x,tco[x,y].y,frx,fry,adresse,orientation);
end;
end;
end;
end;
end;
// pilotage des signaux
procedure envoi_signauxCplx;
var i,signalCplx : integer;
begin
//Affiche('Envoi des signaux (envoi_signauxCplx)',ClGreen);
for i:=1 to NbreFeux do
begin
signalCplx:=feux[i].adresse;
if not(ferme) and (signalCplx<>0) then envoi_signal(signalCplx);
end;
end;
// extrait un entier d'une chaine ex: extract_int('chaine123') = 123
function extract_int(s : string) : integer;
var i,j,l,erreur : integer;
trouve : boolean;
begin
i:=0;
l:=length(s);
trouve:=false;
while (i<l) and not(trouve) do
begin
inc(i);
trouve:=s[i] in ['0'..'9'];
end;
if trouve then
begin
val(copy(s,i,l),j,erreur);
extract_int:=j;
end
else extract_int:=0;
end;
// trouve l'index d'un détecteur dans une branche
// si pas trouvé, renvoie 0
function index_detecteur(detecteur,Num_branche : integer) : integer;
var i,adr : integer;
trouve : boolean;
procedure recherche;
begin
repeat
adr:=BrancheN[Num_Branche,i].adresse;
trouve:=(detecteur=adr) and ((BrancheN[Num_Branche,i].Btype=det) or (BrancheN[Num_branche,i].BType=buttoir)); // cherche un détecteur
//Affiche('cherche='+intToSTR(det)+'/explore='+intToSTR(adr)+' Branche='+intToStr(Num_branche)+' index='+intToStr(i),ClWhite);
if not(trouve) then inc(i);
//if trouve then Affiche('Trouvé en branche'+IntToSTR(Num_branche)+' index='+IntToSTR(i),clGreen);
until trouve or (adr=0) ;
end;
begin
if debug=3 then formprinc.Caption:='index_detecteur '+IntToSTR(detecteur);
i:=1;index2_det:=0;
recherche;
if trouve then result:=i else result:=0;
//affiche(inttostr(ai+1),clOrange);
i:=2; // à voir
//affiche('------------------------',clWhite);
recherche;
//affiche('------------------------',clGreen);
if trouve then index2_det:=i else index2_det:=0;
//affiche('index2='+IntToSTR(index2_det),clWhite);
if debug=3 then formprinc.Caption:='';
end;
// trouve l'index d'un aiguillage dans une branche
// si pas trouvé, renvoie 0
function index_aiguillage(AdrAig,Num_branche : integer) : integer;
var i,adr : integer;
trouve : boolean;
procedure recherche;
begin
repeat
adr:=BrancheN[Num_Branche,i].adresse;
trouve:=(AdrAig=adr) and ((BrancheN[Num_Branche,i].Btype=aig) or (BrancheN[Num_branche,i].BType=buttoir)); // cherche un aiguillage
//Affiche('cherche='+intToSTR(det)+'/explore='+intToSTR(adr)+' Branche='+intToStr(Num_branche)+' index='+intToStr(i),ClWhite);
if not(trouve) then inc(i);
//if trouve then Affiche('Trouvé en branche'+IntToSTR(Num_branche)+' index='+IntToSTR(i),clGreen);
until trouve or (adr=0) or (i>MaxElBranches) ;
end;
begin
i:=1;index2_aig:=0;
recherche;
if trouve then result:=i else result:=0;
//affiche(inttostr(ai+1),clOrange);
i:=2; // à voir
//affiche('------------------------',clWhite);
recherche;
//affiche('------------------------',clGreen);
if trouve then index2_aig:=i else index2_aig:=0;
//affiche('index2='+IntToSTR(index2_det),clWhite);
end;
// trouve le détecteur dans les branches (branche_trouve, Indexbranche_trouve)
// si pas trouvé, IndexBranche_trouve=0
procedure trouve_detecteur(detecteur : integer);
var NBranche,i : integer;
begin
Nbranche:=1;
repeat
i:=index_detecteur(detecteur,Nbranche);
if i=0 then inc(NBranche);
until (Nbranche>NbreBranches) or (i<>0);
// if (i<>0) and traceDet then Affiche('Détecteur trouvé en branche '+intToSTR(NBranche)+' index='+IntToSTR(i),clYellow);
branche_trouve:=NBranche;
IndexBranche_trouve:=i;
end;
// trouve un aiguillage dans une branche par son adresse
// si pas trouvé, IndexBranche_trouve=0
procedure trouve_aiguillage(adresse : integer);
var NBranche,i : integer;
begin
Nbranche:=1;
repeat
i:=index_aiguillage(Adresse,Nbranche);
if i=0 then inc(NBranche);
until (Nbranche>NbreBranches) or (i<>0);
//if (i<>0) then Affiche('aiguillage '+IntToSTR(adresse)+' trouvé en branche '+intToSTR(NBranche)+' index='+IntToSTR(i),clYellow);
branche_trouve:=NBranche;
IndexBranche_trouve:=i;
end;
// si 0 = OK
// si 1 = erreur code Unisemaf
// si 2 = erreur cohérence entre code et aspect
// si 3 = signal inconnu
function verif_UniSemaf(adresse,UniSem : integer) : integer;
var aspect,i : integer;
begin
if UniSem=0 then begin verif_unisemaf:=1;exit;end;
if (UniSem<>2) and (UniSem<>3) and (UniSem<>4) and (UniSem<>51) and (UniSem<>52) and (UniSem<>71) and (UniSem<>72) and (UniSem<>73) and
((UniSem<90) or (UniSem>99)) then begin verif_UniSemaf:=1;exit;end;
i:=index_feu(adresse);
if i<>0 then
begin
aspect:=feux[i].aspect;
if ((aspect=2) and (UniSem=2)) or
((aspect=3) and (UniSem=3)) or
((aspect=4) and (UniSem=4)) or
((aspect=5) and ((UniSem=51) or (UniSem=52))) or
((aspect=7) and ((UniSem=71) or (UniSem=72) or (UniSem=73))) or
((aspect=9) and ((UniSem>=90) or (UniSem<=99)))
then Verif_unisemaf:=0
else Verif_Unisemaf:=2;
end
else
begin
Affiche('Erreur Signal '+intToSTR(adresse)+' inconnu',clred);
Verif_Unisemaf:=3;
end;
end;
// trouve un élément dans les branches à partir de la branche offset renvoie branche_trouve IndexBranche_trouve
// el : adresse de l'élément TypeEL=(1=détécteur 2=aig 3=aig Bis 4=aig triple - Buttoir)
procedure trouve_element(el: integer; TypeEl : TEquipement; Offset : integer);
var i,adr,Branche : integer ;
s : string;
BT : TEquipement;
sort : boolean;
begin
if debug=3 then formprinc.Caption:='Trouve_element '+IntToSTR(el);
Branche:=Offset;
branche_trouve:=0;
IndexBranche_trouve:=0;
i:=1;
repeat
adr:=BrancheN[Branche,i].Adresse;
Bt:=BrancheN[Branche,i].BType;
if ((adr=0) and (Bt=rien)) then begin inc(Branche);i:=0;end;
inc(i);
sort:=(Branche>NbreBranches) or ((adr=el) and (TypeEL=Bt));
until (sort);
if (adr=el) then
begin
branche_trouve:=Branche;
IndexBranche_trouve:=i-1;
end
else begin s:='Erreur 175 : élément '+intToSTR(el)+' ';
s:=s+BTypeToChaine(TypeEl);
s:=s+' non trouvé';Affiche(s,clred);
branche_trouve:=0; IndexBranche_trouve:=0;
if NivDebug>=1 then AfficheDebug(s,clred);
end;
if debug=3 then formprinc.Caption:='';
end;
// renvoie l'élément suivant des deux éléments dans le sens (prec,typeElprec) -> (actuel,typeElActuel) quels qu'ils soient mais contigus
// attention, si les éléments ne sont pas contigus, le résultat est erronné!!!
// un élément est constitué de son adresse et de son type
// et renvoie aussi en variable globale: typeGen le type de l'élément
// s'ils ne sont pas contigus, on aura une erreur
// alg= algorithme 1 à 8:
// bit0 (1)=arret sur suivant qu'il soit un détecteur ou un aiguillage
// bit1 (2)=arret sur aiguillage en talon mal positionné
// bit2 (4)=arret sur aiguillage réservé
// bits1 et 2: (2+4)=6= arret sur aiguillage en talon mal positionnée ou aiguillage réservé
// bit3 (8)=arret sur un aiguillage pris en pointe dévié et AdrDevie contient l'adresse de l'aiguillage dévié ainsi que typeGen
// code de sortie : élément suivant ou:
// 9999: erreur fatale ou itération trop longue
// 9998: arret sur aiguillage en talon mal positionnée
// 9997: arrêt sur aiguillage dévié
// 9996: arrêt sur position inconnue d'aiguillage
// 9995: arrêt anormal sur buttoir
// 9994: arrêt sur aiguillage réservé
// la variable actuel peut etre changée en cas de TJD!
function suivant_alg3(prec : integer;typeELprec : TEquipement;actuel : integer;typeElActuel : TEquipement;alg : integer) : integer;
var Adr,AdrPrec,indexBranche_prec,branche_trouve_prec,indexBranche_actuel,branche_trouve_actuel,
tjsc1,tjsc2,AdrTjdP,Adr2,N_iteration,index,NetatTJD,index2 : integer;
tjscourbe1,tjscourbe2,tjdC,tjsC : boolean;
A,Aprec,tjsc1B,tjsc2B,typeprec: char;
Md,BT,BtypePrec,TypeEL : TEquipement;
s : string;
label recommence;
begin
n_iteration:=0;
recommence:
if (TypeELPrec=rien) or (typeElActuel=rien) then
begin
s:='Erreur 800 - Types nuls : '+intToSTR(prec)+'/'+BtypeToChaine(TypeElPrec)+' '+IntToSTr(actuel)+'/'+BtypeToChaine(typeElActuel) ;
Affiche(s,clred);
AfficheDebug(s,clred);
Suivant_alg3:=9999;exit;
end;
if NivDebug=3 then
AfficheDebug('Alg3 précédent='+intToSTR(prec)+'/'+BtypeToChaine(TypeElprec)+' actuel='+intToSTR(actuel)+'/'+BtypeToChaine(typeElActuel)+' Alg='+intToSTr(alg),clyellow);
// trouver les éléments du précédent
trouve_element(prec,TypeELPrec,1); // branche_trouve IndexBranche_trouve
if IndexBranche_trouve=0 then
begin
if NivDebug=3 then AfficheDebug('Element '+intToSTR(prec)+' non trouvé',clred);
suivant_alg3:=9999;exit;
end;
indexBranche_prec:=IndexBranche_trouve;
branche_trouve_prec:=branche_trouve;
BtypePrec:=BrancheN[branche_trouve_prec,indexBranche_prec].Btype;
trouve_element(actuel,typeElActuel,1); // branche_trouve IndexBranche_trouve
if IndexBranche_trouve=0 then
begin
if NivDebug=3 then AfficheDebug('Element '+intToSTR(actuel)+' non trouvé',clred);
suivant_alg3:=9999;exit;
end;
indexBranche_actuel:=IndexBranche_trouve;
branche_trouve_actuel:=branche_trouve;
Adr:=actuel;
Bt:=BrancheN[branche_trouve_actuel,indexBranche_actuel].Btype;
//Affiche('Btype='+intToSTR(Btype)+' Actuel='+inTToSTR(actuel),clyellow);
if Bt=det then // l'élément actuel est un détecteur
begin
// on part de l'actuel pour retomber sur le précédent
if BrancheN[branche_trouve_actuel,indexBranche_actuel-1].Adresse=prec then // c'est l'autre sens
begin
if NivDebug=3 then AfficheDebug('40 - trouvé détecteur '+intToSTR(adr)+' en + ',clwhite);
Prec:=Adr;
Aprec:=a;
A:='Z';
Adr:=BrancheN[branche_trouve_actuel,indexBranche_actuel+1].Adresse;
typeGen:=BrancheN[branche_trouve_actuel,indexBranche_actuel+1].Btype;
if NivDebug=3 then
begin
s:='41 - Le suivant est :'+intToSTR(adr);
AfficheDebug(s,clwhite);
end;
suivant_alg3:=adr;
exit;
end;
if BrancheN[branche_trouve_actuel,indexBranche_actuel+1].Adresse=prec then
begin
if NivDebug=3 then AfficheDebug('42 - trouvé détecteur '+intToSTR(adr)+' en - ',clwhite);
Prec:=Adr;
Aprec:=a;
A:='Z';
Adr:=BrancheN[branche_trouve_actuel,indexBranche_actuel-1].Adresse;
typeGen:=BrancheN[branche_trouve_actuel,indexBranche_actuel-1].Btype;
if NivDebug=3 then
begin
s:='43 - Le suivant est :'+intToSTR(adr);
AfficheDebug(s,clwhite);
end;
suivant_alg3:=adr;
exit;
end;
// ici, les éléments sont non consécutifs. voir si l'un des deux est une TJD/TJS
if (btypePrec=aig) then // car btype dans les branches vaut det, aig, buttoir mais jamais tjd ni tjs
begin
// changer l'adresse du précédent par l'autre adresse de la TJD/S
index:=index_aig(prec);
md:=aiguillage[index].modele;
if (md=tjs) or (md=tjd) then
begin
prec:=Aiguillage[index_aig(prec)].Ddroit;
if NivDebug=3 then AfficheDebug('Le précedent est une TJD/S - substitution du precédent par la pointe de la TJD qui est '+intToSTR(prec),clYellow);
end;
end;
inc(n_iteration);
if n_iteration>50 then
begin
s:='Erreur fatale 9999, trop d''itérations:';
s:=s+' Alg3 précédent='+intToSTR(prec)+'/'+BtypeToChaine(TypeElprec)+' actuel='+intToSTR(actuel)+'/'+BtypeToChaine(typeElActuel)+' Alg='+intToSTr(alg);
Affiche(s,clRed);
AfficheDebug(s,clRed);
suivant_alg3:=9999;
exit;
end;
goto recommence;
end;
if (Bt=aig) or (Bt=buttoir) then // aiguillage ou buttoir
begin
index:=index_aig(adr);
if index=0 then
begin
if bt=aig then
begin
s:='Erreur 420 : aiguillage '+intToSTR(adr)+' inconnu';
Affiche(s,clred);
AfficheDebug(s,clred);
suivant_alg3:=9999;
exit;
end;
suivant_alg3:=9995;
exit;
end;
if (aiguillage[index].modele=aig) and (Bt=aig) then // aiguillage normal
begin
// si aiguillage reservé
if (alg and $4=$4) and (aiguillage[index].AdrTrain<>0) then
begin
if NivDebug=3 then AfficheDebug('230 - aiguillage '+intToSTR(adr)+' réservé par train @'+intToSTR(aiguillage[index].AdrTrain),clyellow);
suivant_alg3:=9997;
exit;
end;
// aiguillage index (adr) pris en pointe
if (aiguillage[index].Apointe=prec) then
begin
if aiguillage[index].position=const_droit then
begin
if NivDebug=3 then AfficheDebug('130 - aiguillage '+intToSTR(Adr)+' Pris en pointe droit',clyellow);
if Adr=0 then
begin
Affiche('131 - Erreur fatale',clRed);suivant_alg3:=9999;exit;
end;
BtypePrec:=Bt;
Aprec:=a;
A:=aiguillage[index].AdroitB;
Adr:=aiguillage[index].Adroit;
if adr<>0 then
begin
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(adr,typeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype;
end
else
typeGen:=buttoir;
suivant_alg3:=adr;
exit;
end;
if aiguillage[index].position=const_devie then
begin
if NivDebug=3 then AfficheDebug('133 - aiguillage '+intToSTR(Adr)+' Pris en pointe dévié',clyellow);
if (alg and 8)=8 then // on demande d'arreter si l'aiguillage pris en pointe est dévié
begin
typeGen:=rien;
AdrDevie:=Adr;
suivant_alg3:=9997;
exit;
end;
if Adr=0 then
begin Affiche('134 - Erreur fatale',clRed);
if NivDebug>=1 then AfficheDebug('134 - Erreur fatale',clRed);
suivant_alg3:=9999;exit;
end;
BtypePrec:=Bt;
Aprec:=A;
A:=aiguillage[index].AdevieB;
Adr:=aiguillage[index].Adevie;
if adr<>0 then
begin
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype;
end
else typeGen:=buttoir;
suivant_alg3:=adr;
exit;
end;
if aiguillage[index].position=const_inconnu then
begin
if NivDebug>=1 then
begin
s:='134.2 - Aiguillage '+IntToSTR(adr)+' non résolu car position inconnue';
AfficheDebug(s,clOrange);
Affiche(s,clOrange);
end;
typeGen:=rien;
suivant_alg3:=9996;
exit;
end;
end
else
begin
// aiguillage index (adr) pris en talon
if NivDebug=3 then AfficheDebug('135 - aiguillage '+intToSTR(Adr)+' Pris en talon',clyellow);
if (alg and 2)=2 then // on demande d'arreter si l'aiguillage en talon est mal positionné
begin
if aiguillage[index].position=const_droit then
begin
// si TJD (modele=2) sur le précédent, alors substituer avec la 2eme adresse de la TJD
md:=aiguillage[index_aig(prec)].modele;
if (md=tjd) or (md=tjs) then prec:=aiguillage[index_aig(prec)].DDroit;
if prec<>aiguillage[index_aig(Adr)].Adroit then //Adroit
begin
if NivDebug=3 then AfficheDebug('135.1 - Aiguillage '+intToSTR(adr)+' mal positionné',clyellow);
suivant_alg3:=9998;
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('135.2 - Aiguillage '+intToSTR(adr)+' bien positionné',clyellow);
end;
end
else
begin
// si TJD (modele=2) sur le précédent, alors substituer avec la 2eme adresse de la TJD
md:=aiguillage[index_aig(prec)].modele;
if (md=tjd) or (md=tjs) then prec:=aiguillage[index_aig(prec)].Ddevie;
if prec<>aiguillage[index].Adevie then
begin
if NivDebug=3 then AfficheDebug('135.3 Aiguillage '+intToSTR(adr)+' mal positionné',clyellow);
suivant_alg3:=9998;
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('135.4 Aiguillage '+intToSTR(adr)+' bien positionné',clyellow);
end;
end;
end;
// AdrPrec:=Adr;
if Adr=0 then
begin
Affiche('136 - Erreur fatale',clRed);
if NivDebug>=1 then AfficheDebug('136 - Erreur fatale',clRed);
suivant_alg3:=9999;exit;
end;
BtypePrec:=Bt;
APrec:=A;
A:=aiguillage[index].ApointeB;
Adr:=aiguillage[index].Apointe;
if adr<>0 then
begin
// Affiche('trouvé '+intToSTR(adr),clyellow);
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype;
end
else TypeGen:=Buttoir;
suivant_alg3:=adr;
exit;
end;
if (NivDebug>1) or traceListe then
begin
s:='138 - Aiguillage '+IntToSTR(adr)+' non résolu';
if aiguillage[index].position=const_inconnu then s:=s+' car position inconnue';
AfficheDebug(s,clOrange);
Affiche(s,clOrange);
end;
suivant_alg3:=9996; // position inconnue
exit;
end;
// TJD ou TJS-----------------------------
if (aiguillage[index].modele=tjd) or (aiguillage[index].modele=tjs) then
begin
if ((alg and 4)=4) and (aiguillage[index].AdrTrain<>0) then
begin
if NivDebug=3 then AfficheDebug('231 - TJD/S '+intToSTR(Adrtjdp)+' réservée par train @'+intToSTR(aiguillage[index].AdrTrain),clyellow);
suivant_alg3:=9994;
exit;
end;
// récupérer les élements de la TJD/S
AdrTjdP:=aiguillage[index].Ddroit; // 2eme adresse de la TJD/S
index2:=index_aig(AdrTjdP);
tjdC:=aiguillage[index].modele=tjd;
tjsC:=aiguillage[index].modele=tjs;
tjsc1:=aiguillage[index].tjsint; // adresses de la courbe de la TJS
tjsc2:=aiguillage[index2].tjsint;
tjsc1B:=aiguillage[index].tjsintB;
tjsc2B:=aiguillage[index2].tjsintB;
NetatTJD:=aiguillage[index].etatTJD;
if ((alg and 4)=4) and (aiguillage[index2].AdrTrain<>0) then
begin
if NivDebug=3 then AfficheDebug('130 - TJD/S '+intToSTR(Adrtjdp)+' réservée par train @'+intToSTR(aiguillage[index2].AdrTrain),clyellow);
suivant_alg3:=9994;
exit;
end;
if tjsc1<>0 then // si tjs
begin
tjscourbe1:=(aiguillage[index].tjsintB='S') and (aiguillage[index2].position<>const_droit);
tjscourbe1:=((aiguillage[index].tjsintB='D') and (aiguillage[index2].position=const_droit)) or tjscourbe1;
end;
if tjsc2<>0 then
begin
tjscourbe2:=(aiguillage[index2].tjsintB='S') and (aiguillage[index2].position<>const_droit);
tjscourbe2:=((aiguillage[index2].tjsintB='D') and (aiguillage[index2].position=const_droit)) or tjscourbe2;
end;
if NivDebug=3 then
begin
s:='137 - TJD/S '+intToSTR(Adr);
if NetatTJD=4 then s:=s+'/'+IntToSTR(AdrTjdP);
s:=s+' pos=';
if aiguillage[index].position=const_droit then s:=s+'droit'
else if aiguillage[index].position=const_devie then s:=s+'dévié'
else s:=s+'inconnu' ;
if NetatTJD=4 then
begin
if aiguillage[index_aig(AdrTJDP)].position=const_droit then s:=s+'/droit'
else if aiguillage[index_aig(AdrTJDP)].position=const_devie then s:=s+'/dévié'
else s:=s+'/inconnu' ;
end;
AfficheDebug(s,clyellow);
end;
// rechercher le port de destination de la tjd
Adr2:=0;A:='Z';
//---------------TJD 2 états
if (NetatTJD=2) and tjdC then
begin
if aiguillage[index].position=const_droit then
begin
// d'où vient t-on de la tjd
if BtypePrec=Aig then
begin
if (aiguillage[index].Ddroit=prec) and
(
((aiguillage[index].DdroitB='D') and (aiguillage[index_aig(prec)].position=const_droit)) or
((aiguillage[index].DdroitB='S') and (aiguillage[index_aig(prec)].position=const_devie))
) then
begin
Adr:=aiguillage[index].Adroit;
A:=aiguillage[index].AdroitB;
end
else
begin
if (nivdebug>1) or traceliste then
begin
s:='Erreur 120 : TJD 2 états '+intToSTR(Adr)+' non résolue';
AfficheDebug(s,clred);
suivant_alg3:=9999;
exit;
end;
end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig)
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd 2 états est '+IntToSTR(adr)+a,clyellow);
exit;
end;
if BtypePrec=det then
begin
if aiguillage[index].Adroit=prec then
begin
Adr:=aiguillage[index].DDroit;
A:=aiguillage[index].DdroitB;
end;
if aiguillage[index].Adevie=prec then
begin
Adr:=aiguillage[index].Ddevie;
A:=aiguillage[index].DdevieB;
end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig)
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd 2 états est '+IntToSTR(adr)+a,clyellow);
exit;
end;
end;
if aiguillage[index].position=const_devie then
begin
if BtypePrec=Aig then
begin
if (aiguillage[index].Ddroit=prec) and
(
((aiguillage[index].DdroitB='D') and (aiguillage[index_aig(prec)].position=const_droit)) or
((aiguillage[index].DdroitB='S') and (aiguillage[index_aig(prec)].position=const_devie))
)
then
begin
Adr:=aiguillage[index].Adevie;
A:=aiguillage[index].AdevieB;
end
else
begin
if (nivdebug>1) or traceliste then
begin
s:='Erreur 121 : TJD 2 états '+intToSTR(Adr)+' non résolue';
AfficheDebug(s,clred);
suivant_alg3:=9999;
exit;
end;
end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig)
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd 2 états est '+IntToSTR(adr)+a,clyellow);
exit;
end;
if BtypePrec=det then
begin
if aiguillage[index].Adroit=prec then
begin
Adr:=aiguillage[index].Ddevie;
A:=aiguillage[index].DdevieB;
end;
if aiguillage[index].Adevie=prec then
begin
Adr:=aiguillage[index].Ddroit;
A:=aiguillage[index].DdroitB;
end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig)
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd 2 états est '+IntToSTR(adr)+a,clyellow);
exit;
end;
end;
end;
//--------------- 4 états ou TJS
if (NetatTJD=4) or tjsC then
begin
// determiner la position de la première section de la TJD (4 cas)
// cas 1 : droit droit
if (( aiguillage[index].position=const_droit) and
(aiguillage[index2].position=const_droit) ) then
begin
// d'où vient ton sur la tjs
if BtypePrec=Aig then
begin
if ( ((aiguillage[index].AdroitB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdroitB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
then
begin if NivDebug=3 then AfficheDebug('TJD/S '+intToSTR(adr)+' bien positionnée cas 1.1',clyellow);end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.5- TJD/S '+intToSTR(adr)+' mal positionnée cas 1.1',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if BtypePrec=det then
begin
if (aiguillage[index].Adroit)=prec then
begin
if NivDebug=3 then AfficheDebug('TJD/S '+intToSTR(adr)+' bien positionnée cas 1.2',clyellow);end
else
begin
if (nivdebug>1) then AfficheDebug('135.6- TJD/S '+intToSTR(adr)+' mal positionnée cas 1.2',clyellow);
if (alg and 2=2) then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if aiguillage[index].position=const_droit then
begin
Adr:=aiguillage[index2].Adroit;
A:=aiguillage[index2].AdroitB;
end
else
//if A='S' then
begin
Adr:=aiguillage[index2].Adevie;
A:=aiguillage[index2].AdevieB;
end;
if NivDebug=3 then AfficheDebug('cas1.1 tjd/s: '+s+' Adr='+intToSTR(adr)+A,clYellow);
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig
suivant_alg3:=adr;
Actuel:=aiguillage[index2].Adresse; // substitution de la TJS
if nivDebug=3 then Affichedebug('le port de destination de la tjd/s est '+IntToSTR(adr)+a,clyellow);
exit;
end;
// cas 2 TJD
if (aiguillage[index].position=const_devie)
and (aiguillage[index2].position=const_droit) and tjdC then
begin
// d'où vient ton sur la tjd
if BtypePrec=Aig then
begin
if ( ((aiguillage[index].AdroitB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdroitB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
then
begin if NivDebug=3 then AfficheDebug('TJD/S '+intToSTR(adr)+' bien positionnée - cas 2.1',clyellow);
if (alg and 4)=4 then // on demande d'arreter si l'aiguillage pris en pointe est dévié
begin
typeGen:=rien;
AdrDevie:=Adr;
suivant_alg3:=9997;exit;
end;
end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.7- TJD '+intToSTR(adr)+' mal positionnée - cas 2.1',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if BtypePrec=det then
begin
if (aiguillage[index].Adroit)=prec then
begin
if NivDebug=3 then AfficheDebug('TJD '+intToSTR(adr)+' bien positionnée cas 2.2',clyellow);
if (alg and 4)=4 then // on demande d'arreter si l'aiguillage pris en pointe est dévié
begin
typeGen:=rien;
AdrDevie:=Adr;
suivant_alg3:=9997;exit;
end;
end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.18- TJD '+intToSTR(adr)+' mal positionnée cas 2.2',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if aiguillage[index].position=const_devie then
begin
Adr:=aiguillage[index2].Adevie;
A:=aiguillage[index2].AdevieB;
end
else
begin
Adr:=aiguillage[index2].Adroit;
A:=aiguillage[index2].AdroitB;
end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig
Actuel:=aiguillage[index2].Adresse;
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd 4 états est '+IntToSTR(adr)+a,clyellow);
exit;
end;
// cas 3 TJD
if (aiguillage[index].position=const_droit)
and (aiguillage[index2].position=const_devie) and tjdC then
begin
// d'où vient ton sur la tjd
if BtypePrec=Aig then
begin
if ( ((aiguillage[index].AdevieB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdevieB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
then
begin if NivDebug=3 then AfficheDebug('TJD '+intToSTR(adr)+' bien positionnée cas 3.1',clyellow);
if (alg and 4)=4 then // on demande d'arreter si l'aiguillage pris en pointe est dévié
begin
typeGen:=rien;
AdrDevie:=Adr;
suivant_alg3:=9997;exit;
end;
end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.7- TJD '+intToSTR(adr)+' mal positionnée cas 3.1',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if BtypePrec=det then
begin
if (aiguillage[index].Adevie)=prec then
begin
if NivDebug=3 then AfficheDebug('TJD '+intToSTR(adr)+' bien positionnée cas 3.2',clyellow);
if (alg and 4)=4 then // on demande d'arreter si l'aiguillage pris en pointe est dévié
begin
typeGen:=rien;
AdrDevie:=Adr;
suivant_alg3:=9997;exit;
end;
end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.8- TJD '+intToSTR(adr)+' mal positionnée cas 3.2',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if aiguillage[index].position=const_devie then
begin
Adr:=aiguillage[index2].Adevie;
A:=aiguillage[index2].AdevieB;
end
//if A='S' then
else
begin
Adr:=aiguillage[index2].Adroit;
A:=aiguillage[index2].AdroitB;
end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig
Actuel:=aiguillage[index2].Adresse;
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd est '+IntToSTR(adr)+a,clyellow);
exit;
end;
// cas 4 tjd
if (aiguillage[index].position=const_devie)
and (aiguillage[index2].position=const_devie) then
begin
// d'où vient ton sur la tjd
if BtypePrec=Aig then
begin
if ( ((aiguillage[index].AdevieB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdevieB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
then
begin if NivDebug=3 then AfficheDebug('TJD '+intToSTR(adr)+' bien positionnée cas 4.1',clyellow);end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.7- TJD '+intToSTR(adr)+' mal positionnée cas 4.1',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if BtypePrec=det then
begin
if (aiguillage[index].Adevie)=prec then
begin
if NivDebug=3 then AfficheDebug('TJD '+intToSTR(adr)+' bien positionnée cas 4.2',clyellow);end
else
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.8- TJD '+intToSTR(adr)+' mal positionnée cas 4.2',clyellow);
if (alg and 2)=2 then
begin
suivant_alg3:=9998;exit;
end;
end;
end;
if aiguillage[index].position=const_droit then
begin
Adr:=aiguillage[index2].Adroit;
A:=aiguillage[index2].AdroitB;
end
//if A='S' then
else
begin
Adr:=aiguillage[index2].Adevie;
A:=aiguillage[index2].AdevieB;
end;
if NivDebug=3 then AfficheDebug('cas4.1 tjd: '+s+' Adr='+intToSTR(adr)+A,clYellow);
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig
Actuel:=aiguillage[index2].Adresse;
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd est '+IntToSTR(adr)+a,clyellow);
exit;
end;
// cas TJS prise dans sa position courbe
if ((aiguillage[index].Adevie=Prec) and (aiguillage[index].AdevieB=Aprec) and (aiguillage[index].position<>const_droit)
and (aiguillage[index_aig(AdrTjdP)].position=const_droit) and (tjsC) and tjscourbe1 and tjscourbe2) then
begin
if NivDebug=3 then AfficheDebug('cas tjs en courbe1',clYellow);
A:=aiguillage[index_aig(AdrTjdP)].AdevieB;
Adr:=aiguillage[index_aig(AdrTjdP)].Adevie;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig
Actuel:=aiguillage[index2].Adresse;
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd est '+IntToSTR(adr)+a,clyellow);
exit;
end;
// cas 3 TJS prise dans sa 2eme position courbe
if ((aiguillage[index].Adroit=Prec) and (aiguillage[index].AdroitB=Aprec) and (aiguillage[index].position=const_droit)
and (aiguillage[index_aig(AdrTjdP)].position<>const_droit) and (tjsC) and tjscourbe1 and tjscourbe2 ) then
begin
if NivDebug=3 then AfficheDebug('cas1 tjs en courbe 2',clYellow);
A:=aiguillage[index_aig(AdrTjdP)].AdevieB;
Adr:=aiguillage[index_aig(AdrTjdP)].Adevie;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig
suivant_alg3:=adr;
Actuel:=aiguillage[index2].Adresse;
if nivDebug=3 then Affichedebug('le port de destination de la tjd est '+IntToSTR(adr)+a,clyellow);
exit;
end;
if ((nivdebug>1) or traceliste) and not(init_aig_cours) then
begin
s:='1026 - position TJD/S '+IntToSTR(Adr)+'='+intToSTR(aiguillage[index].position)+' / '+intToSTR(index)+'='+intToSTR(aiguillage[index2].position)+' inconnue';
AfficheDebug(s,clOrange);
end;
suivant_alg3:=9999;exit;
end;
end;
if (aiguillage[index].modele=crois) then
begin
// si reservé
if ((alg and 4)=4) and (aiguillage[index].AdrTrain<>0) then
begin
if NivDebug=3 then AfficheDebug('235 - croisement '+intToSTR(adr)+' réservé par train @'+intToSTR(aiguillage[index].AdrTrain),clyellow);
suivant_alg3:=9994;
exit;
end;
adr:=9999;
if aiguillage[index].Adroit=prec then begin adr:=aiguillage[index].Ddroit;A:=aiguillage[index].DdroitB;end;
if aiguillage[index].Adevie=prec then begin adr:=aiguillage[index].Ddevie;A:=aiguillage[index].DdevieB;end;
if aiguillage[index].Ddevie=prec then begin adr:=aiguillage[index].Adevie;A:=aiguillage[index].AdevieB;end;
if aiguillage[index].Ddroit=prec then begin adr:=aiguillage[index].Adroit;A:=aiguillage[index].AdroitB;end;
if A='Z' then typeGen:=det else typeGen:=aig; //TypeEL=(1=détécteur 2=aig)
suivant_alg3:=adr;
if a='' then a:=' ';
if (nivdebug>1) then Affichedebug('le port de destination du croisement '+intToSTR(aiguillage[index].adresse)+' est '+IntToSTR(adr)+a,clyellow);
// Affiche('croisement '+intToSTR(prec)+' '+intToSTR(actuel),clLime);
// mémoriser dans un tableau l'entrée et la sortie du croisement
if ncrois<20 then
begin
inc(ncrois);
croisement[ncrois].adresse:=aiguillage[index].adresse;
croisement[ncrois].entree:=prec;
croisement[ncrois].sortie:=adr;
end;
exit;
end;
if (aiguillage[index].modele=triple) then // aiguillage triple
begin
Adr2:=aiguillage[index].AdrTriple;
if (aiguillage[index].Apointe=prec) then
begin
// aiguillage triple pris en pointe
//Affiche('position='+intToSTR(aiguillage[index_aig(Adr].position),clyellow);
if (aiguillage[index].position=const_droit) and (aiguillage[index_aig(Adr2)].position=const_droit) then
begin
if NivDebug=3 then AfficheDebug('Aiguillage triple pris en pointe droit',clYellow);
A:=aiguillage[index].AdroitB;
Adr:=aiguillage[index].Adroit;
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType;
suivant_alg3:=adr;exit;
end;
if (aiguillage[index].position<>const_droit) and (aiguillage[index_aig(Adr2)].position=const_droit) then
begin
if NivDebug=3 then AfficheDebug('Aiguillage triple dévié1 (à gauche)',clYellow);
A:=aiguillage[index].AdevieB;
Adr:=aiguillage[index].Adevie;
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType;
suivant_alg3:=adr;exit;
end;
if (aiguillage[index].position=const_droit) and (aiguillage[index_aig(Adr2)].position<>const_droit) then
begin
if NivDebug=3 then AfficheDebug('Aiguillage triple dévié2 (à droite)',clYellow);
A:=aiguillage[index].Adevie2B;
Adr:=aiguillage[index].Adevie2;
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType;
suivant_alg3:=adr;
exit;
end;
if aiguillage[index].position=const_inconnu then begin suivant_alg3:=9996;exit;end; // pour échappement
s:='Aiguillage triple '+IntToSTR(Adr)+' : configuration des aiguilles interdite';
if CDM_connecte then s:=s+': '+IntToSTR(aiguillage[index].position);
AfficheDebug(s,clYellow);
Affiche(s,clRed);
suivant_alg3:=9999;
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('Aiguillage triple pris en talon',clyellow);
if (alg and 2)=2 then // on demande d'arreter si l'aiguillage en talon est mal positionné
begin
if (aiguillage[index].position=const_droit) and (aiguillage[index_aig(adr2)].position=const_droit) then
begin
if prec<>aiguillage[index].Adroit then
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow);
suivant_alg3:=9998;
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('135.4 - Aiguillage '+intToSTR(adr)+'triple bien positionné',clyellow);
end;
end;
if (aiguillage[index].position<>const_droit) and (aiguillage[index_aig(adr2)].position=const_droit) then
begin
if prec<>aiguillage[index].Adevie then
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow);
suivant_alg3:=9998;
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('135.4 - Aiguillage '+intToSTR(adr)+'triple bien positionné',clyellow);
end;
end;
if (aiguillage[index].position=const_droit) and (aiguillage[index_aig(adr2)].position<>const_droit) then
begin
if prec<>aiguillage[index].Adevie2 then
begin
if (nivdebug>1) or traceliste then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow);
suivant_alg3:=9998;
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('135.4 - Aiguillage '+intToSTR(adr)+'triple bien positionné',clyellow);
end;
end;
end;
A:=aiguillage[index].ApointeB;
Adr:=aiguillage[index].Apointe;
if A='Z' then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig
trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType;
suivant_alg3:=Adr;
exit;
end;
end;
end;
suivant_alg3:=adr;
end;
// renvoie l'adresse du signal s'il est associé au détecteur "detecteur"
function signal_detecteur(detecteur : integer) : integer;
var trouve : boolean;
i : integer;
begin
i:=1;
repeat
trouve:=(feux[i].Adr_det1=detecteur) or (feux[i].Adr_det2=detecteur) or (feux[i].Adr_det3=detecteur) or (feux[i].Adr_det4=detecteur);
inc(i);
until (i>=NbreFeux) or trouve;
if trouve then signal_detecteur:=feux[i-1].adresse else signal_detecteur:=0;
end;
// trouve l'index du feu associé au détecteur adr
// renvoie dans voie le numéro de la voie (1 à 4) du signal sur lequel le détecteur se trouve
// attention , il peut y avoir plus d'un feu sur un detecteur (suivant le sens)!
// si 2eme feu, son index est dans index2
function index_feu_det(adr : integer;var voie,index2 : integer) : integer ;
var trouve,i,index1 : integer;
trouve1,trouve2,trouve3,trouve4 : boolean;
begin
i:=1;
trouve:=0;
index2:=0;
index1:=0;
voie:=0;
repeat
trouve1:=feux[i].Adr_det1=adr;
trouve2:=feux[i].Adr_det2=adr;
trouve3:=feux[i].Adr_det3=adr;
trouve4:=feux[i].Adr_det4=adr;
if trouve1 or trouve2 or trouve3 or trouve4 then
begin
inc(trouve);
if trouve=1 then index1:=i;
if trouve=2 then index2:=i;
if trouve=1 then // on ne mémorise la voie qu'a la premiere recherche
begin
if trouve1 then voie:=1;
if trouve2 then voie:=2;
if trouve3 then voie:=3;
if trouve4 then voie:=4;
end;
end;
inc(i);
until (trouve=2) or (i>NbreFeux);
Index_feu_det:=index1;
end;
//renvoie l'élément connecté de l'aiguillage ou de la tjd tjs "adr" sur le point D,S ou P passé par connect
procedure aig_ext(adr : integer ; connect : char;var suiv : integer;var typ_suiv: char);
var i : integer;
typ : TEquipement;
begin
i:=index_aig(adr);
typ:=aiguillage[i].modele;
if (typ=aig) or (typ=triple) then
begin
if connect='P' then
begin
suiv:=aiguillage[i].APointe;typ_suiv:=aiguillage[i].ApointeB;
end;
if connect='S' then
begin
suiv:=aiguillage[i].ADevie;typ_suiv:=aiguillage[i].ADevieB;
end;
if connect='D' then
begin
suiv:=aiguillage[i].ADroit;typ_suiv:=aiguillage[i].ADroitB;
end;
// aiguillage triple
if connect='2' then
begin
suiv:=aiguillage[i].ADevie2;typ_suiv:=aiguillage[i].ADevie2B;
end;
end;
if (typ=tjd) or (typ=tjs) then
begin
//Affiche('TJD',clYellow);
if connect='S' then
begin
suiv:=aiguillage[i].ADevie;typ_suiv:=aiguillage[i].ADevieB;
end;
if connect='D' then
begin
suiv:=aiguillage[i].ADroit;typ_suiv:=aiguillage[i].ADroitB;
end;
end;
if (typ=crois) then
begin
if connect='S' then
begin
suiv:=aiguillage[i].ADevie;typ_suiv:=aiguillage[i].ADevieB;
end;
if connect='D' then
begin
suiv:=aiguillage[i].ADroit;typ_suiv:=aiguillage[i].ADroitB;
end;
end;
if typ_suiv=#0 then typ_suiv:='Z';
end;
// renvoie l'élément avant det2 si det1 et det2 sont contigus ou ne sont séparés que par des aiguillages
// si det1 et det2 sont contigus sans aiguillages entre eux, çà renvoie det1 sinon renvoie l'aiguillage entre les 2
// s'ils ne sont pas contigus, renvoie 0
// det_contigu(527,520: renvoie 7 dans suivant
// det_contigu(514,522: renvoie 514 dans suivant
// det_contigu(517,524: renvoie 30
procedure det_contigu(det1,det2 : integer;var suivant : integer;var ElSuiv : TEquipement);
var suiv1,indexBranche_det1,indexBranche_det2,branche_det2,branche_det1,
suiv_2,detC,indexBranche_det,suiv_pointe,dernier,it : integer;
type1,Tp,type_dernier : Tequipement;
type_tmp : char;
trouve,afdeb : boolean;
// donne le suivant au point de connexion de l'aiguillage
// prec=det ou aig ; suiv=aig
// aig_suiv(527,7) : renvoie 520 dans suiv_2
// procédure récursive
procedure aig_suiv(prec,suiv : integer) ;
var adr2,index : integer;
typ : Tequipement;
begin
inc(it);
if it>50 then
begin
Affiche('Erreur 680 : limite de récursivité',clred);
exit;
end;
index:=index_aig(suiv);
typ:=aiguillage[index].modele;
// aiguillage en pointe?
if afdeb then afficheDebug('250. Aig_suiv('+intToSTR(prec)+','+intToSTR(suiv)+')',clOrange);
aig_ext(suiv,'P',suiv_pointe,type_tmp);
if (suiv_pointe=prec) and ((typ=aig) or (typ=triple)) then
begin
// faire le droit
if afdeb then afficheDebug('251. Aig '+intToSTR(suiv)+' test en pointe droit',clyellow);
type_Dernier:=aig;
aig_ext(suiv,'D',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé ',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow);
end;
// faire le dévié
if afdeb then afficheDebug('252.Aig '+intToSTR(suiv)+' test en pointe dévié',clyellow);
type_Dernier:=aig;
aig_ext(suiv,'S',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé ',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu ('+intToSTR(det2)+')',clyellow)
end;
// si triple faire S2
if typ=triple then
begin
if afdeb then afficheDebug('Aig triple'+intToSTR(suiv)+' test en pointe dévié2',clyellow);
type_Dernier:=aig;
aig_ext(suiv,'2',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé ',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow)
end;
end;
end
else
begin
// aiguillage en talon ou tjd ou croisement
type_Dernier:=aig;
if (typ=aig) or (typ=triple) then
begin
if afdeb then afficheDebug('Aig '+intToSTR(suiv)+' test en talon',clyellow);
aig_ext(suiv,'P',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé ',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow)
end;
end;
if typ=tjd then
begin
if afdeb then afficheDebug('Tjd '+intToSTR(suiv),clyellow);
Adr2:=aiguillage[index].DDevie; // 2eme adresse de la tjd
//index2:=index_aig(adr2);
suiv:=Adr2;
aig_ext(suiv,'D',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé sur D',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow)
end;
aig_ext(suiv,'S',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé sur S',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow)
end;
end;
if typ=tjs then
begin
if afdeb then afficheDebug('Tjs '+intToSTR(suiv),clyellow);
Adr2:=aiguillage[index].DDevie; // 2eme adresse de la tjd
//index2:=index_aig(adr2);
suiv:=Adr2;
aig_ext(suiv,'D',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé sur D',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu ('+intToSTR(det2)+')',clyellow)
end;
aig_ext(suiv,'S',suiv_2,type_tmp);
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé sur S',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow)
end;
end;
if typ=crois then
begin
if afdeb then afficheDebug('crois '+intToSTR(suiv),clyellow);
if aiguillage[index].ADroit=prec then begin suiv_2:=aiguillage[index].Ddroit;type_tmp:=aiguillage[index].DdroitB;end;
if aiguillage[index].DDroit=prec then begin suiv_2:=aiguillage[index].Adroit;type_tmp:=aiguillage[index].AdroitB;end;
if aiguillage[index].ADevie=prec then begin suiv_2:=aiguillage[index].Ddevie;type_tmp:=aiguillage[index].DdevieB;end;
if aiguillage[index].DDevie=prec then begin suiv_2:=aiguillage[index].ADevie;type_tmp:=aiguillage[index].AdevieB;end;
if type_tmp<>'Z' then aig_suiv(suiv,suiv_2) else
begin
trouve:=(suiv_2=det2);
if trouve then
begin
dernier:=suiv;
if afdeb then afficheDebug('trouvé ',clLime);
exit;
end;
if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu ('+intToSTR(det2)+')',clyellow)
end;
end;
end;
end; // fin de la procédure aig_suiv
begin
// trouver les éléments du précédent
if debug=3 then formprinc.Caption:='Det_contigu '+intToSTR(det1)+' '+intToSTr(det2);
afdeb:=false;//TraceListe ;
it:=0;
if afdeb then afficheDebug('Det_contigu '+intToSTR(det1)+' '+intToSTr(det2),clyellow);
tp:=det;
if det1=0 then tp:=buttoir;
trouve_element(det1,tp,1); // branche_trouve IndexBranche_trouve
if IndexBranche_trouve=0 then
begin
if NivDebug=3 then AfficheDebug('Element '+intToSTR(det1)+' non trouvé',clred);
if debug=3 then formprinc.Caption:='';
exit;
end;
indexBranche_det1:=IndexBranche_trouve;
branche_det1:=branche_trouve;
tp:=det;
if det2=0 then tp:=buttoir;
trouve_element(det2,tp,1); // branche_trouve IndexBranche_trouve
if IndexBranche_trouve=0 then
begin
if NivDebug=3 then AfficheDebug('Element '+intToSTR(actuel)+' non trouvé',clred);
if debug=3 then formprinc.Caption:='';
exit;
end;
trouve:=false;
indexBranche_det2:=IndexBranche_trouve;
branche_det2:=branche_trouve;
detC:=det1;
indexBranche_det:=indexBranche_det1;
Branche_Det:=Branche_det1;
dernier:=0;
// faire en incrément
if afdeb then afficheDebug('incrément',cyan);
suiv1:=BrancheN[Branche_Det,indexBranche_det+1].adresse;
type1:=BrancheN[Branche_Det,indexBranche_det+1].Btype; // det aig buttoir
// type aig, aig triple, tjd, tjs
if type1=aig then
begin
aig_suiv(detC,suiv1);
if trouve then
begin
type_dernier:=aig;
if afdeb then afficheDebug('ok1',cllime);
end;
end;
if (type1=det) and not(trouve) then
begin
trouve:=suiv1=det2;
if trouve then
begin
dernier:=det1;
type_Dernier:=det;
if afdeb then afficheDebug('ok2',ClLime);
end;
end;
// faire en décrément
if afdeb then afficheDebug('décrément',cyan);
if not(trouve) then
begin
suiv1:=BrancheN[Branche_Det,indexBranche_det-1].adresse;
type1:=BrancheN[Branche_Det,indexBranche_det-1].Btype;
if type1=aig then
begin
aig_suiv(detC,suiv1);
if trouve then
begin
type_Dernier:=aig;
if afdeb then afficheDebug('ok3',cllime);
end;
end;
if (type1=det) and not(trouve) then
begin
trouve:=suiv1=det2;
if trouve then
begin
dernier:=det1;
if dernier=0 then type_dernier:=buttoir else type_dernier:=det;
if afdeb then afficheDebug('ok4',ClLime);
end;
end;
end;
//Affiche(intToSTR(dernier),clOrange);
if afdeb then
begin
if (dernier=0) then afficheDebug('----Pas trouvé',ClLime)
else afficheDebug('----Trouvé dernier='+intToSTR(dernier),clLime);
end;
suivant:=dernier;ElSuiv:=type_dernier;
if debug=3 then formprinc.Caption:='';
end;
// renvoie le détecteur suivant aux détecteurs 1 et 2
// les aiguillages n'ont pas besoin d'être positionnés entre 1 et 2.
// par contre pour le suivant au det2, les aiguillages doivent être positionnés
// si on ne trouve pas le suivant, renvoie 9999
function det_suiv_cont(det1,det2 : integer) : integer;
var dernier: integer;
derniertyp : Tequipement;
begin
// si un aiguilage est entre det1 et det2 renvoie l'aig, sinon renvoie det1 si det1 et det2 sont contigus
det_contigu(det1,det2,dernier,dernierTyp);
if dernier<>0 then
begin
// détecteur suivant
det_suiv_cont:=detecteur_suivant(dernier,dernierTyp,det2,det,1);
//Affiche(intToSTR(suivant),clorange);
end
else det_suiv_cont:=9999;
end;
// renvoie les adresses des détecteurs adjacents au détecteur "adresse" (avant, après)
// résultat dans adj1 et adj2 en variable globale
procedure Det_Adj(adresse : integer);
var Adr,AdrFonc,Branche,AdrPrec,IndexBranche,i,Dir : integer;
sortie : boolean;
BtypeFonc,BtypePrec : TEquipement;
begin
trouve_element(adresse,det,1); // branche_trouve IndexBranche_trouve
if (IndexBranche_trouve=0) then
begin
Affiche('Erreur 380 : élément '+IntToSTR(adresse)+' det non trouvé',clred);
exit;
end;
IndexBranche:=IndexBranche_trouve;
branche:=branche_trouve;
Dir:=1 ; //test direction
repeat
if (Dir=1) then i:=IndexBranche-1 else i:=IndexBranche+1;
AdrPrec:=Adresse;
BtypePrec:=det;
AdrFonc:=BrancheN[branche,i].Adresse;
BtypeFonc:=BrancheN[branche,i].BType;
i:=0;
repeat
if BtypeFonc<>det then
begin
Adr:=suivant_alg3(AdrPrec,BtypePrec,AdrFonc,BtypeFonc,2); // élément suivant mais arret sur aiguillage en talon mal positionnée
end
else
begin Adr:=AdrFonc;TypeGen:=BtypeFonc;end;
if Adr>9990 then typeGen:=det;
if (NivDebug=3) then AfficheDebug('trouvé '+intToSTR(Adr)+' '+BTypeToChaine(typeGen),clorange);
AdrPrec:=AdrFonc;BtypePrec:=BtypeFonc;
AdrFonc:=Adr;BtypeFonc:=typeGen;
i:=i+1;
sortie:=(i=20) or (Adr=0) or (Adr>=9990) or (TypeGen=det);
until (sortie) ; // boucle de parcours
if (typeGen=det) and (Dir=1) then begin Adj1:=Adr;end;
if (typeGen=det) and (Dir=2) then begin Adj2:=Adr;end;
inc(dir);
until dir=3;
end;
// renvoie l'adresse du détecteur suivant les deux éléments
// les aiguillages doivent être correctement positionnés entre El1 et el2
// El1 et El2 peuvent être séparés par des aiguillages, mais de pas plus de 3 détecteurs
// en sortie : 9999= det1 ou det2 non trouvé
// 9996 : non trouvé
function detecteur_suivant_El(el1: integer;TypeDet1 : TEquipement;el2 : integer;TypeDet2 : TEquipement;alg : integer) : integer ;
var IndexBranche_det1,IndexBranche_det2,branche_trouve_det1,branche_trouve_det2,i,
j,AdrPrec,Adr,AdrFonc,i1,N_det : integer;
Sortie : boolean;
TypePrec,TypeFonc : Tequipement;
s : string;
label reprise;
begin
if debug=3 then formprinc.Caption:='Detecteur_suivant_el '+intToSTR(el1)+' '+intToSTR(el2);
if NivDebug>=2 then
AfficheDebug('Proc Detecteur_suivant_EL '+intToSTR(el1)+','+BTypeToChaine(Typedet1)+'/'+intToSTR(el2)+','+BTypeToChaine(Typedet2)+'-------------------------',clLime);
if (el1>9000) or (el2>9000) then
begin
if NivDebug=3 then AfficheDebug('paramètres incorrects >9000',clred);
detecteur_suivant_El:=9999;
exit;
end;
// trouver détecteur 1
trouve_element(el1,Typedet1,1); // branche_trouve IndexBranche_trouve
if (IndexBranche_trouve=0) then
begin
if NivDebug=3 then
begin
s:='611. '+IntToSTR(el1)+' non trouvé';
AfficheDebug(s,clOrange);
end;
detecteur_suivant_El:=9999;
exit;
end;
IndexBranche_det1:=IndexBranche_trouve;
branche_trouve_det1:=branche_trouve;
// trouver détecteur 2
trouve_element(el2,Typedet2,1); // branche_trouve IndexBranche_trouve
if (IndexBranche_trouve=0) then
begin
if NivDebug=3 then
begin
s:='612. '+IntToSTR(el2)+' non trouvé';
AfficheDebug(s,clred);
AfficheDebug(s,clOrange);
end;
detecteur_suivant_El:=9999;exit;
end;
IndexBranche_det2:=IndexBranche_trouve;
branche_trouve_det2:=branche_trouve;
j:=1; // J=1 test en incrément J=2 test en décrément
// étape 1 : trouver le sens de progression (en incrément ou en décrément)
repeat
//préparer les variables
AdrPrec:=el1;TypePrec:=typeDet1;
if j=1 then i1:=IndexBranche_det1+1;
if j=2 then i1:=IndexBranche_det1-1;
// les suivants dansla branche sont:
AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse;
typeFonc:=BrancheN[branche_trouve_det1,i1].Btype ;
if NivDebug=3 then
begin
s:='------> Test en ';
if (j=1) then s:=s+'incrément ' else s:=s+'décrément ';
s:=s+'- départ depuis élément '+IntToSTR(el1)+' trouvé en index='+intToSTR(IndexBranche_det1)+' Branche='+intToSTR(branche_trouve_det1);
AfficheDebug(s,clyellow);
end;
i:=0;N_Det:=0;
if AdrFonc<>El2 then // si pas déja trouvé le sens de progression
begin
repeat
//AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow);
if nivDebug=3 then AfficheDebug('i='+IntToSTR(i)+' NDet='+IntToSTR(N_det),clyellow);
if (AdrFonc<>0) or (TypeFonc<>rien) then Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,alg) else
begin
Adr:=9999;
end;
//AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow);
if TypeGen=det then inc(N_Det);
if NivDebug=3 then
begin
s:='613 : trouvé='+intToSTR(Adr)+BTypeToChaine(typeGen);
AfficheDebug(s,clYellow);
end;
AdrPrec:=AdrFonc;TypePrec:=TypeFonc;
AdrFonc:=Adr;TypeFonc:=typeGen;
inc(i);
sortie:=((typeDet2=TypeGen) and (Adr=el2)) or (Adr=0) or (Adr>=9990) or (i=15) or (N_Det=Nb_det_dist);
until sortie ;
if (i=15) and (Nivdebug=3) then afficheDebug('Pas trouvé',clyellow);
if (N_det=Nb_det_dist) and (Nivdebug=3) then
begin
s:='Elements trop distants '+intToStr(el1)+' '+intToSTR(el2);
afficheDebug(s,clorange);
end;
end
else
begin
// déja trouvé
adr:=el2;typeGen:=TypeDet2;
end;
if (typeDet2=TypeGen) and (Adr=el2) and (N_Det<>Nb_det_dist) then
begin
if Nivdebug=3 then AfficheDebug('614 - Trouvé '+intToSTR(el2),clYellow);
i:=0;
repeat
//AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow);
Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,alg);
//AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow);
if NivDebug=3 then
begin
s:='615 : trouvé='+intToSTR(Adr)+BTypeToChaine(typeGen);
AfficheDebug(s,clorange);
end;
AdrPrec:=AdrFonc;TypePrec:=TypeFonc;
AdrFonc:=Adr;TypeFonc:=typeGen;
inc(i);
sortie:=(TypeGen=det) or (Adr=0) or (Adr>=9990) or (i=10);
until sortie;
if (TypeGen=det) or (TypeGen=buttoir) then
begin
if NivDebug=3 then
begin
AfficheDebug('le détecteur suivant est le '+IntToSTR(Adr),clyellow);
affichedebug('------------------',clyellow);
end;
detecteur_suivant_el:=Adr;
if debug=3 then formprinc.Caption:='';
exit;
end;
end;
if (i=10) then if NivDebug=3 then AfficheDebug('201 : Itération trop longue',clred);
inc(j);
//AfficheDebug('j='+intToSTR(j),clyellow);
until j=3; // boucle incrément/décrément
detecteur_suivant_el:=9996;
if NivDebug=3 then affichedebug('------------------',clyellow);
if debug=3 then formprinc.Caption:='';
end;
// renvoie le nombre de croisements entre les détecteurs el1 et el2
function Test_croisement(el1,el2,alg: integer) : integer ;
var IndexBranche_det1,IndexBranche_det2,branche_trouve_det1,branche_trouve_det2,i,
j,AdrPrec,Adr,AdrFonc,i1,N_det : integer;
Sortie : boolean;
TypePrec,TypeFonc : Tequipement;
s : string;
label reprise;
begin
if NivDebug>2 then AfficheDebug('Proc Test_croisement '+intToSTR(el1)+','+intToSTR(el2)+',',clyellow);
if (el1>9000) or (el2>9000) then
begin
if NivDebug=3 then AfficheDebug('paramètres incorrects >9000',clred);
Test_croisement:=9999;
exit;
end;
// trouver détecteur 1
trouve_element(el1,det,1); // branche_trouve IndexBranche_trouve
if (IndexBranche_trouve=0) then
begin
if NivDebug=3 then
begin
s:='611. '+IntToSTR(el1)+' non trouvé';
AfficheDebug(s,clOrange);
end;
Test_croisement:=9999;
exit;
end;
IndexBranche_det1:=IndexBranche_trouve;
branche_trouve_det1:=branche_trouve;
// trouver détecteur 2
trouve_element(el2,det,1); // branche_trouve IndexBranche_trouve
if (IndexBranche_trouve=0) then
begin
if NivDebug=3 then
begin
s:='612. '+IntToSTR(el2)+' non trouvé';
AfficheDebug(s,clred);
AfficheDebug(s,clOrange);
end;
Test_croisement:=9999;exit;
end;
IndexBranche_det2:=IndexBranche_trouve;
branche_trouve_det2:=branche_trouve;
j:=1; // J=1 test en incrément J=2 test en décrément
// étape 1 : trouver le sens de progression (en incrément ou en décrément)
repeat
//préparer les variables
ncrois:=0; // pour voir si on passe par un croisement
AdrPrec:=el1;TypePrec:=det;
if j=1 then i1:=IndexBranche_det1+1;
if j=2 then i1:=IndexBranche_det1-1;
// les suivants dansla branche sont:
AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse;
typeFonc:=BrancheN[branche_trouve_det1,i1].Btype ;
if NivDebug=3 then
begin
s:='------> Test en ';
if (j=1) then s:=s+'incrément ' else s:=s+'décrément ';
s:=s+'- départ depuis élément '+IntToSTR(el1)+' trouvé en index='+intToSTR(IndexBranche_det1)+' Branche='+intToSTR(branche_trouve_det1);
AfficheDebug(s,clyellow);
end;
i:=0;N_Det:=0;
if AdrFonc<>El2 then // si pas déja trouvé le sens de progression
begin
repeat
//AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow);
if nivDebug=3 then AfficheDebug('i='+IntToSTR(i)+' NDet='+IntToSTR(N_det),clyellow);
if (AdrFonc<>0) or (TypeFonc<>rien) then Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,alg) else
begin
Adr:=9999;
end;
//AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow);
if TypeGen=det then inc(N_Det);
if NivDebug=3 then
begin
s:='713 : trouvé='+intToSTR(Adr)+BTypeToChaine(typeGen);
AfficheDebug(s,clYellow);
end;
AdrPrec:=AdrFonc;TypePrec:=TypeFonc;
AdrFonc:=Adr;TypeFonc:=typeGen;
inc(i);
sortie:=((TypeGen=det) and (Adr=el2)) or (Adr=0) or (Adr>=9990) or (i=15) or (N_Det=Nb_det_dist);
until sortie ;
if (i=15) and (Nivdebug=3) then afficheDebug('Pas trouvé',clyellow);
if (N_det=Nb_det_dist) and (Nivdebug=3) then
begin
s:='Elements trop distants '+intToStr(el1)+' '+intToSTR(el2);
afficheDebug(s,clorange);
end;
end
else
begin
// déja trouvé
adr:=el2;typeGen:=det;
end;
if (TypeGen=det) and (Adr=el2) and (N_Det<>Nb_det_dist) then
begin
test_croisement:=ncrois;
exit;
end;
if (i=10) then if NivDebug=3 then AfficheDebug('711 : Itération trop longue',clred);
inc(j);
//AfficheDebug('j='+intToSTR(j),clyellow);
until j=3; // boucle incrément/décrément
Test_croisement:=0;
ncrois:=0; // annuler le croisement détecté
if NivDebug=3 then affichedebug('------------------',clyellow);
end;
// renvoie vrai si les aiguillages déclarés dans la définition du signal sont mal positionnés
// (conditions suppplémentares)
function cond_carre(adresse : integer) : boolean;
var i,l,k,NCondCarre,adrAig,index : integer;
resultatET,resultatOU: boolean;
s : string;
begin
i:=index_feu(adresse);
if i=0 then
begin
Affiche('Erreur 602 - feu '+IntToSTR(adresse)+' non trouvé',clred);
if NivDebug=3 then AfficheDebug('Erreur 602 - feu '+IntToSTR(adresse)+' non trouvé',clred);
cond_carre:=true;
exit;
end;
NCondCarre:=Length(feux[i].condcarre[1]);
l:=1;
resultatOU:=false;
while NcondCarre<>0 do
begin
if Ncondcarre<>0 then dec(Ncondcarre);
resultatET:=true;
for k:=1 to NcondCarre do
begin
//s2:=s2+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig+' ';
AdrAig:=feux[i].condcarre[l][k].Adresse;
index:=index_aig(adrAig);
if index<>0 then
begin
if nivDebug=3 then AfficheDebug('Contrôle aiguillage '+IntToSTR(AdrAig),clyellow);
resultatET:=((aiguillage[index].position=const_devie) and (feux[i].condcarre[l][k].PosAig='S') or (aiguillage[index].position=const_droit) and (feux[i].condcarre[l][k].PosAig='D'))
and resultatET;
end;
end;
//if resultatET then Affiche('VRAI',clyellow) else affiche('FAUX',clred);
inc(l);
resultatOU:=resultatOU or resultatET;
NCondCarre:=Length(feux[i].condcarre[l]);
end;
//if resultatOU then Affiche('VRAI final',clyellow) else affiche('FAUX final',clred);
if NivDebug=3 then
begin
s:='Conditions supp. de carré suivant aiguillages: ';
if ResultatOU then s:=s+'vrai : le signal doit afficher carré' else s:=s+'faux : le signal ne doit pas afficher de carré';
AfficheDebug(s,clyellow);
end;
cond_carre:=ResultatOU;
end;
// renvoie vrai si le signal adresse doit afficher un carré car les aiguillages au dela du signal sont mal positionnés
// TrainReserve : adresse du train qui demande la fonction
// Si reserveTrainTiers=vrai, le parcours est réservé par un autre train
function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean) : boolean;
var
i,j,k,prec,indexFeu,AdrSuiv,index2,voie,AdrFeu,adrtrain : integer;
TypeELPrec,TypeElActuel : TEquipement;
multi, sort : boolean;
s : string;
begin
AdrTrain:=0;
ReserveTrainTiers:=false;
if (NivDebug>=1) then AfficheDebug('Test si signal '+IntToSTR(adresse)+' doit afficher un carré si aiguillage avals mal positionnés',clyellow);
i:=Index_feu(adresse);
if i=0 then
begin
Affiche('Erreur 603 - signal '+IntToSTR(adresse)+' non trouvé',clred);
if NivDebug=3 then AfficheDebug('Erreur 603 - feu '+IntToSTR(adresse)+' non trouvé',clred);
carre_signal:=true;
exit;
end;
j:=0;
prec:=feux[i].Adr_det1;
TypeElPrec:=Det;
actuel:=feux[i].Adr_el_suiv1;
if feux[i].Btype_suiv1=det then TypeElActuel:=det; // le type du feu 1=détécteur 2=aig 5=bis
if feux[i].Btype_suiv1=aig then TypeElActuel:=aig;
multi:=feux[i].Adr_det2<>0;
// trouver si une des voies présente un train
if (multi) then
begin
reserveTrainTiers:=false;
carre_signal:=false; // pour l'instant verrouillé en mode pas de carré
exit;
end;
if debug=3 then formprinc.Caption:='carre_signal '+intToSTR(adresse);
if (typeElActuel=Aig) or (typeElActuel=Crois) then
begin
// adresse
k:=index_aig(actuel);
if aiguillage[k].AdrTrain<>0 then
begin
AdrTrain:=aiguillage[k].AdrTrain;
if AdrTrain<>0 then
begin
reserveTrainTiers:=reserveTrainTiers or (adrTrain<>TrainReserve);
if (nivdebug>=1) then AfficheDebug('Aiguillage '+intToSTR(aiguillage[k].adresse)+' verrouillé par train @'+intToSTR(AdrTrain),clorange);
end;
end;
end;
//Affiche(IntToSTR(actuel),clyellow);
repeat
inc(j);
AdrSuiv:=suivant_alg3(prec,typeElPrec,actuel,typeELActuel,2); // arret sur aiguille en talon mal positionéne
if (AdrSuiv=9999) or (AdrSuiv=9996) or (AdrSuiv=9995) then // élément non trouvé ou position aiguillage inconnu ou buttoir
begin;
carre_signal:=true;
if debug=3 then formprinc.Caption:='';
exit;
end;
if (AdrSuiv<>9998) then // arret sur aiguillage en talon mal positionnée
begin
prec:=actuel;
TypeElPrec:=TypeElActuel;
actuel:=AdrSuiv;
TypeElActuel:=typeGen;
end;
// si le précédent est un détecteur comporte t-il un signal?
indexFeu:=0;
if (typeElPrec=det) then
begin
//indexFeu:=index_feu_det(AdrSuiv,voie,index2); // trouve l'index du feu correspondant au détecteur AdrSuiv
indexFeu:=index_feu_det(prec,voie,index2); // trouve l'index du feu correspondant au détecteur AdrSuiv
if indexFeu<>0 then
begin
AdrFeu:=feux[indexFeu].adresse;
if nivdebug=3 then s:='Trouvé signal '+intToSTR(AdrFeu);
if ((voie=1) and (Feux[indexFeu].Adr_el_suiv1=AdrSuiv)) or
((voie=2) and (Feux[indexFeu].Adr_el_suiv2=AdrSuiv)) or
((voie=3) and (Feux[indexFeu].Adr_el_suiv3=AdrSuiv)) or
((voie=4) and (Feux[indexFeu].Adr_el_suiv4=AdrSuiv))
then // le feu est-il dans le bon sens de progression?
begin
if nivdebug=3 then begin s:=s+' dans le bon sens';AfficheDebug(s,clYellow);end;
end
else
begin
if nivdebug=3 then
begin
s:=s+' dans le mauvais sens';
AfficheDebug(s,clYellow);
end;
indexFeu:=0;
// 2eme feu?
if index2<>0 then
begin
// vérifier le 2eme feu
AdrFeu:=Feux[index2].Adresse;
if (adrFeu=Adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
IndexFeu:=0;j:=10; // on ne trouve pas de suivant
end;
//AdrSuivProv:=suivant_alg3(prec,typeElPrec,actuel,typeELActuel,2);
if (Feux[index2].Adr_el_suiv1=AdrSuiv) then // le feu est-il dans le bon sens de progression?
begin
// oui
if NivDebug=3 then AfficheDebug('Sur même détecteur, trouvé feu2 suivant Adr='+IntToSTR(AdrFeu)+': ',clYellow);
indexFeu:=index2;
end
else
begin
if NivDebug=3 then AfficheDebug('Sur même détecteur, trouvé feu2 '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clYellow);
IndexFeu:=0;
end;
end;
end;
end;
//Affiche(IntToSTR(AdrFeu),clOrange);
end;
// si le suivant est un aiguillage
if (typeElActuel=Aig) or (typeElActuel=Crois) then
begin
// adresse
k:=index_aig(actuel);
if aiguillage[k].AdrTrain<>0 then
begin
AdrTrain:=aiguillage[k].AdrTrain;
if adrTrain<>0 then
begin
reserveTrainTiers:=reserveTrainTiers or (AdrTrain<>Trainreserve);
if (nivdebug>=1) then AfficheDebug('Aiguillage '+intToSTR(aiguillage[k].adresse)+' verrouillé par train @'+intToSTR(AdrTrain),clorange);
end;
end;
end;
sort:=(j=10) or (indexFeu<>0) or (AdrSuiv=9998) or (AdrSuiv=0); // arret si aiguillage en talon ou buttoir
until (sort);
// si trouvé un feu ou j=10, les aiguillages sont bien positionnés
// si trouvé 9998, aiguillages mal positionnés
if (NivDebug>=1) then
begin
if (AdrSuiv=9998) then AfficheDebug('Le signal '+intToSTR(adresse)+' doit afficher un carré car l''aiguillage pris en talon '+IntToSTR(actuel)+' est mal positionné',clYellow);
if AdrTrain<>0 then afficheDebug('Un aiguillage est réservé par le train '+intToSTR(AdrTrain),clyellow);
if (AdrSuiv<>9998) and (AdrTrain=0) then AfficheDebug('Le signal '+intToSTR(adresse)+' ne doit pas afficher de carré',clyellow);
end;
carre_signal:=AdrSuiv=9998;
if debug=3 then formprinc.Caption:='';
end;
// renvoie l'adresse du signal suivant à partir du détecteur det1 (non compris) et dans le sens det1 vers det2.
// Si renvoie 0, pas trouvé le signal suivant.
function signal_suivant_det(det1,det2 : integer) : integer;
var num_feu,AdrFeu,i,j,prec,AdrSuiv,index2,voie : integer;
Typ,TypePrec,TypeActuel : TEquipement;
s : string;
begin
//traceDet:=true;
if NivDebug>=2 then AfficheDebug('Cherche Signal suivant détecteur '+IntToSTR(det1),clyellow);
// trouve l'élément suivant contigu
det_contigu(det2,det1,i,Typ);
if i=0 then
begin
affiche('Erreur 65 : Signal_suivant_det('+intToSTR(det1)+','+intToSTR(det2)+') ne sont pas liés ',clred);
signal_suivant_det:=0;
exit;
end;
// si det1 et det2 sont contigus, i=det1
// sinon i contient l'adresse de l'aiguillage avant det2
if debug=3 then formprinc.Caption:='signal_suivant_det '+intToSTR(det1)+' '+inttostr(det2);
j:=0;
prec:=det1; // détecteur sur le courant
TypePrec:=det;
if prec=0 then
begin
Affiche('Msg 601 - feu '+intToSTR(prec)+' détecteur non renseigné ',clOrange);
if NivDebug=3 then AfficheDebug('Msg 602 - détecteur '+intToSTR(prec)+' non renseigné ',clOrange);
signal_suivant_det:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
actuel:=i;
typeActuel:=typ;
if nivDebug=3 then AfficheDebug('Actuel ='+IntToSTR(actuel),clyellow);
repeat
inc(j);
if nivDebug=3 then AfficheDebug('Itération '+IntToSTR(j),clyellow);
// à la première itération, si "actuel" est déja un détecteur, ne pas faire de recherche sur le suivant
if (j=1) and (TypeActuel=det) then
begin
AdrSuiv:=actuel;
end
else
begin
//if nivDebug=3 then AfficheDebug('Engagement j='+IntToSTR(j)+' '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow);
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1); // arret sur élément suivant
if Nivdebug=3 then AfficheDebug('Suivant='+intToSTR(AdrSuiv),clyellow);
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
if (AdrSuiv=9999) or (AdrSuiv=9996) then
begin
signal_suivant_det:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
if (AdrSuiv=0) then
begin
if NivDebug=3 then AfficheDebug(intToSTR(j)+' Le suivant est un buttoir',clyellow);
signal_suivant_det:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
end;
// si le suivant est un détecteur comporte t-il un signal?
AdrFeu:=0;
if (TypeActuel=det) then // détecteur?
begin
i:=Index_feu_det(Actuel,voie,index2); // trouve l'index de feu affecté au détecteur "Actuel"
if i<>0 then
begin
AdrFeu:=Feux[i].Adresse;
if (adrFeu=det1) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0;j:=10; // on ne trouve pas de suivant
end;
if (AdrFeu<>0) then // si l'adresse est <>0
begin
//nivDebug:=3;
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1);
//nivDebug:=0;
if nivdebug=3 then afficheDebug('Trouvé Feu='+IntToSTR(AdrFeu)+'sur det '+intToSTR(actuel)+' Suivant='+IntToSTR(AdrSuiv)+' sur voie='+IntToSTR(voie),clyellow );
//if NivDebug=3 then AfficheDebug('Suiv='+intToSTR(AdrSuiv),clyellow);
if ((voie=1) and (Feux[i].Adr_el_suiv1=AdrSuiv)) or
((voie=2) and (Feux[i].Adr_el_suiv2=AdrSuiv)) or
((voie=3) and (Feux[i].Adr_el_suiv3=AdrSuiv)) or
((voie=4) and (Feux[i].Adr_el_suiv4=AdrSuiv))
then // le feu est-il dans le bon sens de progression?
begin
// oui
signal_suivant_det:=AdrFeu;
if NivDebug=3 then
begin
s:='Trouvé feu suivant Adr='+IntToSTR(AdrFeu);
AfficheDebug(s,clorange);
end;
end
else
begin
if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clOrange);
AdrFeu:=0;
if index2<>0 then
begin
// vérifier le 2eme feu
AdrFeu:=Feux[index2].Adresse;
if (adrFeu=det1) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0;j:=10; // on ne trouve pas de suivant
end;
if (Feux[index2].Adr_el_suiv1=AdrSuiv) then // le feu est-il dans le bon sens de progression?
begin
// oui
inc(num_feu);
signal_suivant_det:=AdrFeu;
if NivDebug=3 then
begin
s:=IntToSTR(AdrFeu);
AfficheDebug('Sur même détecteur, trouvé feu2 suivant Adr='+s,clorange);
end;
end
else
begin
if NivDebug=3 then AfficheDebug('Sur même détecteur, trouvé feu2 '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clOrange);
AdrFeu:=0;
end;
end;
// AdrFeu:=0;
end;
end
end
else if nivDebug=3 then AfficheDebug('Pas de feu pour le det '+IntToSTR(AdrSuiv),clyellow);
end;
until (j=10) or (AdrFeu<>0);
signal_suivant_det:=Adrfeu;
{
if (AdrFeu<>0) and traceListe then
begin
AfficheDebug('Elements verrouillés trouvés sur le cantons',clyellow);
for i:=1 to idEl-1 do
begin
Affiche_Suivi(intToSTR(elements[i].adresse)+' ',clyellow);
end;
end;
}
if debug=3 then formprinc.Caption:='';
if (NivDebug=3) and (adrFeu=0) then AfficheDebug('Pas Trouvé de feu suivant au feu Adr='+IntToSTR(det1),clOrange);
end;
// renvoie l'état du signal suivant. Si renvoie 0, pas trouvé le signal suivant.
// adresse : adresse du feu
// rang=1 pour feu suivant, 2 pour feu suivant le 1, etc
// retour dans AdrSignalsuivant : adresse du feu suivant
// stocke les éléments trouvés dans Elements
function etat_signal_suivant(Adresse,rang : integer;var AdrSignalsuivant : integer) : integer;
var num_feu,etat,AdrFeu,i,j,prec,AdrSuiv,index2,voie : integer;
aspect,combine : integer;
TypePrec,TypeActuel : TEquipement;
s : string;
begin
if NivDebug>=2 then AfficheDebug('Cherche état du signal suivant au '+IntToSTR(adresse),clyellow);
i:=Index_feu(adresse);
if i=0 then
begin
if NivDebug>=2 then AfficheDebug('Feu '+IntToSTR(adresse)+' non trouvé',clyellow);
etat_signal_suivant:=0;
exit;
end;
if feux[i].aspect>10 then
begin
s:='La demande de l''état du signal suivant depuis un feu directionnel '+IntToSTR(Adresse)+' est irrecevable';
Affiche(s,clred);
AfficheDebug(s,clred);
etat_signal_suivant:=0;
exit;
end;
if i=0 then
begin
Affiche('Erreur 600 - feu '+IntToSTR(adresse)+' non trouvé',clred);
if NivDebug=3 then AfficheDebug('Erreur 600 - feu '+IntToSTR(adresse)+' non trouvé',clred);
etat_signal_suivant:=0;
AdrSignalsuivant:=0;
exit;
end;
Etat:=0;
j:=0;
num_feu:=0;
prec:=Feux[i].Adr_det1; // détecteur sur le courant
TypePrec:=det;
if prec=0 then
begin
Affiche('Msg 601 - feu '+intToSTR(adresse)+' détecteur non renseigné ',clOrange);
if NivDebug=3 then AfficheDebug('Msg 601 - feu '+intToSTR(adresse)+' détecteur non renseigné ',clOrange);
etat_signal_suivant:=0;
AdrSignalsuivant:=0;
exit;
end;
if debug=3 then formprinc.Caption:='Etat_signal_suivant '+intToSTR(adresse);
actuel:=feux[i].Adr_el_suiv1;
typeActuel:=feux[i].Btype_suiv1;
elements[1].adresse:=actuel;elements[1].typ:=typeActuel;
idEl:=2;
if nivDebug=3 then AfficheDebug('Actuel ='+IntToSTR(actuel),clyellow);
repeat
inc(j);
if nivDebug=3 then AfficheDebug('Itération '+IntToSTR(j),clyellow);
// à la première itération, si "actuel" est déja un détecteur, ne pas faire de recherche sur le suivant
if (j=1) and (TypeActuel=det) then
begin
AdrSuiv:=actuel;
end
else
begin
//if nivDebug=3 then AfficheDebug('Engagement j='+IntToSTR(j)+' '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow);
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1);
if Nivdebug=3 then AfficheDebug('Suivant='+intToSTR(AdrSuiv),clyellow);
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
if idEl<20 then
begin
elements[idEl].adresse:=actuel;elements[IdEl].typ:=typeActuel;
inc(idEl);
end;
if (AdrSuiv=9999) or (AdrSuiv=9996) then
begin
Etat_signal_suivant:=0;
AdrSignalsuivant:=0;
exit;
end;
if (AdrSuiv=0) then
begin
if NivDebug=3 then AfficheDebug(intToSTR(j)+' Le suivant est un buttoir',clyellow);
Etat_signal_suivant:=carre_F; // faire comme si c'était un signal au carré
AdrSignalsuivant:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
end;
// si le suivant est un détecteur comporte t-il un signal?
AdrFeu:=0;
if (TypeActuel=det) then // détecteur?
begin
i:=Index_feu_det(Actuel,voie,index2); // trouve l'index de feu affecté au détecteur "Actuel"
if i<>0 then
begin
AdrFeu:=Feux[i].Adresse;
if (adrFeu=Adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0;j:=10; // on ne trouve pas de suivant
end;
if (AdrFeu<>0) then // si l'adresse est <>0
begin
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1);
if nivdebug=3 then afficheDebug('Trouvé Feu='+IntToSTR(AdrFeu)+'sur det '+intToSTR(actuel)+' Suivant='+IntToSTR(AdrSuiv)+' sur voie='+IntToSTR(voie),clyellow );
//if NivDebug=3 then AfficheDebug('Suiv='+intToSTR(AdrSuiv),clyellow);
if ((voie=1) and (Feux[i].Adr_el_suiv1=AdrSuiv)) or
((voie=2) and (Feux[i].Adr_el_suiv2=AdrSuiv)) or
((voie=3) and (Feux[i].Adr_el_suiv3=AdrSuiv)) or
((voie=4) and (Feux[i].Adr_el_suiv4=AdrSuiv))
then // le feu est-il dans le bon sens de progression?
begin
// oui
inc(num_feu);
Etat:=feux[index_feu(AdrFeu)].EtatSignal;
code_to_aspect(Etat,aspect,combine);
Signal_suivant:=AdrFeu;
if NivDebug=3 then
begin
s:='Trouvé feu suivant Adr='+IntToSTR(AdrFeu)+': '+IntToSTR(etat)+'=';
if aspect<>-1 then s:=s+EtatSign[aspect]+' ';
if combine<>-1 then s:=s+EtatSign[combine];
AfficheDebug(s,clorange);
end;
end
else
begin
if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clOrange);
AdrFeu:=0;
if index2<>0 then
begin
// vérifier le 2eme feu
AdrFeu:=Feux[index2].Adresse;
if (adrFeu=Adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0;j:=10; // on ne trouve pas de suivant
end;
if (Feux[index2].Adr_el_suiv1=AdrSuiv) then // le feu est-il dans le bon sens de progression?
begin
// oui
inc(num_feu);
Etat:=feux[index_feu(AdrFeu)].EtatSignal;
code_to_aspect(Etat,aspect,combine);
Signal_suivant:=AdrFeu;
if NivDebug=3 then
begin
s:=IntToSTR(AdrFeu)+': '+IntToSTR(etat)+'=';
if aspect<>-1 then s:=s+EtatSign[aspect]+' ';
if combine<>-1 then s:=s+EtatSign[combine];
AfficheDebug('Sur même détecteur, trouvé feu2 suivant Adr='+s,clorange);
end;
end
else
begin
if NivDebug=3 then AfficheDebug('Sur même détecteur, trouvé feu2 '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clOrange);
AdrFeu:=0;
end;
end;
// AdrFeu:=0;
end;
end
end
else if nivDebug=3 then AfficheDebug('Pas de feu pour le det '+IntToSTR(AdrSuiv),clyellow);
end;
until (j=10) or ((AdrFeu<>0) and (num_feu=rang));
if etat=0 then Signal_Suivant:=0;
etat_signal_suivant:=Etat;
AdrSignalsuivant:=Signal_suivant;
if (NivDebug=3) and (adrFeu=0) then AfficheDebug('Pas Trouvé de feu suivant au feu Adr='+IntToSTR(ADresse),clOrange);
exit;
end;
// renvoie l'adresse de l'aiguille si elle est déviée après le signal et ce jusqu'au prochain signal
// sinon renvoie 0
// adresse=adresse du signal
function Aiguille_deviee(adresse : integer) : integer ;
var AdrFeu,i,j,prec,AdrSuiv,Actuel,index,index2,voie : integer;
TypePrec,TypeActuel : TEquipement;
s : string;
begin
if NivDebug>=2 then AfficheDebug('Test si aiguille déviée après signal '+IntToSTR(Adresse),clyellow);
j:=0;
i:=Index_feu(adresse);
if i=0 then
begin
Affiche('Erreur 168: signal '+intToSTR(adresse)+' non trouvé',clred);
Aiguille_deviee:=0;
exit;
end;
prec:=feux[i].Adr_det1;
TypePrec:=det;
actuel:=feux[i].Adr_el_suiv1;
TypeActuel:=feux[i].Btype_suiv1 ;
AdrFeu:=0;
AdrDevie:=0;
if (TypeActuel=aig) then // aiguillage
begin
index:=index_aig(actuel);
if (aiguillage[index].Apointe=prec) and (aiguillage[index].position<>const_droit) then Aiguille_deviee:=actuel;
end;
repeat
inc(j);
// le 8=demande si le suivant est un aiguillage en pointe dévié oui si AdrSuiv=9997
// dans ce cas la variable globale AdrDevie est mise à jour
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,8); //
if NivDebug=3 then AfficheDebug('701 - Suivant signalaig='+IntToSTR(AdrSuiv),clyellow);
if (AdrSuiv<>9997) and (AdrSuiv<>0) then
begin
// pas trouvé aig dévié
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
// si le suivant est un détecteur comporte t-il un signal?
AdrFeu:=0;
if (TypeActuel=det) then // détecteur
begin
i:=Index_feu_det(AdrSuiv,voie,index2); // trouve l'index de feu affecté au détecteur "AdrSuiv"
AdrFeu:=Feux[i].Adresse;
if NivDebug=3 then AfficheDebug('trouvé signal '+intToSTR(AdrFeu)+' associé au détecteur '+IntToSTR(AdrSuiv),clyellow);
end;
end;
until (j=10) or (AdrSuiv>=9990) or (AdrFeu<>0) or (AdrSuiv=0) ;
if (AdrSuiv=9997) then
begin
s:='le signal '+intToSTR(adresse)+' doit afficher un rappel car l''aiguillage '+intToSTR(AdrDevie);
s:=s+' est dévié';
if NivDebug=3 then AfficheDebug(s,clYellow);
end;
if ((AdrSuiv<>9997) or (j=10)) and (NivDebug=3) then
begin
S:='le signal '+intToSTR(adresse)+' ne doit pas afficher de rappel car ';
if j<>10 then s:=s+'trouvé un autre signal suivant et pas d''aiguillage dévié'
else s:=s+' signal trop éloigné';
AfficheDebug(s,clYellow);
end;
Aiguille_deviee:=AdrDevie;
end;
procedure pilote_direction(Adr,nbre : integer);
var i,j : integer;
begin
i:=index_feu(Adr);
j:=feux[i].decodeur;
case j of
// 0 : envoi_directionvirtuel(Adr,nbre);
1 : envoi_DirectionBahn(Adr,nbre);
2 : envoi_DirectionCDF(Adr,nbre);
//3 : envoi_DirectionLDT(Adr,nbre);
4 : envoi_DirectionLEB(Adr,nbre);
end;
end;
// allume le signal directionnel d'adresse ADR en fonction de la position des aiguillages déclarés pour ce feu
procedure Signal_direction(Adr : integer);
var NAig,i,id,j,NfeuxDir,AdrAigFeu,Position : integer;
PosAigFeu : char;
Positionok : boolean;
begin
id:=Index_feu(Adr);
NfeuxDir:=feux[id].aspect-10;
i:=1; // i=1 position éteinte du feu ; pour les autres valeurs de i : nombre de feux allumés
repeat
NAig:=length(feux[id].AigDirection[i])-1;
if i=1 then positionok:=false else positionok:=true;
for j:=1 to Naig do
begin
// vérifier la position déclarée des aiguillages pour chaque feu
AdrAigFeu:=feux[id].AigDirection[i][j].Adresse;
PosAigFeu:=feux[id].AigDirection[i][j].posAig;
position:=aiguillage[index_aig(AdrAigFeu)].position;
//
if i=1 then positionok:=((position=const_droit) and (posAigFeu='D')) or ((position<>const_droit) and (posAigFeu='S')) or positionok;
if i>1 then positionok:=((position=const_droit) and (posAigFeu='D')) or ((position<>const_droit) and (posAigFeu='S')) and positionok;
end;
inc(i);
until (i>NFeuxDir+1) or positionok;
if positionok then
begin
dec(i,2); // i correspond au nombre de feux à allumer
pilote_direction(Adr,i);
end;
end;
// renvoie vrai si une mémoire de zone est occupée après le signal courant au signal suivant
// sort de suite si on trouve un train
// adresse=adresse du signal
function test_memoire_zones(adresse : integer) : boolean;
var
AdrSuiv,prec,ife,actuel,i,j,it,
dernierdet,AdrFeu,Nfeux,NFeuxMax,voie,index2 : integer;
TypePrec,TypeActuel : TEquipement;
Pres_train : boolean;
s : string;
begin
if NivDebug>=1 then AfficheDebug('Proc test_memoire_zones('+intToSTR(adresse)+')',clyellow);
i:=Index_feu(adresse);
if (i=0) then
begin
s:='Erreur 605 - Signal '+IntToSTR(adresse)+' non trouvé';
Affiche(s,clred);
AfficheDebug(s,clred);
test_memoire_zones:=false;
exit;
end;
if debug=3 then formprinc.Caption:='Test_memoire_zones '+IntToSTR(adresse);
Nfeux:=0;
NFeuxMax:=1; // nombre de feux à trouver (nombre de cantons)
ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu
repeat
j:=0;
if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange);
if (ife=1) then
begin
prec:=feux[i].Adr_det1;
Actuel:=feux[i].Adr_el_suiv1;
TypeActuel:=feux[i].Btype_suiv1;
end; //détecteur sur le signal courant
if (ife=2) then
begin
prec:=feux[i].Adr_det2;
Actuel:=feux[i].Adr_el_suiv2;
TypeActuel:=feux[i].Btype_suiv2;
end; // détecteur sur le signal courant
if (ife=3) then
begin
prec:=feux[i].Adr_det3;
Actuel:=feux[i].Adr_el_suiv3;
TypeActuel:=feux[i].Btype_suiv3;
end; // détecteur sur le signal courant
if (ife=4) then
begin
prec:=feux[i].Adr_det4;
Actuel:=feux[i].Adr_el_suiv4;
TypeActuel:=feux[i].Btype_suiv4;
end; // détecteur sur le signal courant
if prec=0 then
begin
// sortie si aucun détecteur déclaré sur le feu
test_memoire_zones:=Pres_train;
if debug=3 then formprinc.Caption:='';
exit;
end;
Pres_train:=false;
TypePrec:=det;
dernierdet:=prec;
// purge les aiguillages après le feu
it:=0;
if TypeActuel=aig then
repeat
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1);
if (AdrSuiv>9900) or (AdrSuiv=0) then
begin
test_memoire_zones:=Pres_train;
if debug=3 then formprinc.Caption:='';
exit;
end;
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
inc(it);
until (typeactuel=det) or (it>100);
if it>100 then
begin
Affiche('Erreur 750 : trop d''itérations',clred);
AfficheDebug('Erreur 750 : trop d''itérations',clred);
test_memoire_zones:=false;
end;
repeat
inc(j);
if (typeactuel=det) and (dernierdet<>0) then
begin
Pres_train:=MemZone[dernierdet,actuel].etat or detecteur[actuel].etat or Pres_Train;
if (nivDebug=3) then
begin
if Pres_Train then AfficheDebug('Présence train de '+intToSTR(dernierdet)+' à '+intToSTR(actuel),clyellow)
else AfficheDebug('Absence train de '+intToSTR(dernierdet)+' à '+intToSTR(actuel),clyellow)
end;
Pres_train:=MemZone[actuel,dernierdet].etat or Pres_Train;
if (nivDebug=3) then
begin
if Pres_Train then AfficheDebug('Présence train inverse de '+intToSTR(actuel)+' à '+intToSTR(dernierdet),clyellow)
else AfficheDebug('Absence train de '+intToSTR(actuel)+' à '+intToSTR(dernierdet),clyellow)
end;
// sortir de suite
if Pres_train then
begin
test_memoire_zones:=Pres_train;
if debug=3 then formprinc.Caption:='';
exit;
end;
dernierdet:=actuel;
i:=index_feu_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal
if i<>0 then
begin
AdrFeu:=feux[i].adresse; // adresse du feu
if (AdrFeu=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0;j:=10; // on ne trouve pas de suivant
test_memoire_zones:=false;
if debug=3 then formprinc.Caption:='';
exit;
end;
if (AdrFeu<>0) then // si l'adresse est <>0
begin
if (feux[i].Adr_el_suiv1<>prec) then // le feu est-il dans le bon sens de progression?
begin
inc(Nfeux);
j:=0;
s:='Trouvé feu ('+IntToSTR(nfeux)+'/'+intToSTR(NFeuxMax)+') '+IntToSTR(AdrFeu);
if (NivDebug>0) And Pres_Train then AfficheDebug(s+' et mémoire de zone à 1',clyellow);
if (NivDebug>0) And (not(Pres_Train)) then AfficheDebug(s+' et mémoire de zone à 0',clOrange);
if nFeux=NFeuxMax then
begin
test_memoire_zones:=Pres_train;
if debug=3 then formprinc.Caption:='';
exit;
end;
end
else
begin
if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clYellow);
AdrFeu:=0;
end;
end;
end;
end;
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1);
if (AdrSuiv=0) or (AdrSuiv>9990) then
begin
test_memoire_zones:=Pres_train;
if debug=3 then formprinc.Caption:='';
exit;
end;
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
until (j=10); // on arrete si on va trop loin (10 itérations)
inc(ife);
until ife>=5;
if (NivDebug>0) then AfficheDebug('Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow);
if debug=3 then formprinc.Caption:='';
test_memoire_zones:=Pres_train;
end;
Procedure affiche_Event_det;
var i : integer;
begin
with FormDebug.MemoEvtDet do
begin
//lines.clear;
lines.add('-------------');
for i:=1 to N_event_det do
begin
lines.add(intToSTR(event_det[i].adresse));
if traceListe then AfficheDebug(intToSTR(event_det[i].adresse),clyellow);
end;
end;
end;
// supprime un évènement détecteur dans la liste Event_det[]
procedure supprime_event(i : integer);
var l : integer;
begin
for l:=i to N_Event_det do event_det[l]:=event_det[l+1];
dec(N_event_det);
end;
// trouve adresse d'un détecteur à "etat" avant "index" dans le tableau chrono
function trouve_index_det_chrono(Adr,etat,index : integer) : integer;
var i : integer;
trouve : boolean;
begin
if index<=0 then
begin
affiche('Erreur 784 index détecteur invalide',clred);
AfficheDebug('Erreur 784 index détecteur invalide',clred);
trouve_index_det_chrono:=0;
exit;
end;
i:=index;
if i>N_Event_tick then begin trouve_index_det_chrono:=0;exit; end;
inc(i);
repeat
dec(i);
trouve:=(event_det_tick[i].etat=etat) and (event_det_tick[i].Adresse=Adr) and (event_det_tick[i].modele=det);
until (trouve or (i=0));
if trouve then
begin
trouve_index_det_chrono:=i;exit;
end;
trouve_index_det_chrono:=0;
end;
{
// inutilisé
// teste si la route est valide de det1, det2 à det3
// les détecteurs doivent être consécutifs
// trouve le détecteur suivant de det1 à det2 si la route est correcte. (détecteurs en entrée obligatoires)
// transmis dans le tableau Event_det
// Résultat:
// si 9999 : pas de route
// si 10 : ok route trouvée
function test_route_valide(det1,det2,det3 : integer; var previsionnel : integer) : integer;
var det_suiv : integer;
begin
if TraceListe then AfficheDebug('test route valide '+IntToSTR(det1)+' '+IntToSTR(det2)+' vers '+IntToSTR(det3)+' ',clyellow);
det_suiv:=detecteur_suivant_el(det1,det,det2,det,1);
previsionnel:=detecteur_suivant_el(det2,det,det_suiv,det,1);
if det_suiv=det3 then begin test_route_valide:=10;exit;end;
test_route_valide:=9999;
exit;
end;
}
// renvoie l'adresse du signal précédent au signal "adresse"
function Signal_precedent(adresse : integer) : integer;
var
AdrSuiv,prec,ife,actuel,i,j,ifd,
dernierdet,AdrFeu,Nfeux,voie,index2 : integer;
TypePrec,TypeActuel : TEquipement;
malpositionne : boolean;
s : string;
begin
if debug=3 then formprinc.Caption:='Signal_precedent '+IntToSTR(adresse);
if NivDebug>=1 then AfficheDebug('Proc Signal_Precedent'+intToSTR(adresse)+')',clyellow);
i:=Index_feu(adresse);
if (i=0) then
begin
s:='Erreur 605 - Signal '+IntToSTR(adresse)+' non trouvé';
AfficheDebug(s,clred);
Affiche(s,clred);
Signal_precedent:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
idEl:=1;
Nfeux:=0;
ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu
repeat
j:=0;
if NivDebug=3 then AfficheDebug('Boucle de test signal voie '+intToSTR(ife)+'/4',clOrange);
if (ife=1) then
begin
actuel:=feux[i].Adr_det1;
prec:=feux[i].Adr_el_suiv1;
Typeprec:=feux[i].Btype_suiv1;
end; //détecteur sur le signal courant
if (ife=2) then
begin
actuel:=feux[i].Adr_det2;
prec:=feux[i].Adr_el_suiv2;
Typeprec:=feux[i].Btype_suiv2;
end; // détecteur sur le signal courant
if (ife=3) then
begin
actuel:=feux[i].Adr_det3;
prec:=feux[i].Adr_el_suiv3;
Typeprec:=feux[i].Btype_suiv3;
end; // détecteur sur le signal courant
if (ife=4) then
begin
actuel:=feux[i].Adr_det4;
prec:=feux[i].Adr_el_suiv4;
Typeprec:=feux[i].Btype_suiv4;
end; // détecteur sur le signal courant
TypeActuel:=det;
if actuel=0 then
begin
// sortie si aucun détecteur déclaré sur le feu
Signal_precedent:=0;
if nivDebug=3 then AfficheDebug('Pas de voie '+intToSTR(ife),clyellow);
if debug=3 then formprinc.Caption:='';
exit;
end;
dernierdet:=actuel;
repeat
inc(j);
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1);
malpositionne:=(AdrSuiv=0) or (AdrSuiv>9990);
if malpositionne then
begin
if (nivDebug=3) then
begin
if (AdrSuiv>9990) then AfficheDebug('Erreur 41: Alg3='+intToSTR(AdrSuiv)+' Anomalie',clYellow);
if AdrSuiv=0 then AfficheDebug('Buttoir',clyellow);
end;
if debug=3 then formprinc.Caption:='';
Signal_precedent:=0;
exit;
end;
if not(malpositionne) then
begin
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
if idEl<20 then
begin
elements[idEl].adresse:=actuel;elements[idEl].typ:=typeActuel;
inc(idEl);
end;
if typeactuel=det then
begin
dernierdet:=actuel;
ifd:=index_feu_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal
if ifd<>0 then
begin
AdrFeu:=feux[ifd].adresse; // adresse du feu
if (AdrFeu=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
Signal_precedent:=0;
end;
if (AdrFeu<>0) then // si l'adresse est <>0
begin
if (feux[ifd].Adr_el_suiv1=prec) then // le feu est-il dans le bon sens de progression?
begin
inc(Nfeux);
j:=0;
s:='Trouvé feu '+IntToSTR(AdrFeu);
Signal_precedent:=AdrFeu;
if debug=3 then formprinc.Caption:='';
exit;
end
else
begin
if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clYellow);
AdrFeu:=0;
end;
end;
end;
end;
end;
until (j=10) or malpositionne ; // on arrete jusqu'à trouver un signal ou si on va trop loin (10 itérations)
inc(ife);
until ife>=5;
if (NivDebug>0) then AfficheDebug('607. Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow);
if debug=3 then formprinc.Caption:='';
Signal_precedent:=0;
end;
// présence train précédent les n (NbCtSig) cantons du signal
// renvoie vrai si présence train
// dans AdrTrain:
// renvoie 0 si pas d
// renvoie l'adresse du 1er train rencontré dans AdrTrain ou 0 si elle est indisponible
function PresTrainPrec(Adresse,NbCtSig : integer;var AdrTr : integer) : boolean;
var
AdrSuiv,prec,ife,actuel,i,j,ifd,
dernierdet,AdrFeu,Nfeux,NFeuxMax,voie,index2 : integer;
TypePrec,TypeActuel : TEquipement;
Pres_train,malpositionne,etat : boolean;
s : string;
begin
AdrTr:=0;
if debug=3 then formprinc.Caption:='PresTrainPrec '+IntToSTR(adresse);
if NivDebug>=1 then AfficheDebug('Proc testTrainPrec('+intToSTR(adresse)+')',clyellow);
i:=Index_feu(adresse);
if (i=0) then
begin
AfficheDebug('Erreur 605 - Signal '+IntToSTR(adresse)+' non trouvé',clred);
Affiche('Erreur 605 - Signal '+IntToSTR(adresse)+' non trouvé',clred);
PresTrainPrec:=False;
AdrTr:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
Nfeux:=0;
NFeuxMax:=NbCtSig; // nombre de feux à trouver (nombre de cantons)
ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu
repeat
j:=0;
if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange);
if (ife=1) then
begin
actuel:=feux[i].Adr_det1;
prec:=feux[i].Adr_el_suiv1;
Typeprec:=feux[i].Btype_suiv1;
end; //détecteur sur le signal courant
if (ife=2) then
begin
actuel:=feux[i].Adr_det2;
prec:=feux[i].Adr_el_suiv2;
Typeprec:=feux[i].Btype_suiv2;
end; // détecteur sur le signal courant
if (ife=3) then
begin
actuel:=feux[i].Adr_det3;
prec:=feux[i].Adr_el_suiv3;
Typeprec:=feux[i].Btype_suiv3;
end; // détecteur sur le signal courant
if (ife=4) then
begin
actuel:=feux[i].Adr_det4;
prec:=feux[i].Adr_el_suiv4;
Typeprec:=feux[i].Btype_suiv4;
end; // détecteur sur le signal courant
pres_Train:=Detecteur[actuel].etat;
if pres_train and (AdrTr=0) then AdrTr:=Detecteur[actuel].AdrTrain;
TypeActuel:=det;
if actuel=0 then
begin
// sortie si aucun détecteur déclaré sur le feu
PresTrainPrec:=Pres_train;
if nivDebug=3 then AfficheDebug('Pas de voie '+intToSTR(ife),clyellow);
if debug=3 then formprinc.Caption:='';
exit;
end;
dernierdet:=actuel;
repeat
inc(j);
AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,2); // 2 car arrêt sur aiguille en talon mal positionnée
malpositionne:=(AdrSuiv=0) or (AdrSuiv>9990);
if malpositionne then
begin
if AdrSuiv=0 then
begin
PresTrainPrec:=Pres_Train or (Detecteur[actuel].etat);
if (adrTr=0) then AdrTr:=Detecteur[actuel].AdrTrain;
end;
if (nivDebug=3) then
begin
if (AdrSuiv>9990) then AfficheDebug('Erreur 55: Alg3='+IntToSTR(AdrSuiv)+' Anomalie',clYellow);
if AdrSuiv=0 then AfficheDebug('Buttoir',clyellow);
if Pres_train then
begin
s:='Présence train ';
if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' ';
s:=s+'de '+intToSTR(actuel)+' à '+intToSTR(dernierdet);
AfficheDebug(s,clYellow);
end
else AfficheDebug('Absence train de '+intToSTR(actuel)+' à '+intToSTR(dernierdet),clyellow);
end;
if debug=3 then formprinc.Caption:='';
exit;
end;
if not(malpositionne) then
begin
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
if typeactuel=det then
begin
etat:=Detecteur[actuel].etat;
Pres_train:=MemZone[actuel,dernierdet].etat or Pres_Train or (etat);
PresTrainPrec:=Pres_Train;
if adrTr=0 then AdrTr:=Detecteur[actuel].AdrTrain;
if adrtr=0 then AdrTr:=MemZone[actuel,dernierdet].AdrTrain;
if Pres_Train then
begin
if (nivDebug=3) then
begin
s:='Présence train ';
if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' ';
s:=s+'de '+intToSTR(actuel)+' à '+intToSTR(dernierdet);
AfficheDebug(s,clYellow);
if debug=3 then formprinc.Caption:='';
exit;
end;
end
else begin if nivDebug=3 then AfficheDebug('Absence train de '+intToSTR(actuel)+' à '+intToSTR(dernierdet),clyellow);end;
dernierdet:=actuel;
ifd:=index_feu_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal
if ifd<>0 then
begin
AdrFeu:=feux[ifd].adresse; // adresse du feu
if (AdrFeu=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0; // on ne trouve pas de suivant
PresTrainPrec:=false;
AdrTr:=0;
if debug=3 then formprinc.Caption:='';
exit;
end;
if (AdrFeu<>0) then // si l'adresse est <>0
begin
if (feux[ifd].Adr_el_suiv1=prec) then // le feu est-il dans le bon sens de progression?
begin
inc(Nfeux);
j:=0;
s:='Trouvé feu ('+IntToSTR(nfeux)+'/'+intToSTR(NFeuxMax)+') '+IntToSTR(AdrFeu);
if (NivDebug>0) And Pres_Train then AfficheDebug(s+' et mémoire de zone à 1',clOrange);
if (NivDebug>0) And (not(Pres_Train)) then AfficheDebug(s+' et mémoire de zone à 0',clOrange);
if nFeux=NFeuxMax then
begin
presTrainPrec:=pres_train;
if debug=3 then formprinc.Caption:='';
exit;
end;
end
else
begin
if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clYellow);
AdrFeu:=0;
end;
end;
end;
end;
end;
until (j=10) or malpositionne or (nfeux>=NFeuxMax); // on arrete jusqu'à trouver un signal ou si on va trop loin (10 itérations)
inc(ife);
until ife>=5;
if (NivDebug>0) then AfficheDebug('606. Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow);
if debug=3 then formprinc.Caption:='';
PresTrainPrec:=Pres_Train;
end;
// mise à jour de l'état d'un feu en fonction de son environnement et affiche le feu
procedure Maj_Feu(Adrfeu : integer);
var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,trainreserve,AdrTrainLoc : integer ;
PresTrain,Aff_semaphore,car,reserveTrainTiers : boolean;
code,combine,AdrSignalsuivant : integer;
Btype_el_suivant : TEquipement;
s : string;
begin
if affsignal=false then
begin
if signalDebug=AdrFeu then AffSignal:=true
else affsignal:=false;
end;
if AffSignal then
begin
s:='Traitement du feu '+intToSTR(Adrfeu)+'------------------------------------';
AfficheDebug(s,clOrange);
nivDebug:=3;
end;
index:=index_feu(Adrfeu);
if debug=3 then formprinc.Caption:='Maj_Feu'+intToSTR(AdrFeu);
if (AdrFeu<>0) and (index<>0) then
begin
modele:=Feux[index].aspect;
Adr_det:=Feux[index].Adr_det1; // détecteur sur le signal
Adr_El_Suiv:=Feux[index].Adr_el_suiv1; // adresse élément suivant au feu
Btype_el_suivant:=Feux[index].Btype_suiv1;
// signal directionnel ?
if (modele>10) then
begin
//Affiche('Signal directionnel '+IntToSTR(AdrFeu),clyellow);
Signal_direction(AdrFeu);
if debug=3 then formprinc.Caption:='';
exit;
end;
// signal non directionnel
etat:=etat_signal_suivant(AdrFeu,1,AdrSignalsuivant) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant
if AffSignal then
begin
code_to_aspect(etat,code,combine);
s:='Etat_signal_suivant ('+intToSTR(AdrSignalsuivant)+') est ';
s:=s+' à ';
if code<>-1 then s:=s+etatSign[code];
if (Combine<>0) and (combine<>-1) then s:=s+' + '+etatSign[combine];
AfficheDebug(s,clyellow);
end;
// signal à 2 feux = carré violet+blanc
if (modele=2) then //or (feux[i].check<>nil) then // si carré violet
begin
//AfficheDebug('Feux à 2 feux',CLOrange);
// si aiguillage après signal mal positionnées ou réservé ou pas de train avant le signal
PresTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,AdrTrainLoc);
if carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers) or not(PresTrain) or (feux[index].VerrouilleCarre) then
begin
Maj_Etat_Signal(AdrFeu,violet);
envoi_signal(AdrFeu);
if debug=3 then formprinc.Caption:='';
exit;
end
else
begin
if test_memoire_zones(AdrFeu) then Maj_Etat_Signal(AdrFeu,violet) // test si présence train après signal
else Maj_Etat_Signal(AdrFeu,blanc);
envoi_signal(AdrFeu);
if debug=3 then formprinc.Caption:='';
exit;
end;
end;
//if AffSignal then AfficheDebug('Debut du traitement général',clYellow);
// traitement des feux >3 feux différents de violet (cas général)
if (modele>=3) and (feux[index].EtatSignal<>violet_F) then
begin
PresTrain:=false;
// détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré
//if (Feux[index].VerrouCarre) and (modele>=4) then
presTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,AdrTrainLoc); //etape A // présence train par adresse train
if AffSignal and roulage then AfficheDebug('L''@ du train avant le signal est '+intToSTR(AdrTrainLoc),clYellow);
// si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal
// verrouillable au carré, afficher un carré
car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers); // si reserveTrainTiers, réservé par un autre train
// En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré
if roulage then car:=reserveTrainTiers or car;
// conditions supplémentaires de carré en fonction des aiguillages décrits
car:=cond_carre(AdrFeu) or car;
if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow);
if AffSignal and feux[index].VerrouilleCarre then AfficheDebug('le signal est verrouillé au carré',clYellow);
if (modele>=4) and ( (not(PresTrain) and Feux[index].VerrouCarre) or car or feux[index].VerrouilleCarre ) then Maj_Etat_Signal(AdrFeu,carre)
else
begin
// si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation
// pour ne pas passer au rouge un feu à contresens.
// trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge
if AffSignal then AfficheDebug('test du sémaphore',clYellow);
Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal
if Aff_Semaphore then
begin
if AffSignal then AfficheDebug('Présence train après signal'+intToSTR(AdrFeu)+' -> sémaphore ou carré',clYellow);
if testBit(feux[index].EtatSignal,carre)=FALSE then
begin
if feux[index].checkFR then Maj_Etat_Signal(AdrFeu,semaphore_cli)
else Maj_Etat_Signal(AdrFeu,semaphore);
end;
end
else
begin
Aig:=Aiguille_deviee(Adrfeu);
// si aiguille locale déviée
if (aig<>0) and (feux[index].aspect>=9) then // si le signal peut afficher un rappel et aiguille déviée
begin
indexAig:=Index_aig(aig);
if AffSignal then AfficheDebug('Aiguille '+intToSTR(aig)+' du signal '+intToSTR(AdrFeu)+' déviée',clYellow);
feux[index].EtatSignal:=0;
if (aiguillage[indexAig].vitesse=30) or (aiguillage[indexAig].vitesse=0) then Maj_Etat_Signal(AdrFeu,rappel_30);
if aiguillage[indexAig].vitesse=60 then Maj_Etat_Signal(AdrFeu,rappel_60);
// si signal suivant affiche rappel ou rouge
if (TestBit(etat,rappel_60)) or (testBit(etat,rappel_30)) or (testBit(etat,carre)) or (testBit(etat,semaphore))
then Maj_Etat_Signal(AdrFeu,jaune)
else
begin
// sinon si signal suivant=jaune
if (TestBit(etat,jaune)) then
begin
Maj_Etat_Signal(AdrFeu,jaune_cli);
//if AffSignal then AfficheDebug('400.Mise du feu au jaune cli',clyellow);
end;
end;
end
else
// aiguille locale non déviée ou aspect feu<9
// si le signal suivant est rouge
begin
if AffSignal then AfficheDebug('pas d''aiguille déviée',clYellow);
// effacer la signbalisation combinée
feux[index].EtatSignal:=feux[index].EtatSignal and not($3c00);
if TestBit(etat,carre) or testBit(etat,semaphore) or testBit(etat,semaphore_cli )then
begin
Maj_Etat_Signal(AdrFeu,jaune);
//if AffSignal then AfficheDebug('Mise du Feu à l''avertissement',clyellow);
end
else
begin
if affsignal then AfficheDebug('test 403',clyellow);
// si signal suivant affiche rappel
if TestBit(etat,rappel_30) or TestBit(etat,rappel_60) then
begin
feux[index].EtatSignal:=0;
if TestBit(etat,rappel_30) then
begin
Maj_Etat_Signal(AdrFeu,ral_30);
//if affsignal then AfficheDebug('Mise du feu au ralen 30',clyellow);
end;
if TestBit(etat,rappel_60) then
begin
//if AffSignal then AfficheDebug('Mise du Feu au ralen 60',clyellow);
Maj_Etat_Signal(AdrFeu,ral_60); // si signal suivant est au rappel60, il faut tester s'il est à l'avertissement aussi
if TestBit(etat,jaune) then Maj_Etat_Signal(AdrFeu,jaune_cli);
end;
end
else
begin
// si le signal suivant est jaune
//if affsignal then AfficheDebug('test 404',clyellow);
if TestBit(etat,jaune) then
begin
Maj_Etat_Signal(AdrFeu,jaune_cli);
//if affsignal then AfficheDebug('401.Mise du feu au jaune cli',clyellow);
end
else
begin
// feu vert, vert cli ou blanc
//if affsignal then AfficheDebug('test 405',clyellow);
if feux[index].checkFB<>nil then
begin
//if affsignal then AfficheDebug('test 406',clyellow);
if feux[index].checkFB.Checked then
begin
Maj_Etat_Signal(AdrFeu,blanc);
//if affsignal then AfficheDebug('Mise du feu au blanc',clyellow);
end
else Maj_Etat_Signal(AdrFeu,vert);
end
else
begin
if feux[index].checkFV then Maj_Etat_Signal(AdrFeu,vert_cli)
else Maj_Etat_Signal(AdrFeu,vert);
//if affsignal then AfficheDebug('Mise du feu au vert',clyellow);
end;
end;
end;
end;
end;
end;
end;
end;
end;
envoi_signal(AdrFeu);
if signalDebug=AdrFeu then begin AffSignal:=false;nivDebug:=0;end;
if debug=3 then formprinc.Caption:='';
end;
Procedure Maj_feux;
var i : integer;
begin
//Affiche('MAJ FEUX',clOrange);
if not(maj_feux_cours) then
begin
Maj_feux_cours:=TRUE;
for i:=1 to NbreFeux do
begin
Maj_feu(Feux[i].Adresse);
end;
Maj_feux_cours:=FALSE;
end;
end;
// trouve l'index d'un détecteur dans une branche depuis la fin de la branche
// si pas trouvé, renvoie 0
// non utilisé
function index_detecteur_fin(detecteur,Num_branche : integer) : integer;
var dernier,i,j : integer;
trouve : boolean;
procedure recherche;
begin
repeat
if BrancheN[Num_Branche,i].Btype=det then // cherche un détecteur
begin
j:=BrancheN[Num_Branche,i].adresse;
trouve:=detecteur=j;
end;
if not(trouve) then dec(i);
until trouve or (j=0)
end;
begin
// déterminer la fin de la branche
i:=1;
repeat
inc(i);
until (BrancheN[Num_Branche,i].adresse=0) and (BrancheN[Num_Branche,i].btype=rien);
dernier:=i-1;
// Affiche('dernier'+intToSTR(dernier),clwhite);
// rechercher le détecteur depuis l'index i
i:=dernier;index2_det:=0;
recherche;
if trouve then result:=i else result:=0;
//affiche(inttostr(ai+1),clOrange);
//affiche('------------------------',clWhite);
recherche;
//affiche('------------------------',clGreen);
if trouve then index2_det:=i else index2_det:=0;
//affiche('index2='+IntToSTR(index2_det),clWhite);
end;
// trouve si le détecteur adr est contigu à un buttoir
function buttoir_adjacent(adr : integer) : boolean;
begin
trouve_element(adr,det,1); // branche_trouve IndexBranche_trouve
if Branche_trouve=0 then begin buttoir_adjacent:=false;exit;end;
buttoir_adjacent:=( (BrancheN[branche_trouve,IndexBranche_trouve+1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve+1].BType=buttoir) or
(BrancheN[branche_trouve,IndexBranche_trouve-1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve-1].BType=buttoir) )
end;
// renvoie vrai si le signal adresse est dans le sens det1 det2
function signal_sens(adrSig,det1,det2 : integer) : boolean;
var i,it,suiv,succ,actuel : integer;
typeAct,typSuiv : tEquipement;
begin
if debug=3 then formprinc.Caption:='Signal_sens '+IntToSTR(AdrSig);
it:=0;
i:=index_feu(adrsig);
if i=0 then
begin
result:=false;
if debug=3 then formprinc.Caption:='';
exit;
end;
actuel:=det1;
typeAct:=det;
suiv:=feux[i].Adr_el_suiv1;
typSuiv:=feux[i].Btype_suiv1;
if suiv=det2 then
begin
signal_sens:=true;
if debug=3 then formprinc.Caption:='';
exit;
end;
repeat
//parcourir les éléments jusque detecteur2
// oui, est-il dans le bon sens?
succ:=suivant_alg3(actuel,typeAct,suiv,typSuiv,1);
actuel:=suiv;typeact:=typSuiv;
suiv:=succ;typSuiv:=typeGen;
inc(it);
until (succ=det2) or (it>7);
if debug=3 then formprinc.Caption:='';
signal_sens:=succ=det2;
end;
// libère le canton avant detecteur2 comportant un signal et le signal précédent
// attention le détecteur 2 n'est pas forcément associé à un signal (et dans le bon sens
Procedure libere_canton(detecteur1,detecteur2 : integer);
var sd2,i,j: integer;
typ : tEquipement;
begin
if not(roulage) then exit;
if traceliste then afficheDebug('demande libération canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clorange);
// est-on en limite de canton du detecteur 2 pour le libérer?
sd2:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2
if sd2=0 then exit; // pas de signal associé
// ce signal sd2 est il dans le bon sens
i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal associé au détecteur
if i<>sd2 then exit;
// trouver le signal précédent
i:=Signal_precedent(i); // trouve les éléments entre les deux signaux
if traceListe then AfficheDebug('Libération canton det '+IntToSTR(detecteur1)+' '+intToSTR(detecteur2)+' : ',clLime);
for i:=1 to idEl-1 do
begin
j:=elements[i].adresse;
typ:=elements[i].typ;
if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then
begin
if traceListe then Affichedebug_Suivi(intToSTR(j)+' ',clLime);
Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'aiguillage
end;
end;
Maj_Feux;
end;
// réserve le canton du detecteur équipé du feu (non compris) au feu suivant
// det1 et det2 sont contigus
procedure reserve_canton(detecteur1,detecteur2,adrtrain : integer);
var AdrSig,i,j,etat,etatSuiv,AdrSignalsuivant : integer;
rouge,cas2 : boolean;
typ : tEquipement;
begin
if not(roulage) then exit;
if traceliste then afficheDebug('demande réservation canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2)+' par train @'+intToSTR(adrtrain),clorange);
// y a t-il un signal sur le détecteur1
cas2:=false;
AdrSig:=signal_detecteur(detecteur1); // trouve le signal associé au detecteur1
if adrSig<>0 then
begin
// si le signal est dans le bon sens
if signal_sens(AdrSig,detecteur1,detecteur2) then cas2:=true; // oui
end;
if not(cas2) then AdrSig:=signal_suivant_det(detecteur1,detecteur2);
if traceListe then afficheDebug('le signal suivant est '+intToSTR(AdrSig),clyellow);
etat:=feux[index_feu(AdrSig)].etatSignal;
etatSuiv:=etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal AdrSig au suivant : AdresseFeuSuivant
// dans le bon sens
rouge:=testbit(etat,semaphore) or testbit(etat,carre) or testbit(etat,violet);
if rouge then
begin
if TraceListe then AfficheDebug('Le signal '+intToSTR(AdrSig)+' étant rouge, pas de réservation aval pour le train @'+intToSTR(adrtrain),clYellow);
exit;
end;
// etat_signal_suivant(i,1); // AdresseFeuSuivant et faire la réservation
if TraceListe then AfficheDebug('Réservation canton det '+intToSTR(detecteur1)+' '+intToSTR(detecteur2)+' par train @'+intToSTR(adrTrain)+' : ',clLime);
// marquer les aiguillages réservés
for i:=1 to idEl-1 do
begin
j:=elements[i].adresse;
typ:=elements[i].typ;
if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then
begin
if TraceListe then AfficheDebug_Suivi(intToSTR(j)+' ',clOrange);
Aiguillage[index_aig(j)].AdrTrain:=AdrTrain;
end;
end;
// réservation canton suivant
AdrSig:=AdrSignalSuivant;
etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal AdrSig au suivant : AdresseFeuSuivant
if traceListe then afficheDebug('le signal sursuivant est '+intToSTR(AdrSig),clyellow);
rouge:=testbit(etatSuiv,semaphore) or testbit(etatSuiv,carre) or testbit(etatSuiv,violet);
if rouge then
begin
if TraceListe then AfficheDebug('Le signal sursuivant '+intToSTR(AdrSig)+' étant rouge, pas de réservation aval pour le train @'+intToSTR(adrtrain),clYellow);
exit;
end;
etat:=etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal
// marquer les aiguillages réservés
if traceliste then AfficheDebug('Elements réservés: ',clOrange);
for i:=1 to idEl-1 do
begin
j:=elements[i].adresse;
typ:=elements[i].typ;
if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then
begin
if TraceListe then AfficheDebug_Suivi(intToSTR(j)+' ',clOrange);
Aiguillage[index_aig(j)].AdrTrain:=AdrTrain; // réserve l'aiguillage
end;
end;
Maj_feux;
end;
// pilote le train sur le détecteur det2, d'adresse adrtrain
// le det1 indique d'ou vient le train pour le bon sens du signal
// le train est piloté si ontrouve un signal dans le bon sens sur det2
// it : numéro du train du réseau (pour la couleur)
procedure pilote_train(det1,det2,AdrTrain,it : integer);
var entree_signal,jauneC,rappel30C,rappel60C,rouge : boolean;
i,index_train,adresse,adresse2,Etat,voie,i2 : integer;
couleur : TColor;
s : string;
begin
if not(roulage) or (adrtrain=0) then exit;
i:=index_feu_det(det2,voie,i2); // index du feu associé au det2 j:=signal_detecteur(det3);
if i=0 then exit;
i2:=((it-1) mod NbCouleurTrain) +1;
couleur:=CouleurTrain[i2];
index_train:=index_train_adresse(adrTrain); // index du tableau trains
adresse:=feux[i].adresse; //voir si il est dans le bon sens
adresse2:=signal_suivant_det(det1,det2); // renvoie le signal suivant dans le sens det1 det2
if adresse<>adresse2 then exit; // non pas dans le bon sens
etat:=feux[i].EtatSignal;
rouge:=testbit(etat,semaphore) or testbit(etat,carre) or testbit(etat,violet);
jauneC:=testbit(etat,jaune) or testbit(etat,blanc) or testbit(etat,blanc_cli);
rappel30C:=testbit(etat,rappel_30);
rappel60C:=testbit(etat,rappel_60);
entree_signal:=detecteur[det2].etat;
// si le feu est au rouge et qu'on entre dans son détecteur
if rouge and entree_signal then
begin
s:='Signal '+intToSTR(adresse)+' au rouge - Arrêt train @'+intToSTR(AdrTrain);
if traceListe then AfficheDebug(s,couleur);
Affiche(s,couleur);
event_det_train[it].signal_rouge:=adresse;
if (index_train<>0) and (index_train<Max_Trains) then trains[index_train].TempoArret:=50;
exit;
end;
event_det_train[it].signal_rouge:=0;
if (jauneC or Rappel30C) and entree_signal then
begin
if traceListe then
begin
if jauneC then AfficheDebug('Signal '+intToSTR(adresse)+' à l''avertissement - Ralentissement train @'+intToSTR(AdrTrain),clLime);
if Rappel30C and not(jauneC) then AfficheDebug('Signal '+intToSTR(adresse)+' au rappel30 - Ralentissement train @'+intToSTR(AdrTrain),clLime);
end;
if (index_train<>0) and (index_train<Max_Trains) then vitesse_loco('',AdrTrain,trains[index_train].VitRalenti,not(placement[index_train].inverse));
end;
if (Rappel60C) and not(jauneC) and entree_signal then
begin
if traceListe then AfficheDebug('Signal '+intToSTR(adresse)+' au rappel60 - Ralentissement train @'+intToSTR(AdrTrain),clLime);
if (index_train<>0) and (index_train<Max_Trains) then
vitesse_loco('',AdrTrain,trains[index_train].VitRalenti,not(placement[index_train].inverse));
end;
if (testbit(etat,vert) or testbit(etat,vert_cli)) and entree_signal then
begin
if traceListe then AfficheDebug('Signal '+intToSTR(adresse)+' Voie libre - Vitesse nominale train @'+intToSTR(AdrTrain),clLime);
if (index_train<>0) and (index_train<Max_Trains) then vitesse_loco('',AdrTrain,trains[index_train].VitNominale,not(placement[index_train].inverse));
end;
if testbit(etat,jaune_Cli) and entree_signal then
begin
if traceListe then AfficheDebug('Signal '+intToSTR(adresse)+' Jaune cli - Vitesse nominale train @'+intToSTR(AdrTrain),clLime);
if (index_train<>0) and (index_train<Max_Trains) then vitesse_loco('',AdrTrain,trains[index_train].VitNominale,not(placement[index_train].inverse));
end;
if testbit(etat,semaphore_cli) and entree_signal then
begin
if traceListe then AfficheDebug('Signal '+intToSTR(adresse)+' Sémaphore cli - Vitesse réduite train @'+intToSTR(AdrTrain),clLime);
if (index_train<>0) and (index_train<Max_Trains) then vitesse_loco('',AdrTrain,trains[index_train].VitRalenti,not(placement[index_train].inverse));
end;
end;
// le traitement d'un détecteur à 0 est temporisé car il peut électriquement rebondir à cause des mauvais contacts.
procedure traite_det0(adresse : integer);
var i,j,k,EtatSig,det1,det2,det3,det4,det_suiv,adrSuiv,AdrTrainLoc,n : integer;
suivOk,CasAig : boolean;
s,train_ch : string;
begin
det3:=adresse;
for i:=1 to N_trains do
begin
index_couleur:=((i - 1) mod NbCouleurTrain) +1;
couleur:=CouleurTrain[index_couleur];
//Nbre:=event_det_train[i].NbEl ; // Nombre d'éléments du tableau courant exploré
det1:=event_det_train[i].det[1].adresse;
det2:=event_det_train[i].det[2].adresse;
if TraceListe or (NivDebug=3) then AfficheDebug('2-0 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur);
// test si det1, det2 et det3 sont contigus malgré aig mal positionnés
det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3)
if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),couleur);
SuivOk:=det_suiv=det3;
CasAig:=false;
if not(SuivOk) then
begin
// cas d'un aiguillage qui a changé
if det3=event_det_train[i].suivant then
begin
CasAig:=true;
s:='***CasAigChg train '+intToSTR(i)+' '+intToSTR(det1)+' '+intToSTR(det2)+' '+intToSTR(det3);
Affiche_Evt(s,couleur);
if TraceListe then AfficheDebug(s,couleur);
// trouver le suivant
det_Adj(det3);
if adj1<9990 then adrSuiv:=adj1;
if adj2<9990 then adrSuiv:=adj2;
event_det_tick[N_event_tick].reaffecte:=2; // réaffecté par changement d'aiguillage
end;
end;
if SuivOk or CasAig then
begin
if TraceListe then AfficheDebug('Route est valide, dét '+intToSTR(det2)+' '+intToSTR(det3)+' contigus',couleur);
// ici on cherche le suivant à det2 det3, algo=1
event_det_tick[N_event_tick].train:=i;
if not(casAig) then AdrSuiv:=detecteur_suivant_el(det2,det,det3,det,0); // dans le cas de CasAig, alors adrSuiv=9996 donc AdrSuiv est calculé plus haut
event_det_train[i].suivant:=AdrSuiv;
if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur);
if (Adrsuiv>=9990) and not(casaig) then
begin
//Affiche('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed);
if (NivDebug=3) or TraceListe then AfficheDebug('Msg 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clorange);
end
else
begin
// en mode roulage, voir si on perd le détecteur si le train était arreté devat un signal rouge
{if roulage then
begin
AdrFeu:=event_det_train[i].signal_rouge;
if AdrFeu<>0 then
begin
s:='Erreur signal '+intToSTR(AdrFeu)+' au rouge et perte détecteur: ignoré';
Affiche_Evt(s,clred);
if traceListe then AfficheDebug(s,clred);
event_det_tick[N_event_tick].reaffecte:=4; // fd sur un feu à 0
exit;
end;
end;}
if (det2<NbMemZone) and (det3<NbMemZone) and (AdrSuiv<NbMemZone) then
begin
//*** route validée ***
train_ch:=event_det_train[i].nom_train;
AdrTrainLoc:=event_det_train[i].Adrtrain;
// efface zone précédente
MemZone[det2,det3].etat:=FALSE;
MemZone[det2,det3].train:='';
MemZone[det2,det3].AdrTrain:=0;
MemZone[det2,det3].NumTrain:=0;
// on dévalide la zone inverse
MemZone[det3,det2].etat:=False;
MemZone[det3,det2].train:='';
MemZone[det3,det2].AdrTrain:=0;
MemZone[det3,det2].NumTrain:=0;
// valide la nouvelle zone
MemZone[det3,AdrSuiv].etat:=TRUE;
MemZone[det3,AdrSuiv].train:=train_ch;
MemZone[det3,AdrSuiv].AdrTrain:=AdrTrainLoc;
MemZone[det3,AdrSuiv].NumTrain:=i;
// on dévalide la zone inverse
MemZone[AdrSuiv,det3].etat:=False;
MemZone[AdrSuiv,det3].train:='';
MemZone[AdrSuiv,det3].AdrTrain:=0;
MemZone[AdrSuiv,det3].NumTrain:=0;
detecteur[det3].train:=train_ch ; // affectation nom train au nouveau détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc;
if detecteur[det2].train=train_ch then detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur si le nom du train est égal
if detecteur[det2].AdrTrain=AdrTrainLoc then detecteur[det2].AdrTrain:=0; // désaffectation du nom de train de l'ancien détecteur
libere_canton(det2,det3);
reserve_canton(det3,AdrSuiv,adrTrainLoc);
maj_feux;
// stockage dans historique de zones
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
with TrainZone[i] do
begin
Nbre:=n;
Zone[n].det1:=det3;
Zone[n].det2:=AdrSuiv;
Nbre:=n;
end;
// zone suivante en prévision
det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1);
TrainPrevZone[i][1]:=det4;
end;
event_act(det2,det3,0,''); // désactivation zone
event_act(det3,AdrSuiv,1,''); // activation zone
end
else
begin
s:='Erreur 740 : Adresse détecteur trop élevé ';
if det2>NbMemZone then s:=s+inttostr(det2)+' ';
if det3>NbMemZone then s:=s+inttostr(det2)+' ';
if AdrSuiv>NbMemZone then s:=s+inttostr(det2);
Affiche(s,clred);
end;
// supprimer le 1er et décaler
with event_det_train[i] do
begin
det[1].adresse:=event_det_train[i].det[2].adresse;
det[1].etat:=event_det_train[i].det[2].etat;
det[2].adresse:=det3;
det[2].etat:=detecteur[det3].etat;
NbEl:=2;
end;
// affichages
s:='2-0 Train n°'+intToSTR(i)+' route ok de '+intToSTR(det2)+' à '+IntToSTR(det3);
if casAig then s:=s+'A';
s:=s+' à '+IntToSTR(Adrsuiv);
Affiche_evt(s,couleur);
if traceListe then AfficheDebug(s,clyellow);
s:='Train '+IntToSTR(i);
if AdrTrainLoc<>0 then s:=s+' @'+intToSTR(AdrTrainLoc);
s:=s+' '+Train_ch+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv);
if traceListe then AfficheDebug(s,couleur);
s:='Train '+IntToSTR(i);
if AdrTrainLoc<>0 then s:=s+' '+train_ch+' @'+intToSTR(AdrTrainLoc);
s:=s+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv);
Affiche(s,Couleur);
if AffAigDet then AfficheDebug(s,couleur);
Affiche_Evt('1.Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur);
Affiche_Evt(intToSTR(event_det_train[i].det[1].adresse),couleur);
Affiche_Evt(intToStr(event_det_train[i].det[2].adresse),couleur);
if TraceListe or dupliqueEvt then
begin
AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur);
AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur);
end;
if TCOouvert then
begin
zone_TCO(det2,det3,0); // désactivation
// activation
if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
else zone_TCO(det3,AdrSuiv,2); // affichage avec la couleur de index_couleur du train
end;
// mettre à jour si présence signal sur det3 pour le passer au rouge de suite
j:=signal_detecteur(det3);
if j<>0 then
begin
Maj_Feu(j);
k:=index_feu(j);
// si le feu j est au rouge
etatSig:=feux[k].etatsignal;
if (testBit(etatSig,carre)) or (testBit(etatSig,semaphore)) or (testBit(etatSig,semaphore_cli)) then
begin
// Maj du signal précédent (pour l'avertissement)
j:=Signal_precedent(j);
if j<>0 then
begin
maj_feu(j);
j:=Signal_precedent(j);
if j<>0 then maj_feu(j);
end;
end;
end;
maj_feux; // mise à jour générale
maj_feux; // 2eme mise à jour
maj_feux;
exit; // sortir absolument
end;
end
else
begin
//Affiche_Evt('Route invalide: dét '+intToSTR(det2)+' '+intToSTR(det3)+' non contigus',clOrange);
if event_det_train[i].det[2].adresse=det3 then
begin
s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
FormDebug.MemoEvtDet.lines.add(s);
if dupliqueEvt then AfficheDebug(s,clyellow);
end;
end;
end;
end;
// calcul des zones depuis le tableau des fronts montants ou descendants des évènements détecteurs
// transmis dans le tableau Event_det
// rattache le nouveau détecteur à un train
// adresse: adresse du detecteur, front: état du détecteur
procedure calcul_zones_V1(adresse: integer;etat : boolean);
var m,AdrFeu,AdrDetFeu,AdrTrainLoc,Nbre,i,i2,j,k,n,det1,det2,det3,det4,AdrSuiv,AdrPrec,Prev,
id_couleur,det_suiv,nc,etatSig : integer ;
traite,trouve,SuivOk,casaig,rebond : boolean;
couleur : tcolor;
TypeSuiv : tEquipement;
s,train_ch : string;
begin
det3:=adresse; // c'est le nouveau détecteur
if det3=0 then exit; // pas de nouveau détecteur
traite:=false;
rebond:=false;
s:='Le nouveau détecteur est '+IntToSTR(det3);
if etat then s:=s+' 1' else s:=s+' 0';
Affiche_evt(s,clwhite) ;
if dupliqueEvt then AfficheDebug(s,clyellow) ;
for i:=1 to N_trains do
begin
index_couleur:=((i - 1) mod NbCouleurTrain) +1;
couleur:=CouleurTrain[index_couleur];
Nbre:=event_det_train[i].NbEl ; // Nombre d'éléments du tableau courant exploré
det1:=event_det_train[i].det[1].adresse;
det2:=event_det_train[i].det[2].adresse;
if ((det2=det3) and (nbre=2)) or ((det1=det3) and (nbre=1)) then
begin
//s:='Dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
//Affiche_evt(s,clwhite);
event_det_tick[N_event_tick].train:=i;
event_det_tick[N_event_tick].reaffecte:=3;
if dupliqueEvt then AfficheDebug(s,clyellow);
rebond:=true; // possible rebond ?
end;
// 1 élément dans le tableau et détecteur à 0---------------------------------------------
if (nbre=1) and not(etat) then
begin
Det_Adj(det3); // renvoie les adresses des détecteurs adjacents au détecteur "det3" résultat dans adj1 et adj2
//if (roulage) then
begin
// traiter pour les cas avec 1 élément
if traceListe then AfficheDebug('1-0 traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow);
// vérifier si l'élément du tableau et le nouveau sont contigus
if (Adj1=det1) or (Adj2=det1) then
begin
event_det_tick[N_event_tick].train:=i;
with event_det_train[i] do
begin
det[2].adresse:=det3;
det[2].etat:=etat;
NbEl:=2;
end;
// en mode roulage, on a placé les trains
if roulage then
begin
adrTrainLoc:=event_det_train[i].Adrtrain;
Train_ch:=event_det_train[i].nom_train;
if (AdrTrainLoc=0) and roulage then Affiche('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred);
j:=1;
repeat
trouve:=placement[j].detdir=det3;
inc(j);
until (j>6) or trouve;
dec(j);
//si début de démarrage train i
if not(trouve) or (TrainZone[i].Nbre>0) then
begin
exit;
end;
// affecter le nouveau détecteur
detecteur[det3].train:=Train_ch;
detecteur[det3].AdrTrain:=AdrTrainLoc;
// libérer l'ancien
//detecteur[event_det_train[i].Det[1].adresse].AdrTrain:=0;
//detecteur[event_det_train[i].Det[1].adresse].train:='';
end;
AdrSuiv:=detecteur_suivant_el(det1,det,det3,det,1);
//*** route validée ***
if (det1<NbMemZone) and (det2<NbMemZone) and (det3<NbMemZone) and (adrSuiv<NbMemZone) then
begin
MemZone[det1,det3].etat:=FALSE; // dévalide l'ancienne zone
MemZone[det1,det3].train:='';
MemZone[det1,det3].Adrtrain:=0;
MemZone[det3,det1].etat:=FALSE; // dévalide l'ancienne zone inverse
MemZone[det3,det1].train:='';
MemZone[det3,det1].Adrtrain:=0; // libère la réservation
MemZone[det3,AdrSuiv].etat:=true; // valide la nouvelle zone
MemZone[det3,AdrSuiv].train:=Train_ch;
MemZone[det3,AdrSuiv].AdrTrain:=AdrTrainLoc;
MemZone[AdrSuiv,det3].etat:=False; // on dévalide la zone inverse
MemZone[AdrSuiv,det2].train:='';
MemZone[AdrSuiv,det2].AdrTrain:=0;
end;
// stockage dans historique de zones
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
with TrainZone[i] do
begin
Nbre:=n;
Zone[n].det1:=det1;
Zone[n].det2:=det3;
train:=train_ch;
AdrTrain:=AdrTrainLoc
end;
end;
//reserve_canton(det1,det3,false,0,false); // déreserve le canton précedent
//reserve_canton(det3,AdrSuiv,false,TrainZone[i].Adrtrain,true); // si feu réserve canton courant
libere_canton(det1,det3); // on quitte det3
reserve_canton(det3,adrSuiv,adrtrainLoc);
event_act(det1,det3,1,''); // évènement actionneur
maj_feux;
// affichages
Affiche_Evt('1-0 route ok de '+intToSTR(det1)+' à '+IntToSTR(det3),clWhite);
if traceListe then AfficheDebug(s,clyellow);
//Affiche(s,CouleurTrain[index_couleur]);
if AffAigDet then AfficheDebug(s,clyellow);
Affiche_Evt('1-0. Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur);
s:=intToSTR(event_det_train[i].det[1].adresse);
Affiche_Evt(s,couleur);
if dupliqueEvt or traceliste then AfficheDebug(s,clyellow);
s:=intToSTR(event_det_train[i].det[2].adresse);
Affiche_evt(s,couleur);
if dupliqueEvt or traceliste then AfficheDebug(s,clyellow);
if TCOouvert then
begin
// activation
if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
else zone_TCO(det3,adrSuiv,2); // affichage avec la couleur de index_couleur du train
end;
exit; // sortir absolument
end
else
begin
Affiche_evt('1-0 Les éléments '+intToSTR(det1)+' et '+intToSTR(det3)+' ne sont pas contigus',clyellow);
// det3 et det1 non adjacents
end;
end;
end;
// 1 élément dans le tableau et détecteur à 1 : on pilote le train si feu sur det3---------------------------------------------
if (nbre=1) and etat then
begin
if traceListe then AfficheDebug('1-1 Traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow);
// vérifier si l'élément du tableau et le nouveau sont contigus
Det_Adj(det1); // renvoie les adresses des détecteurs adjacents au détecteur "det1" résultat dans adj1 et adj2
suivok:=(Adj1=det3) or (Adj2=det3);
if suivok then
begin
Train_ch:=event_det_train[i].nom_train;
AdrTrainLoc:=event_det_train[i].AdrTrain;
event_det_tick[N_event_tick].train:=i;
// en mode roulage, on a placé les trains
if roulage then
begin
j:=1;
repeat
trouve:=placement[j].detdir=det3;
inc(j);
until (j>6) or trouve;
dec(j);
//si début de démarrage train i
if trouve and (TrainZone[i].Nbre=0) and (det1<NbMemZone) and (det3<NbMemZone) then
begin
//Affiche('on a trouvé le train '+intToSTR(j),clYellow);
detecteur[det3].train:=train_ch; // affecter le nom du train au détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc ; // affecter l'@ du train au détecteur
detecteur[det1].train:=''; // désaffecter le nom du train du détecteur précédent
detecteur[det1].AdrTrain:=0;
//*** route validée ***
MemZone[det1,det3].etat:=TRUE; // valide la nouvelle zone
MemZone[det1,det3].train:=train_ch;
MemZone[det1,det3].AdrTrain:=AdrTrainLoc;
MemZone[det3,det1].etat:=False; // on dévalide la zone inverse
// test si on peut réserver le canton suivant
det_suiv:=det_suiv_cont(det1,det3);
if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i);
Affiche_Evt(s,clWhite);
if TCOouvert then
begin
// activation
if ModeCouleurCanton=0 then zone_TCO(det1,det3,1)
else zone_TCO(det1,det3,2); // affichage avec la couleur de index_couleur du train
end;
end;
end;
pilote_train(det1,det3,adrtrainLoc,i); // pilote le train sur det3
//event_act(det1,det3,1,''); // activation zone
// actualiser le signal du det3
j:=signal_detecteur(det3);
if j<>0 then Maj_Feu(j);
exit;
end;
if Traceliste then AfficheDebug(inttoSTR(det3)+' n''est pas contigu à '+intToSTR(det1)+' pour le train '+intToSTR(i),clyellow);
traite:=true; // traiter le train suivant
end;
// 2 éléments dans le tableau et détecteur à 0---------------------------------------------
if (nbre=2) and not(etat) then
{ begin
if not(cdm_connecte) then
begin
detecteur[det3].tempo0:=3; // filtrage à 0,3s
exit;
end;
traite_det0(det3); // ne faire qu'une
end;
}
begin
if TraceListe or (NivDebug=3) then AfficheDebug('2-0 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur);
// test si det1, det2 et det3 sont contigus malgré aig mal positionnés
det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3)
if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),couleur);
SuivOk:=det_suiv=det3;
CasAig:=false;
if not(SuivOk) then
begin
// cas d'un aiguillage qui a changé
if det3=event_det_train[i].suivant then
begin
CasAig:=true;
s:='***CasAigChg train '+intToSTR(i)+' '+intToSTR(det1)+' '+intToSTR(det2)+' '+intToSTR(det3);
Affiche_Evt(s,couleur);
if TraceListe then AfficheDebug(s,couleur);
// trouver le suivant
det_Adj(det3);
if adj1<9990 then adrSuiv:=adj1;
if adj2<9990 then adrSuiv:=adj2;
event_det_tick[N_event_tick].reaffecte:=2; // réaffecté par changement d'aiguillage
end;
end;
if SuivOk or CasAig then
begin
if TraceListe then AfficheDebug('Route est valide, dét '+intToSTR(det2)+' '+intToSTR(det3)+' contigus',couleur);
// ici on cherche le suivant à det2 det3, algo=1
event_det_tick[N_event_tick].train:=i;
if not(casAig) then AdrSuiv:=detecteur_suivant_el(det2,det,det3,det,0); // dans le cas de CasAig, alors adrSuiv=9996 donc AdrSuiv est calculé plus haut
event_det_train[i].suivant:=AdrSuiv;
if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur);
if (Adrsuiv>=9990) and not(casaig) then
begin
//Affiche('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed);
if (NivDebug=3) or TraceListe then AfficheDebug('Msg 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clorange);
end
else
begin
// en mode roulage, voir si on perd le détecteur si le train était arreté devat un signal rouge
{if roulage then
begin
AdrFeu:=event_det_train[i].signal_rouge;
if AdrFeu<>0 then
begin
s:='Erreur signal '+intToSTR(AdrFeu)+' au rouge et perte détecteur: ignoré';
Affiche_Evt(s,clred);
if traceListe then AfficheDebug(s,clred);
event_det_tick[N_event_tick].reaffecte:=4; // fd sur un feu à 0
exit;
end;
end;}
if (det2<NbMemZone) and (det3<NbMemZone) and (AdrSuiv<NbMemZone) then
begin
//*** route validée ***
train_ch:=event_det_train[i].nom_train;
AdrTrainLoc:=event_det_train[i].Adrtrain;
// efface zone précédente
MemZone[det2,det3].etat:=FALSE;
MemZone[det2,det3].train:='';
MemZone[det2,det3].AdrTrain:=0;
MemZone[det2,det3].NumTrain:=0;
// on dévalide la zone inverse
MemZone[det3,det2].etat:=False;
MemZone[det3,det2].train:='';
MemZone[det3,det2].AdrTrain:=0;
MemZone[det3,det2].NumTrain:=0;
// valide la nouvelle zone
MemZone[det3,AdrSuiv].etat:=TRUE;
MemZone[det3,AdrSuiv].train:=train_ch;
MemZone[det3,AdrSuiv].AdrTrain:=AdrTrainLoc;
MemZone[det3,AdrSuiv].NumTrain:=i;
// on dévalide la zone inverse
MemZone[AdrSuiv,det3].etat:=False;
MemZone[AdrSuiv,det3].train:='';
MemZone[AdrSuiv,det3].AdrTrain:=0;
MemZone[AdrSuiv,det3].NumTrain:=0;
detecteur[det3].train:=train_ch ; // affectation nom train au nouveau détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc;
if detecteur[det2].train=train_ch then detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur si le nom du train est égal
if detecteur[det2].AdrTrain=AdrTrainLoc then detecteur[det2].AdrTrain:=0; // désaffectation du nom de train de l'ancien détecteur
libere_canton(det2,det3);
reserve_canton(det3,AdrSuiv,adrTrainLoc);
maj_feux;
// stockage dans historique de zones
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
with TrainZone[i] do
begin
Nbre:=n;
Zone[n].det1:=det3;
Zone[n].det2:=AdrSuiv;
Nbre:=n;
end;
// zone suivante en prévision
det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1);
TrainPrevZone[i][1]:=det4;
end;
event_act(det2,det3,0,''); // désactivation zone
event_act(det3,AdrSuiv,1,''); // activation zone
end
else
begin
s:='Erreur 740 : Adresse détecteur trop élevé ';
if det2>NbMemZone then s:=s+inttostr(det2)+' ';
if det3>NbMemZone then s:=s+inttostr(det2)+' ';
if AdrSuiv>NbMemZone then s:=s+inttostr(det2);
Affiche(s,clred);
end;
// supprimer le 1er et décaler
with event_det_train[i] do
begin
det[1].adresse:=event_det_train[i].det[2].adresse;
det[1].etat:=event_det_train[i].det[2].etat;
det[2].adresse:=det3;
det[2].etat:=detecteur[det3].etat;
NbEl:=2;
end;
// affichages
s:='2-0 Train n°'+intToSTR(i)+' route ok de '+intToSTR(det2)+' à '+IntToSTR(det3);
if casAig then s:=s+'A';
s:=s+' à '+IntToSTR(Adrsuiv);
Affiche_evt(s,couleur);
if traceListe then AfficheDebug(s,clyellow);
s:='Train '+IntToSTR(i);
if AdrTrainLoc<>0 then s:=s+' @'+intToSTR(AdrTrainLoc);
s:=s+' '+Train_ch+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv);
if traceListe then AfficheDebug(s,couleur);
s:='Train '+IntToSTR(i);
if AdrTrainLoc<>0 then s:=s+' '+train_ch+' @'+intToSTR(AdrTrainLoc);
s:=s+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv);
Affiche(s,Couleur);
if AffAigDet then AfficheDebug(s,couleur);
Affiche_Evt('1.Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur);
Affiche_Evt(intToSTR(event_det_train[i].det[1].adresse),couleur);
Affiche_Evt(intToStr(event_det_train[i].det[2].adresse),couleur);
if TraceListe or dupliqueEvt then
begin
AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur);
AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur);
end;
if TCOouvert then
begin
zone_TCO(det2,det3,0); // désactivation
// activation
if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
else zone_TCO(det3,AdrSuiv,2); // affichage avec la couleur de index_couleur du train
end;
// mettre à jour si présence signal sur det3 pour le passer au rouge de suite
j:=signal_detecteur(det3);
if j<>0 then
begin
Maj_Feu(j);
k:=index_feu(j);
// si le feu j est au rouge
etatSig:=feux[k].etatsignal;
if (testBit(etatSig,carre)) or (testBit(etatSig,semaphore)) or (testBit(etatSig,semaphore_cli)) then
begin
// Maj du signal précédent (pour l'avertissement)
j:=Signal_precedent(j);
if j<>0 then
begin
maj_feu(j);
j:=Signal_precedent(j);
if j<>0 then maj_feu(j);
end;
end;
end;
maj_feux; // mise à jour générale
maj_feux; // 2eme mise à jour
maj_feux;
exit; // sortir absolument
end;
end
else
begin
//Affiche_Evt('Route invalide: dét '+intToSTR(det2)+' '+intToSTR(det3)+' non contigus',clOrange);
if event_det_train[i].det[2].adresse=det3 then
begin
s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
FormDebug.MemoEvtDet.lines.add(s);
if dupliqueEvt then AfficheDebug(s,clyellow);
end;
end;
end;
if (nbre=2) and etat then
begin
if TraceListe or (NivDebug=3) then AfficheDebug('2-1 traitement Train n°'+intToSTR(i)+' 2 détecteurs',clwhite);
// front descendant sur détecteur 2
det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3)
if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),clWhite);
if (det_suiv=det3) then
begin
event_det_tick[N_event_tick].train:=i;
if TraceListe then AfficheDebug('La route est valide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' sont contigus',couleur);
if (det1<NbMemZone) and (det2<NbMemZone) and (det3<NbMemZone) then
begin
//*** route validée ***
MemZone[det1,det2].etat:=false;
MemZone[det2,det1].etat:=False; // on dévalide la zone inverse
MemZone[det2,det3].etat:=TRUE; // valide la nouvelle zone
MemZone[det3,det2].etat:=False; // on dévalide la zone inverse
//Train_Ch:=event_det_train[i].nom_train;
//AdrTrainLoc:=event_det_train[i].Adrtrain;
Train_ch:=MemZone[det2,det3].train;
AdrTrainLoc:=MemZone[det2,det3].AdrTrain;
detecteur[det3].train:=Train_ch; // affectation nom train au nouveau détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc; // affectation train au nouveau détecteur
detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur
detecteur[det2].AdrTrain:=0;
i2:=index_train_adresse(AdrTrainLoc);
if i2<>0 then trains[i2].index_event_det_train:=i; // lier l'index du train en circulation
pilote_train(det2,det3,adrtrainLoc,i); // pilote le train sur det3
// test si on peut réserver le canton suivant
det_suiv:=det_suiv_cont(det2,det3);
if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
// libère canton
libere_canton(det2,det3);
//event_act(det2,det3,1,''); // activation zone
end
else
begin
s:='Erreur 740 : Adresse détecteur trop élevé ';
if det2>NbMemZone then s:=s+inttostr(det2)+' ';
if det3>NbMemZone then s:=s+inttostr(det2)+' ';
if AdrSuiv>NbMemZone then s:=s+inttostr(det2);
Affiche(s,clred);
end;
// stockage dans historique de zones sauf s'il est déja stocké
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre;
if (TrainZone[i].Zone[n].det1<>det2) or (TrainZone[i].Zone[n].det2<>det3) then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
TrainZone[i].Nbre:=n;
TrainZone[i].Zone[n].det1:=det2;
TrainZone[i].Zone[n].det2:=det3;
TrainZone[i].Nbre:=n;
// zone suivante en prévision
det4:=detecteur_suivant_EL(det2,det,det3,det,1);
TrainPrevZone[i][1]:=det4;
end;
end;
// affichages
s:='2-1 Train n°'+intToSTR(i)+' Route ok de '+intToSTR(det2)+' à '+IntToSTR(det3);
Affiche_evt(s,couleur);
if traceListe then AfficheDebug(s,Couleur);
if AffAigDet then AfficheDebug(s,couleur);
if TCOouvert then
begin
zone_TCO(det1,det2,0); // désactivation
// activation
if ModeCouleurCanton=0 then zone_TCO(det2,det3,1)
else zone_TCO(det2,det3,2); // affichage avec la couleur de index_couleur du train
end;
exit; // sortir absolument
end
else
begin
if TraceListe then AfficheDebug('La route est invalide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' ne sont pas contigus',clOrange);
{if rebond and (event_det_train[i].det[2].adresse=det3) then
begin
s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
FormDebug.MemoEvtDet.lines.add(s);
if dupliqueEvt then AfficheDebug(s,clyellow);
// désaffecter la zone
memzone[det2,det_suiv].etat:=false;
memZone[det1,det2].etat:=true;
exit; // rebond :sortir
end; }
end;
traite:=true; // non traité: train suivant
end;
end; // fin de la boucle for i
// dans cette partie, le détecteur n'a pas encore été affecté à un train existant.
if rebond then exit;
if etat then
begin
for i:=1 to N_trains do
begin
i2:=event_det_train[i].Suivant;
SuivOk:=event_det_train[i].Det[2].etat ;
det_adj(det3);
if (adj1=i2) or (adj2=i2) then
begin
s:='Train '+intToSTR(i)+' Détection '+intToSTR(det3)+' à 1 avant RAZ du '+intToSTR(i2);
Affiche_evt(s,clorange);
if traceListe then afficheDebug(s,clorange);
detecteur[det3].AdrTrain:=i; // récupération du train au détecteur
adrTrainLoc:=detecteur[i2].AdrTrain;
Train_ch:=MemZone[det2,i2].train;
detecteur[det3].train:=Train_ch; // affectation nom train au nouveau détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc; // affectation train au nouveau détecteur
detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur
detecteur[det2].AdrTrain:=0;
event_det_tick[N_event_tick].train:=i;
event_det_tick[N_event_tick].reaffecte:=1; // mauvais séquençage détecteurs contigus
pilote_train(i2,det3,adrtrainLoc,i); // pilote le train sur det3
// test si on peut réserver le canton suivant
det_suiv:=det_suiv_cont(i2,det3);
if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
// libère canton
libere_canton(i2,det3);
exit;
end;
end;
end;
// nouveau train front det=0
if not(etat) then
begin
if traceListe then AfficheDebug('Nouveau train',clyellow);
// Nombre d'éléments à 0 : ici c'est un nouveau train donc créer un train, donc un tableau
if N_Trains>=Max_Trains then
begin
Affiche('Erreur nombre de train maximal atteint',clRed);
N_trains:=0;
end;
Inc(N_trains);
event_det_tick[N_event_tick].train:=n_trains;
with event_det_train[N_trains] do
begin
det[1].adresse:=0;
det[2].adresse:=0;
NbEl:=0;
nom_train:='';
end;
// vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir
for i:=1 to NbreFeux do
begin
AdrFeu:=Feux[i].Adresse;
AdrDetfeu:=Feux[i].Adr_Det1;
if (AdrDetFeu=Det3) and (feux[i].aspect<10) then
begin
AdrSuiv:=Feux[i].Adr_el_suiv1;
TypeSuiv:=Feux[i].Btype_suiv1;
AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,det,1) ; // détecteur précédent le feu ; algo 1
if AdrPrec=0 then
begin
if TraceListe then Affiche('FD - Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow);
if AdrDetFeu<NbMemZone then
MemZone[0,AdrDetFeu].etat:=false
else
Affiche('Erreur 741: Adresse détecteur feu trop élevé: '+intToSTR(AdrDetFeu),clred);
maj_feu(AdrFeu);
end;
end;
end;
if TraceListe then AfficheDebug('Création Train n°'+intToSTR(N_trains),clyellow);
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
// si on démarre d'un buttoir
if buttoir_adjacent(det3) then
begin
if TraceListe then AfficheDebug('Détection démarrage depuis détecteur '+IntToSTR(det3)+' buttoir',clyellow);
event_det_train[N_trains].det[1].adresse:=0;
event_det_train[N_trains].det[2].adresse:=det3;
event_det_train[N_trains].NbEl:=2;
s:='3. Nouveau Tampon train '+intToStr(N_Trains)+'--------';
Affiche_Evt(s,couleur);
Affiche_Evt(intToSTR(event_det_train[N_Trains].det[1].adresse),couleur);
Affiche_Evt(intToSTR(event_det_train[N_Trains].det[2].adresse),couleur);
if dupliqueEvt then
begin
AfficheDebug(s,clyellow);
AfficheDebug(intToSTR(event_det_train[N_Trains].det[1].adresse),couleur);
AfficheDebug(intToSTR(event_det_train[N_Trains].det[2].adresse),couleur);
end;
end
else
begin
with event_det_train[N_trains] do
begin
det[1].adresse:=det3;
det[1].etat:=etat;
NbEl:=1;
nom_train:=detecteur[det3].train;
AdrTrain:=detecteur[det3].AdrTrain;
end;
TrainZone[n_trains].train:=detecteur[det3].train;
TrainZone[n_trains].AdrTrain:=detecteur[det3].Adrtrain;
if roulage then
begin
j:=index_train_adresse(detecteur[det3].AdrTrain);
j:=placement[j].detdir; // detecteur destination
MemZone[det3,j].etat:=true;
MemZone[det3,j].train:=detecteur[det3].train;
MemZone[det3,j].AdrTrain:=detecteur[det3].AdrTrain;
end;
s:=intToSTR(event_det_train[N_trains].det[1].adresse);
id_couleur:=((N_trains - 1) mod NbCouleurTrain) +1;
Affiche_Evt('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',CouleurTrain[id_couleur]);
Affiche_evt(s,CouleurTrain[id_couleur]);
if dupliqueEvt then
begin
AfficheDebug('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',clyellow);
AfficheDebug(s,clyellow);
end;
if TraceListe then
begin
AfficheDebug('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',clyellow);
AfficheDebug(s,clyellow);
end;
end;
end;
end;
// calcul des zones depuis le tableau des fronts montants ou descendants des évènements détecteurs
// transmis dans le tableau Event_det
// rattache le nouveau détecteur à un train
// adresse: adresse du detecteur, front: état du détecteur
procedure calcul_zones_V2(adresse: integer;etat : boolean);
var m,AdrFeu,AdrDetFeu,AdrTrainLoc,Nbre,i,j,k,n,det1,det2,det3,det4,AdrSuiv,AdrPrec,Prev,
id_couleur,det_suiv,nc,etatSig : integer ;
traite,trouve,SuivOk,casaig,rebond : boolean;
couleur : tcolor;
TypeSuiv : tEquipement;
s,train_ch : string;
begin
det3:=adresse; // c'est le nouveau détecteur
if det3=0 then exit; // pas de nouveau détecteur
traite:=false;
rebond:=false;
s:='Le nouveau détecteur est '+IntToSTR(det3);
if etat then s:=s+' 1' else s:=s+' 0';
Affiche_evt(s,clwhite) ;
if dupliqueEvt then AfficheDebug(s,clyellow) ;
for i:=1 to N_trains do
begin
index_couleur:=((i - 1) mod NbCouleurTrain) +1;
couleur:=CouleurTrain[index_couleur];
Nbre:=event_det_train[i].NbEl ; // Nombre d'éléments du tableau courant exploré
det1:=event_det_train[i].det[1].adresse;
det2:=event_det_train[i].det[2].adresse;
{
if ((det2=det3) and (nbre=2) ) or ((det1=det3) and (nbre=1)) then
begin
s:='Dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
Affiche_evt(s,clwhite);
event_det_tick[N_event_tick].train:=i;
event_det_tick[N_event_tick].reaffecte:=3;
if dupliqueEvt then AfficheDebug(s,clyellow);
rebond:=true; // possible rebond ?
end; }
// 1 élément dans le tableau et détecteur à 0---------------------------------------------
if (nbre=1) and not(etat) then
begin
Det_Adj(det3); // renvoie les adresses des détecteurs adjacents au détecteur "det3" résultat dans adj1 et adj2
//if (roulage) then
begin
// traiter pour les cas avec 1 élément
if traceListe then AfficheDebug('1-0 traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow);
// vérifier si l'élément du tableau et le nouveau sont contigus
if (Adj1=det1) or (Adj2=det1) then
begin
event_det_tick[N_event_tick].train:=i;
with event_det_train[i] do
begin
det[2].adresse:=det3;
det[2].etat:=etat;
NbEl:=2;
end;
// en mode roulage, on a placé les trains
if roulage then
begin
adrTrainLoc:=event_det_train[i].Adrtrain;
Train_ch:=event_det_train[i].nom_train;
if (AdrTrainLoc=0) and roulage then Affiche('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred);
j:=1;
repeat
trouve:=placement[j].detdir=det3;
inc(j);
until (j>6) or trouve;
dec(j);
//si début de démarrage train i
if not(trouve) or (TrainZone[i].Nbre>0) then
begin
exit;
end;
// affecter le nouveau détecteur
detecteur[det3].train:=Train_ch;
detecteur[det3].AdrTrain:=AdrTrainLoc;
// libérer l'ancien
//detecteur[event_det_train[i].Det[1].adresse].AdrTrain:=0;
//detecteur[event_det_train[i].Det[1].adresse].train:='';
end;
AdrSuiv:=detecteur_suivant_el(det1,det,det3,det,1);
//*** route validée ***
if (det1<NbMemZone) and (det2<NbMemZone) and (det3<NbMemZone) and (adrSuiv<NbMemZone) then
begin
MemZone[det1,det3].etat:=FALSE; // dévalide l'ancienne zone
MemZone[det1,det3].train:='';
MemZone[det1,det3].Adrtrain:=0;
MemZone[det3,det1].etat:=FALSE; // dévalide l'ancienne zone inverse
MemZone[det3,det1].train:='';
MemZone[det3,det1].Adrtrain:=0;
MemZone[det3,AdrSuiv].etat:=true; // valide la nouvelle zone
MemZone[det3,AdrSuiv].train:=Train_ch;
MemZone[det3,AdrSuiv].AdrTrain:=AdrTrainLoc;
MemZone[AdrSuiv,det3].etat:=False; // on dévalide la zone inverse
MemZone[AdrSuiv,det2].train:='';
MemZone[AdrSuiv,det2].AdrTrain:=0;
end;
// stockage dans historique de zones
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
with TrainZone[i] do
begin
Nbre:=n;
Zone[n].det1:=det1;
Zone[n].det2:=det3;
train:=train_ch;
AdrTrain:=AdrTrainLoc
end;
end;
//reserve_canton(det1,det3,false,0,false); // déreserve le canton précedent
//reserve_canton(det3,AdrSuiv,false,TrainZone[i].Adrtrain,true); // si feu réserve canton courant
libere_canton(det1,det3); // on quitte det3
reserve_canton(det3,adrSuiv,adrtrainLoc);
event_act(det1,det3,1,''); // évènement actionneur
maj_feux;
// affichages
Affiche_Evt('1-0 route ok de '+intToSTR(det1)+' à '+IntToSTR(det3),clWhite);
if traceListe then AfficheDebug(s,clyellow);
//Affiche(s,CouleurTrain[index_couleur]);
if AffAigDet then AfficheDebug(s,clyellow);
Affiche_Evt('1-0. Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur);
s:=intToSTR(event_det_train[i].det[1].adresse);
Affiche_Evt(s,couleur);
if dupliqueEvt or traceliste then AfficheDebug(s,clyellow);
s:=intToSTR(event_det_train[i].det[2].adresse);
Affiche_evt(s,couleur);
if dupliqueEvt or traceliste then AfficheDebug(s,clyellow);
if TCOouvert then
begin
// activation
if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
else zone_TCO(det3,adrSuiv,2); // affichage avec la couleur de index_couleur du train
end;
exit; // sortir absolument
end
else
begin
Affiche_evt('1-0 Les éléments '+intToSTR(det1)+' et '+intToSTR(det3)+' ne sont pas contigus',clyellow);
// det3 et det1 non adjacents
end;
end;
end;
// 1 élément dans le tableau et détecteur à 1 : on pilote le train si feu sur det3---------------------------------------------
if (nbre=1) and etat then
begin
if traceListe then AfficheDebug('1-1 Traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow);
// vérifier si l'élément du tableau et le nouveau sont contigus
Det_Adj(det1); // renvoie les adresses des détecteurs adjacents au détecteur "det1" résultat dans adj1 et adj2
suivok:=(Adj1=det3) or (Adj2=det3);
if suivok then
begin
Train_ch:=event_det_train[i].nom_train;
AdrTrainLoc:=event_det_train[i].AdrTrain;
event_det_tick[N_event_tick].train:=i;
// en mode roulage, on a placé les trains
if roulage then
begin
j:=1;
repeat
trouve:=placement[j].detdir=det3;
inc(j);
until (j>6) or trouve;
dec(j);
//si début de démarrage train i
if trouve and (TrainZone[i].Nbre=0) and (det1<NbMemZone) and (det3<NbMemZone) then
begin
//Affiche('on a trouvé le train '+intToSTR(j),clYellow);
detecteur[det3].train:=train_ch; // affecter le nom du train au détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc ; // affecter l'@ du train au détecteur
detecteur[det1].train:=''; // désaffecter le nom du train du détecteur précédent
detecteur[det1].AdrTrain:=0;
//*** route validée ***
MemZone[det1,det3].etat:=TRUE; // valide la nouvelle zone
MemZone[det1,det3].train:=train_ch;
MemZone[det1,det3].AdrTrain:=AdrTrainLoc;
MemZone[det3,det1].etat:=False; // on dévalide la zone inverse
// test si on peut réserver le canton suivant
det_suiv:=det_suiv_cont(det1,det3);
if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i);
Affiche_Evt(s,clWhite);
if TCOouvert then
begin
// activation
if ModeCouleurCanton=0 then zone_TCO(det1,det3,1)
else zone_TCO(det1,det3,2); // affichage avec la couleur de index_couleur du train
end;
end;
end;
pilote_train(det1,det3,adrtrainLoc,i); // pilote le train sur det3
//event_act(det1,det3,1,''); // activation zone
// actualiser le signal du det3
j:=signal_detecteur(det3);
if j<>0 then Maj_Feu(j);
exit;
end;
if Traceliste then AfficheDebug(inttoSTR(det3)+' n''est pas contigu à '+intToSTR(det1)+' pour le train '+intToSTR(i),clyellow);
traite:=true; // traiter le train suivant
end;
// 2 éléments dans le tableau et détecteur à 0---------------------------------------------
if (nbre=2) and not(etat) then
begin
if TraceListe or (NivDebug=3) then AfficheDebug('2-0 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur);
// test si det1, det2 et det3 sont contigus malgré aig mal positionnés
{
det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3)
if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),couleur);
SuivOk:=det_suiv=det3;
CasAig:=false;
if not(SuivOk) then
begin
// cas d'un aiguillage qui a changé
if det3=event_det_train[i].suivant then
begin
CasAig:=true;
s:='***CasAigChg train '+intToSTR(i)+' '+intToSTR(det1)+' '+intToSTR(det2)+' '+intToSTR(det3);
Affiche_Evt(s,couleur);
if TraceListe then AfficheDebug(s,couleur);
// trouver le suivant
det_Adj(det3);
if adj1<9990 then adrSuiv:=adj1;
if adj2<9990 then adrSuiv:=adj2;
event_det_tick[N_event_tick].reaffecte:=2; // réaffecté par changement d'aiguillage
end;
end;
}
casaig:=false;
suivok:=det2=det3;
if SuivOk or CasAig then
begin
if TraceListe then AfficheDebug('Route est valide, dét '+intToSTR(det2)+' '+intToSTR(det3)+' contigus',couleur);
// ici on cherche le suivant à det2 det3, algo=1
event_det_tick[N_event_tick].train:=i;
Adrsuiv:=det_suiv_cont(det1,det2);
//if not(casAig) then AdrSuiv:=detecteur_suivant_el(det2,det,det3,det,0); // dans le cas de CasAig, alors adrSuiv=9996 donc AdrSuiv est calculé plus haut
event_det_train[i].suivant:=AdrSuiv;
if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur);
if (Adrsuiv>=9990) and not(casaig) then
begin
//Affiche('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed);
if (NivDebug=3) or TraceListe then AfficheDebug('Msg 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clorange);
end
else
begin
if (det2<NbMemZone) and (det3<NbMemZone) and (AdrSuiv<NbMemZone) then
begin
//*** route validée ***
train_ch:=event_det_train[i].nom_train;
AdrTrainLoc:=event_det_train[i].Adrtrain;
// efface zone précédente
MemZone[det2,det3].etat:=FALSE;
MemZone[det2,det3].train:='';
MemZone[det2,det3].AdrTrain:=0;
MemZone[det2,det3].NumTrain:=0;
// on dévalide la zone inverse
MemZone[det3,det2].etat:=False;
MemZone[det3,det2].train:='';
MemZone[det3,det2].AdrTrain:=0;
MemZone[det3,det2].NumTrain:=0;
// valide la nouvelle zone
MemZone[det3,AdrSuiv].etat:=TRUE;
MemZone[det3,AdrSuiv].train:=train_ch;
MemZone[det3,AdrSuiv].AdrTrain:=AdrTrainLoc;
MemZone[det3,AdrSuiv].NumTrain:=i;
// on dévalide la zone inverse
MemZone[AdrSuiv,det3].etat:=False;
MemZone[AdrSuiv,det3].train:='';
MemZone[AdrSuiv,det3].AdrTrain:=0;
MemZone[AdrSuiv,det3].NumTrain:=0;
detecteur[det3].train:=train_ch ; // affectation nom train au nouveau détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc;
if detecteur[det2].train=train_ch then detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur si le nom du train est égal
if detecteur[det2].AdrTrain=AdrTrainLoc then detecteur[det2].AdrTrain:=0; // désaffectation du nom de train de l'ancien détecteur
libere_canton(det2,det3);
reserve_canton(det3,AdrSuiv,adrTrainLoc);
maj_feux;
// stockage dans historique de zones
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
with TrainZone[i] do
begin
Nbre:=n;
Zone[n].det1:=det3;
Zone[n].det2:=AdrSuiv;
Nbre:=n;
end;
// zone suivante en prévision
det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1);
TrainPrevZone[i][1]:=det4;
end;
event_act(det2,det3,0,''); // désactivation zone
event_act(det3,AdrSuiv,1,''); // activation zone
end
else
begin
s:='Erreur 740 : Adresse détecteur trop élevé ';
if det2>NbMemZone then s:=s+inttostr(det2)+' ';
if det3>NbMemZone then s:=s+inttostr(det2)+' ';
if AdrSuiv>NbMemZone then s:=s+inttostr(det2);
Affiche(s,clred);
end;
{
// supprimer le 1er et décaler
with event_det_train[i] do
begin
det[1].adresse:=event_det_train[i].det[2].adresse;
det[1].etat:=event_det_train[i].det[2].etat;
det[2].adresse:=det3;
det[2].etat:=detecteur[det3].etat;
NbEl:=2;
end;
}
event_det_train[i].det[2].etat:=etat;
// affichages
s:='2-0 Train n°'+intToSTR(i)+' route ok de '+intToSTR(det2)+' à '+IntToSTR(det3);
if casAig then s:=s+'A';
s:=s+' à '+IntToSTR(Adrsuiv);
Affiche_evt(s,couleur);
if traceListe then AfficheDebug(s,clyellow);
s:='Train '+IntToSTR(i);
if AdrTrainLoc<>0 then s:=s+' @'+intToSTR(AdrTrainLoc);
s:=s+' '+Train_ch+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv);
if traceListe then AfficheDebug(s,couleur);
s:='Train '+IntToSTR(i);
if AdrTrainLoc<>0 then s:=s+' '+train_ch+' @'+intToSTR(AdrTrainLoc);
s:=s+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv);
Affiche(s,Couleur);
if AffAigDet then AfficheDebug(s,couleur);
Affiche_Evt('1.Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur);
Affiche_Evt(intToSTR(event_det_train[i].det[1].adresse),couleur);
Affiche_Evt(intToStr(event_det_train[i].det[2].adresse)+' 0',couleur);
if TraceListe or dupliqueEvt then
begin
AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur);
AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur);
end;
if TCOouvert then
begin
zone_TCO(det2,det3,0); // désactivation
// activation
if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
else zone_TCO(det3,AdrSuiv,2); // affichage avec la couleur de index_couleur du train
end;
// mettre à jour si présence signal sur det3 pour le passer au rouge de suite
j:=signal_detecteur(det3);
if j<>0 then
begin
Maj_Feu(j);
k:=index_feu(j);
// si le feu j est au rouge
etatSig:=feux[k].etatsignal;
if (testBit(etatSig,carre)) or (testBit(etatSig,semaphore)) or (testBit(etatSig,semaphore_cli)) then
begin
// Maj du signal précédent (pour l'avertissement)
j:=Signal_precedent(j);
if j<>0 then
begin
maj_feu(j);
j:=Signal_precedent(j);
if j<>0 then maj_feu(j);
end;
end;
end;
maj_feux; // mise à jour générale
maj_feux; // 2eme mise à jour
maj_feux;
exit; // sortir absolument
end;
end
else
begin
//Affiche_Evt('Route invalide: dét '+intToSTR(det2)+' '+intToSTR(det3)+' non contigus',clOrange);
if event_det_train[i].det[2].adresse=det3 then
begin
s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
FormDebug.MemoEvtDet.lines.add(s);
if dupliqueEvt then AfficheDebug(s,clyellow);
// exhit sortir
end;
end;
//traite:=true;
end;
if (nbre=2) and etat then
begin
if TraceListe or (NivDebug=3) then AfficheDebug('2-1 traitement Train n°'+intToSTR(i)+' 2 détecteurs',clwhite);
// front descendant sur détecteur 2
det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3)
if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),clWhite);
if (det_suiv=det3) then
begin
event_det_tick[N_event_tick].train:=i;
if TraceListe then AfficheDebug('La route est valide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' sont contigus',couleur);
if (det1<NbMemZone) and (det2<NbMemZone) and (det3<NbMemZone) then
begin
//*** route validée ***
MemZone[det1,det2].etat:=false;
MemZone[det2,det1].etat:=False; // on dévalide la zone inverse
MemZone[det2,det3].etat:=TRUE; // valide la nouvelle zone
MemZone[det3,det2].etat:=False; // on dévalide la zone inverse
//Train_Ch:=event_det_train[i].nom_train;
//AdrTrainLoc:=event_det_train[i].Adrtrain;
Train_ch:=MemZone[det2,det3].train;
AdrTrainLoc:=MemZone[det2,det3].AdrTrain;
detecteur[det3].train:=Train_ch; // affectation nom train au nouveau détecteur
detecteur[det3].AdrTrain:=AdrTrainLoc; // affectation train au nouveau détecteur
detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur
detecteur[det2].AdrTrain:=0;
// supprimer le 1er et décaler
with event_det_train[i] do
begin
det[1].adresse:=event_det_train[i].det[2].adresse;
det[1].etat:=event_det_train[i].det[2].etat;
det[2].adresse:=det3;
det[2].etat:=detecteur[det3].etat;
NbEl:=2;
end;
Affiche_Evt('2-1 Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur);
Affiche_Evt(intToSTR(event_det_train[i].det[1].adresse),couleur);
Affiche_Evt(intToStr(event_det_train[i].det[2].adresse)+' 1',couleur);
pilote_train(det2,det3,adrtrainLoc,i); // pilote le train sur det3
// test si on peut réserver le canton suivant
det_suiv:=det_suiv_cont(det2,det3);
if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
// libère canton
libere_canton(det2,det3);
//event_act(det2,det3,1,''); // activation zone
end
else
begin
s:='Erreur 740 : Adresse détecteur trop élevé ';
if det2>NbMemZone then s:=s+inttostr(det2)+' ';
if det3>NbMemZone then s:=s+inttostr(det2)+' ';
if AdrSuiv>NbMemZone then s:=s+inttostr(det2);
Affiche(s,clred);
end;
// stockage dans historique de zones sauf s'il est déja stocké
if i<MaxTrainZone then
begin
n:=TrainZone[i].Nbre;
if (TrainZone[i].Zone[n].det1<>det2) or (TrainZone[i].Zone[n].det2<>det3) then
begin
n:=TrainZone[i].Nbre+1;
if n>MaxZones then n:=1;
TrainZone[i].Nbre:=n;
TrainZone[i].Zone[n].det1:=det2;
TrainZone[i].Zone[n].det2:=det3;
TrainZone[i].Nbre:=n;
// zone suivante en prévision
det4:=detecteur_suivant_EL(det2,det,det3,det,1);
TrainPrevZone[i][1]:=det4;
end;
end;
// affichages
s:='2-1 Train n°'+intToSTR(i)+' Route ok de '+intToSTR(det2)+' à '+IntToSTR(det3);
Affiche_evt(s,couleur);
if traceListe then AfficheDebug(s,Couleur);
if AffAigDet then AfficheDebug(s,couleur);
if TCOouvert then
begin
zone_TCO(det1,det2,0); // désactivation
// activation
if ModeCouleurCanton=0 then zone_TCO(det2,det3,1)
else zone_TCO(det2,det3,2); // affichage avec la couleur de index_couleur du train
end;
exit; // sortir absolument
end
else
begin
if TraceListe then AfficheDebug('La route est invalide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' ne sont pas contigus',clOrange);
{if rebond and (event_det_train[i].det[2].adresse=det3) then
begin
s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i);
FormDebug.MemoEvtDet.lines.add(s);
if dupliqueEvt then AfficheDebug(s,clyellow);
// désaffecter la zone
memzone[det2,det_suiv].etat:=false;
memZone[det1,det2].etat:=true;
exit; // rebond :sortir
end; }
end;
traite:=true; // non traité: train suivant
end;
end; // fin de la boucle for i
// dans cette partie, le détecteur n'a pas encore été affecté à un train existant.
if rebond then exit;
if etat then
begin
for i:=1 to N_trains do
begin
det2:=event_det_train[i].Suivant;
SuivOk:=event_det_train[i].Det[2].etat ;
det_adj(det3);
if (adj1=det2) or (adj2=det2) then
begin
Affiche_evt('Train '+intToSTR(i)+' Détection '+intToSTR(det3)+' à 1 avant RAZ du '+intToSTR(det2),clorange);
detecteur[det3].AdrTrain:=i; // récupération du train au détecteur
event_det_tick[N_event_tick].train:=i;
event_det_tick[N_event_tick].reaffecte:=1; // mauvais séquençage détecteurs contigus
exit;
end;
end;
end;
// nouveau train front det=0
if not(etat) then
begin
if traceListe then AfficheDebug('Nouveau train',clyellow);
// Nombre d'éléments à 0 : ici c'est un nouveau train donc créer un train, donc un tableau
if N_Trains>=Max_Trains then
begin
Affiche('Erreur nombre de train maximal atteint',clRed);
N_trains:=0;
end;
Inc(N_trains);
event_det_tick[N_event_tick].train:=n_trains;
with event_det_train[N_trains] do
begin
det[1].adresse:=0;
det[2].adresse:=0;
NbEl:=0;
nom_train:='';
end;
// vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir
for i:=1 to NbreFeux do
begin
AdrFeu:=Feux[i].Adresse;
AdrDetfeu:=Feux[i].Adr_Det1;
if (AdrDetFeu=Det3) and (feux[i].aspect<10) then
begin
AdrSuiv:=Feux[i].Adr_el_suiv1;
TypeSuiv:=Feux[i].Btype_suiv1;
AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,det,1) ; // détecteur précédent le feu ; algo 1
if AdrPrec=0 then
begin
if TraceListe then Affiche('FD - Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow);
if AdrDetFeu<NbMemZone then
MemZone[0,AdrDetFeu].etat:=false
else
Affiche('Erreur 741: Adresse détecteur feu trop élevé: '+intToSTR(AdrDetFeu),clred);
maj_feu(AdrFeu);
end;
end;
end;
if TraceListe then AfficheDebug('Création Train n°'+intToSTR(N_trains),clyellow);
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
// si on démarre d'un buttoir
if buttoir_adjacent(det3) then
begin
if TraceListe then AfficheDebug('Détection démarrage depuis détecteur '+IntToSTR(det3)+' buttoir',clyellow);
event_det_train[N_trains].det[1].adresse:=0;
event_det_train[N_trains].det[2].adresse:=det3;
event_det_train[N_trains].NbEl:=2;
s:='3. Nouveau Tampon train '+intToStr(N_Trains)+'--------';
with FormDebug.MemoEvtDet do
begin
lines.add(s);
lines.add(intToSTR(event_det_train[N_Trains].det[1].adresse));
lines.add(intToSTR(event_det_train[N_Trains].det[2].adresse));
end;
if dupliqueEvt then
begin
AfficheDebug(s,clyellow);
AfficheDebug(intToSTR(event_det_train[N_Trains].det[1].adresse),clyellow);
AfficheDebug(intToSTR(event_det_train[N_Trains].det[2].adresse),clyellow);
end;
end
else
begin
with event_det_train[N_trains] do
begin
det[1].adresse:=det3;
det[1].etat:=etat;
NbEl:=1;
nom_train:=detecteur[det3].train;
AdrTrain:=detecteur[det3].AdrTrain;
end;
TrainZone[n_trains].train:=detecteur[det3].train;
TrainZone[n_trains].AdrTrain:=detecteur[det3].Adrtrain;
if roulage then
begin
j:=index_train_adresse(detecteur[det3].AdrTrain);
j:=placement[j].detdir; // detecteur destination
MemZone[det3,j].etat:=true;
MemZone[det3,j].train:=detecteur[det3].train;
MemZone[det3,j].AdrTrain:=detecteur[det3].AdrTrain;
end;
s:=intToSTR(event_det_train[N_trains].det[1].adresse);
id_couleur:=((N_trains - 1) mod NbCouleurTrain) +1;
Affiche_Evt('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',CouleurTrain[id_couleur]);
Affiche_evt(s,CouleurTrain[id_couleur]);
if dupliqueEvt then
begin
AfficheDebug('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',clyellow);
AfficheDebug(s,clyellow);
end;
if TraceListe then
begin
AfficheDebug('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',clyellow);
AfficheDebug(s,clyellow);
end;
end;
end;
end;
procedure calcul_zones(adresse: integer;front : boolean);
begin
if debug=3 then formprinc.Caption:='Calcul_zones '+intToSTR(adresse);
if Algo_localisation=1 then calcul_zones_v1(adresse,front);
if Algo_localisation=2 then calcul_zones_v2(adresse,front);
if debug=3 then formprinc.Caption:='';
end;
// demande l'état d'un détecteur à la centrale. Le résultat sera réceptionné sur évènement des informations
// de rétrosignalisation.
procedure demande_info_det_XpressNet(adresse : integer);
var s : string;
n,module : byte;
begin
// uniquement si connecté directement à la centrale
if portCommOuvert or parSocketLenz or (etat_init_interface>=11) then
begin
if protocole=1 then
begin
module:=(adresse-1) div 8; // module à partir de 64
module:=module;
s:=#$42+char(module);
//n:=((module-64) mod 8) div 2; // N=0 ou 1 (513..516 N=0 517..520 N=1 etc)
n:=((adresse-1) mod 8) div 4; // N=0 ou 1 (513..516 N=0 517..520 N=1 etc)
//Affiche(intToSTR(adresse)+' '+intToSTR(module)+' '+intToSTR(n),ClWhite);
n:=$80 or n;
s:=s+char(n);
s:=checksum(s);
envoi(s);
end;
if protocole=2 then
begin
Affiche('Erreur demande info détecteur '+intToSTR(adresse)+' non traitée en dcc+',clred);
end;
end;
end;
// demande l'état d'un accessoire à la centrale. Le résultat sera réceptionné sur évènement des informations
// de rétrosignalisation.
procedure demande_info_acc_XpressNet(adresse : integer);
var s : string;
n : byte;
begin
// uniquement si connecté directement à la centrale
if portCommOuvert or parSocketLenz then
begin
if protocole=1 then
begin
s:=#$42+char((adresse-1) div 4);
n:=((adresse-1) mod 4) div 2; // N=0 ou 1
//AfficheDebug(intToSTR(adresse)+' '+intToSTR(n),ClWhite);
n:=$80 or n;
s:=s+char(n);
s:=checksum(s);
envoi(s);
end;
if protocole=2 then
begin
Affiche('Erreur demande info accessoire '+intToSTR(adresse)+' non traitée en dcc+',clred);
end;
end;
end;
// demande l'état de tous les détecteurs par l'interface
procedure demande_etat_det;
var j,adr,t : integer;
s : string;
begin
if portCommOuvert or parSocketLenz or (etat_init_interface>=11) then
begin
Affiche('Demande état des détecteurs',ClYellow);
if protocole=1 then
begin
modeStkRetro:=true; // stockage sans evt
for j:=1 to NDetecteurs do
begin
adr:=Adresse_detecteur[j];
Affiche('Demande état détecteur '+intToSTR(adr),clLime);
retEtatDet:=false;
demande_info_det_XpressNet(adr);
t:=0;
repeat
Application.ProcessMessages;
inc(t);
sleep(10);
until (retEtatDet) or (t>100);
if t>100 then s:='=?' else
if Detecteur[adr].etat then s:='=1' else s:='=0';
Affiche_suivi(s,clLime);
end;
modeStkRetro:=false; // avec evt
end;
end;
end;
// demande l'état de tous les accessoires par l'interface
procedure demande_etat_acc;
var i,adresse : integer;
model : Tequipement;
begin
if portCommOuvert or parSocketLenz then
begin
Affiche('Demande état des aiguillages',ClYellow);
if protocole=1 then
begin
for i:=1 to maxaiguillage do
begin
model:=aiguillage[i].modele ;
if (model<>rien) and (model<>crois) then
begin
adresse:=aiguillage[i].Adresse;
Affiche('Demande état aiguillage '+intToSTR(adresse),clLime);
demande_info_acc_XpressNet(adresse);
end;
end;
end;
if protocole=2 then
begin
affiche_aigdcc:=true;
envoi('<T>');
affiche_aigdcc:=false;
end;
end;
end;
// traitement des évènements actionneurs (detecteurs aussi)
// adr adr2 : pour mémoire de zone
procedure Event_act(adr,adr2,etat : integer;trainDecl : string);
var typ,i,v,va,etatAct,Af,Ao,Access,sortie,dZ1F,dZ2F,dZ1O,dZ2O : integer;
s,st,trainDest : string;
presTrain_PN,adresseOk : boolean;
Ts : TAccessoire;
begin
// vérifier si l'actionneur en évènement a été déclaré pour réagir
if AffAigDet then AfficheDebug('Tick='+IntToSTR(tick)+' Evt Act '+intToSTR(Adr)+'/'+intToSTR(Adr2)+'='+intToSTR(etat),clyellow);
if adr=0 then exit;
//Affiche(intToSTR(adr)+'/'+intToSTR(adr2)+' '+intToSTR(etat),clyellow);
for i:=1 to maxTablo_act do
begin
s:=Tablo_actionneur[i].trainDecl;
etatAct:=Tablo_actionneur[i].etat ;
typ:=Tablo_actionneur[i].typdeclenche;
if typ=0 then
begin
st:='Détecteur/actionneur '+intToSTR(adr);
end;
if typ=1 then
begin
adresseok:=adresseOk and (Tablo_actionneur[i].adresse2=adr2);
st:='Mémoire de zone '+intToSTR(adr)+' '+intToStr(adr2);
end;
if typ=2 then
begin
st:='Aiguillage '+intToSTR(adr);
end;
adresseok:=( ((Tablo_actionneur[i].adresse=adr) and (adr2=0) ) and ((typ=0) or (typ=2)) ) or
( ((Tablo_actionneur[i].adresse=adr) and (Tablo_actionneur[i].adresse2=adr2) ) and (typ=1) );
// actionneur pour fonction train
if adresseOk and (Tablo_actionneur[i].loco) and ((s=trainDecl) or (s='X') or (trainDecl='X') or (trainDecl='')) and (etatAct=etat) then
begin
trainDest:=Tablo_actionneur[i].trainDest;
// exécution de la fonction F vers CDM
if (trainDest='X') or (trainDest='') then traindest:=traindecl;
if (trainDest='X') then traindest:=s;
Affiche(st+' TrainDecl='+trainDecl+' TrainDest='+trainDest+' F'+IntToSTR(Tablo_actionneur[i].fonction)+':'+intToSTR(etat),clyellow);
envoie_fonction_CDM(Tablo_actionneur[i].fonction,etat,trainDest);
tablo_actionneur[i].TrainCourant:=trainDest; // pour mémoriser le train pour la retombée de la fonction
tablo_actionneur[i].TempoCourante:=tablo_actionneur[i].Tempo div 100;
end;
// actionneur pour accessoire
if adresseOk and (Tablo_actionneur[i].act) and ((s=trainDecl) or (s='X') or (trainDecl='X') or (trainDecl='')) and (etatAct=etat) then
begin
access:=Tablo_actionneur[i].accessoire;
sortie:=Tablo_actionneur[i].sortie;
Affiche(st+' Train='+trainDecl+' Accessoire '+IntToSTR(access)+':'+intToSTR(sortie),clyellow);
// exécution la fonction accessoire vers CDM
if Tablo_actionneur[i].RAZ then Ts:=aigP else Ts:=Feu;
pilote_acc(access,sortie,Ts); // sans RAZ
end;
// actionneur pour son
if adresseOk and (Tablo_actionneur[i].Son) and ((s=trainDecl) or (s='X') or (trainDecl='X') or (trainDecl='')) and (etatAct=etat)
then
begin
if typ<>2 then st:=st+' Train='+trainDecl;
Affiche(st+' son '+Tablo_actionneur[i].FichierSon,clyellow);
PlaySound(pchar(Tablo_actionneur[i].FichierSon),0,SND_ASYNC);
end;
end;
// dans le tableau des PN
for i:=1 to NbrePN do
begin
if Tablo_PN[i].voie[1].actOuvre<>0 then
begin
// PN par actionneur
for v:=1 to Tablo_PN[i].nbvoies do
begin
aF:=Tablo_PN[i].voie[v].actFerme;
aO:=Tablo_PN[i].voie[v].actOuvre;
if (aO=adr) and (etat=0) then // actionneur d'ouverture
begin
Tablo_PN[i].voie[v].PresTrain:=false;
// vérifier les présences train sur les autres voies du PN
presTrain_PN:=false;
for va:=1 to Tablo_PN[i].nbvoies do
begin
presTrain_PN:=presTrain_PN or Tablo_PN[i].voie[va].PresTrain;
end;
if not(presTrain_PN) then
begin
Affiche('Ouverture PN'+intToSTR(i)+' par act '+intToSTr(adr)+' (train voie '+IntToSTR(v)+')',clOrange);
if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu;
pilote_acc(Tablo_PN[i].AdresseOuvre,Tablo_PN[i].CommandeOuvre,ts);
end;
end;
if (aF=adr) and (etat=1) then // actionneur de fermeture
begin
Tablo_PN[i].voie[v].PresTrain:=true;
s:='Fermeture PN'+IntToSTR(i)+' par act '+intToSTr(adr)+' (train voie '+IntToSTR(v)+')';
Affiche(s,clOrange);
if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu;
pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,ts);
end;
end
end
else
begin
// PN par zone de détection
//Affiche(intToSTR(adr)+'/'+intToSTR(adr2)+' '+intToSTR(etat),clyellow);
for v:=1 to Tablo_PN[i].nbvoies do
begin
dZ1F:=Tablo_PN[i].voie[v].detZ1F;
dZ2F:=Tablo_PN[i].voie[v].detZ2F;
dZ1O:=Tablo_PN[i].voie[v].detZ1O;
dZ2O:=Tablo_PN[i].voie[v].detZ2O;
if (dZ1O=adr) and (dZ2O=adr2) and (etat=0) then // zone d'ouverture
begin
Tablo_PN[i].voie[v].PresTrain:=false;
// vérifier les présences train sur les autres voies du PN
presTrain_PN:=false;
for va:=1 to Tablo_PN[i].nbvoies do
begin
presTrain_PN:=presTrain_PN or Tablo_PN[i].voie[va].PresTrain;
end;
if not(presTrain_PN) then
begin
s:='Ouverture PN'+intToSTR(i)+' par zone '+intToSTr(adr)+' '+intToSTR(adr2);
Affiche(s,clorange);
//if AffAigDet then AfficheDebug(s,clorange);
if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu;
pilote_acc(Tablo_PN[i].AdresseOuvre,Tablo_PN[i].CommandeOuvre,ts);
end;
end;
if (dZ1F=adr) and (dZ2F=adr2) and (etat=1) then // zone de fermeture
begin
Tablo_PN[i].voie[v].PresTrain:=true;
s:='Fermeture PN'+IntToSTR(i)+' par zone '+intToSTr(adr)+' '+intToSTR(adr2)+' (train voie '+IntToSTR(v)+')';
affiche(s,clorange);
//if AffAigDet then AfficheDebug(s,clorange);
if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu;
pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,ts);
end;
end;
end;
end;
end;
Procedure affiche_memoire;
var s: string;
begin
s:='Mémoire évènements '+IntToSTR(100*N_Event_tick div Max_Event_det_tick)+' %';
Formprinc.statictext.caption:=s;
end;
procedure evalue;
begin
if not(configNulle) then Maj_feux; // on ne traite pas les calculs si CDM en envoie plusieurs
end;
// traitement des évènements détecteurs
procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string);
var dr,i,AdrSuiv,AdrFeu,AdrDetfeu,index,Etat01,AdrPrec : integer;
typeSuiv : tequipement;
s : string;
begin
if adresse>NbMemZone then
begin
Affiche('Erreur 82 : reçu adresse de détecteur trop grande : '+intToSTR(adresse),clred);
exit;
end;
// vérifier si front descendant pour filtrage
if filtrageDet0<>0 then
begin
dr:=detecteur[adresse].tempo0;
if (detecteur[Adresse].etat and not(etat)) and (dr=0) then
begin
if dr<>0 then exit;
detecteur[adresse].tempo0:=filtrageDet0;
exit;
end;
if dr=99 then detecteur[adresse].tempo0:=0;
// si détecteur passe à 1 et qu'un filtrage à 0 est en cours, annuler le 0
if etat and (dr<>0) then
begin
Affiche_Evt('Détecteur '+intToSTR(adresse)+' à 0 annulé',clorange);
detecteur[adresse].tempo0:=0;
end;
end;
s:=detecteur[adresse].train;
if (train='') and (s<>'') then train:=s;
if Etat then Etat01:=1 else Etat01:=0;
// Affiche('Event Det '+inTToSTR(adresse)+' '+IntToSTR(etat01),Cyan);
// vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état
// on reçoit un doublon dans deux index consécutifs.
(*
if N_Event_tick>=1 then
begin
if (event_det_tick[N_event_tick].etat=etat01) and (event_det_tick[N_event_tick].detecteur=Adresse) then
begin
//Affiche(IntToSTR(Adresse)+' déja stocké',clorange);
exit; // déja stocké
end;
end;
*)
if Traceliste then AfficheDebug('--------------- détecteur '+intToSTR(Adresse)+' à '+intToSTR(etat01)+' par train'+Detecteur[adresse].Train+' -----------------------',clOrange);
if AffAigDet then
begin
//s:='Evt Det '+intToSTR(adresse)+'='+intToSTR(etat01);
s:='Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01)+' Train='+train;
AfficheDebug(s,clyellow);
end;
ancien_detecteur[Adresse]:=detecteur[Adresse].etat;
detecteur[Adresse].etat:=etat;
detecteur[Adresse].train:=train;
detecteur_chgt:=Adresse;
// stocke les changements d'état des détecteurs dans le tableau chronologique
if (N_Event_tick>=Max_Event_det_tick) then
begin
N_Event_tick:=0;
Affiche('Raz Evts détecteurs',clLime);
end;
inc(N_Event_tick);
event_det_tick[N_event_tick].tick:=tick;
event_det_tick[N_event_tick].adresse:=Adresse;
event_det_tick[N_event_tick].modele:=det;
event_det_tick[N_event_tick].etat:=etat01;
if (n_Event_tick mod 10) =0 then affiche_memoire;
// Affiche('stockage de '+intToSTR(N_event_tick)+' '+IntToSTR(Adresse)+' à '+intToSTR(etat01),clyellow);
// compter le nombre de détecteurs à 1 simultanément
NbDet1:=0;
for i:=1 to NDetecteurs do
begin
dr:=Adresse_detecteur[i];
if Detecteur[dr].etat then inc(NbDet1);
end;
// détection front montant
if not(ancien_detecteur[Adresse]) and (detecteur[Adresse].etat) then
begin
if AffFD then AfficheDebug('Tick='+intToSTR(tick)+' Index='+intToSTR(N_event_tick)+' FM '+intToSTR(Adresse),clyellow);
inc(N_event_det);
if algo_localisation=1 then event_det[N_event_det].adresse:=Adresse;
event_det[N_event_det].etat:=true;
if not(confignulle) then
//explore les feux pour voir si on démarre d'un buttoir
for i:=1 to NbreFeux do
begin
AdrFeu:=Feux[i].Adresse;
AdrDetfeu:=Feux[i].Adr_Det1;
if (AdrDetFeu=Adresse) and (feux[i].aspect<10) then
begin
AdrSuiv:=Feux[i].Adr_el_suiv1;
TypeSuiv:=Feux[i].Btype_suiv1;
if AffSignal then AfficheDebug('Pour Feu '+intToSTR(AdrFeu)+' detecteursuivant('+intToSTR(AdrSuiv)+','+BTypeToChaine(typeSuiv)+','+intToSTR(AdrDetFeu)+',1)',clyellow);
AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,det,1) ; // détecteur précédent le feu, algo 1
if AdrPrec=0 then
begin
If traceListe then AfficheDebug('Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow);
MemZone[0,AdrDetFeu].etat:=true;
event_act(0,AdrDetFeu,1,''); // activation zone
maj_feu(AdrFeu);
end;
end;
end;
// gérer l'évènement actionneur pour action
if etat then i:=1 else i:=0;
event_act(Adresse,0,i,'');
if not(confignulle) then calcul_zones(adresse,true);
end;
// détection fronts descendants
if ancien_detecteur[Adresse] and not(detecteur[Adresse].etat) and (N_Event_det<Max_event_det) then
begin
// si le FD du détecteur a déjà été stocké à l'index précédent ne pas en tenir compte
//if event_det[N_event_det]<>Adresse then
begin
if AffFD then AfficheDebug('Tick='+intToSTR(tick)+' Index='+intToSTR(N_event_tick)+' FD '+intToSTR(Adresse),clyellow);
inc(N_event_det);
if algo_localisation=1 then event_det[N_event_det].adresse:=Adresse;
event_det[N_event_det].etat:=false;
// vérification de la connaissance de la position de tous les aiguillages au premier évènement FD détecteur
if not(PremierFD) then
begin
for i:=1 to MaxAiguillage do
begin
index:=index_aig(i);
if aiguillage[index].modele<>rien then
begin
if aiguillage[index].position=const_inconnu then
begin
Affiche('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred);
AfficheDebug('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred);
end;
end;
end;
end;
premierFD:=True;
// gérer l'évènement detecteur pour action
if etat then i:=1 else i:=0;
event_act(Adresse,0,i,train);
if not(confignulle) then calcul_zones(adresse,false);
end;
end;
if (N_event_det>=Max_event_det) then
begin
Affiche('Débordement d''évènements FD - Raz tampon',clred);
N_event_det:=0;
FormDebug.MemoEvtDet.lines.add('Raz sur débordement');
end;
// attention à partir de cette section le code est susceptible de ne pas être exécuté??
// Mettre à jour le TCO
if TcoOuvert then
begin
formTCO.Maj_TCO(Adresse);
end;
end;
// note: si on pilote un aiguillage par signaux complexes vers CDM et que celui ci est inversé,
// on recoit un evt de CDM de l'aiguillage dans le mauvais sens.
// par contre si on pilote cet aiguillage dans CDM, on le recoit dans le bon sens.
// évènement d'aiguillage (accessoire)
// pos = const_droit=2 ou const_devie=1
procedure Event_Aig(adresse,pos : integer);
var s: string;
faire_event,inv : boolean;
prov,index,i,etatact,typ,adr : integer;
begin
index:=index_aig(adresse);
if index=0 then exit;
// si l'aiguillage est inversé dans CDM et qu'on est en mode autonome ou CDM, inverser sa position
inv:=false;
if (aiguillage[index].inversionCDM=1) and (portCommOuvert or parSocketLenz) then
begin
prov:=pos;
inv:=true;
if prov=const_droit then pos:=const_devie else pos:=const_droit;
end;
// ne pas faire l'évaluation si l'ancien état de l'aiguillage est indéterminée (9)
// car le RUN vient de démarrer
faire_event:=aiguillage[index].position<>9;
aiguillage[index].position:=pos; // stockage de la nouvelle position de l'aiguillage
// ------------- stockage évènement aiguillage dans tampon event_det_tick -------------------------
if (N_Event_tick>=Max_Event_det_tick) then
begin
N_Event_tick:=0;
Affiche('Raz Evts ',clLime);
end;
if AffAigDet then
begin
s:='Tick='+IntToSTR(tick)+' Evt Aig '+intToSTR(adresse)+'='+intToSTR(pos);
case pos of
const_droit : s:=s+' droit';
const_devie : s:=s+' dévié';
const_inconnu : s:=s+' inconnu';
end;
if inv then s:=s+' INV';
AfficheDebug(s,clyellow);
FormDebug.MemoEvtDet.lines.add(s) ;
end;
if (n_Event_tick mod 10) =0 then affiche_memoire;
inc(N_Event_tick);
event_det_tick[N_event_tick].tick:=tick;
event_det_tick[N_event_tick].adresse:=adresse;
event_det_tick[N_event_tick].modele:=aig;
event_det_tick[N_event_tick].etat:=pos;
// Mettre à jour le TCO
if TCOouvert then formTCO.Maj_TCO(Adresse);
// l'évaluation des routes est à faire selon conditions
if faire_event and not(confignulle) then begin evalue;evalue;end;
// actionneur d'aiguillage
for i:=1 to maxTablo_act do
begin
etatAct:=Tablo_actionneur[i].etat ;
adr:=Tablo_actionneur[i].adresse;
typ:=Tablo_actionneur[i].typdeclenche;
if (typ=2) and (Adr=adresse) then event_act(Adresse,0,pos,'');
end;
end;
// pilote une sortie à 0 à l'interface dont l'adresse est à 1 ou 2 (octet)
procedure Pilote_acc0_X(adresse : integer;octet : byte);
var groupe : integer ;
fonction : byte;
s : string;
begin
if (portCommOuvert or parSocketLenz) then
begin
if debug_dec_sig then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet)+' à 0',clorange);
if protocole=1 then
begin
groupe:=(adresse-1) div 4;
fonction:=((adresse-1) mod 4)*2 + (octet-1);
s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie
s:=checksum(s);
envoi(s); // envoi de la trame à l'interface et attente Ack
end;
if protocole=2 then
begin
//la RAZ d'une sortie n'existe pas en DCC+!
end;
end;
end;
// pilotage d'un accessoire (décodeur d'aiguillage, de signal) et génère l'event aig
// par CDM ou interface
// octet = 1 (dévié) ou 2 (droit)
// si acc=Taig, alors la sortie "octet" est mise à 1 puis à 0
// si acc=feu, alors la sortie "octet" est mise à 1 uniquement.
// Résultat true si ok
function pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire): boolean;
var groupe,temp,indexAig,AdrTrain : integer ;
fonction,pilotage : byte;
s : string;
label mise0;
begin
//Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow);
pilotage:=octet;
// test si pilotage aiguillage inversé
if (acc=aigP) then
begin
indexAig:=index_aig(adresse);
AdrTrain:=aiguillage[indexAig].AdrTrain;
if AdrTrain<>0 then
begin
Affiche('Pilotage impossible, l''aiguillage '+intToSTR(adresse)+' est réservé par le train @'+intToSTR(AdrTrain),clred);
Result:=false;
exit;
end;
if (aiguillage[indexAig].inversionCDM=1) then
begin
if octet=1 then pilotage:=2 else pilotage:=1;
end;
end;
// pilotage par CDM rail -----------------
if CDM_connecte then
begin
//AfficheDebug(intToSTR(adresse),clred);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(pilotage),clorange);
if aff_acc then Affiche('Accessoire '+intToSTR(adresse)+' à '+intToSTR(pilotage),clorange);
s:=chaine_CDM_Acc(adresse,pilotage);
envoi_CDM(s);
if (acc=feu) and not(Raz_Acc_signaux) then exit;
sleep(50);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
if aff_acc then Affiche('Accessoire '+intToSTR(adresse)+' à 0',clorange);
s:=chaine_CDM_Acc(adresse,0);
envoi_CDM(s);
event_aig(adresse,pilotage);
result:=true;
exit;
end;
if (pilotage=0) or (pilotage>2) then exit;
// pilotage par USB ou par éthernet de la centrale ------------
if (portCommOuvert or parSocketLenz) then
begin
if hors_tension then
begin
Affiche('Voie hors tension, pas de pilotage d''accessoires',clRose);
result:=false;
exit;
end;
if protocole=1 then
begin
groupe:=(adresse-1) div 4;
fonction:=((adresse-1) mod 4)*2 + (pilotage-1);
// pilotage à 1
s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie
s:=checksum(s);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(pilotage),clorange);
envoi(s); // envoi de la trame et attente Ack
event_aig(adresse,pilotage);
// si l'accessoire est un feu et sans raz des signaux, sortir
if (acc=feu) and not(Raz_Acc_signaux) then exit;
// si aiguillage, faire une temporisation
//if (index_feu(adresse)=0) or (Acc=aig) then
if Acc=AigP then
begin
temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4;
if portCommOuvert or parSocketLenz then tempo(temp);
end;
//sleep(50);
// pilotage à 0 pour éteindre le pilotage de la bobine du relais
s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie
s:=checksum(s);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
envoi(s); // envoi de la trame et attente Ack
result:=true;
exit;
end;
if protocole=2 then
begin
event_aig(adresse,pilotage);
// en pilotage, on envoie que l'ID cad l'adresse - 0=droit 1=dévié
if pilotage=const_devie then fonction:=1;
if pilotage=const_droit then fonction:=0;
//affiche_retour_DCC:=true;
s:='<T '+intToSTR(adresse)+' '+intToSTR(fonction)+'>';
//Affiche(s,clYellow);
envoi(s);
result:=true;
exit;
end;
end;
// pas de centrale et pas CDM connecté: on change la position de l'aiguillage
if acc=aigP then event_aig(adresse,octet);
result:=true;
end;
// le décodage de la rétro est appelé sur une réception d'une trame de la rétrosignalisation de la centrale.
// On déclenche ensuite les évènements détecteurs ou aiguillages.
// modeStkRetro=false = stockage sur changement d'état, et génère évènement détecteur
// true = stockage de l'état sans évènement
procedure decode_retro_XpressNet(adresse,valeur : integer);
var s : string;
adraig,bitsITT,i : integer;
etat : boolean;
begin
//afficheDebug(IntToSTR(adresse)+' '+intToSTR(valeur),clorange);
bitsITT:=valeur and $40;
// bit à 010X XXXX = c'est un module de rétrosignalisation (pas un aiguillage)
// doc LENZ Xpressnet protocol description page 31
detecteur_chgt:=0;
// ---------- Cas N=1
if (valeur and $10)=$10 then // si bit N=1, les 4 bits de poids faible sont les 4 bits de poids fort du décodeur
begin
// détermine le détecteur qui a changé d'état
// -------état du détecteur
if bitsITT=$40 then // module de rétro = détecteur
begin
// affecter l'état des détecteurs
i:=adresse*8+8;
etat:=(valeur and $8) = $8;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 7
begin
Event_detecteur(i,etat,''); // pas de train affecté sur le décodage de la rétrosignalisation
end;
if modeStkRetro then detecteur[i].etat:=etat;
i:=adresse*8+7;
etat:=(valeur and $4) = $4;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 6
begin
Event_detecteur(i,(valeur and $4) = $4,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
i:=adresse*8+6;
etat:=(valeur and $2) = $2;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 5
begin
Event_detecteur(i,(valeur and $2) = $2,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
i:=adresse*8+5;
etat:=(valeur and $1) = $1;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 4
begin
Event_detecteur(i,(valeur and $1) = $1,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
retEtatDet:=true;
end;
// état de l'aiguillage
if bitsITT=$00 then // module d'aiguillages, N=1
begin
adraig:=((adresse * 4)+1 ); // *4 car N=1, c'est le "poids fort"
if (valeur and $C)=$8 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=2';AfficheDebug(s,clYellow);end;
Event_Aig(adraig+3,const_droit);
end;
if (valeur and $C)=$4 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=1';AfficheDebug(s,clYellow);end;
Event_Aig(adraig+3,const_devie);
end;
if ((valeur and $C)=0) and TraceTrames then begin s:='accessoire '+intToSTR(adraig+3)+' indéfini';AfficheDebug(s,clYellow);end;
if (valeur and $3)=$2 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=2';AfficheDebug(s,clYellow);end;
Event_Aig(adraig+2,const_droit);
end;
if (valeur and $3)=$1 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=1';AfficheDebug(s,clYellow);end;
Event_Aig(adraig+2,const_devie);
end;
if ((valeur and $3)=0) and TraceTrames then begin s:='accessoire '+intToSTR(adraig+2)+' indéfini';AfficheDebug(s,clYellow);end;
end;
end;
// ---------- Cas N=0
if (valeur and $10)=$00 then // si bit N=0, les 4 bits de poids faible sont les 4 bits de poids faible du décodeur
begin
//Affiche('N=0',clYellow);
if bitsITT=$40 then // module de rétro
begin
// affecter l'état des détecteurs
i:=adresse*8+4;
etat:=(valeur and $8) = $8;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 7
begin
Event_detecteur(i,(valeur and $8) = $8,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
i:=adresse*8+3;
etat:=(valeur and $4) = $4;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 6
begin
Event_detecteur(i,(valeur and $4) = $4,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
i:=adresse*8+2;
etat:=(valeur and $2) = $2;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 5
begin
Event_detecteur(i,(valeur and $2) = $2,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
i:=adresse*8+1;
etat:=(valeur and $1) = $1;
if detecteur[i].etat<>etat then // si changement de l'état du détecteur bit 4
begin
Event_detecteur(i,(valeur and $1) = $1,'');
end;
if modeStkRetro then detecteur[i].etat:=etat;
retEtatDet:=true; // marqueur "reçu état détecteur"
end;
if bitsITT=$00 then // module d'aiguillages
begin
adraig:=(adresse * 4)+1;
if (valeur and $C)=$8 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=2';AfficheDebug(s,clYellow);end;
Event_Aig(adraig+1,const_droit);
end;
if (valeur and $C)=$4 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=1';AfficheDebug(s,clYellow);end;
Event_Aig(adraig+1,const_devie);
end;
if ((valeur and $C)=0) and TraceTrames then begin s:='accessoire '+intToSTR(adraig+1)+' indéfini';AfficheDebug(s,clYellow);end;
if (valeur and $3)=$2 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=2';AfficheDebug(s,clYellow);end;
Event_Aig(adraig,const_droit);
end;
if (valeur and $3)=$1 then
begin
if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=1';AfficheDebug(s,clYellow);end;
Event_Aig(adraig,const_devie);
end;
if ((valeur and $3)=0) and TraceTrames then begin s:='accessoire '+intToSTR(adraig)+' indéfini';AfficheDebug(s,clYellow);end;
end;
end;
end;
// renvoi le nombre de paramètres dans une chaine DCC++ entre le premier < >
function nombre_parametres(s : string) : integer;
var i,j,n : integer;
begin
i:=1;n:=0;
j:=pos('>',s);
repeat
i:=posEx(' ',s,i);
if i<>0 then begin inc(n);inc(i);end;
until (i=0) or (i>j);
result:=n;
end;
// décodage chaine au protocole DCC (un seul paramètre encadré par < > )
function decode_chaine_retro_dcc(chaineINT : string) : string;
var i,j,n,adresse,groupe,rang,valeur,erreur : integer;
s : string;
begin
if length(s)>0 then if chaineINT[1]=#$0D then delete(chaineINT,1,1);
if length(s)>0 then if chaineINT[1]=#$0A then delete(chaineINT,1,1);
i:=pos('<',chaineINT);
j:=pos('>',chaineINT);
if (i=0) or (j=0) then exit;
n:=pos(#$0D,chaineINT);
if n>j then delete(chaineINT,n,1);
n:=pos(#$0A,chaineINT);
if n>j then delete(chaineINT,n,1);
if i>1 then delete(chaineINT,1,i-1);
ack:=chaineINT<>'';
// Affiche(copy(chaineINT,i,j-i+1),clblue);
if affiche_retour_dcc then
begin
Affiche(copy(chaineINT,i,j-i+1),clOrange);
end;
if pos('DCC',chaineINT)<>0 then
begin
version_Interface:=chaineINT;
delete(chaineINT,i,j-i+1);
result:=chaineINT;
exit;
end;
// rien
i:=pos('<N',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,j);
result:=chaineINT;
exit;
end;
// réponse écriture eprom
i:=pos('<e',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+2);
val(chaineINT,valeur,erreur);
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
// eprom vide
i:=pos('<0>',chaineINT);
if i<>0 then
begin
delete(chaineINT,i,j-i);
result:=chaineINT;
exit;
end;
// détecteur 0 (Q ID) ou réponse à un détecteur si 3 paramètres (Q ID PIN PULLUP)
i:=pos('<Q',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+2);
val(chaineINT,valeur,erreur);
i:=pos('>',chaineINT);
if i=erreur then // 1 seul paramètre
begin
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
Event_detecteur(valeur+AdrBaseDetDccpp,true,''); // pas de train affecté
exit;
end;
// sinon 3 paramètres
if i<>0 then delete(chaineINT,1,i);
exit;
end;
// détecteur 1
i:=pos('<q',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+2);
val(chaineINT,valeur,erreur);
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
Event_detecteur(valeur+AdrBaseDetDccpp,false,''); // pas de train affecté
exit;
end;
// réponse à la demande de mise sous tension ou hors tension de la voie
i:=pos('<p',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+1);
val(chaineINT,valeur,erreur);
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
// Ok
i:=pos('<O>',chaineINT);
if i<>0 then
begin
delete(chaineINT,i,3);
result:=chaineINT;
exit;
end;
// o
i:=pos('<o',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+2);
val(chaineINT,N_modules_dcc,erreur);
Affiche('Nombre de modules s88='+intToSTR(N_modules_dcc),clyellow);
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
// y détecteur en hexa
i:=pos('<y',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+2);
i:=0;
repeat
if chaineINT[1]='0' then valeur:=0 else valeur:=1;
delete(chaineINT,1,1);
Event_detecteur(AdrBaseDetDccpp+i,valeur=1,'');
//affiche(intToSTR(513+i),clyellow);
inc(i);
until (chaineINT[1]='>') or (length(s)=1);
delete(chaineINT,1,1);
result:=chaineINT;
exit;
end;
// Nok
i:=pos('<X>',chaineINT);
if i<>0 then
begin
delete(chaineINT,i,3);
result:=chaineINT;
exit;
end;
// réponse à un aiguillage ou à leur définition
i:=pos('<H',chaineINT);
if i<>0 then
begin
// détermine le nombre de paramètres
delete(chaineINT,1,i+1);
n:=nombre_parametres(chaineINT);
if n=4 then // position d'un aiguillage, réponse à <T>
begin
val(chaineINT,adresse,erreur);
delete(chaineINT,1,erreur);
val(chaineINT,groupe,erreur);
delete(chaineINT,1,erreur);
val(chaineINT,rang,erreur);
delete(chaineINT,1,erreur);
val(chaineINT,valeur,erreur);
j:=const_inconnu;
if valeur=0 then j:=const_droit;
if valeur=1 then j:=const_devie;
i:=index_aig(adresse);
if i<>0 then aiguillage[i].position:=j
else affiche('Erreur 70 : Aiguillage '+intToSTR(adresse)+' envoyé par la centrale non défini dans signaux_complexes',clred);
if affiche_aigdcc then
begin
s:='Aiguillage '+intToSTR(adresse)+':';
if j=const_droit then s:=s+'droit';
if j=const_devie then s:=s+'devie';
Affiche(s,clyellow);
end;
end;
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
// réponse à une demande de vitesse loco
i:=pos('<T',chaineINT); // <t 4 4 9 7 1> ou <t 4 9 7>
if i<>0 then
begin
delete(chaineINT,1,i+1);
val(chaineINT,valeur,erreur);
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
// réponse à la programmation d'un CV
i:=pos('<r',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+1);
j:=pos('|',chaineINT);
j:=posEx('|',chaineINT,j+1);
delete(chaineINT,1,j);
val(chaineINT,valeur,erreur);
tablo_cv[1]:=valeur;
recu_cv:=true;
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
// réponse aux définitions des sorties
i:=pos('<Y',chaineINT);
if i<>0 then
begin
delete(chaineINT,1,i+2);
val(chaineINT,valeur,erreur);
i:=pos('>',chaineINT);
if i<>0 then delete(chaineINT,1,i);
result:=chaineINT;
exit;
end;
if chaineINT<>'' then Affiche('Reçu commande inconnue :'+chaineINT,clred);
result:='';
end;
// décodage d'une chaine simple de la rétrosignalisation de la centrale
// en sortie, la chaine chaineINT est supprimée de la partie traitée
function decode_chaine_retro_Xpress(chaineINT : string) : string ;
var msg : string;
i,cvLoc,AdrTrainLoc : integer;
begin
//affiche(chaine_hex(chaine),clyellow);
msg:='';
ack:=true;nack:=false;
// décodage du 3eme octet de la chaîne
if chaineINT[1]=#1 then
begin
case chaineINT[2] of // page 13 doc XpressNet
#1 : begin nack:=true;msg:='erreur timout transmission';end;
#2 : begin nack:=true;msg:='erreur timout centrale';end;
#3 : begin nack:=true;msg:='erreur communication inconnue';end;
#4 : begin succes:=true;msg:='succès';end;
#5 : begin nack:=true;msg:='plus de time slot';end;
#6 : begin nack:=true;msg:='débordement tampon LI100';end;
end;
if traceTrames and (chaineINT[2]=#4) then AfficheDebug(msg,clYellow);
if traceTrames and (chaineINT[2]<>#4) then AfficheDebug(msg,clRed);
delete(chaineINT,1,3);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineINT[1]=#2 then
begin
msg:='Version matérielle '+intTohex(ord(chaineINT[2]),2)+' - Version soft '+intToHex(ord(chaineINT[3]),2);
Affiche(msg,clYellow);
version_Interface:=chaineInt;
delete(chaineINT,1,4);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineINT[1]=#$61 then
begin
delete(chaineInt,1,1);
case chaineINT[1] of
#$00 : begin ack:=true;msg:='Voie hors tension';end;
#$01 : begin ack:=true;msg:='Reprise';Hors_tension:=false;end;
#$02 : begin ack:=true;msg:='Mode programmation ';end;
#$80 : begin nack:=true;msg:='erreurs de transferts- Voir doc XpressNet p29';end;
#$81 : begin nack:=true;msg:='Station occupée - Voir doc XpressNet p29';end;
#$82 : begin nack:=true;msg:='Commande non implantée';end;
else begin nack:=true;msg:='Réception inconnue';end;
end;
if nack then affiche(msg,clred) else affiche(msg,clyellow);
delete(chaineINT,1,2);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if ((chaineINT[1]=#$63) and (chaineINT[2]=#$14)) then // V3.6 uniquement
begin
// réception d'un CV. DocXpressNet p26 63 14 01 03 chk
delete(chaineInt,1,2);
cvLoc:=ord(chaineINT[1]);
//Affiche('Réception CV'+IntToSTR(cvLoc)+' à '+IntToSTR(ord(chaineINT[2])),clyellow);
if cvLoc>255 then Affiche('Erreur Recu CV>255',clRed)
else
begin
tablo_cv[cvLoc]:=ord(chaineINT[2]);
inc(N_Cv); // nombre de CV recus
end;
recu_cv:=true;
delete(chaineInt,1,3);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineINT[1]=#$42 then
begin
delete(chaineInt,1,1);
decode_retro_XpressNet(ord(chaineInt[1]),ord(chaineInt[2]));
delete(chaineInt,1,3);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineINT[1]=#$81 then
begin
delete(chaineInt,1,2);
Affiche('Voie hors tension msg1',clRed);
Hors_tension:=true;
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineINT[1]=#$61 then
begin
delete(chaineInt,1,2);
Affiche('Voie hors tension msg2',clRed);
Hors_tension:=false;
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineINT[1]=#$46 then
begin
//FF FD 46 43 40 41 40 40 49 4D non documentée
//FF FD 46 43 50 41 50 40 50 54 non documentée
// 46 43 40 41 40 40 48 4C
// 46 43 50 41 54 40 50 50
Affiche('reprise puissance ',clLime);
delete(chaineInt,1,8);
Hors_tension:=false;
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
i:=pos(#$46+#$43+#$50,chaineInt);
if (i<>0) and (length(chaineInt)>=3) then
begin
delete(chaineInt,1,3);
Affiche('Reprise msg 2',clOrange);
Hors_tension:=false;
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineInt[1]=#$81 then
begin
delete(chaineInt,1,2);
Affiche('Court circuit msg 1',clRed);
Hors_tension:=true;
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
//E3 40 ah al A0
if chaineInt[1]=#$E3 then
begin
// la loco ah al est pilotée par le PC
delete(chaineInt,1,5);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
if chaineInt[1]=#$E4 then
begin
AdrTrainLoc:=ord(chaineInt[2]); // identification
i:=ord(chaineInt[3]); // vitesse
Fa:=ord(chaineInt[4]); // fonction A
Fb:=ord(chaineInt[5]); // fonction B
delete(chaineInt,1,6);
decode_chaine_retro_Xpress:=chaineINT;
exit;
end;
ack:=false;
nack:=true;
affiche('Erreur 7, chaîne rétrosig. inconnue recue:'+chaine_HEX(chaineINT),clred);
decode_chaine_retro_Xpress:='';
end;
// procédure appellée après réception sur le port USB ou socket
// la chaine peut contenir plusieurs informations
// on boucle tant qu'on a pas traitée toute la chaine
function interprete_reponse(chaine : string): string;
var chaineInt: string;
i,j : integer;
begin
chaineINT:=chaine;
if protocole=1 then
begin
while length(chaineINT)>=3 do
begin
if length(chaineINT)>4 then
begin
// supprimer l'entete éventuelle
if (chaineINT[1]=#$ff) and (chaineINT[2]=#$fe) then Delete(chaineINT,1,2);
if (chaineINT[1]=#$ff) and (chaineINT[2]=#$fd) then Delete(chaineINT,1,2);
end;
chaineINT:=decode_chaine_retro_Xpress(chaineINT);
end;
end;
if protocole=2 then
begin
i:=pos('<',chaineINT);
j:=pos('>',chaineINT);
while (i<>0) and (j<>0) do
begin
chaineINT:=decode_chaine_retro_dcc(chaineINT);
i:=pos('<',chaineINT);
j:=pos('>',chaineINT);
end;
end;
interprete_reponse:=chaineINT;
end;
function HexToStr(s: string) : string ;
// transforme une chaîne ascii 0A FF CA.. en chaine d'octets décimaux ascii = 10 255 ...
var i,long,erreur : integer;
st : string;
v : byte;
begin
long:=length(s);
st:='';
i:=1;
repeat
val('$'+copy(s,i,2),v,erreur);
st:=st+char(v);
inc(i,3);
until (i>=long);
HexToStr:=st;
end;
procedure deconnecte_CDM;
var i : integer;
begin
if Cdm_connecte then
begin
with formprinc do
begin
CDM_connecte:=False;
ClientSocketCDM.close;
LabelTitre.caption:=Titre;
caption:=AF;
MenuConnecterUSB.enabled:=true;
DeConnecterUSB.enabled:=true;
ConnecterCDMRail.enabled:=true;
FormPrinc.ComboTrains.Items.Clear;
for i:=1 to ntrains do ComboTrains.Items.Add(trains[i].nom_train);
if ntrains>0 then
begin
ComboTrains.ItemIndex:=0;
editadrtrain.Text:=inttostr(trains[1].adresse);
end;
end;
Affiche('CDM rail déconnecté',Cyan);
AfficheDebug('CDM rail déconnecté',Cyan);
filtrageDet0:=SauvefiltrageDet0;
end;
end;
{$J+}
// vérifie si version OS32 bits ou OS64 bits
function IsWow64Process: Boolean;
type
TIsWow64Process=function(hProcess: THandle; var Wow64Process: Boolean): Boolean; stdcall;
var
DLL: THandle;
pIsWow64Process: TIsWow64Process;
const
IsWow64: Boolean=False;
begin
IsWow64:=false;
DLL:=LoadLibrary('kernel32.dll');
if (DLL<>0) then
begin
pIsWow64Process:=GetProcAddress(DLL,'IsWow64Process');
if (Assigned(pIsWow64Process)) then
begin
pIsWow64Process(GetCurrentProcess,IsWow64);
end;
FreeLibrary(DLL);
end;
Result:=IsWow64;
end;
{$J-}
procedure envoi_aiguillages_DCCpp;
var adr,groupe,fonction,i : integer;
s :string;
begin
Affiche('Envoi la liste des aiguillages à la centrale DCC++',clyellow);
Affiche('',clyellow);
for i:=1 to MaxAiguillage do
begin
adr:=aiguillage[i].adresse;
groupe:=((adr-1) div 4)+1;
fonction:=((adr-1) mod 4);
s:='<T '+intToSTR(adr)+' '+intToSTR(groupe)+' '+intToSTR(fonction)+'>';
Affiche_suivi(intToSTR(adr)+' ',clyellow);
envoi(s);
end;
end;
function test_protocole : boolean;
var s: string;
temp : integer;
begin
begin
if protocole=1 then // Xpressnet
begin
s:=#$f0;
s:=checksum(s);
end;
if protocole=2 then // dcc++
s:='<s>';
envoi_ss_ack(s);
application.processMessages;
temp:=0;
repeat
sleep(100);
inc(temp);
Application.processmessages;
until (version_Interface<>'') or (temp>15);
if (temp>15) then
begin
s:=' mais l''interface n''a pas répondu ';
if protocole=1 then s:=s+' en XpressNet';
if protocole=2 then s:=s+' en DCC++';
Affiche_suivi(s,clyellow);
portCommOuvert:=false; // refermer le port
result:=false;
exit;
end
else
begin
if (protocole=1) and (version_interface[1]=#2) then
begin
Affiche_suivi(' et l''interface a répondu correctement en '+intToSTR(temp)+'00 ms',clLime);
result:=true;
exit;
end;
if (protocole=2) and (version_interface<>'') then
begin
Affiche_suivi(' et l''interface a répondu correctement en '+intToSTR(temp)+'00 ms',clLime);
result:=true;
exit;
end;
Affiche_suivi(s+' mais l''interface a répondu incorrectement',clyellow);
result:=false;
end;
end
end;
// connecte un port usb. Si le port n'est pas ouvert, renvoie 0, sinon renvoie
// le numéro de port
function connecte_port_usb(port : integer) : integer;
var i,j : integer;
trouve : boolean;
s : string;
begin
result:=0;
trouve:=false;
With Formprinc.MSCommUSBLenz do
begin
if debug=1 then Affiche('Test port com'+intToSTR(port),clLime);
version_interface:='';
i:=pos(':',portCom);
j:=pos(',',PortCom);
j:=posEx(',',PortCom,j+1);
j:=posEx(',',PortCom,j+1);
j:=posEx(',',PortCom,j+1);
s:=copy(portCom,i+1,j-i-1);
Settings:=s; // vitesse,n,8,1
if prot_serie>=4 then Handshaking:=0 {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff 4=5=protocoles "maison"}
else Handshaking:=prot_serie;
SThreshold:=1;
RThreshold:=1;
InputLen:=0;
CommPort:=Port;
if protocole=2 then DTREnable:=false // évite de reset de l'arduino à la connexion
else
DTREnable:=True;
if prot_serie=4 then RTSEnable:=True //pour la genli
else RTSenable:=False;
InputMode:=comInputModeBinary;
end;
portCommOuvert:=true;
try
Formprinc.MSCommUSBLenz.portopen:=true;
except
portCommOuvert:=false;
end;
if portCommOuvert then
begin
Affiche('Port COM'+intToSTR(port)+' ouvert',clLime);
sleep(1000);
trouve:=test_protocole;
if not(trouve) then
begin
portCommOuvert:=false;
Formprinc.MSCommUSBLenz.portopen:=false;
end;
end;
if trouve then result:=port else result:=0;
end;
procedure init_dccpp;
var i : integer;
s : string;
begin
if EnvAigDccpp=1 then envoi_aiguillages_DCCpp; // envoi la liste des aiguillages à l'interface DCC++
i:=1;
repeat
s:=CdeDccpp[i];
if s<>'' then
begin
Affiche(s,clLime);
affiche_retour_dcc:=true;
tps_affiche_retour_dcc:=2;
envoi(s);
sleep(200);
end;
inc(i);
until (s='') or (i>MaxCdeDccpp);
end;
procedure connecte_interface_ethernet;
begin
etat_init_interface:=0;
// sinon ouvrir socket vers la centrale
// Initialisation de la comm socket LENZ
if AdresseIP<>'0' then
begin
procetape('Ouverture interface socket');
etat_init_interface:=10;
Affiche('Demande ouverture interface par Ethernet '+AdresseIP+':'+intToSTR(portinterface),clyellow);
with formprinc.ClientSocketInterface do
begin
port:=portInterface;
Address:=AdresseIP;
Open;
end;
//Application.processMessages;
end;
end;
procedure connecte_usb;
var numport,erreur : integer;
s : string;
begin
if debug=1 then affiche('Connexion interface USB',clLime);
if portcommouvert then exit;
numport:=0;
if portcom<>'' then
begin
val(copy(portcom,4,6),Numport,erreur);
end;
if numport=0 then
// scan des ports
begin
numport:=1;
repeat
//Affiche('Test port COM'+intToSTR(numport),clyellow);
With Formprinc.MSCommUSBLenz do
begin
//Affiche('Test port com'+intToSTR(numport),clyellow);
port:=connecte_port_usb(numport);
inc(numport);
end;
until (port<>0) or (numport>MaxPortCom);
end
else port:=connecte_port_usb(numport);
if port=0 then
begin
s:='Pas d''interface ';
if protocole=1 then s:=s+'XpressNet';
if protocole=2 then s:=s+'DCC++';
Affiche(s+' trouvée sur les ports COM de 1 à '+intToSTR(MaxPortCom),clOrange);
end
else
begin
Formprinc.DeConnecterUSB.enabled:=true;
With Formprinc do
begin
ButtonEcrCV.Enabled:=true;
LireunfichierdeCV1.enabled:=true;
ButtonLitCV.Enabled:=true;
end;
if protocole=1 then
begin
etat_init_interface:=20; // interface protocole reconnue
parSocketLenz:=true;
end;
if (protocole=2) then
begin
init_dccpp;
etat_init_interface:=20;
end;
end;
end;
Function GetWindowFromID(ProcessID : Cardinal): THandle;
Var TestID : Cardinal;
TestHandle : Thandle;
Begin
Result:=0;
TestHandle:=FindWindowEx(GetDesktopWindow,0,Nil,Nil);
while TestHandle>0 do
begin
if GetParent(TestHandle)=0 then GetWindowThreadProcessId(TestHandle,@TestID);
if TestID=ProcessID then
begin
Result:=TestHandle;
exit;
end;
TestHandle:=GetWindow(TestHandle,GW_HWNDNEXT)
end;
end;
// renvoie si un process EXE tourne. Renvoie le Handle du process dans CDMHd et l'Id du process dans ProcessID
// sExeName : Nom de l'EXE sans le chemin, et sans EXE }
function ProcessRunning(sExeName: String) : Boolean;
var hSnapShot : THandle;
ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32
processID : DWord;
begin
Result:=false;
hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
Win32Check(hSnapShot<>INVALID_HANDLE_VALUE);
sExeName:=LowerCase(sExeName);
FillChar(ProcessEntry32,SizeOf(TProcessEntry32),#0);
ProcessEntry32.dwSize:=SizeOf(TProcessEntry32); // contient la structure de tous les process
if (Process32First(hSnapShot,ProcessEntry32)) then
repeat
//Affiche(ProcessEntry32.szExeFile,ClYellow);
if (Pos(sExeName,LowerCase(ProcessEntry32.szExeFile))=1) then
begin
processID:=ProcessEntry32.th32ProcessID;
CDMhd:=GetWindowFromID(processID);
//Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange);
Result:=true;
Break;
end;
until (Process32Next(hSnapShot,ProcessEntry32)=false);
CloseHandle(hSnapShot);
end;
// préparation du tampon pour SendInput
procedure KeybdInput(VKey: Byte; Flags: DWORD);
begin
SetLength(KeyInputs, Length(KeyInputs)+1);
KeyInputs[high(KeyInputs)].Itype := INPUT_KEYBOARD;
with KeyInputs[high(KeyInputs)].ki do
begin
wVk:=VKey;
wScan:=MapVirtualKey(wVk,0);
dwFlags:=Flags;
end;
end;
// envoie des touches pour simuler un appui clavier
procedure SendKey(Wnd,VK : Cardinal; Ctrl,Alt,Shift : Boolean);
var MC,MA,MS : Boolean;
begin
// Etats des touches spéciales
MC:=Hi(GetAsyncKeyState(VK_CONTROL))>127;
MA:=Hi(GetAsyncKeyState(VK_MENU))>127;
MS:=Hi(GetAsyncKeyState(VK_SHIFT))>127;
// Simulation des touches de contrôle
if Ctrl<>MC then keybd_event(VK_CONTROL,0,Byte(MC)*KEYEVENTF_KEYUP,0);
if Alt<>MA then keybd_event(VK_MENU,0,Byte(MA)*KEYEVENTF_KEYUP,0);
if Shift<>MS then keybd_event(VK_SHIFT,0,Byte(MS)*KEYEVENTF_KEYUP,0);
// Appui sur les touches
keybd_event(VK,0,0,0);
keybd_event(VK,0,KEYEVENTF_KEYUP,0);
// keybd_event(MapVirtualKeyA(VK,0),0,0,0);
// keybd_event(MapVirtualKeyA(VK,0),0,KEYEVENTF_KEYUP,0);
// Relâchement des touches si nécessaire
if Ctrl<>MC then keybd_event(VK_CONTROL,0,Byte(Ctrl)*KEYEVENTF_KEYUP,0);
if Alt<>MA then keybd_event(VK_MENU,0,Byte(Alt)*KEYEVENTF_KEYUP,0);
if Shift<>MS then keybd_event(VK_SHIFT,0,Byte(Shift)*KEYEVENTF_KEYUP,0);
end;
// conversion d'une chaine standard en chaîne VK (virtual key) pour envoyer des évènements clavier
// 112=F1 .. 135=F20 136 à 143 rien 145 à 159 : spécifique ou non utilisé
// $A0 .. $B0 : contrôles curseur
// $BA : spécifique au pays
// $6A à $6F * + espace - . /
// BB à BE + - . attention la description diffère
function convert_VK(LAY : string) : string;
var i : integer;
s : string;
begin
s:='';
for i:=1 to Length(Lay) do
begin
case Lay[i] of
'0' : s:=s+#96 ;
'1' : s:=s+'a';
'2' : s:=s+'b';
'3' : s:=s+'c';
'4' : s:=s+'d';
'5' : s:=s+'e';
'6' : s:=s+'f';
'7' : s:=s+'g';
'8' : s:=s+'h';
'9' : s:=s+'i';
'*' : s:=s+#$6a;
'+' : s:=s+#$6b;
// ' ' : s:=s+#$6c;
'-' : s:=s+#$6d;
'.' : s:=s+#$6e;
'/' : s:=s+#$6f;
'_' : s:=s+'{8}';
// '\' : s:=s+#$e2;
'a'..'z' : s:=s+Upcase(lay[i]);
' ','A'..'Z',#8..#$D : s:=s+lay[i];
else Affiche('Erreur de conversion VK : '+lay,clred);
end;
end;
convert_VK:=s;
end;
// Lance et connecte CDM rail. en sortie si CDM est lancé Lance_CDM=true,
function Lance_CDM : boolean;
var i,retour,retour2 : integer;
s : string;
cdm_lanceLoc : boolean;
begin
s:='CDR';
if (ProcessRunning(s)) then
begin
// CDM déja lancé;
Affiche('CDM déjà lancé',clOrange);
Lance_CDM:=true;
if CDM_connecte then exit;
deconnecte_USB;
connecte_CDM;
exit;
end;
if lay<>'' then s:='-f '+lay else s:='';
cdm_lanceLoc:=false;
// lancement depuis le répertoire 32 bits d'un OS64
retour:=ShellExecute(Formprinc.Handle,'open',
Pchar('cdr.exe'),
Pchar(s), // paramètre
PChar('C:\Program Files (x86)\CDM-Rail\') // répertoire
,SW_SHOWNORMAL);
if retour>32 then
begin
cdm_lanceLoc:=true;
Affiche('Lancement de CDM 64 ',clyellow);
end;
if not(cdm_lanceLoc) then
begin
// si çà marche pas essayer depuis le répertoire de base sur un OS32
retour2:=ShellExecute(Formprinc.Handle,'open',
PChar('cdr.exe'),
Pchar(s), // paramètre
PChar('C:\Program Files\CDM-Rail\') // répertoire
,SW_SHOWNORMAL);
if retour2<=32 then
begin
ShowMessage('CDM rail introuvable : '+#13#10+'Erreur 32='+intToSTR(retour)+' Erreur 64='+inttoStr(retour2));
lance_CDM:=false;exit;
end;
cdm_lanceLoc:=true;
Affiche('Lancement de CDM 32 ',clyellow);
end;
if cdm_lanceLoc then
begin
Formprinc.caption:=af+' - '+lay;
// On a lancé CDM, déconnecter l'USB
deconnecte_USB;
Affiche('lance les fonctions automatiques de CDM',clyellow);
Sleep(3000);
ProcessRunning(s); // récupérer le handle de CDM
SetForegroundWindow(CDMhd);
Application.ProcessMessages;
// démarre le serveur IP : il faut avoir chargé un réseau sinon le permier menu est fermé------------------------------------
// prépare le tableau pour sendinput
KeybdInput(VK_MENU,0); // enfonce Alt
KeybdInput(Ord('C'),0); // enfonce C
KeybdInput(Ord('C'),KEYEVENTF_KEYUP); // relache C pointe premier menu "Configuration train"
KeybdInput(VK_MENU,KEYEVENTF_KEYUP); // relache ALT
KeybdInput(Ord('C'),0);
KeybdInput(Ord('C'),KEYEVENTF_KEYUP); // pointe sur 2eme menu "comm ip"
KeybdInput(VK_RETURN,0); // valide démarrer comm ip
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
KeybdInput(VK_RETURN,0);
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
// envoie les touches
i:=SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); // la fenetre serveur démarré est affichée
Sleep(300);
Application.ProcessMessages;
KeybdInput(VK_RETURN,0);
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); //fermer la fenetre
Sleep(500);
connecte_CDM;
Sleep(400);
Application.processMessages;
// Serveur d'interface --------------------------------------
if ServeurInterfaceCDM>0 then
begin
KeybdInput(VK_MENU,0); // enfonce ALT
KeybdInput(Ord('I'),0); // I
KeybdInput(Ord('I'),KEYEVENTF_KEYUP);
KeybdInput(VK_MENU,KEYEVENTF_KEYUP); // relache ALT
KeybdInput(Ord('I'),0);
KeybdInput(Ord('I'),KEYEVENTF_KEYUP);
KeybdInput(VK_RETURN,0);
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
KeybdInput(VK_RETURN,0);
KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); // affiche la fenetre d'interface
Sleep(300);
// descendre le curseur n fois pour sélectionner le serveur
for i:=1 to ServeurInterfaceCDM-1 do
begin
KeybdInput(VK_DOWN, 0);
KeybdInput(VK_DOWN, KEYEVENTF_KEYUP);
end;
// 2x TAB pour pointer sur OK
KeybdInput(VK_TAB, 0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP);
KeybdInput(VK_TAB, 0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP);
KeybdInput(VK_SPACE, 0);KeybdInput(VK_SPACE, KEYEVENTF_KEYUP);
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
Sleep(200);
// Interface
if (ServeurInterfaceCDM=1) or (ServeurInterfaceCDM=7) then
begin
for i:=1 to ServeurRetroCDM-1 do
begin
KeybdInput(VK_DOWN,0);KeybdInput(VK_DOWN,KEYEVENTF_KEYUP);
SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
end;
// 2x TAB pour pointer sur OK
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP);
KeybdInput(VK_TAB,0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP);
KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE, KEYEVENTF_KEYUP); // valide la fenetre d'interface
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
Sleep(200);
KeybdInput(VK_RETURN,0);KeybdInput(VK_RETURN, KEYEVENTF_KEYUP); // valide la fenetre finale
SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
end;
end;
end;
Lance_CDM:=true;
end;
procedure Raz_reservations ;
var i : integer;
begin
// raz des réservations
for i:=1 to MaxAiguillage do
begin
aiguillage[i].AdrTrain:=0;
end;
end;
// supprime les events, les trains etc
Procedure Raz_tout;
var i,j : integer;
begin
N_Event_tick:=0;
N_event_det:=0;
N_trains:=0;
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
for i:=1 to Max_Trains do Event_det_Train[i].NbEl:=0;
for i:=1 to 20 do begin TrainZone[i].Nbre:=0;TrainZone[i].train:='';end;
// initialisation de la chronologie des évènements détecteurs
for i:=0 to Max_Event_det_tick do
begin
event_det_tick[i].adresse:=-1;
event_det_tick[i].modele:=rien;
event_det_tick[i].etat:=-1;
event_det_tick[i].reaffecte:=0 ;
end;
for i:=1 to NbMemZone do
begin
detecteur[i].etat:=false;
detecteur[i].train:='';
detecteur[i].adrTrain:=0;
ancien_detecteur[i]:=false;
end;
for i:=1 to NbMemZone do
for j:=1 to NbMemZone do
begin
MemZone[i,j].etat:=false;
MemZone[i,j].train:='';
end;
for i:=1 to idEl do
begin
elements[i].adresse:=0;
elements[i].typ:=rien;
end;
for i:=1 to Max_Trains do
begin
event_det_train[i].NbEl:=0;
event_det_train[i].AdrTrain:=0;
event_det_train[i].nom_train:='';
event_det_train[i].Det[1].adresse:=0;
event_det_train[i].Det[1].etat:=false;
event_det_train[i].Det[2].adresse:=0;
event_det_train[i].Det[2].etat:=false;
end;
// raz des réservations
for i:=1 to maxaiguillage do
begin
aiguillage[i].AdrTrain:=0;
end;
i_simule:=0;
if DebugAffiche then
begin
FormDebug.MemoEvtDet.Clear;
end;
roulage:=false;
{ ralentit au démarrage
for i:=1 to NbreFeux do
begin
typeFeu:=feux[i].aspect;
if TypeFeu=2 then feux[i].EtatSignal:=violet_F;
if TypeFeu=3 then feux[i].EtatSignal:=semaphore_F;
if (TypeFeu>3) and (TypeFeu<10) then feux[i].EtatSignal:=carre_F;
envoi_signal(feux[i].adresse);
end; }
end;
// positionnement des aiguillages au démarrage : seulement en mode autonome
procedure init_aiguillages;
var i,pos,index : integer;
s : string;
model : Tequipement;
begin
// positionnement des aiguillages meme si pas connecté à la centrale ou à CDM
// faire en 2 fois :
// 1 fois pour initialser la position dans le tableau
// 2eme fois pour positionner physiquement les aiguillages
// pour générer les evts de position
// Affiche('Positionnement aiguillages',cyan);
init_aig_cours:=true;
for i:=1 to MaxAcc do
begin
index:=index_aig(i);
model:=aiguillage[index].modele;
if (model<>rien) and (model<>crois) then // si l'aiguillage existe et différent de croisement
begin
pos:=aiguillage[index].posInit;
if (pos=const_devie) or (pos=const_droit) then
begin
s:='Init aiguillage '+intToSTR(i)+'='+intToSTR(pos);
case pos of
const_devie : s:=s+' (dévié)';
const_droit : s:=s+' (droit)';
else
s:=s+' non positionné';
end;
Affiche(s,cyan);
aiguillage[index].position:=pos;
end;
if (pos=const_devie) or (pos=const_droit) then
begin
pilote_acc(i,pos,aigP);
if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig);
end;
end;
end;
init_aig_cours:=false;
end;
// démarrage principal du programme signaux_complexes
procedure TFormPrinc.FormCreate(Sender: TObject);
var i : integer;
s : string;
begin
TraceSign:=True;
configPrete:=false; // form config prete
PremierFD:=false;
// services commIP CDM par défaut
ntrains:=0;
ntrains_cdm:=0;
protocole:=1;
filtrageDet0:=3;
Srvc_Aig:=true;
Srvc_Det:=true;
Srvc_Act:=true;
DebugAffiche:=false;
Srvc_PosTrain:=false;
Srvc_sig:=false;
confasauver:=false;
config_modifie:=false;
AF:='Client TCP-IP CDM Rail ou USB - système XpressNet DCC++ Version '+Version+sousVersion;
chaine_recue:='';
Caption:=AF;
Application.onHint:=doHint;
// box2=CV
GroupBox2.Left:=633;
GroupBox2.Top:=60;
GroupBox2.Visible:=false;
// box3=vitesses et fonctions F
GroupBox3.Left:=633;
GroupBox3.Top:=60;
GroupBox3.visible:=true;
procetape(''); //0
// version d'OS pour info
if IsWow64Process then s:='OS 64 Bits' else s:='OS 32 Bits';
s:=DateToStr(date)+' '+TimeToStr(Time)+' '+s;
Affiche(s,clLime);
LabelEtat.Caption:='Initialisations en cours';
N_Trains:=0;
NivDebug:=0;
ncrois:=0;
EnvAigDccpp:=0;
debugtrames:=false;
algo_Unisemaf:=1;
MaxPortCom:=30;
roulage:=false;
espY:=15;
etat_init_interface:=0;
debug:=0;
etape:=1;
affevt:=false;
DebugAffiche:=false;
Algo_localisation:=1; // normal
avecRoulage:=0;
AvecInit:=true; // &&&& avec initialisation des aiguillages ou pas
Option_demarrage:=false; // démarrage des trains après tempo, pas encore au point
Diffusion:=AvecInit; // mode diffusion publique
roulage1.visible:=false;
// pour Rad studio------------------------
FenRich.Height:=Height-150;
ScrollBox1.Height:=Height-280;
StaticText.AutoSize:=true;
StaticText.Top:=FenRich.Height+FenRich.Top+10;
//----------------------------------------
ferme:=false;
CDM_connecte:=false;
pasreponse:=0;
residuCDM:='';
Nbre_recu_cdm:=0;
AffMem:=true;
N_routes:=0;
N_trains:=0;
NumTrameCDM:=0;
protocole:=1;
procetape(''); //1
for i:=1 to NbMemZone do
begin
Ancien_detecteur[i]:=false;
detecteur[i].etat:=false;
detecteur[i].train:='';
end;
Application.HintHidePause:=30000;
visible:=true; // rend la form visible plus tot
// ouvrir le TCO avant de lire la config car en mode DCC++, on va
// recevoir les events détecteurs et la mise à jour du TCO
// !!non il faut ouvrir e TCO après la config
{
procetape('Debug et TCO');
if debug=1 then affiche('Ouverture du debug',clLime);
formdebug:=TformDebug.Create(nil);
i:=0;
repeat
application.processmessages;
inc(i);
until (DebugAffiche) or (i>15);
if not(DebugAffiche) then Affiche('Erreur : fenêtre debug non créée',clred);
if debugAffiche and (Debug=1) then Affiche('Fenêtre Debug créée',clYellow);
if debug=1 then affiche('Ouverture du TCO',clLime);
//créée la fenêtre TCO non modale avant la fin de la création de formprinc
FormTCO:=TformTCO.Create(nil);
i:=0;
repeat
application.processmessages;
inc(i);
until (TcoOuvert) or (i>15);
if not(TCOOUvert) then Affiche('Erreur : fenêtre TCO non créée',clred);
if TCOOuvert and (Debug=1) then Affiche('Fenêtre TCO créée',clYellow);
}
// TCO
for i:=1 to MaxCdeDccpp do CdeDccpp[i]:='';
// lecture fichiers de configuration
procetape('on va lire la config');
lit_config;
lire_fichier_tco;
procetape('on a lu la config');
if protocole=1 then
begin
ButtonEnv.visible:=false;
EditEnvoi.Visible:=false;
end;
if protocole=2 then
begin
ButtonEnv.visible:=true;
EditEnvoi.Visible:=true;
end;
Application.ProcessMessages;
// Initialisation des images des signaux
procetape('Création des signaux');
NbreImagePLigne:=Formprinc.ScrollBox1.Width div (largImg+5);
// ajoute les images des feux dynamiquement
for i:=1 to NbreFeux do
begin
if debug=1 then affiche('Création du signal '+intToSTR(i)+' ----------',clLime);
cree_image(i); // et initialisation tableaux signaux
end;
Tempo_init:=5; // démarre les initialisation des signaux et des aiguillages dans 0,5 s
// il faut afficher la fenetre TCO pour l'init aiguillage sinon violation
begin
//créée la fenêtre TCO non modale
FormTCO:=TformTCO.Create(nil);
i:=0;
repeat
application.processmessages;
inc(i);
until (TcoOuvert) or (i>20);
Application.processmessages;
if avecTCO then FormTCO.show; // créer fiche dynamique (projet/fichier)
end;
raz_tout;
procetape('Début des init');
I_Simule:=0;
tick:=0;
N_Event_tick:=0 ; // dernier index
NombreImages:=0;
//Affiche('Fin des initialisations',clyellow);
LabelEtat.Caption:=' ';
Affiche_memoire;
modeStkRetro:=false;
// lancer CDM rail et le connecte si on le demande à faire après la création des feux et du tco
procetape('test CDM et son lancement');
if LanceCDM then Lance_CDM;
procetape('fin cdm');
Loco.Visible:=true;
// tenter la liaison vers CDM rail
procetape('Test connexion CDM');
if not(CDM_connecte) then connecte_CDM;
// si CDM n'est pas connecté, on ouvre la liaison vers la centrale
if not(CDM_connecte) then
begin
procetape('Ouvertures COM/USB');
// ouverture par USB
etat_init_interface:=1; // demande connexion usb
if AvecDemandeInterfaceUSB then connecte_USB;
if not(portCommOuvert) and AvecDemandeInterfaceEth then
begin
application.ProcessMessages;
connecte_interface_ethernet; // la connexion du socket ne se fait qu'a la sortie de cette procédure create
end;
end;
if portCommOuvert or parSocketLenz then
With Formprinc do
begin
ButtonEcrCV.Enabled:=true;
LireunfichierdeCV1.enabled:=true;
ButtonLitCV.Enabled:=true;
end
else
With Formprinc do
begin
ButtonEcrCV.Enabled:=false;
ButtonLitCV.Enabled:=false;
LireunfichierdeCV1.enabled:=false;
end;
if AvecInit then
begin
if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then
begin
Affiche('Positionnement des signaux',clYellow);
init_aiguillages; // initialisation des aiguillages
envoi_signauxCplx; // initialisation des feux
end;
if not(AvecInitAiguillages) and not(ferme) and (parSocketLenz or portCommOuvert)
and AvecDemandeAiguillages then
begin
procetape('demande etats accessoires');
demande_etat_acc; // demande l'état des accessoires (position des aiguillages)
end;
LabelEtat.Caption:=' ';
//Menu_interface(valide);
end;
DoubleBuffered:=true;
{
aiguillage[index_aig(1)].position:=const_droit;
aiguillage[index_aig(3)].position:=const_devie;
aiguillage[index_aig(4)].position:=const_devie;
aiguillage[index_aig(5)].position:=const_droit;
aiguillage[index_aig(6)].position:=const_devie;
aiguillage[index_aig(7)].position:=const_devie;
aiguillage[index_aig(8)].position:=const_devie;
aiguillage[index_aig(10)].position:=const_devie;
aiguillage[index_aig(11)].position:=const_devie;
aiguillage[index_aig(12)].position:=const_droit;
aiguillage[index_aig(18)].position:=const_devie;
aiguillage[index_aig(19)].position:=const_devie;
aiguillage[index_aig(20)].position:=const_droit;
aiguillage[index_aig(21)].position:=const_droit;
aiguillage[index_aig(26)].position:=const_droit;
aiguillage[index_aig(27)].position:=const_droit;
aiguillage[index_aig(28)].position:=const_devie;
aiguillage[index_aig(29)].position:=const_droit;
aiguillage[index_aig(31)].position:=const_devie;
aiguillage[index_aig(25)].position:=const_droit;
aiguillage[index_aig(9)].position:=const_droit;
// roulage:=true;
det_contigu(526,515,i,teq);
Affiche(intToSTR(i),clred); }
procetape('fini !!');
end;
// évènement réception d'une trame sur le port COM USB (centrale Lenz)
procedure TFormPrinc.MSCommUSBLenzComm(Sender: TObject);
var i,tev : integer;
tablo : array of byte; // tableau rx usb
begin
tev:=MSCommUSBLenz.commEvent;
{
Affiche('Evt '+intToSTR(tev),clOrange);
Case tev of
//liste des erreurs possibles
comEventBreak : Affiche('Break',clOrange); // On a reçu un signal dinterruption (Break)
comEventCDTO : Affiche('Timeout Porteuse',clOrange); // Timeout de la porteuse
comEventCTSTO : Affiche('Timeout signal CTS',clOrange); // Timeout du signal CTS (Clear To Send)
comEventDSRTO : Affiche('Timeout signal Rx',clOrange); // Timeout du signal de réception
comEventFrame : Affiche('Erreur trame',clOrange); // Erreur de trame
comEventOverrun : Affiche('Données perdues',clOrange); // Des données ont été perdues
comEventRxOver : Affiche('Tampon Rx saturé',clOrange); // Tampon de réception saturé
comEventRxParity : Affiche('Erreur parité',clOrange); //Erreur de parité
comEventTxFull : Affiche('Tampon Tx saturé',clOrange); //Tampon denvoi saturé
comEventDCB : Affiche('Erreur DCB',clOrange); //Erreur de réception DCB (jamais vu)
// liste des événements normaux possibles
comEvCD : Affiche('Chgt CD',clYellow); // ' Changement dans la broche CD (porteuse)
comEvCTS: Affiche('Chgt CTS',clYellow); // Changement dans broche CTS
comEvDSR : Affiche('Chgt DSR',clYellow); // Changement dans broche DSR (réception)
comEvRing : Affiche('Chgt RI',clYellow); // Changement dans broche RING (sonnerie)
comEvSend : Affiche('Car a envoyer',clYellow); // Il y a des caractères à envoyer
comEvEOF : Affiche('Recu EOF',clYellow); //On a reçu le caractère EOF
end;
}
if tev=comEvReceive then
begin
tablo:=MSCommUSBLenz.Input;
for i:=0 to length(tablo)-1 do
begin
chaine_recue:=chaine_recue+char(tablo[i]);
end;
setlength(tablo,0);
if traceTrames then
begin
if protocole=1 then AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+chaine_Hex(chaine_recue),Clwhite);
if protocole=2 then AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+chaine_recue,Clwhite);
end;
//if terminal then Affiche(chaine_recue,clLime);
chaine_recue:=interprete_reponse(chaine_recue);
//interprete_reponse(chaine_recue);
end;
end;
procedure TFormPrinc.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Ferme:=true;
if portCommOuvert then begin portCommOuvert:=false;MSCommUSBLenz.Portopen:=false; end;
portCommOuvert:=false;
ClientSocketCDM.close;
ClientSocketInterface.close;
if TCO_modifie then
if MessageDlg('Le TCO a été modifié. Voulez vous le sauvegarder ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
sauve_fichier_tco;
if config_modifie then
if MessageDlg('La configuration a été modifiée. Voulez vous la sauvegarder ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
sauve_config;
if confasauver then sauve_config;
Application.ProcessMessages;
end;
// timer à 100 ms
procedure TFormPrinc.Timer1Timer(Sender: TObject);
var aspect,i,a,x,y,Bimage,adresse,TailleX,TailleY,orientation : integer;
imageFeu : Timage;
frx,fry : real;
s : string;
begin
inc(tick);
if sourisclic then inc(Temposouris);
if Tdoubleclic>0 then dec(Tdoubleclic);
if Tempo_init>0 then dec(Tempo_init);
if tps_affiche_retour_dcc>0 then
begin
dec(tps_affiche_retour_dcc);
if tps_affiche_retour_dcc=0 then affiche_retour_dcc:=false;
end;
if temps>0 then dec(temps);
// gestion du clignotant des feux de la page principale
if tempsCli>0 then dec(tempsCli);
if tempsCli=0 then
begin
tempsCli:=4;
clignotant:=not(clignotant); // inversion du clignotant
//tester chaque feu pour voir s'il y a un code de clignotement
for i:=1 to NbreFeux do
begin
a:=feux[i].EtatSignal; // a = état binaire du feu
adresse:=feux[i].adresse;
if TestBit(a,jaune_cli) or TestBit(a,ral_60) or
TestBit(a,rappel_60) or testBit(a,semaphore_cli) or
testBit(a,vert_cli) or testbit(a,blanc_cli) then
begin
//Affiche(IntToSTR(adresse),clOrange);
Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adresse,1);
//Affiche('Clignote feu '+IntToSTR(adresse),clyellow);
end;
end;
// feux du TCO
if TCOouvert then // évite d'accéder à la variable FormTCO si elle est pas encore ouverte
begin
// parcourir les feux du TCO
for y:=1 to NbreCellY do
for x:=1 to NbreCellX do
begin
PcanvasTCO.pen.mode:=pmCOpy;
BImage:=TCO[x,y].bImage;
if Bimage=30 then
begin
adresse:=TCO[x,y].adresse;
i:=index_feu(adresse);
a:=feux[i].EtatSignal; // a = état binaire du feu
if TestBit(a,jaune_cli) or TestBit(a,ral_60) or
TestBit(a,rappel_60) or testBit(a,semaphore_cli) or
testBit(a,vert_cli) or testbit(a,blanc_cli) then
begin
aspect:=feux[index_feu(adresse)].Aspect;
case aspect of
2 : ImageFeu:=Formprinc.Image2feux;
3 : ImageFeu:=Formprinc.Image3feux;
4 : ImageFeu:=Formprinc.Image4feux;
5 : ImageFeu:=Formprinc.Image5feux;
7 : ImageFeu:=Formprinc.Image7feux;
9 : ImageFeu:=Formprinc.Image9feux;
else ImageFeu:=Formprinc.Image3feux;
end;
TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale)
TailleX:=ImageFeu.picture.BitMap.Width;
Orientation:=TCO[x,y].FeuOriente;
// réduction variable en fonction de la taille des cellules
calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY);
Dessine_feu_mx(PCanvasTCO,tco[x,y].x,tco[x,y].y,frx,fry,adresse,orientation);
end;
end;
end;
end;
// fenêtre de pilotage manuel du feu
if AdrPilote<>0 then
begin
a:=feux[0].EtatSignal;
if TestBit(a,jaune_cli) or TestBit(a,ral_60) or
TestBit(a,rappel_60) or testBit(a,semaphore_cli) or
testBit(a,vert_cli) or testbit(a,blanc_cli) then
Dessine_feu_pilote; // dessiner le feu en fonction du bit "clignotant"
end;
end;
// tempo retombée actionneur
for i:=1 to maxTablo_act do
begin
if Tablo_actionneur[i].TempoCourante<>0 then
begin
dec(Tablo_actionneur[i].TempoCourante);
if Tablo_actionneur[i].TempoCourante=0 then
begin
A:=Tablo_actionneur[i].adresse;
s:=Tablo_actionneur[i].trainCourant;
Affiche('Actionneur '+intToSTR(a)+' TrainDest='+s+' F'+IntToSTR(Tablo_actionneur[i].fonction)+':0',clyellow);
envoie_fonction_CDM(Tablo_actionneur[i].fonction,0,s);
end;
end;
end;
// arret loco sur n secondes
// démarrage loco temporisé
for i:=1 to 20 do
begin
a:=trains[i].TempoArret;
if a<>0 then
begin
dec(a);
trains[i].TempoArret:=a;
if a=0 then vitesse_loco('',trains[i].adresse,0,true) else
if (a mod 10)=0 then vitesse_loco('',trains[i].adresse,trains[i].VitRalenti div 2,true);
end;
a:=trains[i].TempoDemarre;
if a<>0 then
begin
dec(a);
trains[i].TempoDemarre:=a;
if a=0 then
begin
//Affiche('Démarrage train @'+intToSTR(trains[i].Adresse),clLime);
vitesse_loco('',trains[i].Adresse,trains[i].VitNominale,not(placement[i].inverse));
end;
end;
end;
//simulation
if (i_simule<>0) then
begin
if not(MsgSim) then
begin
Affiche('Simulation en cours ',Cyan);MsgSim:=true;
end;
if intervalle_courant>=Intervalle then
begin
intervalle_courant:=0;
tick:=Tablo_simule[i_simule].tick;
//s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick);Affiche(s,clYellow);
// evt détecteur ?
if Tablo_simule[I_simule].modele=det then
begin
s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' det='+intToSTR(Tablo_simule[i_simule].adresse)+'='+IntToSTR(Tablo_simule[i_simule].etat);
Event_Detecteur(Tablo_simule[i_simule].adresse, Tablo_simule[i_simule].etat=1,''); // créer évt détecteur
StaticText.caption:=s;
//Affiche(s,clyellow);
end;
// evt aiguillage ?
if Tablo_simule[I_simule].modele=aig then
begin
s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' aig='+intToSTR(Tablo_simule[i_simule].adresse)+'='+IntToSTR(Tablo_simule[i_simule].etat);
Event_Aig(Tablo_simule[i_simule].Adresse,Tablo_simule[i_simule].etat); // créer évt aiguillage
StaticText.caption:=s;
//Affiche(s,clyellow);
end;
inc(i_simule);
if i_Simule>Index_simule then
begin
Index_Simule:=0; // fin de simulation
I_Simule:=0;
MsgSim:=false;
filtrageDet0:=SauvefiltrageDet0;
Affiche('Fin de simulation',Cyan);
StaticText.caption:='';
end;
end;
inc(intervalle_courant);
end;
// temporisation détecteur à 0
for i:=1 to NbMemZone do
begin
a:=detecteur[i].tempo0;
if a<>0 then
begin
dec(a);
detecteur[i].tempo0:=a;
if (a=0) then
begin
detecteur[i].tempo0:=99;
event_detecteur(i,false,detecteur[i].train);
end;
end;
end;
end;
// bouton de commande d'un accessoire
procedure TFormPrinc.ButtonDroitClick(Sender: TObject);
var adr,erreur : integer;
s : string;
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
if pilote_acc(adr,const_droit,aigP) then
begin
s:='accessoire '+IntToSTR(adr)+' droit';
Affiche(s,clyellow);
end;
Self.ActiveControl:=nil;
end;
procedure TFormPrinc.ButtonDevieClick(Sender: TObject);
var adr,erreur : integer;
s : string;
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
pilote_acc(adr,const_devie,aigP);
s:='accessoire '+IntToSTR(adr)+' dévié';
Affiche(s,clyellow);
Self.ActiveControl:=nil;
end;
procedure TFormPrinc.EditvalEnter(Sender: TObject);
begin
if (Editval.Text<>'1') and (Editval.Text<>'2') then editval.text:='1';
end;
procedure TFormPrinc.BoutonRafClick(Sender: TObject);
begin
Maj_feux;
end;
// erreur sur socket Lenz (interface XpressNet)
procedure TFormPrinc.ClientSocketInterfaceError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var s : string;
begin
s:='Erreur '+IntToSTR(ErrorCode)+' socket IP Xpressnet';
case ErrorCode of
10053 : begin
s:=s+': Connexion avortée - Timeout';
deconnecte_cdm;
end;
10054 : s:=s+': Connexion avortée par un tiers';
10060 : s:=s+': Timeout';
10061 : s:=s+': Connexion refusée';
10065 : s:=s+': Port non connecté';
end;
if nivDebug=3 then
begin
afficheDebug(s,clOrange);
affiche(s,clOrange);
end;
parSocketLenz:=false;
ErrorCode:=0;
end;
procedure TFormPrinc.ClientSocketCDMError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var s : string;
begin
s:='Erreur '+IntToSTR(ErrorCode)+' socket IP CDM Rail';
case ErrorCode of
10053 : s:=s+': Connexion avortée - Timeout';
10054 : s:=s+': Connexion avortée par tiers';
10060 : s:=s+': Timeout';
10061 : s:=s+': Connexion refusée';
10065 : s:=s+': Port non connecté';
end;
if nivdebug=3 then
begin
afficheDebug(s,ClOrange);
affiche(s,clOrange);
end;
deconnecte_cdm;
if (portCommOuvert=false) and (parSocketLenz=false) then LabelTitre.caption:=titre;
caption:=AF;
ErrorCode:=0;
end;
// lecture depuis socket
procedure TFormPrinc.ClientSocketInterfaceRead(Sender: TObject;
Socket: TCustomWinSocket);
var s : string;
begin
s:=ClientSocketInterface.Socket.ReceiveText;
if traceTrames then afficheDebug(chaine_hex(s),clWhite);
interprete_reponse(s);
end;
// procédure Event appelée si on clique sur un checkbox de demande de feu blanc des images des feux
procedure TFormprinc.proc_checkBoxFB(Sender : Tobject);
var s : string;
Cb : TcheckBox;
etat,adresse : integer;
i : word;
coche : boolean;
begin
Cb:=Sender as TcheckBox;
coche:=cb.Checked; // état de la checkbox
s:=Cb.Name;
adresse:=extract_int(s);
if adresse<>0 then
begin
i:=index_feu(adresse);
if i=0 then exit;
etat:=feux[i].EtatSignal;
//affiche(IntToSTR(etat),clyellow);
// si le feu est vert et que la coche est mise, substituer le blanc
if ((etat=vert_F) or (etat=vert_cli_F)) and coche then
begin
Maj_Etat_Signal(Adresse,blanc);
Envoi_signauxCplx;
end;
// si pas coché, on revient en normal
if not(coche) then Maj_feux;
end;
end;
// procédure Event appelée si on clique sur un checkbox de demande de feu blanc des images des feux
procedure TFormprinc.proc_checkBoxFV(Sender : Tobject);
var s : string;
Cb : TcheckBox;
etat,adresse : integer;
i : word;
coche : boolean;
begin
Cb:=Sender as TcheckBox;
coche:=cb.Checked; // état de la checkbox
s:=Cb.name;
adresse:=extract_int(s);
if adresse<>0 then
begin
i:=index_feu(adresse);
if i=0 then exit;
etat:=feux[i].EtatSignal;
//affiche(IntToSTR(etat),clyellow);
// si le feu est vert et que la coche est mise, substituer le blanc
if (etat=vert_f) and coche then
begin
Maj_Etat_Signal(Adresse,vert_cli);
Envoi_signauxCplx;
end;
// si pas coché, on revient en normal
if not(coche) then Maj_feux;
end;
end;
// procédure Event appelée si on clique sur un checkbox de demande de feu blanc des images des feux
procedure TFormprinc.proc_checkBoxFR(Sender : Tobject);
var s : string;
Cb : TcheckBox;
etat,adresse : integer;
i : word;
coche : boolean;
begin
Cb:=Sender as TcheckBox;
coche:=cb.Checked; // état de la checkbox
s:=Cb.Name;
adresse:=extract_int(s);
if adresse<>0 then
begin
i:=index_feu(adresse);
if i=0 then exit;
etat:=feux[i].EtatSignal;
//affiche(IntToSTR(etat),clyellow);
// si le feu est vert et que la coche est mise, substituer le blanc
if (etat=semaphore_f) and coche then
begin
Maj_Etat_Signal(Adresse,semaphore_cli);
Envoi_signauxCplx;
end;
// si pas coché, on revient en normal
if not(coche) then Maj_feux;
end;
end;
procedure TFormPrinc.MenuConnecterUSBClick(Sender: TObject);
begin
Hors_tension:=false;
connecte_USB;
end;
procedure deconnecte_usb;
begin
if portCommOuvert then
begin
portCommOuvert:=false;
Formprinc.MSCommUSBLenz.Portopen:=false;
Affiche('Port USB déconnecté',clyellow);
end;
portCommOuvert:=false;
with formprinc do
begin
ClientSocketInterface.close;
MenuConnecterUSB.enabled:=true;
DeConnecterUSB.enabled:=false;
ConnecterCDMRail.enabled:=true;
DeConnecterCDMRail.enabled:=false;
end;
end;
procedure TFormPrinc.DeconnecterUSBClick(Sender: TObject);
begin
deconnecte_usb;
end;
procedure TFormPrinc.MenuConnecterEthernetClick(Sender: TObject);
begin
if AdresseIP<>'0' then
begin
Affiche('Demande de connexion de l''interface en ethernet sur '+AdresseIP+':'+IntToSTR(PortInterface),clyellow);
ClientSocketInterface.port:=portInterface;
ClientSocketInterface.Address:=AdresseIP;
ClientSocketInterface.Open;
Hors_tension:=false;
end;
end;
procedure TFormPrinc.MenuDeconnecterEthernetClick(Sender: TObject);
begin
ClientSocketInterface.Close;
end;
procedure TFormPrinc.AffEtatDetecteurs(Sender: TObject);
var j,adr,adrTrain : integer;
s : string;
begin
Affiche('Etat des détecteurs:',ClLime);
for j:=1 to NDetecteurs do
begin
adr:=Adresse_detecteur[j];
s:='Dét '+intToSTR(adr)+'=';
if Detecteur[adr].etat then s:=s+'1 ' else s:=s+'0 ';
s:=s+detecteur[adr].train;
AdrTrain:=detecteur[adr].AdrTrain;
if AdrTrain<>0 then s:=s+' @='+intToSTR(AdrTrain);
AdrTrain:=detecteur[adr].IndexTrain;
if AdrTrain<>0 then s:=s+' IndexTrain='+intToSTR(AdrTrain);
Affiche(s,clYellow);
end;
Affiche('Nombre de détecteurs à 1 :'+intToSTR(NbDet1),clYellow);
end;
// trouve l'index du détecteur de. Si pas trouvé, renvoie 0
function index_adresse_detecteur(de : integer) : integer;
var j : integer;
trouve : boolean;
begin
j:=1;
repeat
trouve:=Adresse_detecteur[j]=de;
inc(j);
until (j>NbMaxDet) or trouve;
if trouve then index_adresse_detecteur:=j
else index_adresse_detecteur:=0;
end;
procedure TFormPrinc.Etatdesaiguillages1Click(Sender: TObject);
var i,j,pos,r : integer;
model : TEquipement;
s : string;
begin
Affiche('Position des aiguillages:',ClLime);
for i:=1 to maxaiguillage do
begin
s:='';
model:=aiguillage[i].modele ;
if (model<>rien) then
begin
if model<>crois then
begin
s:='Aiguillage '+IntToSTR(aiguillage[i].Adresse)+' : ';
pos:=aiguillage[i].position;
case pos of
const_devie : s:=s+' dévié' ;
const_droit : s:=s+' droit';
const_inconnu : s:=s+' inconnue';
else s:=s+' erreur ('+intToSTR(pos)+')';
end;
end;
if model=triple then // aig triple
begin
j:=aiguillage[i].AdrTriple;
s:=s+' Aig '+IntToSTR(j)+': '+intToSTR(aiguillage[index_aig(j)].position);
if aiguillage[index_aig(j)].position=1 then s:=s+' (dévié)' else s:=s+' (droit)';
end;
r:=aiguillage[i].AdrTrain;
if (r<>0) and (model=Crois) then s:='Croisement '+IntToSTR(aiguillage[i].Adresse)+' : ';
if r<>0 then s:=s+' réservé par train @'+intToSTR(r);
if s<>'' then Affiche(s,clWhite);
end;
end;
end;
procedure TFormPrinc.Codificationdesaiguillages1Click(Sender: TObject);
var i,adr : integer ;
s : string;
begin
Affiche('Codification interne des aiguillages',Cyan);
Affiche('D=position droite S=position déviée P=pointe Z=détecteur',Cyan);
for i:=1 to MaxAiguillage do
begin
adr:=aiguillage[i].adresse;
begin
s:=IntToSTR(i)+' Adr='+IntToSTR(adr);
if aiguillage[i].modele=aig then s:=s+' Pointe=';
if (aiguillage[i].modele=crois) then
begin
s:=s+' CROI:';
end;
if (aiguillage[i].modele=tjd) then
begin
s:=s+' TJD:';
s:=s+intToSTR(aiguillage[i].EtatTJD)+' états ';
if aiguillage[i].inversionCDM=1 then s:=s+'(INV) ';
end;
if aiguillage[i].modele=tjs then
begin
s:=s+' TJS:';
if aiguillage[i].inversionCDM=1 then s:=s+'(INV) ';
end;
if aiguillage[i].modele=triple then s:=s+'/'+intToSTR(aiguillage[i].AdrTriple)+' Triple: Pointe=';
if (aiguillage[i].modele=aig) or (aiguillage[i].modele=triple) then
begin
s:=s+IntToSTR(aiguillage[i].APointe)+aiguillage[i].APointeB;
s:=s+' Dévie='+IntToSTR(aiguillage[i].ADevie)+aiguillage[i].ADevieB+
' Droit='+IntToSTR(aiguillage[i].ADroit)+aiguillage[i].ADroitB;
end;
if (aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs) or (aiguillage[i].modele=crois) then
begin
s:=s+' Ddroit='+intToSTR(aiguillage[i].Ddroit)+aiguillage[i].DdroitB;
s:=s+' Ddevie='+intToSTR(aiguillage[i].DDevie)+aiguillage[i].DdevieB;
s:=s+' Adroit='+intToSTR(aiguillage[i].Adroit)+aiguillage[i].AdroitB;
s:=s+' Adevie='+intToSTR(aiguillage[i].ADevie)+aiguillage[i].AdevieB;
if (aiguillage[i].modele=tjs) then
s:=s+' L='+IntToSTR(aiguillage[i].tjsInt)+aiguillage[i].tjsIntB;
end;
if aiguillage[i].modele=triple then s:=s+' Dévié2='+intToSTR(aiguillage[i].ADevie2)+aiguillage[i].ADevie2B;
if aiguillage[i].vitesse<>0 then s:=s+' Vitesse déviée='+intToSTR(aiguillage[i].vitesse);
if aiguillage[i].inversionCDM<>0 then s:=s+' pilotage inversé';
Affiche(s,clYellow);
end;
end;
end;
procedure TFormPrinc.ClientSocketInterfaceConnect(Sender: TObject;Socket: TCustomWinSocket);
var trouve : boolean;
begin
Affiche('Socket interface connecté ',clYellow);
AfficheDebug('Socket interface connecté ',clYellow);
ButtonEcrCV.Enabled:=true;
ButtonLitCV.Enabled:=true;
LireunfichierdeCV1.enabled:=true;
LabelTitre.caption:=titre+' Interface connectée par Ethernet';
etat_init_interface:=11; // socket connecté
trouve:=test_protocole; // appelle l'état des détécteurs
if trouve then // protocole reconnu
begin
if protocole=1 then
begin
etat_init_interface:=20; // interface protocole reconnue
parSocketLenz:=true;
end;
if (protocole=2) then
begin
init_dccpp;
etat_init_interface:=20;
end;
// interface ethernet connectée, faire les init
demande_etat_det;
if AvecInit then
begin
if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then
begin
Affiche('Positionnement des signaux',clYellow);
init_aiguillages; // initialisation des aiguillages
envoi_signauxCplx; // initialisation des feux
end;
if not(AvecInitAiguillages) and not(ferme) and (parSocketLenz or portCommOuvert)
and AvecDemandeAiguillages then
begin
procetape('demande etats accessoires');
demande_etat_acc; // demande l'état des accessoires (position des aiguillages)
end;
LabelEtat.Caption:=' ';
end;
end;
if not(trouve) then ClientSocketInterface.Close;
end;
procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket);
var s : string;
begin
s:='Socket CDM rail connecté';
LabelTitre.caption:=titre+' '+s;
Affiche(s,clYellow);
CDM_connecte:=True;
MenuConnecterUSB.enabled:=false;
DeConnecterUSB.enabled:=false;
ConnecterCDMRail.enabled:=false;
DeConnecterCDMRail.enabled:=true;
end;
// décodage d'une trame CDM au protocole IPC
// la trame_CDM peut contenir 2000 caractères à l'initialisation du RUN.
procedure Interprete_trameCDM(trame_CDM:string);
var i,j,objet,k,l,erreur,posErr,adr,adr2,etat,etataig,
vitesse,etatAig2,name,prv,nbre,nbreVir,long,index,posDes,AncNumTrameCDM : integer ;
x,y,x2,y2 : longint ;
nom,s,ss,train,commandeCDM : string;
traite,sort : boolean;
label reprise;
begin
{
trame_CDM:='S-R-14-0004-CMDACC-__ACK|000|S-E-14-5162-CMDACC-ST_DT|052|05|NAME=2756;OBJ=2756;AD=518;TRAIN=CC406526;STATE=1;';
trame_cdm:=trame_cdm+'S-E-14-5163-CMDACC-ST_DT|049|05|NAME=2757;OBJ=2757;AD=518;TRAIN=_NONE;STATE=1;';
trame_cdm:='';
trame_cdm:=trame_cdm+'S-C-07-1373-DSCTRN-SPEED|029|03|NAME=CAMERA;AD=6;TMAX=120;' ;
trame_cdm:=trame_cdm+'S-C-07-1374-DSCTRN-__END|000|' ;
//S-R-01-0004-CMDTRN-__ERR|048|03|ERR=300;SEV=2;MSG=Throttle_By_Name_Not_Found;
}
//affiche(trame_cdm,clLime);
residuCDM:='';
AckCDM:=trame_CDM<>'';
k:=0;
repeat
{// inutile de vérifier les numéros de trames, elles peuvent ne pas être envoyées dans l'ordre!!
if length(trame_CDM)>3 then
begin
if copy(trame_CDM,1,3)='S-E' then
begin
// numéro de la trame
i:=pos('-',trame_CDM);
if i<>0 then
begin
i:=posEx('-',trame_CDM,i+1);
if i<>0 then
begin
i:=posEx('-',trame_CDM,i+1);
if i<>0 then
begin
j:=posEx('-',trame_CDM,i+1);
AncNumTrameCDM:=NumTrameCDM;
val(copy(trame_CDM,i+1,j-1),NumTrameCDM,erreur);
if AncNumTrameCDM=0 then AncNumTrameCDM:=NumTrameCDM-1;
affiche(IntToSTR(NumTrameCDM),clLime);
if AncNumTrameCDM+1<>NumTrameCDM then
begin
s:='Erreur trames CDM perdues: #dernière='+intToSTR(AncNumTrameCDM)+' #Nouvelle='+intToSTR(NumTrameCDM);
Affiche(s,clred);
AfficheDebug(s,clred);
end;
end;
end;
end;
end;
end;}
// trouver la longueur de la chaîne de paramètres entre les 2 premiers |xxx|
i:=pos('|',trame_CDM);
if i=0 then
begin
if debugTrames then
begin
Affiche('tronqué1 : '+trame_CDM,clred);
AfficheDebug('tronqué1 : '+trame_CDM,clyellow);
end;
residuCDM:=trame_CDM;
Nbre_recu_cdm:=0;
exit;
end;
j:=posEx('|',trame_CDM,i+1);
if j=0 then
begin
if debugTrames then
begin
Affiche('tronqué2 : '+trame_CDM,clRed);
AfficheDebug('tronqué2 : '+trame_CDM,clyellow);
end;
residuCDM:=trame_CDM;
Nbre_recu_cdm:=0;
exit;
end;
l:=length(trame_cdm)-j;
val(copy(trame_CDM,i+1,5),long,erreur);
//Affiche('long chaine param='+intToSTR(long),clyellow);
if long=0 then
begin
//if debugTrames then Affiche('Longueur nulle',clYellow);
if pos('ACK',trame_cdm)<>0 then Ack_cdm:=true;
if pos('DSCTRN-__END',trame_cdm)<>0 then
begin
//fin de la description des trains
FormPrinc.ComboTrains.Items.Clear;
for i:=1 to ntrains_cdm do Formprinc.ComboTrains.Items.Add(trains_cdm[i].nom_train);
with formprinc do
begin
ComboTrains.ItemIndex:=0;
editadrtrain.Text:=inttostr(trains_cdm[1].adresse);
end;
end;
delete(trame_cdm,1,j);
goto reprise;
end;
if long>l then
begin
if debugTrames then
begin
Affiche('tronqué3 : '+trame_CDM,clRed);
AfficheDebug('tronqué3 : '+trame_CDM,clyellow);
end;
residuCDM:=trame_CDM;
Nbre_recu_cdm:=0;
exit;
end;
reprise:
if long<>0 then
begin
// nombre de paramètres
val(copy(trame_CDM,j+1,5),nbre,erreur);
//Affiche('nbre='+IntToSTR(nbre),clyellow);
// compter le nombre de virgules qui doit être égal au nombre de paramètres
NbreVir:=0; // nombre de virgules
repeat
i:=posEx(';',trame_CDM,i+1);
if i<>0 then inc(NbreVir);
until (i=0) or (NbreVir=nbre);
if (i=0) then
begin
if debugTrames then
begin
Affiche('tronqué4 : '+trame_CDM,clRed);
AfficheDebug('tronqué4 : '+trame_CDM,clyellow);
end;
residuCDM:=trame_CDM;
Nbre_recu_cdm:=0;
exit;
end;
CommandeCDM:=copy(trame_CDM,1,i);
//if debugTrames then AfficheDebug(commandeCDM,clorange);
Delete(trame_CDM,1,i);
//Affiche('long chaine param='+intToSTR(long),clyellow);
if long=0 then
begin
//if debugTrames then Affiche('Longueur nulle',clYellow);
if pos('ACK',trame_cdm)<>0 then Ack_cdm:=true;
delete(trame_cdm,1,j);
goto reprise;
end;
posERR:=pos('_ERR',commandeCDM);
if posErr<>0 then
begin
if pos('ERR=200',commandeCDM)<>0 then s:='Erreur CDM : réseau non chargé '
else
if pos('ERR=500',commandeCDM)<>0 then s:='Erreur CDM : serveur DCC non lancé '
else
if pos('ERR=300',commandeCDM)<>0 then s:='Erreur CDM : train non trouvé '
else
begin
j:=pos('MSG=',commandeCDM);
if j<>0 then s:='CDM: '+copy(commandeCDM,j,i-j);
end;
Affiche(s,clred);
delete(commandeCDM,1,i);
end;
// description des trains 03|NAME=BB16024;AD=3;TMAX=120;'
posDES:=pos('DSCTRN-SPEED',commandeCDM);
if posDES<>0 then
begin
inc(ntrains_cdm);
delete(commandeCDM,1,posDES+12);
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
trains_cdm[ntrains_cdm].nom_train:=ss;
val(ss,adr,erreur);
//s:='NAME='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,trains_cdm[ntrains_cdm].adresse,erreur);
//s:='AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('TMAX=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
val(ss,trains_cdm[ntrains_cdm].vitmax,erreur);
//s:='AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
end;
// évènement aiguillage. Le champ AD2 n'est pas forcément présent
i:=pos('CMDACC-ST_TO',commandeCDM);
if i<>0 then
begin
delete(commandeCDM,i,12);
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
nom:=ss;
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('OBJ=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,objet,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
//s:='AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('AD2=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,adr2,erreur);
//s:='AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('STATE=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,etat,erreur);
//s:='AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
//Affiche('Aig '+inttostr(adr)+' pos='+IntToSTR(etat),clyellow);
//Affiche(commandeCDM,clyellow);
index:=index_aig(adr);
if index<>0 then
begin
// conversion des états CDM en état Xpressnet standardisés
// aiguillage normal
if aiguillage[index].modele=aig then
begin
//Affiche('Normal',clyellow);
if etat=const_droit_CDM then etatAig:=const_droit else etatAig:=const_devie;
Event_Aig(adr,etatAig);
end;
// TJD TJS
if (aiguillage[index].modele=tjd) or (aiguillage[index].modele=tjs) then
begin
//Affiche('TJD/S',clyellow);
if aiguillage[index].EtatTJD=4 then
begin
adr2:=aiguillage[index].Ddroit; // 2eme adresse de la TJD
if (aiguillage[index].inversionCDM=0) and (aiguillage[index_aig(adr2)].inversionCDM=0) then // pas d'inversions
case etat of
0 : begin etatAig:=const_droit;EtatAig2:=const_droit;end;
1 : begin etatAig:=const_devie;EtatAig2:=const_droit;end;
4 : begin etatAig:=const_devie;EtatAig2:=const_devie;end;
5 : begin etatAig:=const_droit;EtatAig2:=const_devie;end;
end;
if (aiguillage[index].inversionCDM=1) then // inversion tjd1
case etat of
0 : begin etatAig:=const_devie;EtatAig2:=const_droit;end;
1 : begin etatAig:=const_droit;EtatAig2:=const_droit;end;
4 : begin etatAig:=const_droit;EtatAig2:=const_devie;end;
5 : begin etatAig:=const_devie;EtatAig2:=const_devie;end;
end;
if (aiguillage[index_aig(adr2)].inversionCDM=1) then // inversion tjd2
case etat of
0 : begin etatAig:=const_droit;EtatAig2:=const_devie;end;
1 : begin etatAig:=const_devie;EtatAig2:=const_devie;end;
4 : begin etatAig:=const_devie;EtatAig2:=const_droit;end;
5 : begin etatAig:=const_droit;EtatAig2:=const_droit;end;
end;
Event_Aig(adr,etatAig);
Event_Aig(adr2,etatAig2);
end;
if aiguillage[index].EtatTJD=2 then
begin
if (aiguillage[index].inversionCDM=0) then
case etat of
0 : etatAig:=const_droit;
1 : etatAig:=const_devie;
end;
if (aiguillage[index].inversionCDM=1) then
case etat of
0 : etatAig:=const_devie;
1 : etatAig:=const_droit;
end;
Event_Aig(adr,etatAig);
end;
end;
// aiguillage triple
if aiguillage[index].modele=triple then
begin
//Affiche('Triple',clyellow);
// état de l'aiguillage 1
if (etat=0) or (etat=2) then etatAig:=2;
if etat=3 then etatAig:=1;
// état de l'aiguillage 2
adr2:=aiguillage[index].AdrTriple;
if (etat=0) or (etat=3) then etatAig2:=2;
if etat=2 then etatAig2:=1;
Event_Aig(adr,etatAig);
Event_Aig(adr2,etatAig2);
end;
end
else
begin
s:='Recu evt aig de CDM pour un aiguillage '+intToSTR(Adr)+' non déclaré';
Affiche(s,clorange);
AfficheDebug(s,clOrange);
end;
end;
// évènement détecteur. Si det=1, Le nom du train est souvent _NONE
// si det=0 le nom du train est toujours _NONE
i:=pos('CMDACC-ST_DT',commandeCDM);
if i<>0 then
begin
Delete(commandeCDM,i,12);
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('TRAIN=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
train:=copy(commandeCDM,i+6,l-i-6);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('STATE=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,etat,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
nom:=copy(commandeCDM,i+6,l-i-6);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('OBJ=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,objet,erreur);
Delete(commandeCDM,i,l-i+1);
end;
Event_detecteur(Adr,etat=1,train);
end ;
// évènement signal - non stocké ni interprété
// S-E-01-0021-CMDACC-ST_SG|039|05|NAME=150;OBJ=150;AD=0;AD2=0;STATE=0;
i:=pos('CMDACC-ST_SG',commandeCDM);
if i<>0 then
begin
Delete(commandeCDM,i,12);
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
nom:=copy(commandeCDM,i+5,l-i-5);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('OBJ=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,objet,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('AD2=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,adr2,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('STATE=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,etat,erreur);
Delete(commandeCDM,i,l-i+1);
end;
s:='SignalCDM '+intToSTR(adr)+'='+IntToStr(etat);
if afftiers then AfficheDebug(s,ClSkyBlue);
end;
// évènement actionneur
// attention un actionneur qui repasse à 0 ne contient pas de nom de train
//S-E-03-0157-CMDACC-ST_AC|049|05|NAME=0;OBJ=7101;AD=815;TRAIN=CC406526;STATE=1;
i:=pos('CMDACC-ST_AC',commandeCDM);
if i<>0 then
begin
Delete(commandeCDM,i,12);
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if i<>0 then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('OBJ=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if i<>0 then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,objet,erreur);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if i<>0 then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
nom:=ss;
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('TRAIN=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if i<>0 then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
train:=ss;
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('STATE=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if i<>0 then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,etat,erreur);
Delete(commandeCDM,i,l-i+1);
end;
if AffAigDet then
AfficheDebug('Actionneur AD='+intToSTR(adr)+' Nom='+intToSTR(name)+' Train='+train+' Etat='+IntToSTR(etat),clyellow);
Event_act(adr,0,etat,train); // déclenche évent actionneur
end;
// évènement position des trains - non stocké ni interprété
// S-E-01-0039-CDMTRN-SPDXY|063|07|NAME=TRAIN_3;AD=0;SPEED=3;X=24735;Y=19630;X2=16874;Y2=19630;
i:=pos('CDMTRN-SPDXY',commandeCDM);
if i<>0 then
begin
Delete(commandeCDM,i,12);
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
s:='Train AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
train:=copy(commandeCDM,i+5,l-i-5);
s:=s+' '+train;
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('SPEED=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,vitesse,erreur);
s:=s+' SPEED='+IntToSTR(vitesse);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('X=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+2,l-i-2);
val(ss,x,erreur);
s:=s+' X='+IntTostr(x);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('Y=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+2,l-i-2);
val(ss,y,erreur);
s:=s+' Y='+IntTostr(y);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('X2=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,x2,erreur);
s:=s+' X2='+IntTostr(x2);
Delete(commandeCDM,i,l-i+1);
end;
if (i<>0) and (l<>0) then
begin
i:=posEx('Y2=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,y2,erreur);
s:=s+' Y2='+IntTostr(y2);
Delete(commandeCDM,i,l-i+1);
end;
if afftiers then afficheDebug(s,clAqua);
end;
// évènement vitesse des trains - non stocké ni interprété
//S-E-01-0189-CDMTRN-SPEED|054|06|NAME=TRAIN_3;AD=0;SPEED=99;RMAX=120;CMAX=120;REQ=8;
i:=pos('CDMTRN-SPEED',commandeCDM);
if i<>0 then
begin
Delete(commandeCDM,i,12);
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
s:='Train AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
train:=copy(commandeCDM,i+5,l-i-5);
s:=s+' '+train;
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('SPEED=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,vitesse,erreur);
s:=s+' SPEED='+IntToSTR(vitesse);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('RMAX=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
val(ss,x,erreur);
s:=s+' RMAX='+IntTostr(x);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('CMAX=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
val(ss,y,erreur);
s:=s+' CMAX='+IntTostr(y);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('REQ=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,x2,erreur);
s:=s+' REQ='+IntTostr(x2);
Delete(commandeCDM,i,l-i+1);
end;
if afftiers then afficheDebug(s,clAqua);
end;
// évènement port CDM - non stocké ni interprété
// S-E-01-0188-CDMTRN-P_CDM|060|07|NAME=TRAIN_3;AD=0;SPEED=99;SEG=38;PORT=1;X=35565;Y=12364;
i:=pos('CDMTRN-P_CDM',commandeCDM);
if i<>0 then
begin
Delete(commandeCDM,i,12);
i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+3,l-i-3);
val(ss,adr,erreur);
s:='Train AD='+IntToSTR(adr);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
train:=copy(commandeCDM,i+5,l-i-5);
s:=s+' '+train;
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('SPEED=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+6,l-i-6);
val(ss,vitesse,erreur);
s:=s+' SPEED='+IntToSTR(vitesse);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('SEG=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+4,l-i-4);
val(ss,x,erreur);
s:=s+' SEG='+IntTostr(x);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('PORT=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+5,l-i-5);
val(ss,y,erreur);
s:=s+' PORT='+IntTostr(y);
Delete(commandeCDM,i,l-i+1);
end;
i:=posEx('X=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+2,l-i-2);
val(ss,x2,erreur);
s:=s+' X='+IntTostr(x2);
Delete(commandeCDM,i,l-i+1);
end;
if afftiers then afficheDebug(s,clAqua);
i:=posEx('Y=',commandeCDM,1);l:=posEx(';',commandeCDM,i);
if (i<>0) and (l<>0) then
begin
ss:=copy(commandeCDM,i+2,l-i-2);
val(ss,x2,erreur);
s:=s+' Y='+IntTostr(x2);
Delete(commandeCDM,i,l-i+1);
end;
if afftiers then afficheDebug(s,clAqua);
end;
inc(k);
//Affiche('k='+intToSTR(k),clyellow);
end;
sort:=(length(trame_CDM)<10) or (k>=2000);
until (sort);
//Affiche('k='+IntToSTR(k)+' Ligne traitée '+recuCDM,clLime);
//if pos('_ACK',recuCDM)=0 then recuCDM:=''; // effacer la trame sauf si c'est une trame ACK car le trame est utilisée dans le process de connexion de cdm
if k>=2000 then begin Affiche('Erreur 90 : Longrestante='+IntToSTR(length(trame_CDM)),clred); Affiche(trame_CDM,clred); end;
Nbre_recu_cdm:=0;
end;
// réception d'un message de CDM rail
procedure TFormPrinc.ClientSocketCDMRead(Sender: TObject;Socket: TCustomWinSocket);
begin
inc(Nbre_recu_cdm);
//if Nbre_recu_cdm>1 then Affiche('Empilement de trames CDM: '+intToSTR(Nbre_recu_cdm),clred);
recuCDM:=ClientSocketCDM.Socket.ReceiveText;
if traceTrames then AfficheDebug(recuCDM,clWhite);
{begin
n:=80;
l:=length(recuCDM);
i:=0;
repeat
AfficheDebug(copy(recuCDM,(i*n)+1,n),clWhite);
inc(i);
until l<i*n;
end;}
Interprete_trameCDM(residuCDM+recuCDM); // residuCDM est le morceau tronqué de la fin de la réception précédente
end;
procedure TFormPrinc.ConnecterCDMrailClick(Sender: TObject);
begin
connecte_CDM;
end;
procedure TFormPrinc.DeconnecterCDMRailClick(Sender: TObject);
begin
deconnecte_CDM;
end;
procedure TFormPrinc.ClientSocketCDMDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
deconnecte_cdm;
end;
procedure TFormPrinc.CodificationdessignauxClick(Sender: TObject);
var i,j,k,l,NfeuxDir,nc : integer;
s,s2 : string;
begin
Affiche('Codification interne des signaux:',ClYellow);
for i:=1 to NbreFeux do
begin
// feu de signalisation
s:=IntToSTR(i)+' Adr='+IntToSTR(feux[i].Adresse);
s:=s+' décodeur='+IntToStr(feux[i].decodeur);
if feux[i].aspect<10 then
begin
s:=s+' SIG Nbrefeux='+IntToSTR(feux[i].aspect)+' ';
s:=s+' Det='+IntToSTR(feux[i].Adr_det1);
s:=s+' El_Suiv1='+IntToSTR(feux[i].Adr_el_suiv1)+' Type suiv1='+BTypeToChaine(feux[i].Btype_suiv1);
case feux[i].Btype_suiv1 of
det : s:=s+' (det) ';
aig,tjs,tjd : s:=s+' (aig ou TJD-S) ';
triple : s:=s+' (aig triple) ';
end;
if feux[i].decodeur=6 then
s:=s+'Cible unisemaf='+intToSTR(feux[i].Unisemaf);
// conditions sur carré
l:=1;
repeat
nc:=Length(feux[i].condcarre[l])-1 ;
if (nc>0) and (l=1) then begin Affiche(s,clYellow);s:='';end; // pour afficher sur 2 lignes
for k:=1 to nc do
begin
s:=s+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig;
if k<nc then s:=s+',';
end;
inc(l);
if nc>0 then s:=s+'/';
until (nc<=0) or (l>6);
if feux[i].decodeur=7 then
begin
s:=s+' SR(';
for l:=1 to 8 do
begin
s:=s+intToSTR(feux[i].SR[l].sortie1)+',';
s:=s+intToSTR(feux[i].SR[l].sortie0);
if l<8 then s:=s+'/' else s:=s+')';
end;
end;
if (feux[i].decodeur=2) or (feux[i].decodeur=5) then
begin
s:=s+' MOT(';
for l:=1 to 19 do
begin
s:=s+intToSTR(feux[i].SR[l].sortie1);
if l<19 then s:=s+',' else s:=s+')';
end;
end;
end
else
// feu directionnel
begin
s:=s+' DIR Nbrefeux='+IntToSTR(feux[i].aspect-10)+' ';
NfeuxDir:=feux[i].aspect-10;
for j:=1 to NfeuxDir+1 do
begin
s:=s+'(';
for k:=1 to Length(feux[i].AigDirection[j])-1 do
begin
s:=s+IntToSTR(feux[i].AigDirection[j][k].adresse) + feux[i].AigDirection[j][k].posaig+' ';
end;
s:=s+')';
end;
end;
Affiche(s,clYellow);
if s2<>'' then Affiche('Conditions de carré : '+s2,clYellow);
end;
end;
procedure TFormPrinc.ClientSocketInterfaceDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
parSocketLenz:=False;
end;
procedure TFormPrinc.FichierSimuClick(Sender: TObject);
begin
FormSimulation.showModal;
end;
procedure TFormPrinc.ButtonEcrCVClick(Sender: TObject);
var adr,valeur,erreur : integer;
s : string;
begin
// doc XpressNet page 55
val(EditCV.text,adr,erreur);
if (erreur<>0) or (Adr>255) or (Adr<0) then
begin
EditCV.Text:='1';
exit;
end;
val(EditVal.Text,valeur,erreur);
if (erreur<>0) or (valeur<0) or (valeur>255) then
begin
EditVal.text:='1';
exit;
end;
if protocole=1 then
begin
//s:=#$ff+#$fe+#$23+#$1e+Char(adr)+Char(valeur); //CV de 512 à 767 V3.4
//s:=#$ff+#$fe+#$23+#$1d+Char(adr)+Char(valeur); //CV de 256 à 511 V3.4
s:=#$23+#$16+Char(adr)+Char(valeur); //CV de 1 à 256
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack
// la centrale passe en mode service (p23)
end;
if protocole=2 then
begin
s:='<W '+inttostr(adr)+' '+intToSTR(valeur)+' 1 1>';
envoi(s);
end;
Affiche('CV'+intToSTR(Adr)+'='+intToSTR(valeur),clyellow);
end;
// lit un fichier de CV vers un accessoire
procedure Lire_fichier_CV;
var s: string;
fte : textfile;
cv,valeur,erreur : integer;
begin
s:=GetCurrentDir;
//s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL';
with FormPrinc do
begin
OpenDialog.InitialDir:=s;
OpenDialog.DefaultExt:='txt';
OpenDialog.Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*';
if openDialog.Execute then
begin
s:=openDialog.FileName;
assignFile(fte,s);
reset(fte);
while not(eof(fte)) do
begin
readln(fte,s);
val(s,cv,erreur);
if (cv<>0) then
begin
delete(s,1,erreur);
val(s,valeur,erreur);
Affiche('CV='+intToSTR(cv)+' Valeur='+IntToSTR(valeur),clLime);
if cv>255 then Affiche('Erreur CV '+IntToSTR(cv)+'>255',clred);
if valeur>255 then Affiche('Erreur valeur '+IntToSTR(valeur)+'>255',clred);
if (cv<=255) and (valeur<=255) then
begin
s:=#$23+#$16+Char(cv)+Char(valeur); //CV de 1 à 256
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack, la premiere trame fait passer la centrale en mode programmation (service)
tempo(5);
end;
end;
end;
closeFile(fte);
end;
end;
end;
procedure TFormPrinc.LireunfichierdeCV1Click(Sender: TObject);
begin
Lire_fichier_CV;
end;
procedure TFormPrinc.ButtonLitCVClick(Sender: TObject);
var s,sa: string;
i,cv,erreur : integer;
begin
s:=GetCurrentDir;
//s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL';
N_Cv:=0; // nombre de CV recus à 0
sa:='';
Affiche('Lecture CV',clyellow);
val(EditCV.Text,cv,erreur);
if (erreur<>0) or (cv>255) or (cv<0) then
begin
EditCV.Text:='1';
exit;
end;
if protocole=1 then
begin
//trace:=true;
s:=#$22+#$15+Char(cv); //CV de 1 à 256 (V3.0)
//s:=#$22+#$18+Char(cv); //CV de 1 à 255 + 1024 (V3.6)
s:=checksum(s);
// envoi de la trame : fait passer la centrale en mode programmation (service)
envoi_ss_ack(s);
// attendre la trame 01 04 05 (env 1s)
succes:=false;i:=0;
repeat
Application.processMessages;
Sleep(100);
inc(i);
until succes or (i>20);
if succes then
begin
recu_cv:=false;
//Affiche('reçu trame succes',clyellow);
s:=#$21+#$10; // demande d'envoi du résultat du mode service
s:=checksum(s);
//envoi(s);
envoi_ss_ack(s);
Tempo(1);
// attente de la réponse de la centrale
i:=0;
repeat
Tempo(2); // attend 200 ms
inc(i);
until recu_cv or (i>4);
if (i>4) then
begin
Affiche('Erreur attente trop longue CV',clred);
exit;
end;
sa:=sa+'Cv'+IntToSTR(cv)+'='+IntToSTR(Tablo_cv[cv])+' ';
Affiche(sa,clyellow);sa:='';
end
else
Affiche('Pas de réponse de l''interface après demande de passage en mode prog',clOrange);
end;
if protocole=2 then
begin
s:='<R '+intToSTR(cv)+' 1 1>';
envoi_ss_ack(s);
Tempo(1);
// attente de la réponse de la centrale
i:=0;
repeat
Tempo(2); // attend 200 ms
inc(i);
until recu_cv or (i>4);
if (i>4) then
begin
Affiche('Erreur attente trop longue CV',clred);
exit;
end;
sa:=sa+'Cv'+IntToSTR(cv)+'='+IntToSTR(Tablo_cv[1])+' ';
Affiche(sa,clyellow);sa:='';
end;
end;
procedure TFormPrinc.Quitter1Click(Sender: TObject);
begin
close;
end;
procedure TFormPrinc.ConfigClick(Sender: TObject);
begin
if ConfigPrete then
begin
formconfig.showmodal;
// ne pas faire close : déja provoqué par le self de la fermeture
end;
end;
procedure TFormPrinc.Codificationdesactionneurs1Click(Sender: TObject);
var i,typ,adract,etatAct,fonction,v,acc,sortie : integer;
loc,act,son : boolean;
s,s2 : string;
begin
if (maxTablo_act=0) and (NbrePN=0) then
begin
Affiche('Aucun actionneur déclaré',Cyan);
exit;
end;
Affiche('Codification interne des actionneurs',Cyan);
for i:=1 to maxTablo_act do
begin
s:=Tablo_actionneur[i].trainDecl;
etatAct:=Tablo_actionneur[i].etat ;
AdrAct:=Tablo_actionneur[i].adresse;
s2:=Tablo_actionneur[i].trainDecl;
acc:=Tablo_actionneur[i].accessoire;
sortie:=Tablo_actionneur[i].sortie;
fonction:=Tablo_actionneur[i].fonction;
loc:=Tablo_actionneur[i].loco;
act:=Tablo_actionneur[i].act;
son:=Tablo_actionneur[i].son;
typ:=Tablo_actionneur[i].typdeclenche;
if typ=1 then s:='Mem '+intToSTR(adrAct)+' '+inttostr(Tablo_actionneur[i].Adresse2);
if typ=0 then s:=intToSTR(adrAct);
if typ=2 then s:='Aig '+intToSTR(AdrAct);
if loc then
s:='FonctionF Déclencheur='+s+' :'+intToSTR(etatAct)+' TrainDécl='+s2+' TrainDest='+Tablo_actionneur[i].TrainDest+' F'+IntToSTR(fonction)+
' Temporisation='+intToSTR(tablo_actionneur[i].Tempo);
if act then
s:='Accessoire Déclencheur='+s+' :'+intToSTR(etatAct)+' TrainDécl='+s2+' A'+IntToSTR(acc)+
' sortie='+intToSTR(sortie);
if son then
s:='Son Déclencheur='+s+' :'+intToSTR(etatAct)+' TrainDécl='+s2+
' Fichier:'+Tablo_actionneur[i].FichierSon;
Affiche(s,clYellow);
end;
// dans le tableau des PN
for i:=1 to NbrePN do
begin
s:='PN'+intToSTR(i)+' Adresse fermeture PN='+IntToSTR(Tablo_PN[i].AdresseFerme);
s:=s+' Adresse ouverture PN='+IntToSTR(Tablo_PN[i].AdresseOuvre);
Affiche(s,clyellow);
s:=' Commande fermeture='+intToSTR(Tablo_PN[i].commandeFerme);
s:=s+' Commande ouverture='+intToSTR(Tablo_PN[i].commandeOuvre);
s:=s+' Nbre de voies='+intToSTR(Tablo_PN[i].nbVoies);
Affiche(s,clyellow);
if tablo_PN[i].Voie[1].ActFerme<>0 then
// par actionneur
begin
for v:=1 to Tablo_PN[i].nbvoies do
begin
s:=' Voie '+IntToSTR(v)+': Actionneur de fermeture='+intToSTR(Tablo_PN[i].voie[v].ActFerme);
s:=s+' Actionneur d''ouverture='+intToSTR(Tablo_PN[i].voie[v].ActOuvre);
Affiche(s,clyellow);
end;
end
else
// par zone de détection
for v:=1 to Tablo_PN[i].nbvoies do
begin
s:=' Voie '+IntToSTR(v)+': Zones de fermeture='+intToSTR(tablo_PN[i].Voie[v].detZ1F)+'-'+intToSTR(tablo_PN[i].Voie[v].detZ2F);
s:=s+' Zones d''ouverture='+intToSTR(tablo_PN[i].Voie[v].detZ1O)+'-'+intToSTR(tablo_PN[i].Voie[v].detZ2O);
Affiche(s,clyellow);
end;
end;
end;
procedure TFormPrinc.ButtonArretSimuClick(Sender: TObject);
begin
Index_Simule:=0; // fin de simulation
I_Simule:=0;
MsgSim:=false;
filtrageDet0:=SauvefiltrageDet0;
StopSimu:=true;
Affiche('Fin de simulation',Cyan);
end;
procedure TFormPrinc.OuvrirunfichiertramesCDM1Click(Sender: TObject);
var s : string;
fte : textFile;
begin
s:=GetCurrentDir;
s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL';
OpenDialog.InitialDir:=s;
OpenDialog.Title:='Ouvrir un fichier de trames CDM (protocole COM-IPC)';
OpenDialog.DefaultExt:='txt';
OpenDialog.Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*';
if openDialog.Execute then
begin
ButtonArretSimu.Visible:=true;
s:=openDialog.FileName;
assignFile(fte,s);
reset(fte);
StopSimu:=false;
while not(eof(fte)) and (StopSimu=false) do
begin
readln(fte,s);
Affiche(s,clLime);
sleep(100);
Interprete_trameCDM(s);
application.processmessages;
end;
closeFile(fte);
end;
end;
procedure TFormPrinc.ButtonAffTCOClick(Sender: TObject);
begin
formTCO.windowState:=wsNormal; //Maximized;
formTCO.show;
formTCO.BringToFront;
end;
procedure TFormPrinc.ButtonLanceCDMClick(Sender: TObject);
begin
Lance_CDM;
end;
procedure TFormPrinc.Affichefentredebug1Click(Sender: TObject);
begin
// formdebug.Create(nil);
if debugaffiche then formDebug.show;
end;
procedure TFormPrinc.locoClick(Sender: TObject);
var adr,vit,erreur : integer;
s : string;
begin
// vitesse et direction 18 pas
s:=editAdrTrain.Text;
val(s,adr,erreur);
if (erreur<>0) or (adr<0) then exit;
if not(portCommOuvert) and not(parSocketLenz) and not(CDM_Connecte) then exit;
s:=editVitesse.Text;
val(s,vit,erreur);
if (erreur<>0) or (vit<0) then exit;
s:=trains[combotrains.itemindex+1].nom_train;
Affiche('Commande vitesse train '+s+' ('+intToSTR(adr)+') à '+IntToSTR(vit)+'%',cllime);
vitesse_loco(s,adr,vit,true);
if s='' then s:=intToSTR(adr);
end;
// pour déplacer l'ascenseur de l'affichage automatiquement en bas
procedure TFormPrinc.FenRichChange(Sender: TObject);
begin
SendMessage(FenRich.handle,WM_VSCROLL,SB_BOTTOM,0);
end;
procedure TFormPrinc.Copier1Click(Sender: TObject);
begin
FenRich.CopyToClipboard;
FenRich.SetFocus;
end;
procedure TFormPrinc.Etatdessignaux1Click(Sender: TObject);
var Adr,etat,i : integer;
aspect,combine : integer;
s : string;
begin
for i:=1 to NbreFeux do
begin
Adr:=Feux[i].Adresse;
Etat:=Feux[i].EtatSignal;
s:='Signal '+IntToSTR(Adr)+' Etat=';
code_to_aspect(Etat,aspect,combine);
s:=s+IntToSTR(etat);
if Feux[i].aspect<10 then
begin
if aspect<>-1 then s:=s+' '+EtatSign[aspect];
if combine<>-1 then s:=s+' '+EtatSign[combine];
end;
Affiche(s,clYellow);
end;
end;
procedure TFormPrinc.Etatdeszonespartrain1Click(Sender: TObject);
var i,j,n,train : integer;
couleur : tcolor;
rien,aff : boolean;
s,ss : string;
begin
Affiche('',clyellow);
Affiche('Historique de l''état des zones par train',clWhite);
rien:=true;
for train:=1 to 20 do
begin
n:=TrainZone[train].Nbre;
for i:=1 to n do
begin
rien:=false;
s:='Train='+intToSTR(train)+' '+TrainZone[train].train;
if TrainZone[train].adrTrain<>0 then s:=s+' @='+intToSTR(TrainZone[train].adrTrain);
s:=s+' index='+intToSTR(i);
s:=s+' '+intToSTR(TrainZone[train].Zone[i].det1);
s:=s+' '+intToSTR(TrainZone[train].Zone[i].det2);
if i=n then s:=s+' Prev='+intToSTR(TrainPrevZone[train][1]);
couleur:=((train - 1) mod NbCouleurTrain) +1;
Affiche(s,CouleurTrain[couleur]);
end;
end;
Affiche('Liste des zones actuellement occupées:',clWhite);
i:=1;
repeat
j:=1;
repeat
aff:=MemZone[i,j].etat;
if aff then
begin
Affiche('MemZone['+intToSTR(i)+','+intToSTR(j)+'] '+MemZone[i,j].train+' @='+intToSTR(MemZone[i,j].AdrTrain)+' Train n°'+intToSTR(MemZone[i,j].Numtrain),clYellow);
rien:=false;
end;
inc(j);
until (j>NbMemZone);
inc(i);
until (i>NbMemZone);
Affiche('Derniers Elements verrouillés:',clWhite);
for i:=1 to idEl do
begin
Affiche(IntToSTR(elements[i].adresse),clLime);
end;
for i:=1 to n_trains do
begin
s:='Event det train '+intToSTR(i);
n:=event_det_train[i].AdrTrain;
if n<>0 then s:=s+' @'+intToSTR(n);
ss:=event_det_train[i].nom_train;
if ss<>'' then s:=s+' '+ss;
Affiche(s,clOrange);
n:=event_det_train[i].signal_rouge;
if n<>0 then Affiche('Arreté devant signal '+intToSTR(n),clyellow);
for j:=1 to event_det_train[i].NbEl do
begin
s:=intToSTR(event_det_train[i].Det[j].adresse);
Affiche(s,clyellow);
end;
end;
{
Affiche('Evènements détecteurs par train',clWhite);
for i:=1 to n_trains do
begin
index_couleur:=((i - 1) mod NbCouleurTrain) +1;
couleur:=couleurTrain[index_couleur];
Affiche('Train '+intToSTR(i),couleur);
for j:=1 to N_event_tick do
begin
if event_det_tick[j].train=i then Affiche(intToSTR(event_det_tick[j].adresse)+' '+intToSTR(event_det_tick[j].etat),couleur);
end;
end;
}
if rien then Affiche('Aucune zone n''a été déclenchée',clOrange);
end;
procedure TFormPrinc.Apropos1Click(Sender: TObject);
begin
Affiche(' ',clyellow);
Affiche('Signaux complexes GL version '+version+sousVersion+' (C) 2022 F1IWQ Gily TDR',clWhite);
FenRich.SelStart:=length(FenRich.Text);
FenRich.SelAttributes.Style:=[fsUnderline];
FenRich.lines.add('https://github.com/f1iwq2/Signaux_complexes_GL');
RE_ColorLine(FenRich,FenRich.lines.count-1,clAqua);
FenRich.SelStart:=length(FenRich.Text);
FenRich.SelAttributes.Style:=[fsUnderline];
FenRich.lines.add('http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906');
RE_ColorLine(FenRich,FenRich.lines.count-1,clAqua);
Affiche('Ce programme pilote des signaux complexes de façon autonome ou avec CDM rail ',ClYellow);
Affiche('En fonction des détecteurs mis à 1 ou 0 par des locomotives',ClYellow);
Affiche('en circulation sur le réseau',ClYellow);
Affiche('En vert : Trames envoyées à l''interface',ClWhite);
Affiche('En blanc : Trames brutes reçues de l''interface',ClWhite);
Affiche('En rouge : erreurs et défauts',ClWhite);
Affiche('En orange : pilotage des signaux / erreurs mineures',ClWhite);
Affiche('En bleu : pilotage des aiguillages',ClWhite);
Affiche('En jaune : rétrosignalisation reçue depuis l''interface',ClWhite);
Affiche('Taille du TCO : '+intToSTR(SizeOf(tco) div 1024)+' ko',clorange);
Affiche(' ',clyellow);
end;
// cliqué droit sur un feu puis sur le menu propriétés
procedure TFormPrinc.Proprits1Click(Sender: TObject);
var s: string;
begin
clicliste:=false;
s:=((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; // nom du composant, pout récupérer l'adresse du feu (ex: ImageFeu260)
//Affiche(s,clOrange); // nom de l'image du signal (ex: ImageFeu260)
adresseFeuClic:=extract_int(s); // extraire l'adresse (ex 260)
formconfig.PageControl.ActivePage:=formconfig.TabSheetSig;
clicproprietes:=true;
formconfig.showmodal;
formconfig.close;
end;
procedure TFormPrinc.Informationsdusignal1Click(Sender: TObject);
var s: string;
i,aspect,combine,adresse,aig,trainReserve,AdrSignalsuivant : integer;
reserveTrainTiers : boolean;
code : word;
begin
clicliste:=false;
s:=((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; // nom du composant, pout récupérer l'adresse du feu (ex: ImageFeu260)
//Affiche(s,clOrange); // nom de l'image du signal (ex: ImageFeu260)
adresse:=extract_int(s); // extraire l'adresse (ex 260)
i:=index_feu(Adresse);
if feux[i].aspect>10 then exit;
code:=feux[i].EtatSignal;
code_to_aspect(code,aspect,combine);
s:='Signal ad'+IntToSTR(adresse)+'='+chaine_signal(code);
Affiche(s,clYellow);
//Affiche(IntToSTR(aspect),clred);
//Affiche(IntToSTR(combine),clred);
// carré
if aspect=0 then
begin
Affiche('Le signal est au carré car ',clyellow);
if carre_signal(Adresse,trainreserve,reserveTrainTiers) then affiche('les aiguillages en aval du signal sont mal positionnées ou leur positions inconnues',clyellow) ;
if reserveTrainTiers then affiche('un aiguillage ou un croisement en aval du signal sont réservés par un autre train ',clyellow);
if Cond_Carre(Adresse) then affiche_suivi('les aiguillages déclarés dans la définition du signal sont mal positionnés',clyellow);
if feux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,TrainReserve)) then affiche('le signal est verrouillable au carré et aucun train n''est présent avant le signal',clyellow);
if test_memoire_zones(Adresse) then affiche('présence train dans canton suivant le signal',clyellow);
if feux[i].VerrouilleCarre then affiche('le signal est verrouillé au carré dans la fenêtre de pilotage',clYellow);
end;
if aspect=1 then
begin
Affiche('Le signal est au sémaphore car ',clyellow);
if test_memoire_zones(Adresse) then affiche_suivi('Présence train dans canton après le signal',clyellow);
end;
// avertissement
if aspect=8 then
begin
i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant);
Affiche('Le signal est à l''avertissement car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow);
end;
// avertissement cli
if aspect=9 then
begin
i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant);
Affiche('Le signal est au jaune cli car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow);
end;
// ralen 30
if combine=10 then
begin
i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant);
Affiche('Le signal est au ralentissement 30 car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow);
end;
if combine=11 then
begin
i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant);
Affiche('Le signal est au ralentissement 60 car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow);
end;
if (combine=12) or (combine=13) then
begin
Aig:=Aiguille_deviee(Adresse);
// si aiguille locale déviée
if (aig<>0) then Affiche('Le signal est à rappel 30 car l''aiguillage suivant '+intToSTR(Aig)+' est dévié',clyellow);
end;
end;
procedure TFormPrinc.VrifierlacohrenceClick(Sender: TObject);
begin
if verif_coherence then affiche('La configuration est cohérente',clLime);
end;
// cliqué gauche dans la fenetre Fenrich
procedure TFormPrinc.FenRichMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var lc,i : integer;
s : string;
begin
if Tdoubleclic=0 then doubleclic:=false;
if not(doubleclic) then
begin
doubleclic:=true;
Tdoubleclic:=3;
exit;
end;
if doubleclic then
begin
doubleclic:=false;
TdoubleClic:=0;
with FenRich do
begin
i:=Selstart;
lc:=Perform(EM_LINEFROMCHAR,i,0);
s:=lines[lc];
end;
if pos('http',s)<>0 then
begin
ShellExecute(0,'open',Pchar(s),nil,nil,sw_shownormal);
end;
end;
end;
procedure TFormPrinc.ButtonLocCVClick(Sender: TObject);
begin
if groupBox3.Visible then begin groupBox3.Visible:=false;groupBox2.Visible:=true;exit;end
else begin groupBox2.Visible:=false;groupBox3.Visible:=true;end;
end;
procedure TFormPrinc.ComboTrainsChange(Sender: TObject);
var i : integer;
begin
i:=ComboTrains.itemIndex+1;
if (i<>0) and (i<Max_Trains) then
EditAdrTrain.Text:=intToSTR(trains[i].adresse);
end;
procedure TFormPrinc.ButtonFonctionClick(Sender: TObject);
var erreur,fonction,etat,loco : integer;
s : string;
begin
val(editNumFonction.Text,fonction,erreur);
if erreur<>0 then exit;
val(editFonc01.Text,etat,erreur);
if erreur<>0 then exit;
if not(portCommOuvert) and not(parSocketLenz) and not(CDM_connecte) then exit;
val(editAdrTrain.Text,loco,erreur);
s:=trains[combotrains.itemindex+1].nom_train;
if CDM_connecte then
begin
if s='' then begin Affiche('Sélectionnez un train',clOrange);exit;end;
if fonction>12 then
begin
Affiche('Avec CDM Rail, F12 maxi',clOrange);
exit;
end;
envoie_fonction_CDM(fonction,etat,s);
Affiche('Train='+s+' F'+IntToSTR(fonction)+':'+intToSTR(etat),clyellow);
end;
begin
if erreur<>0 then begin Affiche('Sélectionnez un train',clOrange);exit;end;
if fonction>28 then
begin
Affiche('F28 maxi',clOrange);
exit;
end;
Affiche('Train adresse '+intToStr(loco)+' F'+IntToSTR(fonction)+':'+intToSTR(etat),clyellow);
Fonction_Loco_operation(loco,fonction,etat);
end;
end;
procedure TFormPrinc.Demanderlaversiondelacentrale1Click(Sender: TObject);
var s : string;
begin
if (portcommOuvert=false) and (parsocketLenz=false) then
begin
Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
exit;
end;
if (protocole=1) then
begin
s:=#$f0;
s:=checksum(s);
envoi(s);
end ;
if (protocole=2) then
begin
affiche_retour_dcc:=true;
tps_affiche_retour_dcc:=2;
s:=checksum('<s>');
envoi(s);
end
end;
procedure TFormPrinc.Demandetatdesaiguillages1Click(Sender: TObject);
begin
if (portcommOuvert=false) and (parsocketLenz=false) then
begin
Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
exit;
end;
if (protocole=1) then demande_etat_acc ;
end;
procedure TFormPrinc.RepriseDCC1Click(Sender: TObject);
var s : string;
begin
if (portcommOuvert=false) and (parsocketLenz=false) then
begin
Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
exit;
end;
if protocole=1 then
begin
s:=#$21+#$81;
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack
end;
if protocole=2 then envoi('<1>');
end;
procedure TFormPrinc.BoutonRazTrainsClick(Sender: TObject);
begin
Affiche('Raz tous trains et routes',clLime);
Raz_tout;
end;
procedure TFormPrinc.Demandetataccessoires1Click(Sender: TObject);
begin
if portCommOuvert or parSocketLenz then demande_etat_acc
else Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
end;
procedure TFormPrinc.LancerCDMrail1Click(Sender: TObject);
begin
Lance_CDM ;
end;
procedure TFormPrinc.TrackBarVitChange(Sender: TObject);
begin
EditVitesse.Text:=intToSTR(TrackBarVit.position);
end;
procedure TFormPrinc.EditVitesseChange(Sender: TObject);
var i,e : integer;
begin
val(EditVitesse.Text,i,e);
if (e=0) and (i>=0) and (i<=100) then TrackBarVit.position:=i;
end;
procedure TFormPrinc.ButtonEnvClick(Sender: TObject);
begin
affiche_retour_dcc:=true;
tps_affiche_retour_dcc:=2;
Affiche(editEnvoi.text,ClWhite);
envoi(editEnvoi.Text);
end;
procedure TFormPrinc.Placerlestrains1Click(Sender: TObject);
begin
if PlaceAffiche then
begin
if cdm_connecte then
begin
Affiche('Placement des trains incompatible en mode CDM rail',clOrange);
exit;
end;
formplace.showmodal;
end;
end;
procedure TFormPrinc.Demandetatdtecteurs1Click(Sender: TObject);
begin
if portCommOuvert or parSocketLenz then
begin
modeStkRetro:=false; // avec evt
demande_etat_det;
end
else Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
end;
// place les trains, positionne aiguillages et lance le roulage
procedure placement_trains;
var adr,AdrTrain,i,j : integer;
trouve : boolean;
begin
trouve:=false;
for i:=1 to 6 do
begin
Adr:=placement[i].detecteur;
if adr<>0 then
begin
detecteur[Adr].train:=placement[i].train;
detecteur[Adr].AdrTrain:=trains[i].adresse;
event_detecteur(Adr,true,trains[i].nom_train);
Affiche('Positionnement train '+detecteur[Adr].train+' sur détecteur '+intToSTR(Adr),clLime);
end;
end;
init_aiguillages;
for i:=1 to NDetecteurs do
begin
adr:=Adresse_detecteur[i];
if Detecteur[adr].etat and (detecteur[adr].train<>'') then
begin
Affiche('Lancement du train '+detecteur[adr].train+' depuis détecteur '+intToSTR(adr),clYellow);
AdrTrain:=detecteur[Adr].AdrTrain;
j:=index_train_adresse(AdrTrain);
vitesse_loco('',adrTrain,trains[j].VitNominale,not(placement[j].inverse));
trouve:=true;
roulage:=true;
end;
end;
if trouve then Maj_feux;
end;
procedure TFormPrinc.Button1Click(Sender: TObject);
begin
placement_trains;
ouvre_simulation('C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL\2trains_autonome.txt');
// ouvre_simulation('C:\Program Files\Borland\Delphi7\Projects\Signaux_complexes_GL\2trains_autonome.txt');
end;
procedure TFormPrinc.Evenementsdetecteurspartrain1Click(Sender: TObject);
var i,j,train,pos : integer;
s : string;
begin
Affiche('Evenements tous détecteurs',clwhite);
Affiche(' ',clyellow);
for i:=0 to n_trains do
begin
Affiche_Suivi('Train '+intToSTR(i)+' ',clYellow);
end;
for i:=1 to N_event_tick do
begin
if event_det_tick[i].modele=det then
begin
train:=event_det_tick[i].train;
index_couleur:=((train - 1) mod NbCouleurTrain) +1;
couleur:=couleurTrain[index_couleur];
s:='';
for j:=1 to train*15 do s:=s+' ';
s:=s+intToSTR(event_det_tick[i].adresse)+' '+intToSTR(event_det_tick[i].etat);
case event_det_tick[i].reaffecte of
1 : s:=s+'/S';
2 : s:=s+'/A';
3 : s:=s+'/R';
4 : s:=s+'/0';
end;
Affiche(s,couleur);
end;
if event_det_tick[i].modele=aig then
begin
s:='Aiguillage '+intToSTR(event_det_tick[i].adresse)+' ';
pos:=event_det_tick[i].etat;
case pos of
const_devie : s:=s+' dévié' ;
const_droit : s:=s+' droit';
const_inconnu : s:=s+' inconnue';
else s:=s+' erreur ('+intToSTR(pos)+')';
end;
Affiche(s,clWhite);
end;
end;
end;
procedure TFormPrinc.RazResaClick(Sender: TObject);
begin
Affiche('Mise à 0 de la réservation des aiguillages',clYellow);
Raz_reservations;
Maj_feux;
end;
procedure TFormPrinc.SBMarcheArretLocoClick(Sender: TObject);
var i,adr : integer;
begin
for i:=1 to Ntrains do
begin
adr:=Trains[i].adresse;
if adr<>0 then
begin
Affiche('Arrêt train @'+intToSTR(adr)+' '+Trains[i].nom_train,clyellow);
vitesse_loco('',adr,0,not(placement[i].inverse));
end;
end;
end;
end.