easylinux/SignauxComplexes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

V4.8

Browse Source
This commit is contained in:
f1iwq2
2022-11-11 12:25:39 +01:00
parent 0478ffab49
commit d4528407dd
16 changed files with 471 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice d'utilisation des signaux_complexes_GL_V4.73.pdf → Notice d'utilisation des signaux_complexes_GL_V4.8.pdf
BIN
View File
Binary file not shown.
UnitConfig.dcu
BIN
View File
Binary file not shown.
UnitConfig.dfm
+13 -2
View File
@@ -2846,7 +2846,7 @@ object FormConfig: TFormConfig
end
object Label35: TLabel
Left = 40
Top = 428
Top = 444
Width = 201
Height = 13
Caption = 'Temporisation entre deux commandes (ms)'
@@ -3227,12 +3227,23 @@ object FormConfig: TFormConfig
end
object EditTempoFeu: TEdit
Left = 0
Top = 424
Top = 440
Width = 33
Height = 21
TabOrder = 6
OnChange = EditTempoFeuChange
end
object CheckBoxFVR: TCheckBox
Left = 0
Top = 416
Width = 281
Height = 17
Hint = 'Le changement de cette option n'#233'cessite un red'#233'marrage'
Caption = 'Gestion feux verts et s'#233'maphore clignotants'
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
end
object TabSheetAct: TTabSheet
Caption = 'Actionneurs/D'#233'tecteurs'
UnitConfig.pas
+76 -96
View File
@@ -286,6 +286,7 @@ type
Button1: TButton;
Button3: TButton;
CheckPnPulse: TCheckBox;
CheckBoxFVR: TCheckBox;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -446,6 +447,7 @@ NOTIF_VERSION_ch='NOTIF_VERSION';
verif_version_ch='verif_version';
Fonte_ch='Fonte';
Raz_signaux_ch='RazSignaux';
AvecFVR_ch='FeuxVertRougeCli';
// sections de config
section_aig_ch='[section_aig]';
@@ -1078,8 +1080,8 @@ begin
begin
//Affiche('Conditions supplémentaires pour le feu '+IntToSTR(adresse)+' parenthèse '+intToSTR(l),clyellow);
k:=pos(')',s);
sa:=copy(s,t+1,k-t-1); // contient l'intérieur des parenthèses sans les parenthèses
delete(s,1,k);//Affiche(s,clYellow);
sa:=copy(s,t+1,k-t); // contient l'intérieur des parenthèses sans les parenthèses
delete(s,1,k+1);//Affiche(s,clYellow);
// boucle dans la parenthèse
bd:=0;
@@ -1303,10 +1305,12 @@ begin
// Serveur de rétrosignalisation Lenz de CDM
writeln(fichierN,retro_ch+'=',intToSTR(ServeurRetroCDM));
// entête
// Raz Signaux
if Raz_Acc_signaux then s:='1' else s:='0';
writeln(fichierN,'RazSignaux='+s);
writeln(fichierN,Raz_signaux_ch+'='+s);
if AvecFVR then s:='1' else s:='0';
writeln(fichierN,AvecFVR_ch+'='+s);
// temporisation entre 2 commandes décodeurs feu
writeln(fichierN,Tempo_feu_ch+'=',IntToSTR(Tempo_feu));
@@ -1383,7 +1387,7 @@ var s,sa,chaine,SOrigine: string;
trouve_sec_init,trouve_init_aig,trouve_lay,trouve_IPV4_INTERFACE,trouve_PROTOCOLE_SERIE,trouve_INTER_CAR,
trouve_Tempo_maxi,trouve_Entete,trouve_tco,trouve_cdm,trouve_Serveur_interface,trouve_fenetre,trouve_MasqueTCO,
trouve_NOTIF_VERSION,trouve_verif_version,trouve_fonte,trouve_tempo_aig,trouve_raz,trouve_section_aig,
pds,trouve_section_branche,trouve_section_sig,trouve_section_act,fichier_trouve,trouve_tempo_feu,
pds,trouve_section_branche,trouve_section_sig,trouve_section_act,fichier_trouve,trouve_tempo_feu,trouve_FVR,
trouve_algo_uni,croi,trouve_Nb_cantons_Sig,trouve_dem_aig,trouve_demcnxCOMUSB,trouve_demcnxEth : boolean;
bd,virgule,i_detect,i,erreur,aig2,detect,offset,index, adresse,j,position,temporisation,invers,indexPointe,indexDevie,indexDroit,
ComptEl,Compt_IT,Num_Element,k,modele,adr,adr2,erreur2,l,t,Nligne,postriple,itl,
@@ -2312,6 +2316,20 @@ begin
Raz_Acc_signaux:=i=1;
end;
sa:=uppercase(AvecFVR_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
inc(nv);
trouve_FVR:=true;
delete(s,i,length(sa));
val(s,i,erreur);
if i>1 then i:=1;
AvecFVR:=i=1;
if avecFVR then espY:=48 else espY:=15; // espacement Y entre deux lignes de feux
end;
// section aiguillages
sa:=uppercase(section_aig_ch);
if pos(sa,s)<>0 then
@@ -2377,6 +2395,20 @@ begin
trouve_Raz:=false;
trouve_demcnxCOMUSB:=false;
trouve_demcnxEth:=false;
trouve_Algo_Uni:=false;
trouve_Nb_cantons_Sig:=false;
trouve_FVR:=false;
if not(trouve_tempo_feu) then
begin
s:=tempo_feu_ch;
tempo_feu:=100;
s:='';
end;
if not(trouve_NOTIF_VERSION) then s:=NOTIF_VERSION_ch;
if not(trouve_verif_version) then s:=verif_version_ch;
if not(trouve_fonte) then s:=fonte_ch;
if not(trouve_FVR) then s:=AvecFVR_ch;
Nb_Det_Dist:=3;
// initialisation des aiguillages avec des valeurs par défaut
@@ -2414,6 +2446,8 @@ begin
AvecInitAiguillages:=true;
AvecDemandeInterfaceUSB:=true;
AvecDemandeInterfaceEth:=true;
lay:='';
avecFVR:=false;
Tempo_Aig:=100;
Tempo_feu:=100;
ServeurInterfaceCDM:=1;
@@ -2452,6 +2486,7 @@ begin
if not(trouve_dem_aig) then s:=Init_dem_aig_ch;
if not(trouve_demcnxCOMUSB) then s:=Init_dem_interfaceUSBCOM_ch;
if not(trouve_demcnxEth) then s:=Init_dem_interfaceEth_ch;
if not(trouve_FVR) then s:=AvecFVR_ch;
if not(trouve_tempo_feu) then
begin
@@ -2462,10 +2497,11 @@ begin
if not(trouve_NOTIF_VERSION) then s:=NOTIF_VERSION_ch;
if not(trouve_verif_version) then s:=verif_version_ch;
if not(trouve_fonte) then s:=fonte_ch;
if not(trouve_FVR) then s:=AvecFVR_ch;
if s<>'' then
begin
affiche('Manque variables dans '+NomConfig+' : '+s,clOrange);
affiche('Manque variable(s) dans '+NomConfig+' : '+s,clOrange);
Affiche('Elles seront régénérées automatiquement',clOrange);
confasauver:=true;
end;
@@ -2630,11 +2666,12 @@ begin
Srvc_PosTrain:=CheckServPosTrains.checked;
Srvc_Sig:=CheckBoxSrvSig.checked;
Raz_Acc_signaux:=CheckBoxRazSignaux.checked;
AvecFVR:=CheckBoxFVR.checked;
AvecInitAiguillages:=CheckBoxInitAig.Checked;
AvecDemandeAiguillages:=checkPosAig.checked;
AvecDemandeInterfaceUSB:=CheckBoxDemarUSB.checked;
AvecDemandeInterfaceEth:=CheckBoxDemarEth.checked;
end;
if change_srv then services_CDM;
verifie_panneau_config:=ok;
@@ -2778,11 +2815,12 @@ begin
CheckBoxServAct.checked:=Srvc_Act;
CheckServPosTrains.checked:=Srvc_PosTrain;
CheckBoxRazSignaux.checked:=Raz_Acc_signaux;
CheckBoxFVR.Checked:=AvecFVR;
CheckBoxInitAig.checked:=AvecInitAiguillages;
CheckPosAig.checked:=AvecDemandeAiguillages;
CheckBoxDemarUSB.checked:=AvecDemandeInterfaceUSB;
CheckBoxDemarEth.checked:=AvecDemandeInterfaceEth;
clicListe:=true; // empeche le traitement de l'evt text
EditDroit_BD.Text:='';
@@ -5752,7 +5790,9 @@ begin
begin
feux[i].Img.free; // supprime l'image, ce qui efface le feu du tableau graphique
Feux[i].Lbl.free; // supprime le label, ...
if Feux[i].check<>nil then begin Feux[i].check.Free;Feux[i].Check:=nil;end; // supprime le check du feu blanc s'il existait
if Feux[i].checkFB<>nil then begin Feux[i].checkFB.Free;Feux[i].CheckFB:=nil;end; // supprime le check du feu blanc s'il existait
feux[i].checkFR.Free;feux[i].checkFR:=nil;
feux[i].checkFV.Free;feux[i].checkFV:=nil;
end;
for i:=1 to NbreFeux-ligneFin do
@@ -5783,13 +5823,31 @@ begin
Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne));
caption:='@'+IntToSTR(Feux[IndexFeu].adresse);
end;
if Feux[IndexFeu].check<>nil then
with Feux[IndexFeu].Check do
if Feux[IndexFeu].checkFB<>nil then
with Feux[IndexFeu].CheckFB do
begin
Hint:=intToSTR(IndexFeu);
Name:='CheckBoxFB'+intToSTR(adresse);
Hint:='Feu blanc';
Top:=HtImg+15+((HtImg+EspY+20)*((IndexFeu-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne));
end;
if Feux[IndexFeu].checkFV<>nil then
with Feux[IndexFeu].CheckFV do
begin
Name:='CheckBoxFV'+intToSTR(adresse);
Hint:='Feu vert clignotant';
Top:=HtImg+30+((HtImg+EspY+20)*((IndexFeu-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne));
end;
if Feux[IndexFeu].checkFR<>nil then
with Feux[IndexFeu].CheckFR do
begin
Name:='CheckBoxFR'+intToSTR(adresse);
Hint:='Sémaphore clignotant';
Top:=HtImg+45+((HtImg+EspY+20)*((IndexFeu-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne));
end;
//Affiche('décale feu '+IntToSTR(i)+'<'+intToSTR(i+1),clorange);
feux[index].Adresse:=0;
@@ -5815,84 +5873,6 @@ begin
raz_champs_sig;
clicliste:=false;
{
i:=ligneClicSig;
if (i<0) then exit;
index:=i+1; // passe en index tableau
s:='Voulez-vous supprimer le feu '+IntToSTR(feux[index].adresse)+'?';
if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit;
Affiche('Suppression du feu ='+IntToSTR(feux[index].adresse),clOrange);
clicliste:=true; // évite les évènements Edit text
Feu_supprime:=feux[index]; // sauvegarde le feu supprimé
Feu_sauve.adresse:=0; // dévalider sa définition
Feu_sauve.aspect:=0; // dévalider sa définition
// supprime le feu du tableau
ButtonInsFeu.Caption:='Ajouter le feu '+intToSTR(feux[index].adresse)+' supprimé';
feux[index].Img.free; // supprime l'image, ce qui efface le feu du tableau graphique
Feux[index].Lbl.free; // supprime le label, ...
if Feux[index].check<>nil then begin Feux[index].check.Free;Feux[index].Check:=nil;end; // supprime le check du feu blanc s'il existait
// décale le tableau de feux et recalcule les positions des images
for i:=index to NbreFeux-1 do
begin
feux[i]:=feux[i+1];
with feux[i].Img do
begin
Top:=(HtImg+espY+20)*((i-1) div NbreImagePLigne); // détermine les points d'origine
Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne));
Name:='ImageFeu'+IntToSTR(i);
s:='Index='+IntToSTR(i)+' @='+inttostr(feux[i].Adresse)+' Décodeur='+intToSTR(feux[i].Decodeur)+
' Adresse détecteur associé='+intToSTR(feux[i].Adr_det1)+
' Adresse élement suivant='+intToSTR(feux[i].Adr_el_suiv1);
if feux[i].Btype_suiv1=aig then s:=s+' (aig)';
Hint:=s;
end;
with feux[i].Lbl do
begin
Top:=HtImg+((HtImg+EspY+20)*((i-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne));
caption:='@'+IntToSTR(Feux[i].adresse);
end;
if Feux[i].check<>nil then
with Feux[i].Check do
begin
Hint:=intToSTR(i);
Top:=HtImg+15+((HtImg+EspY+20)*((i-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne));
end;
//Affiche('décale feu '+IntToSTR(i)+'<'+intToSTR(i+1),clorange);
end;
dec(NbreFeux);
EditAdrSig.Text:='';
EditDet1.Text:='';EditDet2.Text:='';EditDet3.Text:='';EditDet4.Text:='';
EditSuiv1.Text:='';EditSuiv2.Text:='';EditSuiv3.Text:='';EditSuiv4.Text:='';
config_modifie:=true;
RichSig.Clear;
// réafficher le richsig
for i:=1 to NbreFeux do
begin
s:=encode_Sig_Feux(i);
if s<>'' then
begin
RichSig.Lines.Add(s);
RE_ColorLine(RichSig,RichSig.lines.count-1,ClAqua);
end;
end;
ligneClicSig:=-1;
AncligneClicSig:=-1;
raz_champs_sig;
clicliste:=false;
}
end;
procedure TFormConfig.ButtonSupFeuClick(Sender: TObject);
@@ -7734,10 +7714,10 @@ begin
for index:=1 to NbreFeux do
begin
// créer les nouveau checkBox de feux blancs si de nouveaux ont été cochés
if feux[index].FeuBlanc and (feux[index].check=nil) then
if feux[index].FeuBlanc and (feux[index].checkFB=nil) then
begin
feux[index].Check:=TCheckBox.create(Formprinc.ScrollBox1); // crée le handle
with Feux[index].Check do
feux[index].CheckFB:=TCheckBox.create(Formprinc.ScrollBox1); // crée le handle
with Feux[index].CheckFB do
begin
onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus
Hint:=intToSTR(index);
@@ -7750,10 +7730,10 @@ begin
end;
end;
// supprimer les checkBox de feux blancs si ils ont été décochés
if not(feux[index].FeuBlanc) and (feux[index].check<>nil) then
if not(feux[index].FeuBlanc) and (feux[index].checkFB<>nil) then
begin
Feux[index].Check.free;
Feux[index].Check:=nil;
Feux[index].CheckFB.free;
Feux[index].CheckFB:=nil;
end;
end;
UnitDebug.dcu
BIN
View File
Binary file not shown.
UnitDebug.dfm
+121 -43
View File
@@ -1,8 +1,9 @@
object FormDebug: TFormDebug
Left = 324
Top = 102
Width = 771
Height = 683
Left = 429
Top = 147
Width = 754
Height = 789
VertScrollBar.Position = 82
VertScrollBar.Tracking = True
Caption = 'Fen'#234'tre de d'#233'bug'
Color = clWindow
@@ -16,13 +17,13 @@ object FormDebug: TFormDebug
Position = poMainFormCenter
OnCreate = FormCreate
DesignSize = (
738
645)
721
751)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 597
Top = 4
Left = 564
Top = -78
Width = 108
Height = 13
Anchors = [akTop, akRight]
@@ -37,8 +38,8 @@ object FormDebug: TFormDebug
ParentFont = False
end
object Label2: TLabel
Left = 429
Top = 2
Left = 412
Top = -80
Width = 131
Height = 18
Anchors = [akTop, akRight]
@@ -51,8 +52,8 @@ object FormDebug: TFormDebug
ParentFont = False
end
object EditNivDebug: TEdit
Left = 709
Top = 2
Left = 675
Top = -80
Width = 49
Height = 21
Anchors = [akTop, akRight]
@@ -67,10 +68,10 @@ object FormDebug: TFormDebug
OnKeyPress = EditNivDebugKeyPress
end
object MemoEvtDet: TMemo
Left = 495
Top = 336
Left = 485
Top = 254
Width = 229
Height = 201
Height = 194
Anchors = [akTop, akRight]
Color = clBlack
Font.Charset = ANSI_CHARSET
@@ -88,8 +89,8 @@ object FormDebug: TFormDebug
OnChange = MemoEvtDetChange
end
object ButtonEcrLog: TButton
Left = 389
Top = 328
Left = 379
Top = 246
Width = 97
Height = 29
Anchors = [akTop, akRight]
@@ -98,8 +99,8 @@ object FormDebug: TFormDebug
OnClick = ButtonEcrLogClick
end
object ButtonRazTampon: TButton
Left = 389
Top = 360
Left = 379
Top = 278
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -109,8 +110,8 @@ object FormDebug: TFormDebug
OnClick = ButtonRazTamponClick
end
object ButtonCherche: TButton
Left = 389
Top = 296
Left = 379
Top = 214
Width = 97
Height = 25
Anchors = [akTop, akRight]
@@ -119,8 +120,8 @@ object FormDebug: TFormDebug
OnClick = ButtonChercheClick
end
object ButtonAffEvtChrono: TButton
Left = 389
Top = 256
Left = 379
Top = 174
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -130,8 +131,8 @@ object FormDebug: TFormDebug
OnClick = ButtonAffEvtChronoClick
end
object ButtonCop: TButton
Left = 389
Top = 208
Left = 379
Top = 126
Width = 97
Height = 41
Anchors = [akTop, akRight]
@@ -147,8 +148,8 @@ object FormDebug: TFormDebug
OnClick = ButtonCopClick
end
object RichEdit: TRichEdit
Left = 495
Top = 176
Left = 485
Top = 94
Width = 229
Height = 153
Anchors = [akTop, akRight]
@@ -166,8 +167,8 @@ object FormDebug: TFormDebug
OnChange = RichEditChange
end
object ButtonRazLog: TButton
Left = 389
Top = 400
Left = 379
Top = 318
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -177,15 +178,15 @@ object FormDebug: TFormDebug
OnClick = ButtonRazLogClick
end
object GroupBox1: TGroupBox
Left = 387
Top = 608
Left = 369
Top = 566
Width = 345
Height = 177
Height = 185
Anchors = [akTop, akRight]
Caption = 'Fonctions primitives'
Color = cl3DLight
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Color = clNavy
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
@@ -271,7 +272,7 @@ object FormDebug: TFormDebug
end
object GroupBox4: TGroupBox
Left = 8
Top = 88
Top = 96
Width = 329
Height = 81
Caption = 'D'#233'tecteur/'#233'l'#233'ment suivant'
@@ -325,8 +326,8 @@ object FormDebug: TFormDebug
end
end
object GroupBox2: TGroupBox
Left = 395
Top = 20
Left = 377
Top = -62
Width = 333
Height = 149
Anchors = [akTop, akRight]
@@ -498,9 +499,9 @@ object FormDebug: TFormDebug
end
object RichDebug: TRichEdit
Left = 8
Top = 8
Width = 368
Height = 612
Top = -74
Width = 353
Height = 718
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'RichDebug')
@@ -511,8 +512,8 @@ object FormDebug: TFormDebug
OnChange = RichDebugChange
end
object GroupBox5: TGroupBox
Left = 387
Top = 544
Left = 369
Top = 454
Width = 345
Height = 57
Anchors = [akTop, akRight]
@@ -578,8 +579,8 @@ object FormDebug: TFormDebug
end
end
object ButtonRazTout: TButton
Left = 390
Top = 176
Left = 380
Top = 94
Width = 97
Height = 25
Hint =
@@ -592,6 +593,83 @@ object FormDebug: TFormDebug
TabOrder = 13
OnClick = ButtonRazToutClick
end
object GroupBox6: TGroupBox
Left = 368
Top = 518
Width = 345
Height = 41
Anchors = [akTop, akRight]
Caption = 'Sorties'
Color = cl3DLight
Font.Charset = DEFAULT_CHARSET
Font.Color = clNavy
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = False
ParentFont = False
TabOrder = 14
object Label3: TLabel
Left = 16
Top = 16
Width = 38
Height = 13
Caption = 'Adresse'
end
object Label5: TLabel
Left = 104
Top = 16
Width = 27
Height = 13
Caption = 'Sortie'
end
object EditAdresse: TEdit
Left = 64
Top = 10
Width = 33
Height = 21
Hint = 'Adresse d'#39'accessoire'
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object EditSortie: TEdit
Left = 136
Top = 10
Width = 25
Height = 21
Hint = 'Sortie 1 ou 2'
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object Button1: TButton
Left = 224
Top = 8
Width = 49
Height = 25
Hint =
'Mise '#224' 1 de la sortie - attention peut d'#233'truire les moteurs '#224' bo' +
'bine'
Caption = 'Mise '#224' 1'
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = Button1Click
end
object Button0: TButton
Left = 280
Top = 8
Width = 49
Height = 25
Hint = 'Mise '#224' 0 de la sortie'
Caption = 'Mise '#224' 0'
ParentShowHint = False
ShowHint = True
TabOrder = 3
OnClick = Button0Click
end
end
object SaveDialog: TSaveDialog
Left = 768
Top = 488
UnitDebug.pas
+96 -1
View File
@@ -4,7 +4,7 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls , ComCtrls, Menus;
Dialogs, StdCtrls , ComCtrls, Menus, unitconfig;
type
TFormDebug = class(TForm)
@@ -56,6 +56,13 @@ type
ButtonElSuiv: TButton;
CheckBox1: TCheckBox;
CheckDebugTCO: TCheckBox;
GroupBox6: TGroupBox;
EditAdresse: TEdit;
Label3: TLabel;
Label5: TLabel;
EditSortie: TEdit;
Button1: TButton;
Button0: TButton;
procedure FormCreate(Sender: TObject);
procedure ButtonEcrLogClick(Sender: TObject);
procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
@@ -90,6 +97,8 @@ type
procedure ButtonElSuivClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckDebugTCOClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button0Click(Sender: TObject);
private
{ Déclarations privées }
public
@@ -513,4 +522,90 @@ begin
debugTCO:=checkDebugTCO.checked;
end;
procedure TFormDebug.Button1Click(Sender: TObject);
var adr,sortie,erreur,groupe,pilotage : integer;
fonction : byte;
s : string;
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
val(EditSortie.text,sortie,erreur);
if (sortie<1) or (sortie>2) then
begin
EditSortie.text:='1';
exit;
end;
s:='accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 1';
AfficheDebug(s,clyellow);
if CDM_connecte then
begin
//AfficheDebug(intToSTR(adresse),clred);
s:=chaine_CDM_Acc(adr,sortie);
envoi_CDM(s);
end;
// pilotage par USB ou par éthernet de la centrale ------------
if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then
begin
pilotage:=1;
groupe:=(adr-1) div 4;
fonction:=((adr-1) mod 4)*2 + (sortie-1);
// pilotage à 1
s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack
end;
Self.ActiveControl:=nil;
end;
procedure TFormDebug.Button0Click(Sender: TObject);
var adr,sortie,erreur,groupe,pilotage : integer;
fonction : byte;
s : string;
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
val(EditSortie.text,sortie,erreur);
if (sortie<1) or (sortie>2) then
begin
EditSortie.text:='1';
exit;
end;
s:='accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 0';
AfficheDebug(s,clyellow);
if CDM_connecte then
begin
//AfficheDebug(intToSTR(adresse),clred);
s:=chaine_CDM_Acc(adr,0);
envoi_CDM(s);
end;
// pilotage par USB ou par éthernet de la centrale ------------
if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then
begin
pilotage:=1;
groupe:=(adr-1) div 4;
fonction:=((adr-1) mod 4)*2 + (sortie-1);
// pilotage à 0
s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack
end;
Self.ActiveControl:=nil;
end;
end.
UnitPilote.dcu
BIN
View File
Binary file not shown.
UnitPrinc.dcu
BIN
View File
Binary file not shown.
UnitPrinc.pas
+161 -41
View File
@@ -211,6 +211,8 @@ type
{ Déclarations publiques }
Procedure ImageOnClick(Sender : TObject);
procedure proc_checkBoxFB(Sender : Tobject);
procedure proc_checkBoxFV(Sender : Tobject);
procedure proc_checkBoxFR(Sender : Tobject);
end;
@@ -224,7 +226,6 @@ Max_event_det=400;
MaxBranches=100;
MaxElBranches=200;
LargImg=50;HtImg=91; // Dimensions image des feux
espY=15; // espacement Y entre deux lignes de 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
@@ -299,7 +300,11 @@ 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
check : TCheckBox; // pointeur sur structure Checkbox "demande feu blanc"
checkFB : TCheckBox; // pointeur sur structure Checkbox "demande feu blanc"
checkFR : TCheckBox; // pointeur demande feu rouge cli
checkFV : TcheckBox; // pointeur 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','NMRA','Unisemaf','SR'
Adr_det1 : integer; // adresse du détecteur1 sur lequel il est implanté
@@ -336,7 +341,7 @@ TFeu = record
var
maxaiguillage,detecteur_chgt,Temps,Tempo_init,Suivant,ntrains,
N_Cv,index_simule,NDetecteurs,N_Trains,N_routes,
N_Cv,index_simule,NDetecteurs,N_Trains,N_routes,espY,
NbreImagePligne,NbreBranches,Index2_det,Index2_aig,branche_det,
I_simule,maxTablo_act,NbreVoies,AdresseFeuSuivant,El_suivant,
tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre,Tempo_Aig,Tempo_feu,
@@ -346,7 +351,7 @@ var
ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,
Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO,
Srvc_PosTrain,Srvc_Sig,debugtrames,LayParParam,
Srvc_PosTrain,Srvc_Sig,debugtrames,LayParParam,AvecFVR,
Hors_tension2,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,doubleclic,
NackCDM,MsgSim,succes,recu_cv,AffAigDet,Option_demarrage,AffTiers,AvecDemandeAiguillages,
TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM,AvecInitAiguillages,
@@ -505,6 +510,9 @@ 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;
implementation
@@ -1349,7 +1357,7 @@ begin
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); //5
//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);
@@ -1364,7 +1372,7 @@ begin
picture.Bitmap:=T_Bp;
Width:=T_Bp.width;
Height:=T_Bp.Height;
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;
@@ -1397,12 +1405,12 @@ begin
// créée le checkBox si un feu blanc est déclaré sur ce feu
if feux[rang].FeuBlanc then
begin
Feux[rang].check:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu
Feux[rang].check.onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus
Feux[rang].check.Hint:=intToSTR(adresse); // affecter l'adresse du feu dans le HINT pour pouvoir le retrouver plus tard
with Feux[rang].Check do
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;
@@ -1411,7 +1419,46 @@ begin
BringToFront;
end;
end
else Feux[rang].check:=nil;
else Feux[rang].checkFB:=nil;
// créée la checkbox feu vert cli
if AvecFVR or feux[rang].FeuVertCli then
begin
Feux[rang].CheckFV:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu
with Feux[rang].CheckFV do
begin
onClick:=formprinc.proc_checkBoxFV; // affecter l'adresse de la procédure de traitement quand on clique dessus
Hint:='Vert cli';
Name:='CheckBoxFV'+intToSTR(adresse); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure
caption:='dem FVC';
Parent:=Formprinc.ScrollBox1;
width:=100;height:=15;
Top:=HtImg+30+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne));
BringToFront;
end;
end
else Feux[rang].checkFV:=nil;
// créée la checkbox feu rouge cli
if AvecFVR or feux[rang].FeuRougeCli then
begin
Feux[rang].checkFR:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu
with Feux[rang].CheckFR do
begin
Feux[rang].checkFR.onClick:=formprinc.proc_checkBoxFR; // affecter l'adresse de la procédure de traitement quand on clique dessus
Feux[rang].checkFR.Hint:='Sémaphore cli'; // affecter l'adresse du feu dans le HINT pour pouvoir le retrouver plus tard
Name:='CheckBoxFR'+intToSTR(adresse);
caption:='dem FRC';
Parent:=Formprinc.ScrollBox1;
width:=100;height:=15;
Top:=HtImg+45+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne));
BringToFront;
end;
end
else Feux[rang].checkFR:=nil;
end;
// ajoute en bout de chaine le checksum d'une trame
@@ -5713,7 +5760,15 @@ begin
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 Maj_Etat_Signal(AdrFeu,semaphore);
if testBit(feux[index].EtatSignal,carre)=FALSE then
begin
if feux[index].checkFR<>nil then
begin
if feux[index].checkFR.Checked then Maj_Etat_Signal(AdrFeu,semaphore_cli)
else Maj_Etat_Signal(AdrFeu,semaphore);
end
else Maj_Etat_Signal(AdrFeu,semaphore);
end;
end
else
begin
@@ -5780,25 +5835,31 @@ begin
Maj_Etat_Signal(AdrFeu,jaune_cli);
//if affsignal then AfficheDebug('401.Mise du feu au jaune cli',clyellow);
end
else
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
//if affsignal then AfficheDebug('test 405',clyellow);
if feux[index].check<>nil then
begin
//if affsignal then AfficheDebug('test 406',clyellow);
if feux[index].check.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
Maj_Etat_Signal(AdrFeu,vert);
//if affsignal then AfficheDebug('Mise du feu au vert',clyellow);
end;
end;
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<>nil then
begin
if feux[index].checkFV.Checked then Maj_Etat_Signal(AdrFeu,vert_cli)
else Maj_Etat_Signal(AdrFeu,vert);
end
else Maj_Etat_Signal(AdrFeu,vert);
//if affsignal then AfficheDebug('Mise du feu au vert',clyellow);
end;
end;
end;
end;
end;
@@ -6559,8 +6620,8 @@ end;
// pilotage d'un accessoire (décodeur d'aiguillage, de signal)
// par CDM ou interface
// octet = 1 (dévié) ou 2 (droit)
// la sortie "octet" est mise à 1 puis à 0
// acc = aig ou feu
// si acc=Taig, alors la sortie "octet" est mise à 1 puis à 0
// si acc=feu, alors la sortie "octet" est mise à 1 uniquement.
procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire);
var groupe,temp,index : integer ;
fonction,pilotage : byte;
@@ -6581,7 +6642,7 @@ begin
end;
// pilotage par CDM rail -----------------
if CDM_connecte then
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);
@@ -7498,6 +7559,7 @@ begin
ncrois:=0;
debugtrames:=false;
algo_Unisemaf:=1;
espY:=15;
AvecInit:=true; //&&&& avec initialisation des aiguillages ou pas
Option_demarrage:=false; // démarrage des trains après tempo, pas encore au point
@@ -8049,9 +8111,9 @@ var s : string;
begin
Cb:=Sender as TcheckBox;
coche:=cb.Checked; // état de la checkbox
s:=Cb.Hint;
val(s,adresse,erreur); // adresse du signal correspondant au checkbox cliqué
if erreur=0 then
s:=Cb.Name;
adresse:=extract_int(s);
if adresse<>0 then
begin
i:=index_feu(adresse);
if i=0 then exit;
@@ -8068,6 +8130,64 @@ begin
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,erreur : 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,erreur : 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_tension2:=false;
@@ -8144,8 +8264,8 @@ 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_devie : s:=s+' dévié' ;
const_droit : s:=s+' droit';
const_inconnu : s:=s+' inconnue';
else s:=s+' erreur ('+intToSTR(pos)+')';
end;
@@ -8219,8 +8339,8 @@ end;
procedure TFormPrinc.ClientSocketLenzConnect(Sender: TObject;Socket: TCustomWinSocket);
begin
Affiche('Lenz connecté ',clYellow);
AfficheDebug('Lenz connecté ',clYellow);
Affiche('Socket interface connecté ',clYellow);
AfficheDebug('Socket interface connecté ',clYellow);
parSocketLenz:=True;
ButtonEcrCV.Enabled:=true;
ButtonLitCV.Enabled:=true;
UnitSR.dcu
BIN
View File
Binary file not shown.
UnitSimule.dcu
BIN
View File
Binary file not shown.
UnitTCO.dcu
BIN
View File
Binary file not shown.
verif_version.dcu
BIN
View File
Binary file not shown.
verif_version.pas
+2 -2
View File
@@ -23,8 +23,8 @@ var
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='4.73'; // sert à la comparaison de la version publiée
SousVersion='C'; // en cas d'absence de sous version mettre un espace
Const Version='4.8'; // sert à la comparaison de la version publiée
SousVersion=' '; // en cas d'absence de sous version mettre un espace
implementation
versions.txt
+2
View File
@@ -123,6 +123,8 @@ version 4.7 : R
version 4.71 : Correction bug décodage trame actionneur de CDM
version 4.72 : Renforcement de la vérification de la configuration.
version 4.73 : Pilotage des PN en impulsionnel ou non
version 4.8 : gestion des sémaphores clignotants et voie libre clignotants