diff --git a/Notice d'utilisation des signaux_complexes_GL_V4.73.pdf b/Notice d'utilisation des signaux_complexes_GL_V4.8.pdf similarity index 77% rename from Notice d'utilisation des signaux_complexes_GL_V4.73.pdf rename to Notice d'utilisation des signaux_complexes_GL_V4.8.pdf index b8839d9..9d2e340 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V4.73.pdf and b/Notice d'utilisation des signaux_complexes_GL_V4.8.pdf differ diff --git a/UnitConfig.dcu b/UnitConfig.dcu index a2b6a55..7ac1274 100644 Binary files a/UnitConfig.dcu and b/UnitConfig.dcu differ diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 1206cd4..6e3a558 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -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' diff --git a/UnitConfig.pas b/UnitConfig.pas index 4e0cda9..6b27298 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -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; diff --git a/UnitDebug.dcu b/UnitDebug.dcu index a0456f6..016bae6 100644 Binary files a/UnitDebug.dcu and b/UnitDebug.dcu differ diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 8b07d13..47ccf28 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -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 diff --git a/UnitDebug.pas b/UnitDebug.pas index 5fd829c..4750ad5 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -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. diff --git a/UnitPilote.dcu b/UnitPilote.dcu index 7c3a89e..0f06eab 100644 Binary files a/UnitPilote.dcu and b/UnitPilote.dcu differ diff --git a/UnitPrinc.dcu b/UnitPrinc.dcu index d87f961..6f17335 100644 Binary files a/UnitPrinc.dcu and b/UnitPrinc.dcu differ diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 8b8cb35..a5e17b3 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -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; diff --git a/UnitSR.dcu b/UnitSR.dcu index 6806ee0..06a9695 100644 Binary files a/UnitSR.dcu and b/UnitSR.dcu differ diff --git a/UnitSimule.dcu b/UnitSimule.dcu index eb67930..55326fb 100644 Binary files a/UnitSimule.dcu and b/UnitSimule.dcu differ diff --git a/UnitTCO.dcu b/UnitTCO.dcu index e7b1459..ecc3a48 100644 Binary files a/UnitTCO.dcu and b/UnitTCO.dcu differ diff --git a/verif_version.dcu b/verif_version.dcu index 7354b43..ae2586f 100644 Binary files a/verif_version.dcu and b/verif_version.dcu differ diff --git a/verif_version.pas b/verif_version.pas index 42f8c3f..f79ef56 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -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 diff --git a/versions.txt b/versions.txt index 151703d..ae59506 100644 --- a/versions.txt +++ b/versions.txt @@ -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 +