This commit is contained in:
f1iwq2
2023-01-29 10:32:42 +01:00
parent 1a25d29116
commit 4e63a59382
27 changed files with 1066 additions and 781 deletions
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+25 -10
View File
@@ -1,6 +1,6 @@
object FormConfig: TFormConfig
Left = 253
Top = 95
Left = 243
Top = 119
Hint = 'Modifie la configuration selon les s'#233'lections choisies'
BorderStyle = bsDialog
Caption = 'Configuration g'#233'n'#233'rale'
@@ -1570,7 +1570,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 633
Height = 505
ActivePage = TabSheetAutonome
ActivePage = TabSheetCDM
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
@@ -1910,7 +1910,7 @@ object FormConfig: TFormConfig
Left = 312
Top = 288
Width = 281
Height = 121
Height = 137
Caption = 'Divers'
TabOrder = 5
object Label31: TLabel
@@ -1985,6 +1985,21 @@ object FormConfig: TFormConfig
ShowHint = True
TabOrder = 3
end
object CheckBoxVerifXpressNet: TCheckBox
Left = 8
Top = 112
Width = 233
Height = 17
Hint =
'Contr'#244'le si une adresse DCC se trouve dans la plage 257-272 si o' +
'n utilise Xpressnet. Ne pas cocher si XpressNet n'#39'est pas utilis' +
#233
Caption = 'V'#233'rification des adresses XpressNet'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnClick = CheckBoxVerifXpressNetClick
end
end
end
object TabSheetAutonome: TTabSheet
@@ -3345,8 +3360,8 @@ object FormConfig: TFormConfig
Caption = 'Description de l'#39'action'
TabOrder = 0
object GroupBoxPN: TGroupBox
Left = 0
Top = 24
Left = 8
Top = 16
Width = 233
Height = 401
Caption = 'Action gestion passage '#224' niveau'
@@ -3753,8 +3768,8 @@ object FormConfig: TFormConfig
end
end
object GroupBoxRadio: TGroupBox
Left = 8
Top = 16
Left = 120
Top = 8
Width = 225
Height = 73
Caption = 'Type d'#39'action'
@@ -3788,8 +3803,8 @@ object FormConfig: TFormConfig
end
end
object GroupBoxAct: TGroupBox
Left = 8
Top = 84
Left = 120
Top = 44
Width = 233
Height = 341
Caption = 'Action fonction de locomotive '
+186 -59
View File
@@ -321,6 +321,7 @@ type
GroupBox25: TGroupBox;
Label58: TLabel;
EditFiltrDet: TEdit;
CheckBoxVerifXpressNet: TCheckBox;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -462,6 +463,7 @@ type
procedure ButtonNTClick(Sender: TObject);
procedure EditVitNomChange(Sender: TObject);
procedure EditVitRalentiChange(Sender: TObject);
procedure CheckBoxVerifXpressNetClick(Sender: TObject);
private
{ Déclarations privées }
public
@@ -472,6 +474,7 @@ const
// constantes du fichier de configuration
NomConfig='ConfigGenerale.cfg';
Debug_ch='Debug';
Verif_AdrXpressNet_ch='Verif_AdrXpressNet';
Filtrage_det_ch='Filtrage_det';
Algo_localisation_ch='Algo_localisation';
Avec_roulage_ch='Avec_roulage';
@@ -525,7 +528,7 @@ var
LigneCliqueePN,AncLigneCliqueePN,clicMemo,Nb_cantons_Sig,protocole,Port,clicListeTrain,
ligneclicAig,AncLigneClicAig,ligneClicSig,AncligneClicSig,EnvAigDccpp,AdrBaseDetDccpp,
ligneClicBr,AncligneClicBr,ligneClicAct,AncLigneClicAct,Adressefeuclic,NumTrameCDM,
Algo_localisation : integer;
Algo_localisation,Verif_AdrXpressNet : integer;
ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort,
modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains : boolean;
@@ -539,7 +542,6 @@ procedure decodeAig(s : string;var adr : integer;var B : char);
function sauve_config : boolean;
procedure lit_config;
Procedure aff_champs_sig_feux(index : integer);
procedure decode_ligne_feux(chaine_signal : string;i : integer);
function verif_coherence : boolean;
function compile_branche(s : string;i : integer) : boolean;
function encode_sig_feux(i : integer): string;
@@ -992,12 +994,13 @@ begin
end;
// décode la ligne de signal et la stocke dans l'index i du tableau feux
procedure decode_ligne_feux(chaine_signal : string;i : integer);
function decode_ligne_feux(chaine_signal : string;i : integer) : boolean;
var s,chaine,sa : string;
j,k,l,t,adresse,adr,erreur ,asp,bd: integer;
j,k,l,t,id,adresse,adr,erreur ,asp,bd: integer;
c : char;
multiple,fini : boolean;
begin
decode_ligne_feux:=true; // pas de doublon
if i=0 then
begin
AfficheDebug('Erreur 670 : index nul',clred);
@@ -1007,9 +1010,20 @@ begin
j:=pos(',',s);
if j>1 then
begin
// adresse de feu
// adresse de signal
val(s,adresse,erreur);
if adresse=0 then begin affiche('Erreur 671 ligne '+s,clred);exit;end;
// vérifier si le signal existe pour ne pas le stocker
for id:=1 to NbreFeux do
begin
if feux[id].adresse=adresse then
begin
decode_ligne_feux:=false;
exit;
end;
end;
inc(nbreFeux);
Delete(s,1,j);
feux[i].adresse:=adresse;
j:=pos(',',s);
@@ -1076,7 +1090,7 @@ begin
j:=pos(',',s);
val(s,Feux[i].decodeur,erreur);
if (Feux[i].decodeur>NbDecodeur-1) then Affiche('Erreur 677 Ligne '+chaine_signal+' : erreur décodeur inconnu',clred);
if (Feux[i].decodeur>NbDecodeur-1) then Affiche('Erreur 677 Ligne '+chaine_signal+' : erreur décodeur inconnu: '+intToSTR(Feux[i].decodeur),clred);
if j<>0 then delete(s,1,j);
feux[i].Adr_el_suiv1:=0;feux[i].Adr_el_suiv2:=0;feux[i].Adr_el_suiv3:=0;feux[i].Adr_el_suiv4:=0;
feux[i].Btype_Suiv1:=rien;feux[i].Btype_Suiv2:=rien;feux[i].Btype_Suiv3:=rien;feux[i].Btype_Suiv4:=rien;
@@ -1098,7 +1112,7 @@ begin
Delete(s,1,k);
if Adr>NbMemZone then
begin
Affiche('Erreur 677A : ligne '+chaine_signal+' : adresse détecteur trop grand',clred);
Affiche('Erreur 677A : ligne '+chaine_signal+' : adresse détecteur trop grand: '+intToSTR(adr),clred);
Adr:=NbMemZone;
end;
end;
@@ -1171,7 +1185,7 @@ begin
delete(s,1,erreur);
if k=0 then
begin
if Feux[i].decodeur=6 then begin Affiche('Erreur 680 Ligne '+chaine_signal,clred);Affiche('Manque définition décodeur UniSemaf',clred);end;
if Feux[i].decodeur=6 then begin Affiche('Erreur 680 Ligne '+chaine_signal+' Manque définition décodeur UniSemaf signal '+intToSTR(adresse),clred);end;
end
else
begin
@@ -1179,10 +1193,10 @@ begin
if Feux[i].decodeur=6 then
begin
erreur:=verif_UniSemaf(adresse,k);
if erreur=1 then begin Affiche('Erreur 681 Ligne '+chaine_signal,clred);Affiche('Erreur code Unisemaf',clred);end;
if erreur=1 then begin Affiche('Erreur 681 Ligne '+chaine_signal+' Erreur code Unisemaf',clred);end;
if erreur=2 then
begin
Affiche('Erreur 682 Ligne '+chaine_signal,clred);Affiche('Erreur cohérence aspect signal ('+intToSTR(asp)+') et code Unisemaf ('+intToSTR(k)+')',clred);
Affiche('Erreur 682 Ligne '+chaine_signal+' Erreur cohérence signal (Adresse='+intToSTR(adresse)+' Aspect='+intToSTR(asp)+' et code Unisemaf=('+intToSTR(k)+')',clred);
end;
end;
end;
@@ -1328,6 +1342,7 @@ begin
with formconfig do
begin
NbVoies:=Tablo_PN[i].NbVoies;
if NbVoies>4 then nbVoies:=4;
s:='';
// par actionneur
@@ -1349,7 +1364,6 @@ begin
s:=s+'('+intToSTR(tablo_PN[i].Voie[voie].detZ1F)+'-'+intToSTR(tablo_PN[i].Voie[voie].detZ2F)+','+intToSTR(tablo_PN[i].Voie[voie].detZ1O)+'-'+intToSTR(tablo_PN[i].Voie[voie].detZ2O)+')';
if voie<NbVoies then s:=s+',';
end;
end;
s:=s+',PN('+IntToSTR(tablo_PN[i].AdresseFerme)+',';
@@ -1357,7 +1371,7 @@ begin
s:=s+IntToSTR(tablo_PN[i].AdresseOuvre)+',';
s:=s+intToSTR(tablo_PN[i].commandeOuvre)+'),';
if tablo_PN[i].pulse=1 then s:=s+'1' else s:=s+'0';
if tablo_PN[i].pulse=1 then s:=s+'1' else s:=s+'0';
end;
encode_act_pn:=s;
end;
@@ -1369,8 +1383,6 @@ begin
intToSTR(trains[index].vitRalenti);
end;
// modifie le fichier de config en fonction du paramétrage
// recopie les commentaires du fichier "fichier"
procedure genere_config;
@@ -1395,6 +1407,8 @@ begin
writeln(fichierN,Protocole_ch+'=',protocole);
writeln(fichierN,Verif_AdrXpressNet_ch+'=',Verif_AdrXpressNet);
// adresse ip et port de CDM
writeln(fichierN,IpV4_PC_ch+'=',adresseIPCDM+':'+intToSTR(portCDM));
@@ -1618,13 +1632,23 @@ begin
repeat
inc(Nligne);
s:=lit_ligne;
//affiche(s,clyellow);
if s<>'0' then
begin
inc(NbreFeux);
decode_ligne_feux(s,i);inc(i);
if NbreFeux>=NbreMaxiSignaux then
begin
Affiche('Nombre maximal de signaux atteint',clRed);
end
else
begin
if decode_ligne_feux(s,i) then // décode la chaine et stocke en tableau feux
begin
inc(i);
end
else
Affiche('Erreur 9 : signal '+s+' en doublon a été ignoré',clred);
end;
end;
until (s='0') or eof(fichier);
until (s='0') or eof(fichier);
end;
procedure compile_branches;
@@ -1655,7 +1679,7 @@ procedure compile_actionneurs;
var i : integer;
begin
// raz des actionneurs
for i:=1 to maxTablo_act do
for i:=1 to Max_actionneurs do
begin
Tablo_actionneur[i].trainDecl:='';
Tablo_actionneur[i].trainDest:='';
@@ -1672,7 +1696,6 @@ begin
Tablo_actionneur[i].son:=false;
end;
//Affiche('Définition des actionneurs/détecteurs',clyellow);
maxTablo_act:=1;
NbrePN:=0;Nligne:=1;
@@ -1892,7 +1915,7 @@ begin
i:=pos(')',s);Delete(S,1,i);
i:=pos(',',s);Delete(S,1,i);
Tablo_PN[NbrePN].voie[NbreVoies].PresTrain:=false;
until (copy(s,1,2)='PN') or (NbreVoies=10);
until (copy(s,1,2)='PN') or (NbreVoies=4);
Tablo_PN[NbrePN].NbVoies:=NbreVoies;
Delete(s,1,3); // Supprime PN(
@@ -1954,7 +1977,7 @@ begin
if debugconfig then Affiche(s,ClLime);
if (s<>'0') then
begin
if MaxAiguillage>=MaxAcc then
if MaxAiguillage>=NbreMaxiAiguillages then
begin
Affiche('Nombre maximal d''aiguillages atteint',clRed);
end
@@ -2219,7 +2242,7 @@ begin
val(s,AdrBaseDetDccpp,erreur);
s:='';
end;
sa:=uppercase(section_initpp_ch);
i:=pos(sa,s);
if i<>0 then
@@ -2318,6 +2341,14 @@ begin
val(s,debug,erreur);
end;
sa:=uppercase(Verif_AdrXpressNet_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,Verif_AdrXpressNet,erreur);
end;
sa:=uppercase(Filtrage_det_ch)+'=';
i:=pos(sa,s);
if i=1 then
@@ -2820,7 +2851,7 @@ begin
Nb_Det_Dist:=3;
// initialisation des aiguillages avec des valeurs par défaut
for i:=1 to MaxAcc do
for i:=1 to NbreMaxiAiguillages do
begin
Aiguillage[i].modele:=rien ; // sans existence
Aiguillage[i].adresse:=0;
@@ -2961,6 +2992,8 @@ begin
if (i<0) or (i>3) then i:=0;
Debug:=i;
if CheckBoxVerifXpressNet.checked then Verif_AdrXpressNet:=1 else Verif_AdrXpressNet:=0;
if checkRoulage.Checked then AvecRoulage:=1 else AvecRoulage:=0;
// contrôle adresse IP interface
@@ -3196,6 +3229,7 @@ begin
EditComUSB.Text:=PortCom;
EditFonte.text:=IntToSTR(TailleFonte);
editdebug.Text:=IntToSTR(debug);
CheckBoxVerifXpressNet.Checked:=Verif_AdrXpressNet=1;
checkRoulage.Checked:=AvecRoulage=1;
EditTempoOctetUSB.text:=IntToSTR(TempoOctet);
EditTempoReponse.Text:=IntToSTR(TimoutMaxInterface);
@@ -3545,7 +3579,7 @@ begin
// droit bas
EditDroit_BD.Text:=intToSTR(aiguillage[id2].Adroit)+aiguillage[Id2].AdroitB;
EditDroit_BD.Hint:=TypeElAIg_to_char(aiguillage[id2].ADroit,aiguillage[Id2].AdroitB);
EditDroit_BD.Hint:=TypeElAIg_to_char(aiguillage[id2].ADroit,aiguillage[Id2].AdroitB);
LabelTJD2.Caption:=IntToSTR(adr2);
end;
@@ -3623,7 +3657,7 @@ begin
EditDevie_HD.Hint:=TypeElAIg_to_char(aiguillage[index].Adevie,aiguillage[index].AdevieB);
EditDroit_BD.Text:=intToSTR(aiguillage[index].Adroit)+aiguillage[index].AdroitB;
EditDroit_BD.Hint:=TypeElAIg_to_char(aiguillage[index].Adroit,aiguillage[index].AdroitB);
EditDroit_BD.Hint:=TypeElAIg_to_char(aiguillage[index].Adroit,aiguillage[index].AdroitB);
if tri then
begin
ComboBoxAig.ItemIndex:=3; // 0=n'existe pas 1=aiguillage 2=TJD 3=TJS 4=aiguillage triple
@@ -3896,7 +3930,7 @@ begin
else
ComboBoxAsp.ItemIndex:=d-10+4;
end;
if ((d=2) or (d>=5)) and (d<10) then checkBoxFB.Visible:=true else checkBoxFB.Visible:=false;
if d>2 then
begin
@@ -4026,7 +4060,6 @@ begin
// déclencheurs
with formconfig do
begin
//
case typ of
0 :
begin
@@ -4078,6 +4111,7 @@ begin
if Tablo_actionneur[i].act then
begin
champs_type_act;
{
case typ of
0 : with formconfig do
begin
@@ -4091,8 +4125,8 @@ begin
2 : with formconfig do
begin
end;
end;
}
etatAct:=Tablo_actionneur[i].etat ;
Adresse:=Tablo_actionneur[i].adresse;
@@ -4459,8 +4493,7 @@ begin
s:=encode_aig(index);
formconfig.RichAig.Lines[index-1]:=s;
end;
end;
end;
end;
// on change la valeur de la description de la déviation de l'aiguillage
@@ -6070,6 +6103,11 @@ var s: string;
i : integer;
begin
if affevt then affiche('Evt bouton nouveau acc',clyellow);
if maxtablo_act>=Max_actionneurs then
begin
Affiche('Nombre maximal d''actionneurs atteint',clred);
exit;
end;
clicliste:=true;
inc(maxTablo_act);
i:=MaxTablo_act;
@@ -6093,7 +6131,7 @@ begin
Selstart:=RichAct.GetTextLen-1;
Perform(EM_SCROLLCARET,0,0);
end;
GroupBoxRadio.Visible:=true;
LabelInfo.caption:='';
LigneClicAct:=i-1;
@@ -6109,6 +6147,12 @@ var s: string;
i : integer;
begin
if affevt then affiche('Evt bouton nouveau PN',clyellow);
if maxtablo_act>=Max_actionneurs then
begin
Affiche('Nombre maximal d''actionneurs atteint',clred);
exit;
end;
clicliste:=true;
inc(nbrePN);
i:=nbrePN;
@@ -6251,6 +6295,12 @@ var i,AdrMax : integer;
s : string;
begin
clicliste:=true;
if NbreFeux>=NbreMaxiSignaux then
begin
Affiche('Nombre maximal de signaux atteint',clRed);
exit;
end;
inc(NbreFeux);
AdrMax:=0;
@@ -6478,13 +6528,13 @@ begin
verif_extr_branches:=Erreur;
end;
function verif_coherence : boolean;
function verif_coherence : boolean;
var AncAdr,i,j,k,l,Indexaig,adr,adr2,extr,detect,condcarre,nc,index2,SuivAdr,
x,y,extr2,adr3,index3,det1Br,det2Br,det1index,det2index : integer;
x,y,extr2,adr3,index3,det1Br,det2Br,det1index,det2index,adresse,dec : integer;
modAig,AncModel,model,km,SuivModel,model2: TEquipement;
c : char;
vitesse : longint;
ok,trouveSuiv,TrouvePrec : boolean;
ok,trouveSuiv,TrouvePrec,AdrOk : boolean;
begin
// vérification de la cohérence1
// parcoure les branches jusqu'à trouver un aiguillage pour voir s'il a été décrit
@@ -6628,7 +6678,7 @@ begin
begin
if adr=feux[i].Adresse then
begin
affiche('Erreur 7 : signal '+intToSTR(adr)+' défini deux fois',clred);
affiche('Erreur 9 : signal '+intToSTR(adr)+' défini deux fois',clred);
ok:=false;
end;
end;
@@ -6839,6 +6889,7 @@ begin
// cohérence 7
// parcoure les aiguillages pour voir si les aiguillages déclarés aux extrémités sont existants
// et qu'ils ne pointent pas sur eux mêmes
for Indexaig:=1 to maxaiguillage do
//indexaig:=index_aig(93);
begin
@@ -6859,6 +6910,7 @@ begin
c:=aiguillage[indexaig].AdroitB;
if (c='D') or (c='S') or (c='P') then
begin
if adr2=adr then affiche('Erreur 10.0 : la position droite de l''aiguillage '+intToSTR(adr)+' pointe sur elle même',clred);
index2:=Index_aig(adr2); // adresse de l'aiguillage connecté
model2:=aiguillage[index2].modele; // modèle de l'aiguillage connecté
if index2=0 then
@@ -6894,11 +6946,11 @@ begin
if (model2=aig) or (model2=triple) then
begin
if c='D' then
if c='D' then
begin
extr:=aiguillage[index2].ADroit;
if adr<>extr then Affiche('Erreur 10.23: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'D différent de '+intToSTR(extr),clred);
end;
end;
if c='S' then
begin
extr:=aiguillage[index2].ADevie;
@@ -6909,7 +6961,7 @@ begin
extr:=aiguillage[index2].APointe;
if adr<>extr then Affiche('Erreur 10.25: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'P différent de '+intToSTR(extr),clred);
end;
end;
end;
end;
end;
@@ -6917,6 +6969,7 @@ begin
c:=aiguillage[indexaig].AdevieB;
if (c='D') or (c='S') or (c='P') then
begin
if adr2=adr then affiche('Erreur 10.1 : la position déviée de l''aiguillage '+intToSTR(adr)+' pointe sur elle même',clred);
index2:=Index_aig(adr2); // adresse de l'aiguillage connecté
model2:=aiguillage[index2].modele; // modèle de l'aiguillage connecté
if index2=0 then
@@ -6932,11 +6985,11 @@ begin
if (adr<>aiguillage[index2].Adevie) and (adr<>aiguillage[index2].ADroit) and
(adr<>aiguillage[index2].DDevie) and (adr<>aiguillage[index2].Ddroit) then
begin
Affiche('Erreur 10.31: Discordance de déclaration aiguillage '+intToSTR(adr)+': '+intToSTR(adr2),clred);
Affiche('Erreur 10.31: Discordance de déclaration aiguillage '+intToSTR(adr)+': '+intToSTR(adr2),clred);
ok:=false;
end;
end;
// tjs ou tjs à 4 états
if (((model2=tjs) or (model2=tjd)) and (aiguillage[index2].EtatTJD=4)) then
begin
@@ -6956,13 +7009,13 @@ begin
begin
extr:=aiguillage[index2].ADroit;
if adr<>extr then Affiche('Erreur 10.33: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'D différent de '+intToSTR(extr),clred);
end;
end;
if c='S' then
begin
extr:=aiguillage[index2].ADevie;
if adr<>extr then Affiche('Erreur 10.34: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'S différent de '+intToSTR(extr),clred);
end;
if c='P' then
if c='P' then
begin
extr:=aiguillage[index2].APointe;
if adr<>extr then Affiche('Erreur 10.35: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'P différent de '+intToSTR(extr),clred);
@@ -6975,6 +7028,7 @@ begin
c:=aiguillage[indexaig].ApointeB;
if (c='D') or (c='S') or (c='P') then
begin
if adr2=adr then affiche('Erreur 10.2 : la pointe de l''aiguillage '+intToSTR(adr)+' pointe sur elle même',clred);
index2:=Index_aig(adr2); // adresse de l'aiguillage connecté
model2:=aiguillage[index2].modele; // modèle de l'aiguillage connecté
if index2=0 then
@@ -7009,7 +7063,7 @@ begin
if (model2=aig) or (model2=triple) then
begin
if c='D' then
if c='D' then
begin
extr:=aiguillage[index2].ADroit;
if adr<>extr then Affiche('Erreur 10.43: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'D différent de '+intToSTR(extr),clred);
@@ -7022,12 +7076,12 @@ begin
if c='P' then
begin
extr:=aiguillage[index2].APointe;
if adr<>extr then Affiche('Erreur 10.45: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'P différent de '+intToSTR(extr),clred);
if adr<>extr then Affiche('Erreur 10.45: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'P différent de '+intToSTR(extr),clred);
end;
end;
end;
end;
end;
end;
end;
end;
@@ -7194,6 +7248,84 @@ begin
val(copy(portcom,i+1,j-i),vitesse,l);
if (protocole=2) and (vitesse<>115200) then Affiche('La vitesse COM/USB en procotole DCC++ doit être de 115200 bauds',clred);
// si xpressnet, pas d'accesoires entre 257 à 272
AdrOk:=True;
if Verif_AdrXpressNet=1 then
begin
for i:=1 to maxaiguillage do
begin
adresse:=aiguillage[i].Adresse ;
if (adresse>=257) and (adresse<=272) then
begin
AdrOk:=false;
ok:=false;
Affiche('Erreur 13: l''aiguillage '+IntToSTR(adresse)+' se trouve dans la plage des accessoires DCC interdits (257-272) en Xpressnet',clred);
end;
end;
for i:=1 to NbreFeux do
begin
adresse:=feux[i].Adresse;
dec:=feux[i].decodeur;
nc:=1;
// nc=nombre d'adresses du signal
if dec=1 then nc:=14; // digitalbahn
if dec=2 then nc:=5; // leb
if dec=3 then nc:=8; // ldt
if dec=4 then nc:=feux[i].Na; // cdf
if dec=5 then nc:=feux[i].Na; // digikeijs
if dec=6 then // paco unisemaf
begin
x:=feux[index].Unisemaf; // modèle
case x of
2 : nc:=1;
3,4 : nc:=2;
51,52 : nc:=3;
71 : nc:=2;
72,73 : nc:=3;
91,92 : nc:=3;
93,94,95,96,97,98,99 : nc:=4;
end;
end;
if dec=7 then nc:=8; // sr
if (adresse>=257) and (adresse<=272) or ((adresse+nc-1>=257) and (adresse+nc<=272)) then
begin
AdrOk:=false;
ok:=false;
Affiche('Erreur 14: le signal '+IntToSTR(adresse)+' se trouve dans la plage des accessoires DCC interdits (257-272)',clred);
Affiche('en Xpressnet car son décodeur '+decodeur[dec]+' occupe '+intToSTR(nc)+' adresses de '+intToSTR(adresse)+' à '+intToSTR(adresse+nc-1),clred);
end;
end;
// actionneurs
for i:=1 to maxTablo_act do
begin
if Tablo_actionneur[i].act then
begin
adresse:=Tablo_actionneur[i].accessoire;
if (adresse>=257) and (adresse<=272) then
begin
AdrOk:=false;
ok:=false;
Affiche('Erreur 15: l''actionneur '+IntToSTR(Tablo_actionneur[i].adresse)+' enclenche l''accessoire '+intToSTR(adresse),clred);
Affiche('qui se trouve dans la plage des accessoires DCC interdits (257-272) en Xpressnet',clred);
end;
end;
end;
if not(AdrOk) then
begin
j:=MessageDlg('Une adresse DCC via XpressNet a été trouvée dans la plage interdite.'+#13+
'Si vous n''utilisez pas XpressNet, vous devez choisir d''ignorer cette erreur.'+#13+#13+
'Voulez vous ignorer cette erreur à l''avenir? ',mtConfirmation,[mbNo,mbYes],0) ;
if j=mrYes then
begin
Verif_AdrXpressNet:=0;
sauve_config;
end;
end;
end;
verif_coherence:=ok;
end;
@@ -7201,7 +7333,7 @@ procedure TFormConfig.ButtonNouvAigClick(Sender: TObject);
var i : integer;
s : string;
begin
if MaxAiguillage>=MaxAcc then
if MaxAiguillage>=NbreMaxiAiguillages then
begin
Affiche('Nombre maximal d''aiguillages atteint',clRed);
exit;
@@ -7217,7 +7349,7 @@ begin
aiguillage[i].ApointeB:='Z';
aiguillage[i].Adevie2B:='Z';
aiguillage[i].tjsintB:='D';
aiguillage[i].AdrTrain:=0;
aiguillage[i].posInit:=const_inconnu;
aiguillage[i].Temps:=5;
@@ -8240,9 +8372,9 @@ procedure TFormConfig.FormClose(Sender: TObject; var Action: TCloseAction);
var index : integer;
ok : boolean;
begin
if modif_branches then
if modif_branches then
begin
if MessageDlg('Les branches ont été modifiées mais non validées. Voulez fermer la fenêtre ?',mtConfirmation,[mbYes,mbNo],0)=mrNo then
if MessageDlg('Les branches ont été modifiées mais non validées. Voulez fermer la fenêtre ?',mtConfirmation,[mbYes,mbNo],0)=mrNo then
begin
action:=tCloseAction(caNone);
exit;
@@ -9269,16 +9401,11 @@ begin
supprime_train;
end;
procedure TFormConfig.CheckBoxVerifXpressNetClick(Sender: TObject);
begin
if CheckBoxVerifXpressNet.checked then Verif_AdrXpressNet:=1 else Verif_AdrXpressNet:=0;
end;
end.
Binary file not shown.
BIN
View File
Binary file not shown.
+3 -3
View File
@@ -30,8 +30,8 @@ object FormConfigTCO: TFormConfigTCO
Caption = 'Nombre de cellules en vertical:'
end
object LabelErreur: TLabel
Left = 302
Top = 248
Left = 16
Top = 216
Width = 3
Height = 13
end
@@ -235,7 +235,7 @@ object FormConfigTCO: TFormConfigTCO
end
object Memo1: TMemo
Left = 16
Top = 136
Top = 120
Width = 273
Height = 81
BevelInner = bvLowered
+73 -25
View File
@@ -174,29 +174,46 @@ begin
x2:=x1+width;
jy1:=(HauteurCell div 2)-round(6*frYGlob); // pos Y de la bande sup
jy2:=(HauteurCell div 2)+round(6*frYGlob); // pos Y de la bande inf
canvas.PolyGon([point(x1,jy1),point(x2,jy1),point(x2,jy2),point(x1,jy2)]);
end;
end;
function verif_config_TCO : boolean; // renvoie true si ok
var erreur : integer;
nokNbX,nokNbY,nokHt,nokLg : boolean;
var erreur,mx,my : integer;
ok : boolean;
begin
ok:=true;
with formConfigTCO do
begin
Val(EditNbCellX.Text,NbreCellX,erreur);
nokNbX:=erreur<>0;
if nokNbX then LabelErreur.caption:='Erreur nombre de cellules X';
nokNbX:=(NbreCellX<20) or (NbreCellX>MaxCellX);
if nokNbX then LabelErreur.caption:='Erreur: nombre de cellules X: mini=20 maxi='+IntToSTR(MaxCellX);
Val(EditNbCellX.Text,mx,erreur);
if (mx<20) or (mx>MaxCellX) then
begin
LabelErreur.caption:='Erreur: nombre de cellules X: mini=20 maxi='+IntToSTR(MaxCellX);
ok:=false;
end
else NbreCellX:=mx;
Val(EditNbCellY.Text,NbreCellY,erreur);
nokNbY:=erreur<>0;
if nokNbY then LabelErreur.caption:='Erreur: nombre de cellules Y';
nokNbY:=nokNbY or (NbreCellY<10) or (NbreCellY>MaxCellY);
if nokNbY then LabelErreur.caption:='Erreur: nombre de cellules Y: mini=10 maxi='+IntToSTR(MaxCellY);
Val(EditNbCellY.Text,my,erreur);
if (my<10) or (my>MaxCellY) then
begin
LabelErreur.caption:='Erreur: nombre de cellules Y: mini=10 maxi='+IntToSTR(MaxCellY);
ok:=false;
end
else NbreCellY:=my;
if LargeurCell*NbreCellX>8192 then
begin
LabelErreur.caption:='Erreur: nombre de cellules X';
ok:=false;
end;
if HauteurCell*NbreCellY>8192 then
begin
LabelErreur.caption:='Erreur: nombre de cellules Y';
ok:=false;
end;
{
Val(LabelTailleX.caption,LargeurCell,erreur);
@@ -212,30 +229,57 @@ begin
if nokHt then LabelErreur.caption:='Erreur: Tailles des cellules - hauteur cellules mini=20 maxi=50';
}
val(EditRatio.text,RatioC,erreur);
AvecGrille:=checkDessineGrille.Checked;
if checkCouleur.checked then ModeCouleurCanton:=1 else ModeCouleurCanton:=0;
end;
verif_config_TCO:=not(nokNbX or nokNbY or nokHt or nokLg);
verif_config_TCO:=ok;
NbCellulesTCO:=NbreCellX*NbreCellY;
end;
procedure TFormConfigTCO.ButtonOKClick(Sender: TObject);
var ok : boolean;
larg,haut : integer;
begin
ok:=true;
if verif_config_TCO then
begin
with formTCO do
with FormTCO.ImageTCO do
begin
ImageTCO.Width:=LargeurCell*NbreCellX;
ImageTCO.Height:=HauteurCell*NbreCellY;
end;
Width:=LargeurCell*NbreCellX;
Height:=HauteurCell*NbreCellY;
end;
try
SetLength(TCO,NbreCellX+1,NbreCellY+1);
except
LabelErreur.caption:='TCO Mémoire insuffisante';
NbreCellX:=20;NbreCellY:=12;
SetLength(TCO,NbreCellX+1,NbreCellY+1);
ok:=false;
end;
try
SetLength(TamponTCO,NbreCellX+1,NbreCellY+1);
except
LabelErreur.caption:='TamponTCO Mémoire insuffisante';
NbreCellX:=20;NbreCellY:=12;
SetLength(TamponTCO,NbreCellX+1,NbreCellY+1);
ok:=false;
end;
AvecGrille:=checkDessineGrille.Checked;
calcul_cellules;
affiche_TCO;
LabelErreur.caption:='';
close;
end;
if ok then
begin
calcul_cellules;
affiche_TCO;
LabelErreur.caption:='';
close;
end;
end;
end;
procedure TFormConfigTCO.ButtonDessineClick(Sender: TObject);
@@ -365,4 +409,8 @@ end;
end.
BIN
View File
Binary file not shown.
+70 -49
View File
@@ -2,7 +2,8 @@ object FormDebug: TFormDebug
Left = 306
Top = 21
Width = 864
Height = 721
Height = 788
VertScrollBar.Position = 28
VertScrollBar.Smooth = True
VertScrollBar.Tracking = True
Caption = 'Fen'#234'tre de d'#233'bug'
@@ -21,12 +22,12 @@ object FormDebug: TFormDebug
OnKeyPress = FormKeyPress
DesignSize = (
839
690)
757)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 674
Top = 4
Left = 595
Top = -24
Width = 108
Height = 13
Anchors = [akTop, akRight]
@@ -41,8 +42,8 @@ object FormDebug: TFormDebug
ParentFont = False
end
object Label2: TLabel
Left = 522
Top = 2
Left = 443
Top = -26
Width = 131
Height = 18
Anchors = [akTop, akRight]
@@ -55,8 +56,8 @@ object FormDebug: TFormDebug
ParentFont = False
end
object EditNivDebug: TEdit
Left = 785
Top = 2
Left = 754
Top = -26
Width = 49
Height = 21
Anchors = [akTop, akRight]
@@ -71,8 +72,8 @@ object FormDebug: TFormDebug
OnKeyPress = EditNivDebugKeyPress
end
object ButtonEcrLog: TButton
Left = 449
Top = 328
Left = 442
Top = 300
Width = 97
Height = 29
Anchors = [akTop, akRight]
@@ -81,8 +82,8 @@ object FormDebug: TFormDebug
OnClick = ButtonEcrLogClick
end
object ButtonRazTampon: TButton
Left = 449
Top = 360
Left = 442
Top = 332
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -92,8 +93,8 @@ object FormDebug: TFormDebug
OnClick = ButtonRazTamponClick
end
object ButtonCherche: TButton
Left = 449
Top = 296
Left = 442
Top = 268
Width = 97
Height = 25
Anchors = [akTop, akRight]
@@ -102,8 +103,8 @@ object FormDebug: TFormDebug
OnClick = ButtonChercheClick
end
object ButtonAffEvtChrono: TButton
Left = 449
Top = 256
Left = 442
Top = 228
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -113,8 +114,8 @@ object FormDebug: TFormDebug
OnClick = ButtonAffEvtChronoClick
end
object ButtonCop: TButton
Left = 449
Top = 208
Left = 442
Top = 180
Width = 97
Height = 41
Anchors = [akTop, akRight]
@@ -130,8 +131,8 @@ object FormDebug: TFormDebug
OnClick = ButtonCopClick
end
object ButtonRazLog: TButton
Left = 449
Top = 400
Left = 442
Top = 372
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -141,9 +142,9 @@ object FormDebug: TFormDebug
OnClick = ButtonRazLogClick
end
object GroupBox1: TGroupBox
Left = 455
Top = 600
Width = 372
Left = 448
Top = 572
Width = 369
Height = 185
Anchors = [akTop, akRight]
Caption = 'Fonctions primitives'
@@ -164,7 +165,7 @@ object FormDebug: TFormDebug
Caption = 'Signal'
TabOrder = 0
object Label4: TLabel
Left = 305
Left = 313
Top = 10
Width = 32
Height = 13
@@ -190,7 +191,7 @@ object FormDebug: TFormDebug
OnClick = ButtonSigSuivClick
end
object ButtonCanSuivSig: TButton
Left = 72
Left = 80
Top = 16
Width = 65
Height = 49
@@ -203,7 +204,7 @@ object FormDebug: TFormDebug
OnClick = ButtonCanSuivSigClick
end
object EditSigSuiv: TEdit
Left = 304
Left = 312
Top = 32
Width = 33
Height = 21
@@ -213,7 +214,7 @@ object FormDebug: TFormDebug
TabOrder = 2
end
object ButtonCP: TButton
Left = 136
Left = 152
Top = 16
Width = 81
Height = 49
@@ -223,7 +224,7 @@ object FormDebug: TFormDebug
OnClick = ButtonCPClick
end
object Button2: TButton
Left = 224
Left = 240
Top = 16
Width = 65
Height = 49
@@ -236,7 +237,7 @@ object FormDebug: TFormDebug
object GroupBox4: TGroupBox
Left = 8
Top = 96
Width = 345
Width = 353
Height = 81
Caption = 'D'#233'tecteur/'#233'l'#233'ment suivant'
TabOrder = 1
@@ -289,9 +290,9 @@ object FormDebug: TFormDebug
end
end
object GroupBox2: TGroupBox
Left = 447
Top = 20
Width = 380
Left = 440
Top = -8
Width = 401
Height = 149
Anchors = [akTop, akRight]
Caption = 'S'#233'lections d'#39'affichage'
@@ -445,10 +446,11 @@ object FormDebug: TFormDebug
OnClick = CheckBox1Click
end
object CheckDebugTCO: TCheckBox
Left = 248
Left = 264
Top = 128
Width = 121
Height = 17
Alignment = taLeftJustify
Caption = 'Debug TCO'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -459,13 +461,32 @@ object FormDebug: TFormDebug
TabOrder = 9
OnClick = CheckDebugTCOClick
end
object CheckDetSIg: TCheckBox
Left = 264
Top = 112
Width = 121
Height = 17
Hint = 'Affichage des '#233'v'#232'nements d'#233'tecteurs et signaux avec tick'
Alignment = taLeftJustify
Caption = 'Det et signaux'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 10
OnClick = CheckDetSIgClick
end
end
object RichDebug: TRichEdit
Left = 8
Top = 8
Width = 427
Height = 788
Anchors = [akLeft, akTop, akRight]
Top = -20
Width = 425
Height = 741
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'RichDebug')
PopupMenu = PopupMenuRD
@@ -474,8 +495,8 @@ object FormDebug: TFormDebug
OnChange = RichDebugChange
end
object GroupBox5: TGroupBox
Left = 455
Top = 488
Left = 448
Top = 460
Width = 372
Height = 57
Anchors = [akTop, akRight]
@@ -541,8 +562,8 @@ object FormDebug: TFormDebug
end
end
object ButtonRazTout: TButton
Left = 450
Top = 176
Left = 443
Top = 148
Width = 97
Height = 25
Hint =
@@ -556,9 +577,9 @@ object FormDebug: TFormDebug
OnClick = ButtonRazToutClick
end
object GroupBox6: TGroupBox
Left = 454
Top = 552
Width = 373
Left = 448
Top = 524
Width = 372
Height = 41
Anchors = [akTop, akRight]
Caption = 'Sorties'
@@ -633,9 +654,9 @@ object FormDebug: TFormDebug
end
end
object MemoEvtDet: TRichEdit
Left = 556
Top = 174
Width = 265
Left = 544
Top = 146
Width = 281
Height = 307
Anchors = [akTop, akRight]
Color = clBlack
@@ -644,8 +665,8 @@ object FormDebug: TFormDebug
OnChange = MemoEvtDetChange
end
object SaveDialog: TSaveDialog
Left = 768
Top = 488
Left = 760
Top = 472
end
object PopupMenuRE: TPopupMenu
Left = 768
+16 -7
View File
@@ -62,6 +62,7 @@ type
Button1: TButton;
Button0: TButton;
MemoEvtDet: TRichEdit;
CheckDetSIg: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure ButtonEcrLogClick(Sender: TObject);
procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
@@ -99,6 +100,7 @@ type
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormActivate(Sender: TObject);
procedure MemoEvtDetChange(Sender: TObject);
procedure CheckDetSIgClick(Sender: TObject);
private
{ Déclarations privées }
public
@@ -108,7 +110,7 @@ type
var
FormDebug: TFormDebug;
NivDebug,signalDebug : integer;
AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche : boolean;
AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg : boolean;
N_event_det : integer; // index du dernier évènement (de 1 à 20)
N_Event_tick : integer ; // dernier index
@@ -217,7 +219,7 @@ begin
begin
if (i>=0) and (i<=3) then NivDebug:=i
else EditNivDebug.text:='3';
end
end
else EditNivDebug.text:='0';
end;
RichDebug.Lines.add('Niveau='+intToSTR(NivDebug));
@@ -373,19 +375,21 @@ begin
ancdebug:=NivDebug;
NivDebug:=3;
Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit;
test_memoire_zones(Adr);
if test_memoire_zones(Adr) then AfficheDebug('Présence train',clYellow) else
AfficheDebug('Absence train',clyellow);
NivDebug:=AncDebug;
end;
procedure TFormDebug.ButtonCPClick(Sender: TObject);
var Adr,erreur,ancdebug,adrtrain : integer ;
var Adr,erreur,ancdebug,adrtrain,voie : integer ;
begin
Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit;
ancdebug:=NivDebug;
NivDebug:=3;
PresTrainPrec(Adr,Nb_cantons_Sig,adrtrain);
if PresTrainPrec(Adr,Nb_cantons_Sig,false,voie,adrtrain) then AfficheDebug('Présence train',clYellow) else
AfficheDebug('Absence train',clyellow);
NivDebug:=AncDebug;
end;
@@ -524,7 +528,7 @@ begin
exit;
end;
s:='accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 1';
s:='Accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 1';
AfficheDebug(s,clyellow);
if CDM_connecte then
@@ -566,7 +570,7 @@ begin
exit;
end;
s:='accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 0';
s:='Accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 0';
AfficheDebug(s,clyellow);
if CDM_connecte then
@@ -606,4 +610,9 @@ begin
SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0);
end;
procedure TFormDebug.CheckDetSIgClick(Sender: TObject);
begin
AFfDetSIg:=checkDetSig.checked;
end;
end.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+14 -12
View File
@@ -1,9 +1,9 @@
object FormPrinc: TFormPrinc
Left = 64
Top = 110
Left = 48
Top = 231
Width = 1213
Height = 670
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
Caption = 'Signaux complexes'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -17,8 +17,8 @@ object FormPrinc: TFormPrinc
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
1205
619)
1197
612)
PixelsPerInch = 96
TextHeight = 13
object LabelTitre: TLabel
@@ -666,7 +666,7 @@ object FormPrinc: TFormPrinc
Visible = False
end
object Image2feux: TImage
Left = 888
Left = 896
Top = 88
Width = 33
Height = 57
@@ -1263,8 +1263,8 @@ object FormPrinc: TFormPrinc
end
object StatusBar1: TStatusBar
Left = 0
Top = 597
Width = 1205
Top = 590
Width = 1197
Height = 22
Panels = <>
SimplePanel = True
@@ -1465,8 +1465,8 @@ object FormPrinc: TFormPrinc
end
end
object GroupBox3: TGroupBox
Left = 640
Top = 56
Left = 632
Top = 64
Width = 265
Height = 129
Anchors = [akTop, akRight]
@@ -1642,6 +1642,7 @@ object FormPrinc: TFormPrinc
Width = 25
Height = 21
TabOrder = 1
OnChange = EditAdrTrainChange
end
object EditVitesse: TEdit
Left = 80
@@ -1720,13 +1721,14 @@ object FormPrinc: TFormPrinc
Text = '<1>'
end
object Button1: TButton
Left = 936
Top = 120
Left = 360
Top = 0
Width = 75
Height = 25
Anchors = [akTop, akRight]
Caption = 'Button1'
TabOrder = 11
Visible = False
OnClick = Button1Click
end
object Timer1: TTimer
+562 -490
View File
File diff suppressed because it is too large Load Diff
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+44 -11
View File
@@ -328,7 +328,7 @@ const
type
// structure du TCO
TTCO = array[1..MaxCellX,1..MaxCellY] of record
TTCO = array of array of record
Adresse : integer ; // adresse du détecteur ou de l'aiguillage ou du feu
BImage : integer ; // 0=rien 1=voie 2=aiguillage gauche gauche ... 30=feu
mode : integer; // couleur de voie 0=éteint 1=ClVoies 2=couleur en fonction du train
@@ -357,8 +357,11 @@ var
Xclic,Yclic,XClicCellInserer,YClicCellInserer,Xentoure,Yentoure,RatioC,ModeCouleurCanton,
AncienXClicCell,AncienYClicCell,LargeurCell,HauteurCell,NbreCellX,NbreCellY,NbCellulesTCO,
Epaisseur : integer;
titre_Fonte : string;
TamponTCO,tco : TTco ;
// pour copier coller
TamponTCO_Org : record
x1,y1,x2,y2,NbreCellX,NbreCellY : integer;
@@ -461,8 +464,8 @@ begin
fond:=i;
// eval_format:=true;
end ;
sa:=uppercase(clVoies_ch)+'=';
i:=pos(sa,s);
if i<>0 then
@@ -484,7 +487,7 @@ begin
val('$'+s,i,erreur);
clAllume:=i;
end;
sa:=uppercase(clGrille_ch)+'=';
i:=pos(sa,s);
if i<>0 then
@@ -561,13 +564,12 @@ begin
inc(nv);
trouve_matrice:=true;
delete(s,i,length(sa));
val(s,i,erreur);
NbreCellX:=i;
val(s,NbreCellX,erreur);
i:=pos(',',s);delete(s,1,i);
Val(s,NbreCellY,erreur)
end;
// ratio
sa:=uppercase(Ratio_ch)+'=';
i:=pos(sa,s);
@@ -579,11 +581,39 @@ begin
val(s,i,erreur);
RatioC:=i;
end;
until (pos('[MATRICE]',uppercase(s))<>0) or (eof(fichier));
NbCellulesTCO:=NbreCellX*NbreCellY;
if (NbreCellX<20) or (NbreCellX>MaxCellX) then
begin
NbreCellX:=MaxCellX;
Affiche('TCO: le nombre de cellules X a été ramené à '+intToSTR(NbreCellX),clred);
end;
if (NbreCellY<5) or (NbreCellY>MaxCellY) then
begin
NbreCellY:=MaxCellY;
Affiche('TCO: le nombre de cellules Y a été ramené à '+intToSTR(NbreCellX),clred);
end;
try
SetLength(TCO,NbreCellX+1,NbreCellY+1);
except
Affiche('TCO:Mémoire insuffisante pour'+intToSTR(NbreCellX)+' '+intToSTR(NbreCellY),clred);
NbreCellX:=20;NbreCellY:=12;
SetLength(TCO,NbreCellX+1,NbreCellY+1);
end;
try
SetLength(TamponTCO,NbreCellX+1,NbreCellY+1);
except
Affiche('TamponTCO:Mémoire insuffisante',clred);
NbreCellX:=20;NbreCellY:=12;
SetLength(TamponTCO,NbreCellX+1,NbreCellY+1);
end;
// lire la matrice
while not eof(fichier) do
begin
@@ -678,7 +708,7 @@ begin
// fonte
delete(s,1,1);
i:=pos(',',s);
tco[x,y].fonte:=copy(s,1,i-1);
tco[x,y].fonte:=copy(s,1,i-1);
//Affiche(fonte,clyellow);
Delete(s,1,i);
@@ -3249,6 +3279,9 @@ begin
//affiche('Affiche_tco',clLime);
DimX:=LargeurCell*NbreCellX;
DimY:=HauteurCell*NbreCellY;
// DimX DimY maxi 8191 pixels pour les bitmap
if (dimX>8192) then begin Affiche('Espace TCO X trop grand',clred); exit; end;
if (dimY>8192) then begin Affiche('Espace TCO Y trop grand',clred); exit; end;
PImageTCO.Height:=DimY;
PImageTCO.Width:=DimX;
Binary file not shown.
BIN
View File
Binary file not shown.
+69 -110
View File
@@ -3,7 +3,7 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, unitprinc, unitpilote;
Dialogs, StdCtrls, unitprinc, unitpilote , unitDebug;
type
TFormPlace = class(TForm)
@@ -133,8 +133,8 @@ begin
end;
procedure TFormPlace.ButtonPlaceClick(Sender: TObject);
var suiv,detect,erreur : integer;
s : string;
var Suiv,prec,detect,erreur,i,it : integer;
s,Ssuiv,NomTrain : string;
begin
if cdm_connecte then
begin
@@ -146,79 +146,65 @@ begin
begin
detecteur[detect].train:='';
detecteur[detect].AdrTrain:=0;
detecteur[detect].IndexTrain:=0;
end;
s:=edit1.Text;
if s<>'' then
it:=0;
for i:=1 to 6 do
begin
val(s,detect,erreur);
if (erreur<>0) or (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train 1';
if detect<>0 then
begin
detecteur[detect].adrTrain:=trains[1].adresse;
event_detecteur(detect,true,trains[1].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+EditDir1.Text,clLime);
end
else
begin
detecteur[detect].etat:=false;
detecteur[detect].train:='';
detecteur[detect].adrTrain:=0;
case i of
1 : begin s:=edit1.Text;Ssuiv:=EditDir1.Text;end;
2 : begin s:=edit2.Text;Ssuiv:=EditDir2.Text;end;
3 : begin s:=edit3.Text;Ssuiv:=EditDir3.Text;end;
4 : begin s:=edit4.Text;Ssuiv:=EditDir4.Text;end;
5 : begin s:=edit5.Text;Ssuiv:=EditDir5.Text;end;
6 : begin s:=edit6.Text;Ssuiv:=EditDir6.Text;end;
end;
end;
s:=edit2.Text;
if s<>'' then
begin
val(s,detect,erreur);
if (erreur<>0) or (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train 2';
if detect<>0 then
if (s<>'') and (Ssuiv<>'') then
begin
detecteur[detect].adrTrain:=trains[2].adresse;
event_detecteur(detect,true,trains[2].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+EditDir2.Text,clLime);
end
else
begin
detecteur[detect].etat:=false;
detecteur[detect].train:='';
detecteur[detect].adrTrain:=0;
end;
end;
s:=edit3.Text;
if s<>'' then
begin
val(s,detect,erreur);
if (erreur<>0) or (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train 3';
if detect<>0 then
begin
detecteur[detect].adrTrain:=trains[3].adresse;
event_detecteur(detect,true,trains[3].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+EditDir3.Text,clLime);
end
else
begin
detecteur[detect].etat:=false;
detecteur[detect].train:='';
detecteur[detect].adrTrain:=0;
end;
end;
s:=edit4.Text;
if s<>'' then
begin
val(s,detect,erreur);
if (erreur<>0) or (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train 4';
if detect<>0 then
begin
det_adj(detect);
val(editDir4.Text,Suiv,erreur);
val(s,detect,erreur);
val(Ssuiv,Suiv,erreur);
NomTrain:=trains[i].nom_train;
if (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train '+intToSTR(i);
prec:=det_suiv_cont(Suiv,detect); // détecteur précédent (d'ou vient la loco)
if detect<>0 then
begin
detecteur[detect].adrTrain:=trains[4].adresse;
event_detecteur(detect,true,trains[4].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+EditDir4.Text,clLime);
inc(it);
//detecteur[detect].adrTrain:=trains[i].adresse;
//event_detecteur(detect,true,trains[i].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+Ssuiv,clLime);
{
SauvefiltrageDet0:=filtrageDet0;
filtrageDet0:=0;
Affiche(intToSTR(prec)+' 1',clyellow);
event_detecteur(prec,true,NomTrain);
Affiche(intToSTR(prec)+' 0',clyellow);
event_detecteur(prec,false,NomTrain);
Affiche(intToSTR(detect)+' 1',clyellow);
event_detecteur(detect,true,NomTrain);
filtrageDet0:=SauveFiltrageDet0;
}
detecteur[detect].etat:=true;
detecteur[detect].AdrTrain:=trains[i].adresse;
detecteur[detect].train:=placement[i].train;
detecteur[detect].IndexTrain:=i;
MemZone[prec,detect].etat:=true;
MemZone[prec,detect].train:=placement[i].train;
MemZone[prec,detect].Adrtrain:=trains[i].adresse;
MemZone[prec,detect].NumTrain:=i;
//Affiche(inttostr(prec)+' '+intToSTR(detect),clorange);
event_det_train[it].NbEl:=1 ;
event_det_train[it].AdrTrain:=trains[i].adresse;
event_det_train[it].det[1].adresse:=prec;
event_det_train[it].det[1].etat:=false;
event_det_train[it].nom_train:=placement[i].train;
inc(N_trains);
end
else
begin
@@ -229,43 +215,6 @@ begin
end;
end;
s:=edit5.Text;
if s<>'' then
begin
val(s,detect,erreur);
if (erreur<>0) or (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train 5';
if detect<>0 then
begin
detecteur[detect].adrTrain:=trains[5].adresse;
event_detecteur(detect,true,trains[5].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+EditDir5.Text,clLime);
end
else
begin
detecteur[detect].etat:=false;
detecteur[detect].train:='';
detecteur[detect].adrTrain:=0;
end;
end;
s:=edit6.Text;
if s<>'' then
begin
val(s,detect,erreur);
if (erreur<>0) or (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train 6';
if detect<>0 then
begin
detecteur[detect].adrTrain:=trains[6].adresse;
event_detecteur(detect,true,trains[6].nom_train);
Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+EditDir6.Text,clLime);
end
else
begin
detecteur[detect].etat:=false;
detecteur[detect].train:='';
detecteur[detect].adrTrain:=0;
end;
end;
if formTCO.Showing then
begin
affiche_tco;
@@ -383,6 +332,7 @@ end;
procedure TFormPlace.ButtonLanceRoutageClick(Sender: TObject);
var a,i,j,id,adrDet,AdrTrain,AdrFeu : integer;
trouve,rouge : boolean;
var s: string;
begin
if cdm_connecte then
begin
@@ -391,14 +341,19 @@ begin
end;
trouve:=false;
// explorer les détecteurs pour lancer les trains
for i:=1 to NDetecteurs do
begin
adrDet:=Adresse_detecteur[i];
if Detecteur[adrDet].etat and (detecteur[adrDet].train<>'') then
begin
rouge:=false;
trouve:=true;
roulage:=true;
AdrTrain:=detecteur[AdrDet].AdrTrain;
AdrFeu:=signal_detecteur(AdrDet); // trouve l'adresse du feu correspondant au détecteur
// si il y a un signal sur le détecteur de démarrage du train est il au rouge?
if adrFeu<>0 then
begin
id:=index_feu(AdrFeu);
@@ -410,18 +365,22 @@ begin
begin
j:=index_train_adresse(AdrTrain);
vitesse_loco('',adrTrain,trains[j].VitNominale,not(placement[j].inverse));
trouve:=true;
roulage:=true;
maj_feux;
Affiche('Lancement du train '+detecteur[adrDet].train+' depuis détecteur '+intToSTR(adrDet),clYellow);
maj_feux(true); // avec détecteurs
s:='Lancement du train '+detecteur[adrDet].train+' depuis détecteur '+intToSTR(adrDet);
Affiche(s,clYellow);
if traceListe then AfficheDebug(s,clyellow);
reserve_canton(AdrDet,placement[j].detdir,adrtrain);
end
Else Affiche('Le signal '+intToSTR(AdrFeu)+' étant rouge, le train '+detecteur[adrDet].train+' @'+intToSTR(AdrTrain)+' ne démarre pas',clyellow);
end;
end;
// au moins un train démarre
if trouve then
begin
Maj_feux;
Maj_feux(true);
Formprinc.LabelTitre.caption:=titre+' - Mode roulage en cours';
with Formprinc.SBMarcheArretLoco do
begin
BIN
View File
Binary file not shown.
+1 -1
View File
@@ -23,7 +23,7 @@ var
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='5.4'; // sert à la comparaison de la version publiée
Const Version='5.5'; // sert à la comparaison de la version publiée
SousVersion=' '; // en cas d'absence de sous version mettre un espace
implementation
+3 -4
View File
@@ -141,8 +141,7 @@ version 5.3 : Informations sur les
détection simultanée d'un train sur deux détecteurs
version 5.4 : Amélioration du mode roulage.
Améliorations diverses.
Filtrage des détecteurs en mode autonome.
version 5.5 : Gestion signaux en doublon.
Vérification des adresses interdites en XpressNet
Passage au rouge du signal au premier train quittant son détecteur