diff --git a/Signaux_complexes_GL.cfg b/Signaux_complexes_GL.cfg index 69e7fa7..fb83b3c 100644 --- a/Signaux_complexes_GL.cfg +++ b/Signaux_complexes_GL.cfg @@ -6,7 +6,7 @@ -$F- -$G+ -$H+ --$I+ +-$I- -$J- -$K- -$L+ diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index 5573344..f49bebf 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -9,7 +9,7 @@ E=0 F=0 G=1 H=1 -I=1 +I=0 J=0 K=0 L=1 diff --git a/UnitConfig.dcu b/UnitConfig.dcu index 0949d3e..cdccf0a 100644 Binary files a/UnitConfig.dcu and b/UnitConfig.dcu differ diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 9c952d9..6151f77 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,12 +1,12 @@ object FormConfig: TFormConfig - Left = 266 - Top = 160 + Left = 194 + Top = 249 Hint = 'Modifie les fichiers de configuration selon les s'#233'lections chois' + 'ies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' - ClientHeight = 495 + ClientHeight = 501 ClientWidth = 858 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -1776,7 +1776,7 @@ object FormConfig: TFormConfig Top = 8 Width = 585 Height = 441 - ActivePage = TabSheetAct + ActivePage = TabSheetBranches Font.Charset = DEFAULT_CHARSET Font.Color = clBackground Font.Height = -11 @@ -2120,7 +2120,7 @@ object FormConfig: TFormConfig ImageIndex = 1 object Label9: TLabel Left = 8 - Top = 352 + Top = 384 Width = 297 Height = 13 Caption = 'Ces param'#232'tres sont utilis'#233's en fonctionnement sans CDM Rail' @@ -2335,7 +2335,7 @@ object FormConfig: TFormConfig Left = 8 Top = 296 Width = 297 - Height = 41 + Height = 81 Caption = 'Divers' TabOrder = 7 object CheckBoxRazSignaux: TCheckBox @@ -2349,6 +2349,19 @@ object FormConfig: TFormConfig ShowHint = True TabOrder = 0 end + object CheckBoxInitAig: TCheckBox + Left = 8 + Top = 32 + Width = 281 + Height = 33 + Caption = + 'Initialisation des aiguillages suivant liste dans fichier client' + + '-gl.cfg [section init]' + ParentShowHint = False + ShowHint = False + TabOrder = 1 + WordWrap = True + end end end object TabSheetAig: TTabSheet @@ -2582,6 +2595,7 @@ object FormConfig: TFormConfig Height = 17 Caption = 'Inversion de l'#39#233'tat CDM' TabOrder = 7 + OnClick = CheckInverseClick end end object Edit_HG: TEdit @@ -2591,6 +2605,7 @@ object FormConfig: TFormConfig Height = 21 TabOrder = 1 Text = 'EditPointe' + OnChange = Edit_HGChange end object RichAig: TRichEdit Left = 0 @@ -2877,6 +2892,7 @@ object FormConfig: TFormConfig Color = clBlack Lines.Strings = ( 'RichSig') + ReadOnly = True ScrollBars = ssBoth TabOrder = 1 WordWrap = False @@ -3202,6 +3218,7 @@ object FormConfig: TFormConfig Width = 289 Height = 369 Color = clBlack + ReadOnly = True ScrollBars = ssVertical TabOrder = 1 OnMouseDown = RichActMouseDown diff --git a/UnitConfig.pas b/UnitConfig.pas index eb08a7b..b7f50c4 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -185,6 +185,7 @@ type EditNbDetDist: TEdit; Label31: TLabel; RichAct: TRichEdit; + CheckBoxInitAig: TCheckBox; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -221,6 +222,8 @@ type procedure EditEtatFoncSortieChange(Sender: TObject); procedure EditTempoChange(Sender: TObject); procedure CheckRAZClick(Sender: TObject); + procedure Edit_HGChange(Sender: TObject); + procedure CheckInverseClick(Sender: TObject); private { Déclarations privées } public @@ -254,7 +257,7 @@ var AdresseIPCDM,AdresseIP,PortCom,recuCDM,residuCDM : string; portCDM,TempoOctet,TimoutMaxInterface,Valeur_entete,Port,protocole,NumPort, LigneCliquee,AncLigneCliquee : integer; - ack_cdm,clicliste : boolean; + ack_cdm,clicliste,entreeTCO : boolean; function config_com(s : string) : boolean; function envoi_CDM(s : string) : boolean; @@ -265,7 +268,7 @@ procedure sauve_config; implementation -uses UnitDebug,UnitPrinc; +uses UnitDebug,UnitPrinc, UnitTCO; {$R *.dfm} @@ -656,7 +659,8 @@ begin copie_commentaire; // avec ou sans initialisation des aiguillages - writeln(fichierN,Init_Aig_ch+'=',IntToSTR(AvecInitAiguillages)); + if AvecInitAiguillages then s:='1' else s:='0'; + writeln(fichierN,Init_Aig_ch+'='+s); copie_commentaire; // plein écran @@ -927,6 +931,8 @@ begin Srvc_PosTrain:=CheckServPosTrains.checked; Srvc_Sig:=CheckBoxSrvSig.checked; Raz_Acc_signaux:=CheckBoxRazSignaux.checked; + AvecInitAiguillages:=CheckBoxInitAig.Checked; + end; if change_srv then services_CDM; @@ -940,6 +946,13 @@ procedure TFormConfig.ButtonAppliquerEtFermerClick(Sender: TObject); begin Sauve_config; formConfig.close; + // TCO + if avectco and not(entreeTCO) then + begin + //créée la fenêtre TCO non modale + FormTCO:=TformTCO.Create(nil); + FormTCO.show; + end; end; procedure TFormConfig.Button2Click(Sender: TObject); @@ -997,6 +1010,7 @@ begin CheckInfoVersion.Checked:=notificationVersion; CheckLanceCDM.Checked:=LanceCDM; CheckAvecTCO.checked:=avecTCO; + entreeTCO:=avecTCO; EditNomLay.Text:=Lay; RadioButton4.Checked:=ServeurInterfaceCDM=0; RadioButton5.Checked:=ServeurInterfaceCDM=1; @@ -1020,6 +1034,7 @@ begin CheckBoxServAct.checked:=Srvc_Act; CheckServPosTrains.checked:=Srvc_PosTrain; CheckBoxRazSignaux.checked:=Raz_Acc_signaux; + CheckBoxInitAig.checked:=AvecInitAiguillages; EditDroit_BD.Text:=''; EditPointe_BG.Text:=''; @@ -1628,6 +1643,12 @@ begin clicliste:=false; end; +// on change la valeur de la description du champ HG pour les TJD +procedure change_HG ; +begin + if clicliste then exit; +end; + // on change la valeur de la description de la pointe de l'aiguillage procedure change_Pointe; var AdrAig,adr,erreur : integer; @@ -1823,6 +1844,11 @@ begin change_pointe; end; +procedure TFormConfig.Edit_HGChange(Sender: TObject); +begin + change_HG; +end; + procedure TFormConfig.EditDevie_HDChange(Sender: TObject); begin Change_devie; @@ -1838,6 +1864,21 @@ begin Change_s2; end; + +procedure TFormConfig.CheckInverseClick(Sender: TObject); +var s : string; + adrAig,erreur : integer; +begin + // récupérer l'adresse de l'aiguillage cliqué + s:=formconfig.RichAig.Lines[lignecliquee]; + Val(s,adrAig,erreur); + if checkInverse.Checked then aiguillage[adraig].InversionCDM:=1 else aiguillage[adraig].InversionCDM:=0; + // réencoder la ligne + s:=encode_aig(AdrAig); + formconfig.RichAig.Lines[lignecliquee]:=s; + labelLigne.Caption:=s; +end; + procedure TFormConfig.RadioButtonsansClick(Sender: TObject); var AdrAig,erreur : integer; s : string; @@ -2318,6 +2359,9 @@ begin end; end; + + + end. diff --git a/UnitDebug.dcu b/UnitDebug.dcu index 2e0909d..172fffc 100644 Binary files a/UnitDebug.dcu and b/UnitDebug.dcu differ diff --git a/UnitDebug.dfm b/UnitDebug.dfm index b2ee735..ab0f715 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -1,8 +1,8 @@ object FormDebug: TFormDebug - Left = 329 - Top = 122 + Left = 192 + Top = 290 Width = 855 - Height = 762 + Height = 817 Caption = 'Fen'#234'tre de d'#233'bug' Color = clWindow TransparentColorValue = clTeal @@ -16,7 +16,7 @@ object FormDebug: TFormDebug OnCreate = FormCreate DesignSize = ( 839 - 724) + 779) PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel @@ -49,24 +49,6 @@ object FormDebug: TFormDebug Font.Style = [fsBold, fsItalic] ParentFont = False end - object Label3: TLabel - Left = 485 - Top = 160 - Width = 99 - Height = 185 - Anchors = [akTop, akRight] - AutoSize = False - Caption = 'Label3' - Color = clGray - Font.Charset = ANSI_CHARSET - Font.Color = clWindow - Font.Height = -13 - Font.Name = 'Arial Narrow' - Font.Style = [] - ParentColor = False - ParentFont = False - WordWrap = True - end object EditNivDebug: TEdit Left = 767 Top = 2 @@ -85,7 +67,7 @@ object FormDebug: TFormDebug end object MemoEvtDet: TMemo Left = 591 - Top = 344 + Top = 320 Width = 239 Height = 225 Anchors = [akTop, akRight] @@ -99,12 +81,14 @@ object FormDebug: TFormDebug 'Tableau des '#233'v'#232'nements ' 'fronts descendants d'#233'tecteurs') ParentFont = False + ReadOnly = True ScrollBars = ssVertical TabOrder = 1 + OnChange = MemoEvtDetChange end object ButtonEcrLog: TButton Left = 487 - Top = 464 + Top = 312 Width = 97 Height = 29 Anchors = [akTop, akRight] @@ -114,7 +98,7 @@ object FormDebug: TFormDebug end object ButtonRazTampon: TButton Left = 487 - Top = 536 + Top = 344 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -125,7 +109,7 @@ object FormDebug: TFormDebug end object ButtonCherche: TButton Left = 487 - Top = 432 + Top = 280 Width = 97 Height = 25 Anchors = [akTop, akRight] @@ -135,7 +119,7 @@ object FormDebug: TFormDebug end object ButtonAffEvtChrono: TButton Left = 487 - Top = 392 + Top = 240 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -146,7 +130,7 @@ object FormDebug: TFormDebug end object ButtonCop: TButton Left = 487 - Top = 344 + Top = 192 Width = 97 Height = 41 Anchors = [akTop, akRight] @@ -165,7 +149,7 @@ object FormDebug: TFormDebug Left = 591 Top = 160 Width = 239 - Height = 185 + Height = 153 Anchors = [akTop, akRight] Font.Charset = DEFAULT_CHARSET Font.Color = clWhite @@ -175,12 +159,14 @@ object FormDebug: TFormDebug HideScrollBars = False ParentFont = False PopupMenu = PopupMenuRE + ReadOnly = True ScrollBars = ssVertical TabOrder = 7 + OnChange = RichEditChange end object ButtonRazLog: TButton Left = 487 - Top = 496 + Top = 384 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -191,7 +177,7 @@ object FormDebug: TFormDebug end object GroupBox1: TGroupBox Left = 485 - Top = 576 + Top = 608 Width = 353 Height = 145 Anchors = [akTop, akRight] @@ -453,15 +439,71 @@ object FormDebug: TFormDebug Left = 8 Top = 8 Width = 470 - Height = 705 + Height = 743 Anchors = [akLeft, akTop, akRight, akBottom] Lines.Strings = ( 'RichDebug') PopupMenu = PopupMenuRD + ReadOnly = True ScrollBars = ssBoth TabOrder = 11 OnChange = RichDebugChange end + object GroupBox5: TGroupBox + Left = 487 + Top = 552 + Width = 345 + Height = 49 + Anchors = [akTop, akRight] + Caption = 'Simulation d'#233'tecteur' + Color = cl3DLight + Font.Charset = DEFAULT_CHARSET + Font.Color = clNavy + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 12 + object EditSimuDet: TEdit + Left = 8 + Top = 16 + Width = 73 + Height = 21 + Hint = 'Adresse d'#39'un d'#233'tecteur' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + end + object ButtonSimuDet0: TButton + Left = 120 + Top = 16 + Width = 75 + Height = 25 + Caption = 'D'#233'tecteur '#224' 0' + TabOrder = 1 + OnClick = ButtonSimuDet0Click + end + object ButtonSimuDet1: TButton + Left = 232 + Top = 16 + Width = 75 + Height = 25 + Caption = 'D'#233'tecteur '#224' 1' + TabOrder = 2 + OnClick = ButtonSimuDet1Click + end + end + object ButtonRazTout: TButton + Left = 488 + Top = 160 + Width = 97 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'RAZ tous trains' + TabOrder = 13 + OnClick = ButtonRazToutClick + end object SaveDialog: TSaveDialog Left = 768 Top = 488 diff --git a/UnitDebug.pas b/UnitDebug.pas index d6d274d..b6b6d6f 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -14,7 +14,6 @@ type Label2: TLabel; SaveDialog: TSaveDialog; ButtonEcrLog: TButton; - Label3: TLabel; ButtonRazTampon: TButton; ButtonCherche: TButton; ButtonAffEvtChrono: TButton; @@ -46,6 +45,11 @@ type RichDebug: TRichEdit; PopupMenuRD: TPopupMenu; Copier2: TMenuItem; + GroupBox5: TGroupBox; + ButtonSimuDet0: TButton; + ButtonSimuDet1: TButton; + EditSimuDet: TEdit; + ButtonRazTout: TButton; procedure FormCreate(Sender: TObject); procedure ButtonEcrLogClick(Sender: TObject); procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char); @@ -69,6 +73,11 @@ type procedure Button2Click(Sender: TObject); procedure Copier2Click(Sender: TObject); procedure RichDebugChange(Sender: TObject); + procedure ButtonSimuDet0Click(Sender: TObject); + procedure ButtonSimuDet1Click(Sender: TObject); + procedure ButtonRazToutClick(Sender: TObject); + procedure RichEditChange(Sender: TObject); + procedure MemoEvtDetChange(Sender: TObject); private { Déclarations privées } public @@ -109,6 +118,7 @@ var procedure AfficheDebug(s : string;lacouleur : TColor); +Procedure Raz_tout; procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor); implementation @@ -134,16 +144,27 @@ begin RE_ColorLine(FormDebug.RichDebug,FormDebug.RichDebug.lines.count-1,lacouleur); end; +Procedure Raz_tout; +var i : integer; +begin + N_Event_tick:=0; + N_event_det:=0; + N_trains:=0; + Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains); + for i:=1 to Max_Trains do Event_det_Train[i].NbEl:=0; + i_simule:=0; + FormDebug.MemoEvtDet.Clear; + FormDebug.Richedit.Clear; +end; procedure TFormDebug.FormCreate(Sender: TObject); var s: string; - i : integer; begin EditNivDebug.Text:='0'; s:='Cette fenêtre permet d''afficher des informations sur le '; - s:=s+'comportement du programme. Positionner le niveau de 1 à 3 pour'; + s:=s+'comportement du programme. Positionner le niveau du débug de 1 à 3 pour'; s:=s+' afficher des informations plus ou moins détaillées.'; - Label3.caption:=s; + RichEdit.Lines.add(s); RichDebug.WordWrap:=false; // interdit la coupure des chaînes en limite du composant RichDebug.color:=$33; initform:=false; @@ -393,4 +414,40 @@ begin SendMessage(RichDebug.handle, WM_VSCROLL, SB_BOTTOM, 0); end; +procedure TFormDebug.ButtonSimuDet0Click(Sender: TObject); +var det,erreur : integer; +begin + val(EditSimuDet.Text,det,erreur); + if erreur=0 then + begin + Event_Detecteur(det,false,''); + end; +end; + + +procedure TFormDebug.ButtonSimuDet1Click(Sender: TObject); +var det,erreur : integer; +begin + val(EditSimuDet.Text,det,erreur); + if erreur=0 then + begin + Event_Detecteur(det,true,''); + end; +end; + +procedure TFormDebug.ButtonRazToutClick(Sender: TObject); +begin + Raz_tout; +end; + +procedure TFormDebug.RichEditChange(Sender: TObject); +begin + SendMessage(RichEdit.handle, WM_VSCROLL, SB_BOTTOM, 0); +end; + +procedure TFormDebug.MemoEvtDetChange(Sender: TObject); +begin + SendMessage(MemoEvtDet.handle, WM_VSCROLL, SB_BOTTOM, 0); +end; + end. diff --git a/UnitPrinc.dcu b/UnitPrinc.dcu index 663993c..b14bab0 100644 Binary files a/UnitPrinc.dcu and b/UnitPrinc.dcu differ diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index e79bb56..d99aae6 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,6 +1,6 @@ object FormPrinc: TFormPrinc - Left = 1296 - Top = 222 + Left = 44 + Top = 270 Width = 1212 Height = 664 Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ' @@ -24,7 +24,7 @@ object FormPrinc: TFormPrinc TextHeight = 13 object LabelTitre: TLabel Left = 8 - Top = 16 + Top = 8 Width = 173 Height = 18 Caption = 'Signaux complexes GL' @@ -1203,9 +1203,9 @@ object FormPrinc: TFormPrinc end object ScrollBox1: TScrollBox Left = 631 - Top = 168 - Width = 537 - Height = 377 + Top = 176 + Width = 546 + Height = 385 HorzScrollBar.Smooth = True HorzScrollBar.Tracking = True VertScrollBar.Smooth = True @@ -1218,96 +1218,61 @@ object FormPrinc: TFormPrinc object GroupBox1: TGroupBox Left = 631 Top = 5 - Width = 249 - Height = 129 + Width = 266 + Height = 52 Anchors = [akTop, akRight] Caption = 'Commande d'#39'accessoires' TabOrder = 1 object Label2: TLabel Left = 7 - Top = 16 + Top = 24 Width = 58 Height = 13 Caption = 'adresse acc' end - object Label3: TLabel - Left = 75 - Top = 16 - Width = 30 - Height = 13 - Caption = '1 ou 2' - end - object Label4: TLabel - Left = 133 - Top = 10 - Width = 85 - Height = 13 - Caption = '1=d'#233'vi'#233' 2=droit' - end object EditAdresse: TEdit - Left = 8 - Top = 32 - Width = 57 + Left = 72 + Top = 24 + Width = 49 Height = 21 Hint = 'Adresse accessoire ou de CV' TabOrder = 0 Text = '1' end - object Editval: TEdit - Left = 72 - Top = 32 - Width = 41 - Height = 21 - Hint = 'Entrez 1 ou 2 pour un accessoire DCC et 1 '#224' 255 pour un CV' - TabOrder = 1 - Text = '1' - OnEnter = EditvalEnter - end - object ButtonEcrCV: TButton - Left = 8 - Top = 64 - Width = 225 + object ButtonDroit: TButton + Left = 132 + Top = 16 + Width = 53 Height = 25 - Hint = 'Ecriture CV en mode direct sur voie de programmation' - Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet' + Hint = 'Ecriture des accessoires DCC' + Caption = 'droit' + TabOrder = 1 + WordWrap = True + OnClick = ButtonDroitClick + end + object ButtonDevie: TButton + Left = 192 + Top = 16 + Width = 57 + Height = 25 + Hint = 'Ecriture des accessoires DCC' + Caption = 'devi'#233 TabOrder = 2 WordWrap = True - OnClick = ButtonEcrCVClick - end - object ButtonLitCV: TButton - Left = 8 - Top = 96 - Width = 225 - Height = 25 - Hint = 'Lecture CV en mode direct sur voie de programmation' - Caption = 'Lecture CV - 1 '#224' 255 par le bus XpressNet' - Enabled = False - TabOrder = 3 - OnClick = ButtonLitCVClick - end - object ButtonCommande: TButton - Left = 124 - Top = 24 - Width = 109 - Height = 33 - Hint = 'Ecriture des accessoires DCC' - Caption = 'Envoi commande' - TabOrder = 4 - WordWrap = True - OnClick = ButtonCommandeClick + OnClick = ButtonDevieClick end end object StatusBar1: TStatusBar Left = 0 - Top = 576 + Top = 584 Width = 1196 - Height = 30 + Height = 22 Panels = <> SimplePanel = True end object MSCommUSBLenz: TMSComm - Left = 720 - Top = 144 + Left = 1160 + Top = 192 Width = 32 Height = 32 OnComm = MSCommUSBLenzComm @@ -1316,10 +1281,10 @@ object FormPrinc: TFormPrinc 00020000802500000000080000000000000000003F00000011000000} end object Panel1: TPanel - Left = 887 + Left = 903 Top = 5 - Width = 281 - Height = 129 + Width = 282 + Height = 132 Anchors = [akTop, akRight] TabOrder = 4 object BoutonRaf: TButton @@ -1385,19 +1350,20 @@ object FormPrinc: TFormPrinc OnClick = ButtonTestClick end object ButtonArretSimu: TButton - Left = 104 + Left = 8 Top = 88 - Width = 81 + Width = 89 Height = 33 Caption = 'Arret simulation' TabOrder = 6 Visible = False + WordWrap = True OnClick = ButtonArretSimuClick end object ButtonAffTCO: TButton - Left = 8 + Left = 104 Top = 88 - Width = 89 + Width = 81 Height = 33 Caption = 'Affiche TCO' TabOrder = 7 @@ -1415,12 +1381,11 @@ object FormPrinc: TFormPrinc end end object Panel2: TPanel - Left = 631 - Top = 136 - Width = 153 + Left = 904 + Top = 144 + Width = 281 Height = 25 Anchors = [akTop, akRight] - Caption = 'Panel2' TabOrder = 5 object Label1: TLabel Left = 16 @@ -1430,7 +1395,7 @@ object FormPrinc: TFormPrinc Caption = 'Nombre de trains : ' end object LabelNbTrains: TLabel - Left = 120 + Left = 248 Top = 2 Width = 9 Height = 19 @@ -1445,7 +1410,7 @@ object FormPrinc: TFormPrinc end object StaticText: TStaticText Left = 16 - Top = 560 + Top = 565 Width = 14 Height = 17 Anchors = [akLeft, akRight, akBottom] @@ -1454,9 +1419,9 @@ object FormPrinc: TFormPrinc end object FenRich: TRichEdit Left = 8 - Top = 48 + Top = 32 Width = 617 - Height = 497 + Height = 529 Anchors = [akLeft, akTop, akRight, akBottom] Color = clBlack Font.Charset = DEFAULT_CHARSET @@ -1471,11 +1436,73 @@ object FormPrinc: TFormPrinc TabOrder = 7 OnChange = FenRichChange end + object GroupBox2: TGroupBox + Left = 632 + Top = 64 + Width = 265 + Height = 105 + Anchors = [akTop, akRight] + Caption = 'Variables CV' + TabOrder = 8 + object Label3: TLabel + Left = 208 + Top = 34 + Width = 14 + Height = 13 + Caption = 'CV' + WordWrap = True + end + object LabelVCV: TLabel + Left = 208 + Top = 55 + Width = 47 + Height = 13 + Caption = 'Valeur CV' + WordWrap = True + end + object ButtonEcrCV: TButton + Left = 8 + Top = 16 + Width = 153 + Height = 33 + Hint = 'Ecriture CV en mode direct sur voie de programmation' + Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet' + TabOrder = 0 + WordWrap = True + OnClick = ButtonEcrCVClick + end + object ButtonLitCV: TButton + Left = 8 + Top = 64 + Width = 153 + Height = 33 + Hint = 'Lecture CV en mode direct sur voie de programmation' + Caption = 'Lecture CV - 1 '#224' 255 par le bus XpressNet' + Enabled = False + TabOrder = 1 + WordWrap = True + OnClick = ButtonLitCVClick + end + object EditCV: TEdit + Left = 168 + Top = 32 + Width = 33 + Height = 21 + TabOrder = 2 + end + object EditVal: TEdit + Left = 168 + Top = 52 + Width = 33 + Height = 21 + TabOrder = 3 + end + end object Timer1: TTimer Interval = 100 OnTimer = Timer1Timer - Left = 888 - Top = 80 + Left = 1168 + Top = 224 end object ClientSocketLenz: TClientSocket Active = False @@ -1596,6 +1623,13 @@ object FormPrinc: TFormPrinc ' sur la voie de programmation' OnClick = LireunfichierdeCV1Click end + object N6: TMenuItem + Caption = '-' + end + object Apropos1: TMenuItem + Caption = 'A propos' + OnClick = Apropos1Click + end end end object ClientSocketCDM: TClientSocket diff --git a/UnitPrinc.pas b/UnitPrinc.pas index a996a5f..4f67960 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -27,8 +27,6 @@ type GroupBox1: TGroupBox; EditAdresse: TEdit; Label2: TLabel; - Editval: TEdit; - Label3: TLabel; MainMenu1: TMainMenu; Interface1: TMenuItem; MenuConnecterUSB: TMenuItem; @@ -37,7 +35,6 @@ type MenuConnecterEthernet: TMenuItem; MenuDeconnecterEthernet: TMenuItem; StatusBar1: TStatusBar; - Label4: TLabel; MSCommUSBLenz: TMSComm; Afficher1: TMenuItem; Etatdesdtecteurs1: TMenuItem; @@ -62,7 +59,6 @@ type Divers1: TMenuItem; ClientSocketCDM: TClientSocket; FichierSimu: TMenuItem; - ButtonEcrCV: TButton; OpenDialog: TOpenDialog; N1: TMenuItem; LireunfichierdeCV1: TMenuItem; @@ -70,7 +66,6 @@ type N5: TMenuItem; Quitter1: TMenuItem; Config: TMenuItem; - ButtonLitCV: TButton; Codificationdesactionneurs1: TMenuItem; OuvrirunfichiertramesCDM1: TMenuItem; Panel1: TPanel; @@ -81,7 +76,7 @@ type ButtonReprise: TButton; ButtonTest: TButton; ButtonArretSimu: TButton; - ButtonCommande: TButton; + ButtonDroit: TButton; Panel2: TPanel; Label1: TLabel; LabelNbTrains: TLabel; @@ -94,12 +89,22 @@ type PopupMenuFenRich: TPopupMenu; Copier1: TMenuItem; Etatdessignaux1: TMenuItem; + N6: TMenuItem; + Apropos1: TMenuItem; + ButtonDevie: TButton; + GroupBox2: TGroupBox; + ButtonEcrCV: TButton; + ButtonLitCV: TButton; + EditCV: TEdit; + Label3: TLabel; + LabelVCV: TLabel; + EditVal: TEdit; procedure FormCreate(Sender: TObject); procedure MSCommUSBLenzComm(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure BoutVersionClick(Sender: TObject); - procedure ButtonCommandeClick(Sender: TObject); + procedure ButtonDroitClick(Sender: TObject); procedure EditvalEnter(Sender: TObject); procedure BoutonRafClick(Sender: TObject); procedure ClientSocketLenzError(Sender: TObject; Socket: TCustomWinSocket; @@ -147,6 +152,8 @@ type procedure FenRichChange(Sender: TObject); procedure Copier1Click(Sender: TObject); procedure Etatdessignaux1Click(Sender: TObject); + procedure Apropos1Click(Sender: TObject); + procedure ButtonDevieClick(Sender: TObject); private { Déclarations privées } procedure DoHint(Sender : Tobject); @@ -166,6 +173,7 @@ const_droit=2;const_devie=1; // positions aiguillages transmises par la central const_devieG_CDM=3; // positions aiguillages transmises par cdm const_devieD_CDM=2; // positions aiguillages transmises par cdm const_droit_CDM=0; // positions aiguillages transmises par cdm +const_inconnu=9; // position inconnue ClBleuClair=$FF7070 ; Cyan=$FF6060; clviolet=$FF00FF; @@ -226,14 +234,14 @@ TMA = (valide,devalide); var ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word; - AvecInitAiguillages,tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre, + tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre, NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM, ServeurRetroCDM,TailleFonte,Nb_Det_Dist : integer; Hors_tension2,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD, NackCDM,MsgSim,succes,recu_cv,AffActionneur,AffAigDet,Option_demarrage, - TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM : boolean; + TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM,AvecInitAiguillages : boolean; CDMhd : THandle; branche : array [1..100] of string; @@ -360,6 +368,7 @@ function test_memoire_zones(adresse : integer) : boolean; function PresTrainPrec(AdrFeu : integer) : boolean; function cond_carre(adresse : integer) : boolean; function carre_signal(adresse : integer) : boolean; +procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); implementation @@ -1468,70 +1477,6 @@ begin end; -// pilotage d'un accessoire (décodeur d'aiguillage, de signal) -// octet = 0 ou 1 ou 2 -// la sortie "octet" est mise à 1 puis à 0 -// acc = aig ou feu -procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire); -var groupe,temps : integer ; - fonction : byte; - s : string; -begin - //Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow); - // pilotage par CDM rail - if CDM_connecte then - begin - //AfficheDebug(intToSTR(adresse),clred); - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange); - s:=chaine_CDM_Acc(adresse,octet); - envoi_CDM(s); - if (acc=feu) and not(Raz_Acc_signaux) then exit; - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); - s:=chaine_CDM_Acc(adresse,0); - envoi_CDM(s); - exit; - end; - - // pilotage par USB ou par éthernet de la centrale - - // Affiche('Accessoire '+intToSTR(adresse),clLime); - if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then - begin - // test si pilotage aiguillage inversé - if aiguillage[adresse].inversion=1 then - begin - if octet=1 then octet:=2 else octet:=1; - end; - - if (octet=0) or (octet>2) then exit; - //if (octet>2) then exit; - groupe:=(adresse-1) div 4; - fonction:=((adresse-1) mod 4)*2 + (octet-1); - // pilotage à 1 - s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie - s:=checksum(s); - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange); - envoi(s); // envoi de la trame et attente Ack - // si l'accessoire est un feu et sans raz des signaux, sortir - if (acc=feu) and not(Raz_Acc_signaux) then exit; - - - // si aiguillage, faire une temporisation - //if (index_feu(adresse)=0) or (Acc=aig) then - if Acc=Aig then - begin - temps:=aiguillage[adresse].temps;if temps=0 then temps:=4; - if portCommOuvert or parSocketLenz then tempo(temps); - end; - sleep(50); - - // pilotage à 0 pour éteindre le pilotage de la bobine du relais - s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie - s:=checksum(s); - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); - envoi(s); // envoi de la trame et attente Ack - end; -end; // pilote accessoire en entrée 0->2 1->1 procedure pilote_acc01(adresse : integer;octet : byte); @@ -3486,7 +3431,7 @@ var s,sa,chaine,SOrigine: string; begin begin adresse:=StrToINT(copy(s,1,j-1));Delete(s,1,j); // adresse aiguillage - if (adresse>0) and (AvecInitAiguillages=1) then + if (adresse>0) and (AvecInitAiguillages) then begin j:=pos(',',s); position:=StrToInt(copy(s,1,j-1));Delete(S,1,j);// position aiguillage @@ -3534,7 +3479,7 @@ begin for i:=1 to MaxAcc do begin Aiguillage[i].modele:=0 ; // sans existence - Aiguillage[i].position:=9; // position inconnue + Aiguillage[i].position:=const_inconnu; // position inconnue Aiguillage[i].temps:=5 ; Aiguillage[i].inversion:=0; Aiguillage[i].inversionCDM:=0; @@ -3664,7 +3609,7 @@ begin trouve_init_aig:=true; inc(nv); delete(s,i,length(sa)); - AvecInitAiguillages:=StrToINT(s); + AvecInitAiguillages:=s='1'; end; sa:=uppercase(fenetre_ch)+'='; @@ -4763,9 +4708,9 @@ begin if NivDebug=3 then AfficheDebug('44 - éléments non consécutifs: Prec='+intToSTR(prec)+' Actuel='+intTostr(Actuel),clred); end; - if (Btype>=2) then // aiguillage ou bis ou buttoir + if (Btype>=2) then // aiguillage ou buttoir begin - if (aiguillage[Adr].modele=1) and (Btype=2) then // aiguillage normal non bis + if (aiguillage[Adr].modele=1) and (Btype=2) then // aiguillage normal begin // aiguillage pris en pointe if (aiguillage[adr].Apointe=prec) then @@ -4816,14 +4761,16 @@ begin else begin if NivDebug=3 then AfficheDebug('135 - aiguillage '+intToSTR(Adr)+' Pris en talon',clyellow); - if alg=2 then // on demande d'arreter si l'aiguillage en talon est mal positionné + if (alg=2) then // on demande d'arreter si l'aiguillage en talon est mal positionné begin if aiguillage[adr].position=const_droit then begin + // si TJD (modele=2) sur le précédent, alors substituer avec la 2eme adresse de la TJD + if aiguillage[prec].modele=2 then prec:=aiguillage[prec].DDroit; if prec<>aiguillage[Adr].Adroit then begin - if NivDebug=3 then AfficheDebug('135.1 - Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); - suivant_alg3:=9998;exit; + if NivDebug=3 then AfficheDebug('135.1 - Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); + suivant_alg3:=9998;exit; end else begin @@ -5155,7 +5102,7 @@ begin suivant_alg3:=adr;exit; end; begin - if aiguillage[Adr].position=9 then begin suivant_alg3:=9996;exit;end; // pour échappement + if aiguillage[Adr].position=const_inconnu then begin suivant_alg3:=9996;exit;end; // pour échappement s:='Aiguillage triple '+IntToSTR(Adr)+' : configuration des aiguilles interdite'; if CDM_connecte then s:=s+': '+IntToSTR(aiguillage[Adr].position); AfficheDebug(s,clYellow); @@ -5397,6 +5344,10 @@ begin AdrPrec:=el1;TypePrec:=typeDet1; if j=1 then i1:=IndexBranche_det1+1; if j=2 then i1:=IndexBranche_det1-1; + // les suivants dansla branche sont: + AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse; + typeFonc:=BrancheN[branche_trouve_det1,i1].Btype ; + if NivDebug=3 then begin s:='Test en '; @@ -5405,17 +5356,17 @@ begin AfficheDebug(s,clyellow); end; - AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse; - typeFonc:=BrancheN[branche_trouve_det1,i1].Btype ; - - i:=0;N_Det:=0; if AdrFonc<>El2 then // si pas déja trouvé le sens de progression begin repeat //AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow); if nivDebug=3 then AfficheDebug('i='+IntToSTR(i)+' NDet='+IntToSTR(N_det),clyellow); - Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,1); + if (AdrFonc<>0) or (TypeFonc<>0) then Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,1) else + begin + Adr:=9999; + end; + //AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow); if TypeGen=1 then inc(N_Det); if NivDebug=3 then @@ -5594,7 +5545,7 @@ begin until (sort); // si trouvé un feu ou j=10, les aiguillages sont bien positionnés // si trouvé 9998, aiguillages mal positionnés - if (NivDebug=3) then + if (NivDebug>=1) then begin if (AdrSuiv=9998) then AfficheDebug('Le signal '+intToSTR(adresse)+' doit afficher un carré car l''aiguillage pris en talon '+IntToSTR(actuel)+' est mal positionné',clYellow) else AfficheDebug('Le signal '+IntToSTR(adresse)+' ne doit pas être au carré',clYellow); @@ -5851,7 +5802,8 @@ end; // adresse=adresse du signal function test_memoire_zones(adresse : integer) : boolean; var - AdrSuiv,prec,TypePrec,TypeActuel,ife,actuel,AdrDet,Etat,AdrFeu,i,j,PresTrain01,PrecInitial : integer; + AdrSuiv,prec,TypePrec,TypeActuel,ife,actuel,AdrDet,Etat,AdrFeu,i,j,PresTrain01,PrecInitial, + N_Det : integer; Pres_train,sort : boolean; s : string; begin @@ -5868,6 +5820,7 @@ begin ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu repeat j:=0; + N_Det:=0; if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange); if (ife=1) then begin @@ -5926,7 +5879,7 @@ begin else begin AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1); - + if Typegen=1 then inc(N_Det); prec:=actuel;TypePrec:=TypeActuel; actuel:=AdrSuiv;TypeActuel:=typeGen; if AdrSuiv>9990 then @@ -5936,7 +5889,7 @@ begin end; - if NivDebug=3 then AfficheDebug('132 - suivant='+IntToSTR(adrsuiv),clYellow); + if NivDebug=3 then AfficheDebug('132 - suivant='+IntToSTR(adrsuiv)+'/'+IntToSTR(TypeGen),clYellow); if actuel=0 then begin // si c'est un buttoir @@ -5948,7 +5901,7 @@ begin AdrFeu:=0; if (TypeActuel=1) then // détecteur begin - if (NivDebug=3) and MemZone[PrecInitial][actuel] then AfficheDebug('Présence train de '+intToSTR(PrecInitial)+' à '+intToSTR(actuel),clyellow); + if (NivDebug>0) and MemZone[PrecInitial][actuel] then AfficheDebug('Présence train de '+intToSTR(PrecInitial)+' à '+intToSTR(actuel),clyellow); Pres_train:=MemZone[PrecInitial][actuel] or Pres_train; // mémoire de zone if Pres_Train then PresTrain01:=1 else PresTrain01:=0; @@ -5966,8 +5919,8 @@ begin if (feux[i].Adr_el_suiv1<>prec) then // le feu est-il dans le bon sens de progression? begin s:='Trouvé feu '+IntToSTR(AdrFeu); - if (NivDebug=3) And Pres_Train then AfficheDebug(s+' et sortie proced:Mémoire de zone à 1',clyellow); - if (NivDebug=3) And (not(Pres_Train)) then AfficheDebug(s+' et sortie proced:Mémoire de zone à 0',clyellow); + if (NivDebug>0) And Pres_Train then AfficheDebug(s+' et sortie proced:Mémoire de zone à 1',clyellow); + if (NivDebug>0) And (not(Pres_Train)) then AfficheDebug(s+' et sortie proced:Mémoire de zone à 0',clyellow); test_memoire_zones:=Pres_train;exit; end @@ -5987,11 +5940,11 @@ begin begin if (NivDebug=3) then AfficheDebug('Trouvé aiguillage '+intToSTR(AdrSuiv),clyellow); end; - sort:=(j=10) or (AdrFeu<>0) ; + sort:=(j=10) or (AdrFeu<>0) or (N_Det>=Nb_det_dist); until (sort); // on arrete jusqu'à trouver un signal ou si on va trop loin (10 itérations) inc(ife); until ife>=5; - if (NivDebug=3) and (Etat=0) then AfficheDebug('Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow); + if (NivDebug>0) and (Etat=0) then AfficheDebug('Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow); test_memoire_zones:=Pres_train; end; @@ -6127,18 +6080,22 @@ begin if (det_initial<>0) then begin DetPrec1:=detecteur_suivant(Adr_El_Suiv,Btype_el_suivant,det_initial,1,2); // 2= algo2 = arret sur aiguillage en talon mal positionné + if nivdebug=3 then afficheDebug('detPrec1='+intToSTR(DetPrec1),clorange); if DetPrec1<1024 then // route bloquée par aiguillage mal positionné - begin - DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1); + begin + if detPrec1<>0 then DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1) else DetPrec2:=0; + if nivdebug=3 then afficheDebug('detPrec2='+intToSTR(DetPrec2),clorange); if DetPrec2<1024 then begin - DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1); + if detPrec2<>0 then DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1) else DetPrec3:=0; + if nivdebug=3 then afficheDebug('detPrec3='+intToSTR(DetPrec3),clorange); if DetPrec3<1024 then begin - DetPrec4:=detecteur_suivant_El(DetPrec2,1,DetPrec3,1); + if detPrec3<>0 then DetPrec4:=detecteur_suivant_El(DetPrec2,1,DetPrec3,1) else DetPrec4:=0; + if nivdebug=3 then afficheDebug('detPrec4='+intToSTR(DetPrec4),clorange); if DetPrec4<1024 then begin - if AffSignal or (NivDebug=3) then AfficheDebug('Les détecteurs précédents au feu '+IntToSTR(Adrfeu)+' sont:'+intToSTR(Det_initial)+' '+intToSTR(DetPrec1)+' '+intToSTR(DetPrec2)+' '+intToSTR(DetPrec3)+' '+intToSTR(DetPrec4),clyellow); + if AffSignal or (NivDebug>=2) then AfficheDebug('Les détecteurs précédents au feu '+IntToSTR(Adrfeu)+' sont:'+intToSTR(Det_initial)+' '+intToSTR(DetPrec1)+' '+intToSTR(DetPrec2)+' '+intToSTR(DetPrec3)+' '+intToSTR(DetPrec4),clyellow); PresTrain:=MemZone[DetPrec4,detPrec3] or MemZone[DetPrec3,detPrec2] or MemZone[DetPrec2,detPrec1] or MemZone[DetPrec1,Det_initial] or presTrain ; if AffSignal or (NivDebug=3) then @@ -6175,7 +6132,7 @@ var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,Adr_El_Suiv, s : string; begin s:='Traitement du feu '+intToSTR(Adrfeu)+'------------------------------------'; - //if adrfeu=197 then affsignal:=true else affsignal:=false; + if AffSignal then AfficheDebug(s,clOrange); i:=index_feu(Adrfeu); if AdrFeu<>0 then @@ -6227,6 +6184,7 @@ begin // signal à 2 feux = carré violet+blanc if (Feux[i].aspect=2) then //or (feux[i].check<>nil) then // si carré violet begin + //AfficheDebug('Feux à 2 feux',CLOrange); // si aiguillage après signal mal positionnées if carre_signal(AdrFeu) then begin @@ -6236,7 +6194,9 @@ begin end else begin - Maj_Etat_Signal(AdrFeu,blanc); + if test_memoire_zones(AdrFeu) then Maj_Etat_Signal(AdrFeu,violet) // test si présence train après signal + else Maj_Etat_Signal(AdrFeu,blanc); + Envoi_signauxCplx; exit; end; @@ -6385,6 +6345,16 @@ begin //affiche('index2='+IntToSTR(index2_det),clWhite); end; +// trouve si le détecteur adr est contigu à un buttoir +function buttoir_adjacent(adr : integer) : boolean; +begin + trouve_element(adr,1,1); // branche_trouve IndexBranche_trouve + if Branche_trouve=0 then begin buttoir_adjacent:=false;exit;end; + buttoir_adjacent:=( (BrancheN[branche_trouve,IndexBranche_trouve+1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve+1].BType=4) or + (BrancheN[branche_trouve,IndexBranche_trouve-1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve-1].BType=4) ) + +end; + // calcul des zones depuis le tableau des fronts descendants des évènements détecteurs // transmis dans le tableau Event_det procedure calcul_zones; @@ -6494,13 +6464,15 @@ begin end; end; - // créer un train, donc un tableau + // Nombre d'éléments à 0 : ici c'est un nouveau train donc créer un train, donc un tableau if N_Trains>=Max_Trains then begin Affiche('Erreur nombre de train maximal atteint',clRed); end; Inc(N_trains); + + // vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir for i:=1 to NbreFeux do begin @@ -6515,7 +6487,7 @@ begin if TraceListe then Affiche('FD - Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow); MemZone[0,AdrDetFeu]:=false; //NivDebug:=3; - AffSignal:=true; + //AffSignal:=true; maj_feu(AdrFeu); end; end; @@ -6523,18 +6495,36 @@ begin if TraceListe then AfficheDebug('Création Train n°'+intToSTR(i),clyellow); Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains); - event_det_train[N_trains].det[1]:=det3; - event_det_train[N_trains].NbEl:=1; - with FormDebug.MemoEvtDet do + + // si on démarre d'un buttoir + if buttoir_adjacent(det3) then begin - lines.add('Nouveau Tampon train '+intToStr(N_trains)+'--------'); - lines.add(intToSTR(event_det_train[N_trains].det[1])); - end; - if TraceListe then + if TraceListe then AfficheDebug('detection démarrage depuis détecteur '+IntToSTR(det3)+' buttoir',clyellow); + event_det_train[N_trains].det[1]:=0; + event_det_train[N_trains].det[2]:=det3; + event_det_train[N_trains].NbEl:=2; + with FormDebug.MemoEvtDet do + begin + lines.add('Nouveau Tampon train '+intToStr(N_Trains)+'--------'); + lines.add(intToSTR(event_det_train[N_Trains].det[1])); + lines.add(intToSTR(event_det_train[N_Trains].det[2])); + end; + end + else begin - AfficheDebug('Nouveau Tampon train '+intToStr(N_trains)+'--------',clyellow); - AfficheDebug(intToSTR(event_det_train[N_trains].det[1]),clyellow ); - end; + event_det_train[N_trains].det[1]:=det3; + event_det_train[N_trains].NbEl:=1; + with FormDebug.MemoEvtDet do + begin + lines.add('Nouveau Tampon train '+intToStr(N_trains)+'--------'); + lines.add(intToSTR(event_det_train[N_trains].det[1])); + end; + if TraceListe then + begin + AfficheDebug('Nouveau Tampon train '+intToStr(N_trains)+'--------',clyellow); + AfficheDebug(intToSTR(event_det_train[N_trains].det[1]),clyellow ); + end; + end; end; @@ -6759,7 +6749,7 @@ begin begin if aiguillage[i].modele<>0 then begin - if aiguillage[i].position=9 then + if aiguillage[i].position=const_inconnu then begin Affiche('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); AfficheDebug('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); @@ -6789,18 +6779,18 @@ begin end; // évènement d'aiguillage -procedure Event_Aig(adresse,pos,objet : integer); +procedure Event_Aig(adresse,pos : integer); var s: string; faire_event: boolean; begin // ------------------- traitement du numéro d'objet ------------------------- - // init objet + { init objet if aiguillage[adresse].objet=0 then begin aiguillage[adresse].objet:=objet; //affiche('stockage Aiguillage '+intToSTR(adresse)+' objet='+intToSTR(objet),clYellow); end; - + } // ne pas faire l'évaluation si l'ancien état de l'aiguillage est indéterminée (9) // car le RUN vient de démarrer faire_event:=aiguillage[adresse].position<>9; @@ -6816,7 +6806,7 @@ begin if pos=const_droit then s:=s+' droit' else s:=s+' dévié'; if AffAigDet then begin - if objet<>0 then s:=s+' objet='+IntToSTR(objet); + //if objet<>0 then s:=s+' objet='+IntToSTR(objet); Affiche(s,clyellow); AfficheDebug(s,clyellow); end; @@ -6826,7 +6816,7 @@ begin event_det_tick[N_event_tick].tick:=tick; event_det_tick[N_event_tick].aiguillage:=adresse; event_det_tick[N_event_tick].etat:=pos; - event_det_tick[N_event_tick].objet:=objet; + //event_det_tick[N_event_tick].objet:=objet; // Mettre à jour le TCO if AvecTCO then @@ -6838,6 +6828,75 @@ begin if faire_event then evalue; end; +// pilotage d'un accessoire (décodeur d'aiguillage, de signal) +// octet = 0 ou 1 ou 2 +// la sortie "octet" est mise à 1 puis à 0 +// acc = aig ou feu +procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire); +var groupe,temps : integer ; + fonction : byte; + s : string; +begin + //Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow); + // pilotage par CDM rail + if CDM_connecte then + begin + //AfficheDebug(intToSTR(adresse),clred); + if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange); + s:=chaine_CDM_Acc(adresse,octet); + envoi_CDM(s); + if (acc=feu) and not(Raz_Acc_signaux) then exit; + if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); + s:=chaine_CDM_Acc(adresse,0); + envoi_CDM(s); + exit; + end; + + // pilotage par USB ou par éthernet de la centrale + + // Affiche('Accessoire '+intToSTR(adresse),clLime); + if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then + begin + // test si pilotage aiguillage inversé + if aiguillage[adresse].inversion=1 then + begin + if octet=1 then octet:=2 else octet:=1; + end; + + if (octet=0) or (octet>2) then exit; + //if (octet>2) then exit; + groupe:=(adresse-1) div 4; + fonction:=((adresse-1) mod 4)*2 + (octet-1); + // pilotage à 1 + s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie + s:=checksum(s); + if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange); + envoi(s); // envoi de la trame et attente Ack + // si l'accessoire est un feu et sans raz des signaux, sortir + if (acc=feu) and not(Raz_Acc_signaux) then exit; + + + // si aiguillage, faire une temporisation + //if (index_feu(adresse)=0) or (Acc=aig) then + if Acc=Aig then + begin + temps:=aiguillage[adresse].temps;if temps=0 then temps:=4; + if portCommOuvert or parSocketLenz then tempo(temps); + end; + sleep(50); + + // pilotage à 0 pour éteindre le pilotage de la bobine du relais + s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie + s:=checksum(s); + if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); + envoi(s); // envoi de la trame et attente Ack + exit; + end; + + // pas de centrale et pas CDM connecté: on change la position de l'aiguillage + if acc=aig then event_aig(adresse,octet); +end; + // le décodage de la rétro est appellée sur une réception d'une trame de la rétrosignalisation de la centrale. // On déclenche ensuite les évènements détecteurs ou aiguillages. @@ -6888,22 +6947,22 @@ begin adraig:=((adresse * 4)+1 ); // *4 car N=1, c'est le "poids fort" if (valeur and $C)=$8 then begin - Event_Aig(adraig+3,const_droit,0); + Event_Aig(adraig+3,const_droit); if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=2';AfficheDebug(s,clYellow);end; end; if (valeur and $C)=$4 then begin - Event_Aig(adraig+3,const_devie,0); + Event_Aig(adraig+3,const_devie); if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=1';AfficheDebug(s,clYellow);end; end; if (valeur and $3)=$2 then begin - Event_Aig(adraig+2,const_droit,0); + Event_Aig(adraig+2,const_droit); if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=2';AfficheDebug(s,clYellow);end; end; if (valeur and $3)=$1 then begin - Event_Aig(adraig+2,const_devie,0); + Event_Aig(adraig+2,const_devie); if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=1';AfficheDebug(s,clYellow);end; end; end; @@ -6944,22 +7003,22 @@ begin adraig:=(adresse * 4)+1; if (valeur and $C)=$8 then begin - Event_Aig(adraig+1,const_droit,0); + Event_Aig(adraig+1,const_droit); if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=2';AfficheDebug(s,clYellow);end; end; if (valeur and $C)=$4 then begin - Event_Aig(adraig+1,const_devie,0); + Event_Aig(adraig+1,const_devie); if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=1';AfficheDebug(s,clYellow);end; end; if (valeur and $3)=$2 then begin - Event_Aig(adraig,const_droit,0); + Event_Aig(adraig,const_droit); if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=2';AfficheDebug(s,clYellow);end; end; if (valeur and $3)=$1 then begin - Event_Aig(adraig,const_devie,0); + Event_Aig(adraig,const_devie); if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=1';AfficheDebug(s,clYellow);end; end; end; @@ -7621,7 +7680,7 @@ begin if not(diffusion) then LireunfichierdeCV1.enabled:=true; - // ajoute une image dynamiquement + // ajoute les images des feux dynamiquement for i:=1 to NbreFeux do begin cree_image(i); // et initialisation tableaux signaux @@ -7653,15 +7712,21 @@ begin FormTCO.show; end; - //essai &&&&&&&&&& Affiche('Fin des initialisations',clyellow); LabelEtat.Caption:=' '; Affiche_memoire; //--------------------------------- { - aiguillage[20].position:=const_droit; - aiguillage[21].position:=const_droit; - + aiguillage[6].position:=const_devie; + aiguillage[4].position:=const_droit; + aiguillage[3].position:=const_droit; + aiguillage[1].position:=const_devie; + aiguillage[26].position:=const_droit; + aiguillage[28].position:=const_devie; + + if buttoir_adjacent(515) then affiche('oui',clred); + + NivDebug:=3; FormDebug.show; //i:=Detecteur_suivant_El(591,1,602,1); @@ -7740,13 +7805,13 @@ begin if Tempo_init>0 then dec(Tempo_init); if (Tempo_init=1) and AvecInit then begin - if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages=1) then + if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then begin Affiche('Positionnement des feux',clYellow); envoi_signauxCplx; // initialisation des feux init_aiguillages; // initialisation des aiguillages end; - if (AvecInitAiguillages=0) and not(ferme) and (parSocketLenz or portCommOuvert) then + if not(AvecInitAiguillages) and not(ferme) and (parSocketLenz or portCommOuvert) then begin demande_etat_acc; // demande l'état des accessoires (position des aiguillages) end; @@ -7827,9 +7892,9 @@ begin end; end; - if (not(Maj_feux_cours) and (Tempo_chgt_feux=1)) then Maj_feux(); // mise à jour des feux sur chgt aiguillage + //if (not(Maj_feux_cours) and (Tempo_chgt_feux=1)) then Maj_feux(); // mise à jour des feux sur chgt aiguillage - if (not(Maj_feux_cours) and (Tempo_chgt_feux>0)) then dec(Tempo_chgt_feux); + //if (not(Maj_feux_cours) and (Tempo_chgt_feux>0)) then dec(Tempo_chgt_feux); // tempo retombée actionneur if TempoAct<>0 then @@ -7850,13 +7915,7 @@ begin if not(MsgSim) then begin Affiche('Simulation en cours ',Cyan);MsgSim:=true; - N_Event_tick:=0; - N_event_det:=0; - N_trains:=0; - for i:=1 to Max_Trains do Event_det_Train[i].NbEl:=0; - i_simule:=0; - FormDebug.MemoEvtDet.Clear; - FormDebug.Richedit.Clear; + Raz_tout; // AffTickSimu:=true; end; while tick=Tablo_simule[i_simule+1].tick do @@ -7876,7 +7935,7 @@ begin if Tablo_simule[i_simule].aiguillage<>0 then begin s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' aig='+intToSTR(Tablo_simule[i_simule].aiguillage)+'='+IntToSTR(Tablo_simule[i_simule].etat); - Event_Aig(Tablo_simule[i_simule].Aiguillage,Tablo_simule[i_simule].etat,0); // créer évt aiguillage + Event_Aig(Tablo_simule[i_simule].Aiguillage,Tablo_simule[i_simule].etat); // créer évt aiguillage StaticText.caption:=s; end; @@ -7892,7 +7951,7 @@ begin end; end; - // temporisations de démarrage des trains au feux + // temporisations de démarrage des trains au feux pas encore au point if Option_demarrage then for i:=1 to 1024 do begin @@ -7925,8 +7984,9 @@ begin end; // bouton de commande d'un accessoire -procedure TFormPrinc.ButtonCommandeClick(Sender: TObject); -var adr,valeur,erreur : integer; +procedure TFormPrinc.ButtonDroitClick(Sender: TObject); +var adr,erreur : integer; + s : string; begin val(EditAdresse.text,adr,erreur); if (erreur<>0) or (adr<1) or (adr>2048) then @@ -7935,14 +7995,26 @@ begin exit; end; - val(EditVal.Text,valeur,erreur); - if (erreur<>0) or (valeur<0) or (valeur>255) then - begin - EditVal.text:='1'; - exit; - end; + pilote_acc(adr,const_droit,aig); + s:='accessoire '+IntToSTR(adr)+' droit'; + Affiche(s,clyellow); +end; - pilote_acc(adr,valeur,aig); + +procedure TFormPrinc.ButtonDevieClick(Sender: TObject); + var adr,erreur : integer; + s : string; +begin + val(EditAdresse.text,adr,erreur); + if (erreur<>0) or (adr<1) or (adr>2048) then + begin + EditAdresse.text:='1'; + exit; + end; + + pilote_acc(adr,const_devie,aig); + s:='accessoire '+IntToSTR(adr)+' dévié'; + Affiche(s,clyellow); end; procedure TFormPrinc.EditvalEnter(Sender: TObject); @@ -8120,7 +8192,7 @@ begin s:='Aiguillage '+IntToSTR(i)+' : '+intToSTR(aiguillage[i].position); if aiguillage[i].position=const_devie then s:=s+' (dévié)' ; if aiguillage[i].position=const_droit then s:=s+' (droit)'; - if aiguillage[i].position=9 then s:=s+' inconnue'; + if aiguillage[i].position=const_inconnu then s:=s+' inconnue'; objet:=aiguillage[i].objet; if objet<>0 then s:=s+' objet='+intToSTR(objet); @@ -8303,7 +8375,7 @@ begin begin //Affiche('Normal',clyellow); if etat=0 then etatAig:=2 else etatAig:=1; - Event_Aig(adr,etatAig,objet); + Event_Aig(adr,etatAig); end; // TJD TJS if (aiguillage[adr].modele=2) or (aiguillage[adr].modele=3) then @@ -8323,8 +8395,8 @@ begin adr:=adr2; adr2:=prv; end; - Event_Aig(adr,etatAig,objet); - Event_Aig(adr2,etatAig2,objet); + Event_Aig(adr,etatAig); + Event_Aig(adr2,etatAig2); end; if aiguillage[adr].modele=4 then // aiguillage triple begin @@ -8336,8 +8408,8 @@ begin adr2:=aiguillage[adr].AdrTriple; if (etat=0) or (etat=3) then etatAig2:=2; if etat=2 then etatAig2:=1; - Event_Aig(adr,etatAig,objet); - Event_Aig(adr2,etatAig2,objet); + Event_Aig(adr,etatAig); + Event_Aig(adr2,etatAig2); end; // Tempo_chgt_feux:=10; // demander la mise à jour des feux end; @@ -8598,17 +8670,17 @@ var adr,valeur,erreur : integer; s : string; begin // doc XpressNet page 55 - val(EditAdresse.text,adr,erreur); + val(EditCV.text,adr,erreur); if (erreur<>0) or (Adr>255) or (Adr<0) then begin - EditAdresse.Text:='1'; + EditCV.Text:='1'; exit; end; val(EditVal.Text,valeur,erreur); if (erreur<>0) or (valeur<0) or (valeur>255) then begin - EditAdresse.text:='1'; + EditVal.text:='1'; exit; end; @@ -8695,10 +8767,10 @@ begin sa:=''; Affiche('Lecture CV',clyellow); - val(EditAdresse.Text,cv,erreur); + val(EditCV.Text,cv,erreur); if (erreur<>0) or (cv>255) or (cv<0) then begin - EditAdresse.Text:='1'; + EditCV.Text:='1'; exit; end; //trace:=true; @@ -8904,8 +8976,19 @@ begin end; end; +procedure TFormPrinc.Apropos1Click(Sender: TObject); +begin + Affiche(' ',clyellow); + Affiche('Signaux complexes GL version '+version+' (C) 2020 F1IWQ Gily TDR',clWhite); + Affiche('http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906',clWhite); + Affiche('https://github.com/f1iwq2/Signaux_complexes_GL',clWhite); + Affiche(' ',clyellow); + +end; + begin + end. diff --git a/UnitPrinc.~pas b/UnitPrinc.~pas deleted file mode 100644 index a996a5f..0000000 --- a/UnitPrinc.~pas +++ /dev/null @@ -1,8911 +0,0 @@ -Unit UnitPrinc; -(******************************************** - programme signaux complexes Graphique Lenz - delphi 7 + activeX Tmscomm + clientSocket - ******************************************** - note sur le pilotage des accessoires: - raquette octet sortie - + 2 = aiguillage droit = sortie 2 de l'adresse d'accessoire - - 1 = aiguillage dévié = sortie 1 de l'adresse d'accessoire -*) - -// en mode simulation run, CDM ne renvoie pas les détecteurs au départ du RUN. - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, - ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB , unitConfig ; - -type - TFormPrinc = class(TForm) - Timer1: TTimer; - LabelTitre: TLabel; - ScrollBox1: TScrollBox; - ClientSocketLenz: TClientSocket; - GroupBox1: TGroupBox; - EditAdresse: TEdit; - Label2: TLabel; - Editval: TEdit; - Label3: TLabel; - MainMenu1: TMainMenu; - Interface1: TMenuItem; - MenuConnecterUSB: TMenuItem; - DeconnecterUSB: TMenuItem; - N2: TMenuItem; - MenuConnecterEthernet: TMenuItem; - MenuDeconnecterEthernet: TMenuItem; - StatusBar1: TStatusBar; - Label4: TLabel; - MSCommUSBLenz: TMSComm; - Afficher1: TMenuItem; - Etatdesdtecteurs1: TMenuItem; - Etatdesaiguillages1: TMenuItem; - N3: TMenuItem; - Codificationdesaiguillages1: TMenuItem; - Image9feux: TImage; - Image7feux: TImage; - Image5feux: TImage; - Image4feux: TImage; - Image3feux: TImage; - Image2feux: TImage; - N4: TMenuItem; - ConnecterCDMrail: TMenuItem; - DeconnecterCDMRail: TMenuItem; - Image2Dir: TImage; - Image3Dir: TImage; - Image4Dir: TImage; - Image5Dir: TImage; - Image6Dir: TImage; - Codificationdesfeux1: TMenuItem; - Divers1: TMenuItem; - ClientSocketCDM: TClientSocket; - FichierSimu: TMenuItem; - ButtonEcrCV: TButton; - OpenDialog: TOpenDialog; - N1: TMenuItem; - LireunfichierdeCV1: TMenuItem; - SaveDialog: TSaveDialog; - N5: TMenuItem; - Quitter1: TMenuItem; - Config: TMenuItem; - ButtonLitCV: TButton; - Codificationdesactionneurs1: TMenuItem; - OuvrirunfichiertramesCDM1: TMenuItem; - Panel1: TPanel; - BoutonRaf: TButton; - BoutVersion: TButton; - loco: TButton; - ButtonInfo: TButton; - ButtonReprise: TButton; - ButtonTest: TButton; - ButtonArretSimu: TButton; - ButtonCommande: TButton; - Panel2: TPanel; - Label1: TLabel; - LabelNbTrains: TLabel; - LabelEtat: TLabel; - ButtonAffTCO: TButton; - ButtonLanceCDM: TButton; - Affichefentredebug1: TMenuItem; - StaticText: TStaticText; - FenRich: TRichEdit; - PopupMenuFenRich: TPopupMenu; - Copier1: TMenuItem; - Etatdessignaux1: TMenuItem; - procedure FormCreate(Sender: TObject); - procedure MSCommUSBLenzComm(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure Timer1Timer(Sender: TObject); - procedure BoutVersionClick(Sender: TObject); - procedure ButtonCommandeClick(Sender: TObject); - procedure EditvalEnter(Sender: TObject); - procedure BoutonRafClick(Sender: TObject); - procedure ClientSocketLenzError(Sender: TObject; Socket: TCustomWinSocket; - ErrorEvent: TErrorEvent; var ErrorCode: Integer); - procedure ClientSocketLenzRead(Sender: TObject; Socket: TCustomWinSocket); - procedure ButtonTestClick(Sender: TObject); - procedure ButtonInfoClick(Sender: TObject); - procedure MenuConnecterUSBClick(Sender: TObject); - procedure DeconnecterUSBClick(Sender: TObject); - procedure MenuConnecterEthernetClick(Sender: TObject); - procedure MenuDeconnecterEthernetClick(Sender: TObject); - procedure locoClick(Sender: TObject); - procedure AffEtatDetecteurs(Sender: TObject); - procedure Etatdesaiguillages1Click(Sender: TObject); - procedure Codificationdesaiguillages1Click(Sender: TObject); - procedure ClientSocketCDMError(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; - var ErrorCode: Integer); - procedure ClientSocketLenzConnect(Sender: TObject; - Socket: TCustomWinSocket); - procedure ClientSocketCDMConnect(Sender: TObject; - Socket: TCustomWinSocket); - procedure ClientSocketCDMRead(Sender: TObject; - Socket: TCustomWinSocket); - procedure ConnecterCDMrailClick(Sender: TObject); - procedure DeconnecterCDMRailClick(Sender: TObject); - procedure ClientSocketCDMDisconnect(Sender: TObject; - Socket: TCustomWinSocket); - procedure Codificationdesfeux1Click(Sender: TObject); - procedure ClientSocketLenzDisconnect(Sender: TObject; - Socket: TCustomWinSocket); - procedure FichierSimuClick(Sender: TObject); - procedure ButtonEcrCVClick(Sender: TObject); - procedure ButtonRepriseClick(Sender: TObject); - procedure LireunfichierdeCV1Click(Sender: TObject); - procedure Quitter1Click(Sender: TObject); - procedure ConfigClick(Sender: TObject); - procedure ButtonLitCVClick(Sender: TObject); - procedure Codificationdesactionneurs1Click(Sender: TObject); - procedure ButtonArretSimuClick(Sender: TObject); - procedure OuvrirunfichiertramesCDM1Click(Sender: TObject); - procedure ButtonAffTCOClick(Sender: TObject); - procedure ButtonLanceCDMClick(Sender: TObject); - procedure Affichefentredebug1Click(Sender: TObject); - procedure FenRichChange(Sender: TObject); - procedure Copier1Click(Sender: TObject); - procedure Etatdessignaux1Click(Sender: TObject); - private - { Déclarations privées } - procedure DoHint(Sender : Tobject); - public - { Déclarations publiques } - Procedure ImageOnClick(Sender : TObject); - procedure proc_checkBoxFB(Sender : Tobject); - end; - - -const -titre='Signaux complexes GL '; -tempoFeu=100; -MaxAcc=2048; -LargImg=50;HtImg=91; // image des feux -const_droit=2;const_devie=1; // positions aiguillages transmises par la centrale LENZ -const_devieG_CDM=3; // positions aiguillages transmises par cdm -const_devieD_CDM=2; // positions aiguillages transmises par cdm -const_droit_CDM=0; // positions aiguillages transmises par cdm -ClBleuClair=$FF7070 ; -Cyan=$FF6060; -clviolet=$FF00FF; -GrisF=$414141; -clOrange=$0077FF; -Feu_X=50;Feu_Y=91; -Max_Simule=10000; -NbCouleurTrain=8; -couleurTrain : array[1..NbCouleurTrain] of Tcolor = (clYellow,clLime,clOrange,clAqua,clFuchsia,clLtGray,clred,clWhite); -EtatSign : array[0..13] of string[20] =('carré','sémaphore','sémaphore cli','vert','vert cli','violet', - 'blanc','blanc cli','jaune','jaune cli','ral 30','ral 60','rappel 30','rappel 60'); -NbDecodeur = 7; -decodeur : array[0..NbDecodeur-1] of string[20] =('rien','digital Bahn','CDF','LDT','LEB','NMRA','Unisemaf'); - -type TBranche = record - BType : integer ; // 1= détecteur 2= aiguillage 4=Buttoir - Adresse : integer ; // adresse du détecteur ou de l'aiguillage - end; - - Taiguillage = record - objet : integer; // objet dans CDM rail - modele : integer; // 0=n'existe pas 1=aiguillage 2=TJD 3=TJS 4=aiguillage triple - position, // position actuelle : 1=dévié 2=droit (positions centrale lenz) - Adrtriple, // 2eme adresse pour un aiguillage triple - temps, // temps de pilotage (durée de l'impulsion en x 100 ms) - inversion : integer; // pilotage inversé pour la commande (en mode sans CDM) 0=normal 1=inversé (positionné dans fichier config_gl section_init - InversionCDM : integer ; // inversion pour les aiguillages en lecture (paramètre I) - vitesse : integer; // vitesse de franchissement de l'aiguillage en position déviée (60 ou 90) - - ADroit : integer ; // (TJD:identifiant extérieur) connecté sur la position droite en talon - ADroitB : char ; // id de branche pour TJD - - ADevie : integer ; // (TJD:identifiant extérieur) adresse de l'élément connecté en position déviée - ADevieB : char; // caractère (D ou S)si aiguillage de l'élément connecté en position déviée - - APointe : integer; // adresse de l'élément connecté en position droite ; - APointeB : char; - - DDroit : integer; // destination de la TJD en position droite - DDroitB : char ; - - DDevie : integer; // destination de la TJD en position déviée - DDevieB : char ; - - tjsint : integer; // pour TJS - tjsintb : char ; - - // éléments connectés sur la branche déviée 2 (cas d'un aiguillage triple) - Adevie2 : integer; - Adevie2B : char ; - - // si modifié en mode config - modifie : boolean ; - end; - -Taccessoire = (aig,feu); -TMA = (valide,devalide); - -var - ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word; - AvecInitAiguillages,tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre, - NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, - Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM, - ServeurRetroCDM,TailleFonte,Nb_Det_Dist : integer; - - Hors_tension2,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD, - NackCDM,MsgSim,succes,recu_cv,AffActionneur,AffAigDet,Option_demarrage, - TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM : boolean; - - CDMhd : THandle; - branche : array [1..100] of string; - - FormPrinc: TFormPrinc; - ack,portCommOuvert,traceTrames,AffMem,AfficheDet,CDM_connecte,SocketCDM_connecte, - Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act, - Srvc_PosTrain,Srvc_Sig,debugtrames : boolean; - tablo : array of byte; // tableau rx usb - Enregistrement,chaine_Envoi,chaine_recue,Id_CDM,Af, - entete,suffixe,ConfStCom,LAY : string; - maxaiguillage,detecteur_chgt,Temps,Tempo_init,Suivant,TypeGen, - NbreImagePligne,NbreBranches,Index2_det,Index2_aig,branche_det,Index_det, - I_simule,maxTablo_act,NbreVoies,AdresseFeuSuivant,El_suivant : integer; - Ancien_detecteur : array[0..1024] of boolean; // anciens état des détecteurs et adresses des détecteurs et leur état - detecteur : array[0..1024] of - record - etat : boolean; - tempo : integer; - train : string; - end; - - Adresse_detecteur : array[0..60] of integer; // adresses des détecteurs par index - mem : array[0..1024] of boolean ; // mémoire des états des détecteurs - MemZone : array[0..1024,0..1024] of boolean ; // mémoires de zones - Tablo_actionneur : array[1..100] of - record - actionneur,etat,fonction,tempo, - accessoire,sortie : integer; - Raz : boolean; - train : string; - end; - KeyInputs: array of TInput; - Tablo_PN : array[1..20] of - record - AdresseFerme : integer; // adresse de pilotage DCC pour la fermeture - commandeFerme : integer; // commande de fermeture (1 ou 2) - AdresseOuvre : integer; // adresse de pilotage DCC pour l'ouverture - commandeOuvre : integer; // commande d'ouverture (1 ou 2) - NbVoies : integer; // Nombre de voies du PN - Voie : array [1..10] of record - ActFerme,ActOuvre : integer ; // actionneurs provoquant la fermeture et l'ouverture - PresTrain : boolean; // mémoire de présence de train sur la voie - end; - end; - Tablo_Simule : array[0..Max_Simule] of - record - tick : longint; - Detecteur,Aiguillage,etat : integer ; - end; - TempoAct,RangActCours,N_Cv,index_simule,NDetecteurs,N_Trains,N_routes : integer; - tablo_CV : array [1..255] of integer; - couleur : Tcolor; - fichier : text; - tick,Premier_tick : longint; - // modélisations des fichiers config - mod_branches,mod_act : array[1..100] of string; - // l'indice du tableau aiguillage est son adresse - aiguillage : array[0..MaxAcc] of Taiguillage; - // signaux - L'index du tableau n'est pas l'adresse du feu - feux : array[1..MaxAcc] of 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 avec feu blanc - FeuBlanc : boolean ; // avec checkbox ou pas - decodeur : integer; // type du décodeur - Adr_det1 : integer; // adresse du détecteur1 sur lequel il est implanté - Adr_det2 : integer; // adresse du détecteur2 sur lequel il est implanté (si un signal est pour plusieurs voies) - Adr_det3 : integer; // adresse du détecteur3 sur lequel il est implanté (si un signal est pour plusieurs voies) - Adr_det4 : integer; // adresse du détecteur4 sur lequel il est implanté (si un signal est pour plusieurs voies) - Adr_el_suiv1 : integer; // adresse de l'élément1 suivant - Adr_el_suiv2 : integer; // adresse de l'élément2 suivant (si un signal est pour plusieurs voies) - Adr_el_suiv3 : integer; // adresse de l'élément3 suivant (si un signal est pour plusieurs voies) - Adr_el_suiv4 : integer; // adresse de l'élément4 suivant (si un signal est pour plusieurs voies) - Btype_suiv1 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri - Btype_suiv2 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri - Btype_suiv3 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri - Btype_suiv4 : integer ; // type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri - VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal - modifie : boolean; // feu modifié - EtatSignal : word ; // comme EtatSignalCplx - UniSemaf : integer ; // définition supplémentaire de la cible pour les décodeurs UNISEMAF - AigDirection : array[1..6] of array of record // pour les signaux directionnels : contient la liste des aiguillages associés - Adresse : integer; // 6 feux max associés à un tableau dynamique décrivant les aiguillages - posAig : char; - end; - CondCarre : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le carré - Adresse : integer; // aiguillage - posAig : char; - end; - end; - Fimage : Timage; - BrancheN : array[1..100,1..200] of TBranche; // - -{$R *.dfm} - -// utilisation des procédures et fonctions dans les autres unités -function Index_feu(adresse : integer) : integer; -procedure dessine_feu2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_feu3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_feu5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_feu7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_feu9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer); -procedure dessine_dir2(Acanvas : Tcanvas;EtatSignal : word); -procedure dessine_dir3(Acanvas : Tcanvas;EtatSignal : word); -procedure dessine_dir4(Acanvas : Tcanvas;EtatSignal : word); -procedure dessine_dir5(Acanvas : Tcanvas;EtatSignal : word); -procedure dessine_dir6(Acanvas : Tcanvas;EtatSignal : word); -procedure Maj_Etat_Signal(adresse,aspect : integer); -procedure Affiche(s : string;lacouleur : TColor); -procedure envoi_signal(Adr : integer); -procedure pilote_direction(Adr,nbre : integer); -procedure connecte_USB; -procedure deconnecte_usb; -function IsWow64Process: Boolean; -procedure Dessine_feu_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer); -procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire); -function etat_signal_suivant(Adresse,rang : integer) : integer; -function suivant_alg3(prec : integer;typeELprec : integer;var actuel : integer;typeElActuel : integer;alg : integer) : integer; -function detecteur_suivant_El(el1: integer;TypeDet1 : integer;el2 : integer;TypeDet2 : integer) : integer ; -function test_memoire_zones(adresse : integer) : boolean; -function PresTrainPrec(AdrFeu : integer) : boolean; -function cond_carre(adresse : integer) : boolean; -function carre_signal(adresse : integer) : boolean; - -implementation - -uses UnitDebug, verif_version, UnitPilote, UnitSimule, UnitTCO; - -procedure menu_interface(MA : TMA); -var val : boolean; -begin - val:=MA=valide; - with formprinc do - begin - MenuConnecterUSB.enabled:=val; - DeConnecterUSB.enabled:=val; - MenuConnecterEthernet.enabled:=val; - MenuDeConnecterEthernet.enabled:=val; - end; -end; - -procedure Tformprinc.DoHint(Sender : Tobject); -begin - StatusBar1.Simpletext:=Application.Hint; -end; - -// renvoie le 1er numéro de bit à 1 -// ex BitNum(4)=2 -Function BitNum(n : word) : integer; -var i : integer; - trouve : boolean; -begin - i:=0; - repeat - trouve:=(n and 1)=1 ; - if not(trouve) then inc(i); - n:=n shr 1; - until (i=16) or trouve; - BitNum:=i; -end; - -// conversion du motif de bits (codebin) de la configuration du signal complexe en deux mots: -// en sortie : -// premierBit : code de la signalisation -// Combine = code de la signalisation combinée -// Exemple code_to_aspect(10001000000000) renvoie premierBit=jaune_cli (9) et Combine=rappel 60 (13) -procedure code_to_aspect(codebin : word;var premierbit,combine : word) ; -var i,mot : word; -begin - premierBit:=BitNum(CodeBin and $3ff); - combine:=BitNum(CodeBin and $fc00); -end; - -// dessine un cercle plein dans le feu -procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor); -begin - with Acanvas do - begin - brush.Color:=couleur; - Pen.Color:=clBlack; - Ellipse(x-rayon,y-rayon,x+rayon,y+rayon); - end; -end; - -// dessine les feux sur une cible à 2 feux dans le canvas spécifié -// x,y : offset en pixels du coin supérieur gauche du feu -// frX, frY : facteurs de réduction -procedure dessine_feu2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -var Temp,rayon,xViolet,YViolet,xBlanc,yBlanc, - LgImage,HtImage : integer; - ech : real; - code,combine : word; -begin - code_to_aspect(Etatsignal,code,combine); - rayon:=round(6*frX); - - // récupérer les dimensions de l'image d'origine du feu - LgImage:=Formprinc.Image2feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image2feux.Picture.Bitmap.Height; - - XBlanc:=13; YBlanc:=11; - xViolet:=13; yViolet:=23; - - if (orientation=2) then - begin - //rotation 90° vers la gauche des feux - ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yViolet;YViolet:=XViolet;XViolet:=Temp; - Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; - end; - - if (orientation=3) then - begin - //rotation 90° vers la droite des feux - // calcul des facteurs de réduction pour la rotation - ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-XBlanc;Xblanc:=Yblanc;Yblanc:=Temp; - Temp:=LgImage-Xviolet;Xviolet:=Yviolet;Yviolet:=Temp; - end; - - XBlanc:=round(xBlanc*Frx)+x; YBlanc:=round(Yblanc*Fry)+Y; - XViolet:=round(XViolet*FrX)+x; YViolet:=round(YViolet*FrY)+Y; - - // extinctions - if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,rayon,GrisF); - cercle(ACanvas,xViolet,yViolet,rayon,GrisF); - - // allumages - if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite); - if code=violet then cercle(ACanvas,xViolet,yViolet,rayon,clviolet); -end; - -// dessine les feux sur une cible à 3 feux -procedure dessine_feu3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xvert,Yvert, - LgImage,HtImage : integer; - s : string; - ech : real; - code,combine : word; -begin - code_to_aspect(Etatsignal,code,combine); - rayon:=round(6*frX); - - LgImage:=Formprinc.Image3feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image3feux.Picture.Bitmap.Height; - - Xvert:=13; Yvert:=11; - xSem:=13; ySem:=22; - xJaune:=13; yJaune:=33; - - if (orientation=2) then - begin - ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; - Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; - Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp; - end; - - if (orientation=3) then - begin - //rotation 90° vers la droite des feux - ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; - Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; - Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; - end; - - XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; - Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; - XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; - - // extinctions - if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,GrisF); - if not((code=vert_cli) and clignotant) then cercle(ACanvas,xVert,yVert,rayon,GrisF); - if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,GrisF); - - // allumages - if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xVert,yVert,rayon,clGreen); - if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(Acanvas,xJaune,yJaune,rayon,clOrange); - if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xSem,ySem,rayon,clRed); -end; - -// dessine les feux sur une cible à 4 feux -// orientation=1 vertical -procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xcarre,Ycarre,Xvert,Yvert, - LgImage,HtImage : integer; - ech : real; - code,combine : word; -begin - code_to_aspect(Etatsignal,code,combine); // et aspect - rayon:=round(6*frX); - - LgImage:=Formprinc.Image4feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image4feux.Picture.Bitmap.Height; - - Xcarre:=13; ycarre:=11; - Xvert:=13; Yvert:=22; - xSem:=13; ySem:=33; - xJaune:=13; yJaune:=44; - - if (orientation=2) then - begin - //rotation 90° vers la gauche des feux - ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yjaune; YJaune:=XJaune;Xjaune:=Temp; - Temp:=HtImage-ycarre; Ycarre:=Xcarre;Xcarre:=Temp; - Temp:=HtImage-ySem; YSem:=XSem;XSem:=Temp; - Temp:=HtImage-yvert; Yvert:=Xvert;Xvert:=Temp; - end; - - if (orientation=3) then - begin - //rotation 90° vers la droite des feux - // calcul des facteurs de réduction pour la rotation - ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; - Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; - Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; - Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; - end; - - XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; - Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; - XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; - Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y; - - //extinctions - cercle(ACanvas,Xcarre,yCarre,rayon,GrisF); - if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,Xsem,Ysem,rayon,GrisF); - if not((code=vert_cli) and clignotant) then cercle(ACanvas,Xvert,yvert,rayon,GrisF); - if not((code=jaune_cli) and clignotant) then cercle(ACanvas,Xjaune,YJaune,rayon,GrisF); - - // allumages - if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xVert,yVert,rayon,clGreen); - if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(Acanvas,Xjaune,yJaune,rayon,clOrange); - if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xSem,ySem,rayon,clRed); - if code=carre then - begin - cercle(ACanvas,xSem,Ysem,rayon,clRed); - cercle(ACanvas,xCarre,yCarre,rayon,clRed); - end; -end; - -// dessine les feux sur une cible à 5 feux -procedure dessine_feu5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -var XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre, - Temp,rayon,LgImage,HtImage : integer; - ech : real; - code,combine : word; -begin - code_to_aspect(Etatsignal,code,combine); // et aspect - rayon:=round(6*frX); - XBlanc:=13; YBlanc:=22; - xJaune:=13; yJaune:=55; - Xcarre:=13; Ycarre:=11; - XSem:=13; Ysem:=44; - XVert:=13; YVert:=33; - - LgImage:=Formprinc.Image5feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image5feux.Picture.Bitmap.Height; - - if (orientation=2) then - begin - //rotation 90° vers la gauche des feux - // calcul des facteurs de réduction pour la rotation - ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; - Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; - Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp; - Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; - Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp; - end; - - if (orientation=3) then - begin - //rotation 90° vers la droite des feux - // calcul des facteurs de réduction pour la rotation - ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; - Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; - Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; - Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; - Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp; - end; - - XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; - Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y; - Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; - XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; - Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y; - - // extinctions - if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,rayon,GrisF); - cercle(ACanvas,xcarre,ycarre,rayon,GrisF); - if not((code=vert_cli) and clignotant) then cercle(ACanvas,xvert,yvert,rayon,GrisF); - if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,GrisF); - if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xjaune,yjaune,rayon,GrisF); - - //allumages - if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xsem,ysem,rayon,clRed); - if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,xblanc,yblanc,rayon,clWhite); - if (code=violet) then cercle(ACanvas,xblanc,yblanc,rayon,clViolet); - if code=carre then - begin - cercle(ACanvas,xcarre,ycarre,rayon,clRed); - cercle(ACanvas,xsem,ysem,rayon,clRed); - end; - if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xvert,yVert,rayon,clGreen); - if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(ACanvas,xJaune,yjaune,rayon,clorange); -end; - - -// dessine les feux sur une cible à 7 feux -procedure dessine_feu7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -var XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2, - Temp,rayon,LgImage,HtImage : integer; - ech : real; - code,combine : word; -begin - code_to_aspect(Etatsignal,code,combine); // et combine - rayon:=round(6*frX); - XBlanc:=13; YBlanc:=23; - Xral1:=13; YRal1:=11; - Xral2:=37; YRal2:=11; - xJaune:=13; yJaune:=66; - Xcarre:=13; Ycarre:=35; - XSem:=13; Ysem:=56; - XVert:=13; YVert:=45; - - LgImage:=Formprinc.Image7feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image7feux.Picture.Bitmap.Height; - - if (orientation=2) then - begin - //rotation 90° vers la gauche des feux - // calcul des facteurs de réduction pour la rotation - ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; - Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; - Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp; - Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp; - Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp; - Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; - Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp; - end; - - if (orientation=3) then - begin - //rotation 90° vers la droite des feux - // calcul des facteurs de réduction pour la rotation - ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; - Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; - Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; - Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; - Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp; - Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp; - Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp; - end; - - XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; - Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y; - XRal1:=round(XRal1*FrX)+x; YRal1:=round(YRal1*FrY)+Y; - XRal2:=round(XRal2*FrX)+x; YRal2:=round(YRal2*FrY)+Y; - Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; - XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; - Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y; - - // effacements - if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,rayon,grisF); - if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then - begin - cercle(ACanvas,Xral1,Yral1,rayon,grisF);cercle(ACanvas,Xral2,Yral2,rayon,GrisF); - end; - if not((code=vert_cli) and clignotant) then cercle(ACanvas,xVert,yVert,rayon,GrisF); - cercle(ACanvas,xcarre,yCarre,rayon,GrisF);cercle(ACanvas,xSem,ySem,rayon,GrisF); - if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,GrisF); - if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,GrisF); - - // Allumages - if (code=ral_30) or (combine=ral_30) or ((code=ral_60) or (combine=ral_60)) and clignotant then - begin - cercle(ACanvas,xRal1,yRal1,rayon,clOrange);cercle(ACanvas,xRal2,yRal2,Rayon,clOrange); - end; - if (code=jaune) or ((code=jaune_cli) and clignotant) then cercle(Acanvas,xjaune,yjaune,rayon,clOrange); - if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,xsem,ysem,rayon,clRed); - if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,xVert,yVert,rayon,clGreen); - if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite); - if (code=violet) then cercle(ACanvas,xblanc,yblanc,rayon,clViolet); - if code=carre then - begin - cercle(ACanvas,xCarre,yCarre,rayon,clRed); - cercle(ACanvas,xSem,ySem,rayon,clRed); - end; -end; - -// dessine les feux sur une cible à 9 feux -procedure dessine_feu9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer); -var rayon, - XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2, - Xrap1,Yrap1,Xrap2,Yrap2,Temp : integer; - LgImage,HtImage,xt,yt : integer; - ech : real; - code,combine : word; -begin - rayon:=round(6*frX); - code_to_aspect(Etatsignal,code,combine); // et aspect - // mise à l'échelle des coordonnées des feux en fonction du facteur de réduction frX et frY et x et y (offsets) - - XBlanc:=13; YBlanc:=36; - Xral1:=13; YRal1:=24; - Xral2:=37; YRal2:=24; - xJaune:=13; yJaune:=80; - xRap1:=37; yRap1:=12; - xrap2:=37; yRap2:=37; - Xcarre:=13; Ycarre:=47; - XSem:=13; Ysem:=69; - XVert:=13; YVert:=58; - - LgImage:=Formprinc.Image9feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image9feux.Picture.Bitmap.Height; - - if (orientation=2) then - begin - //rotation 90° vers la gauche des feux - ech:=frY;frY:=frX;FrX:=ech; - Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp; - Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp; - Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp; - Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp; - Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp; - Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp; - Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp; - Temp:=HtImage-yRap1;YRap1:=XRap1;XRap1:=Temp; - Temp:=HtImage-yRap2;YRap2:=XRap2;XRap2:=Temp; - end; - - if (orientation=3) then - begin - //rotation 90° vers la droite des feux - ech:=frY;frY:=frX;FrX:=ech; - Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp; - Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp; - Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; - Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; - Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp; - Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp; - Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp; - Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp; - Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp; - end; - - XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; - Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y; - XRal1:=round(XRal1*FrX)+x; YRal1:=round(YRal1*FrY)+Y; - XRal2:=round(XRal2*FrX)+x; YRal2:=round(YRal2*FrY)+Y; - Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; - XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; - Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y; - XRap1:=round(XRap1*FrX)+x; YRap1:=round(YRap1*FrY)+Y; - XRap2:=round(XRap2*FrX)+x; YRap2:=round(YRap2*FrY)+Y; - - // extinctions - if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,Rayon,grisF); - if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then - begin - cercle(ACanvas,Xral1,Yral1,rayon,grisF);cercle(ACanvas,xRal2,yRal2,rayon,grisF); - end; - if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,grisF); - if not((code=rappel_60) and clignotant) or not((combine=rappel_60) and clignotant) then - begin - cercle(ACanvas,xrap1,yrap1,rayon,grisF);cercle(ACanvas,xrap2,yrap2,rayon,grisF); - end; - cercle(ACanvas,xcarre,Ycarre,rayon,grisF); // carré supérieur - if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,grisF); - if not((code=vert_cli) and clignotant) then cercle(ACanvas,xvert,yvert,rayon,grisF); - - // allumages - if ((code=ral_60) and clignotant) or (code=ral_30) or - ((combine=ral_60) and clignotant) or (combine=ral_30) then - begin - cercle(ACanvas,Xral1,yRal1,rayon,clOrange);cercle(ACanvas,xral2,yral2,rayon,clOrange); - end; - - if ((code=rappel_60) and clignotant) or (code=rappel_30) or - ((combine=rappel_60) and clignotant) or (combine=rappel_30) then - begin - cercle(ACanvas,xrap1,yrap1,rayon,clOrange);cercle(ACanvas,xrap2,yrap2,rayon,clOrange); - end; - if ((code=jaune_cli) and clignotant) or (code=jaune) then cercle(Acanvas,xjaune,yjaune,rayon,clOrange); - if ((code=semaphore_cli) and clignotant) or (code=semaphore) then cercle(ACanvas,Xsem,ySem,rayon,clRed); - if ((code=vert_cli) and clignotant) or (code=vert) then cercle(ACanvas,xvert,yvert,rayon,clGreen); - if ((code=blanc_cli) and clignotant) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite); - if (code=violet) then cercle(ACanvas,xblanc,yblanc,rayon,clViolet); - - if code=carre then - begin - cercle(ACanvas,xcarre,yCarre,rayon,clRed); - cercle(ACanvas,xsem,ysem,rayon,clRed); - end; -end; - - -// dessine les feux sur une cible directionnelle à 2 feux -procedure dessine_dir3(Acanvas : Tcanvas;EtatSignal : word); -begin - if EtatSignal=0 then - begin - cercle(ACanvas,11,13,6,GrisF); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,GrisF); - end; - if EtatSignal=1 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,grisF); - end; - if EtatSignal=2 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,grisF); - end; - if EtatSignal=3 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - end; -end; - -// dessine les feux sur une cible directionnelle à 4 feux -procedure dessine_dir4(Acanvas : Tcanvas;EtatSignal : word); -begin - if EtatSignal=0 then - begin - cercle(ACanvas,11,13,6,GrisF); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,GrisF); - cercle(ACanvas,43,13,6,GrisF); - end; - if EtatSignal=1 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,grisF); - cercle(ACanvas,43,13,6,GrisF); - end; - if EtatSignal=2 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,grisF); - cercle(ACanvas,43,13,6,GrisF); - end; - if EtatSignal=3 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,GrisF); - end; - if EtatSignal=4 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - end; - if EtatSignal=5 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - cercle(ACanvas,53,13,6,clWhite); - end; -end; - -procedure dessine_dir5(Acanvas : Tcanvas;EtatSignal : word); -begin - if EtatSignal=0 then - begin - cercle(ACanvas,11,13,6,GrisF); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,GrisF); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - end; - if EtatSignal=1 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,grisF); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - end; - if EtatSignal=2 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,grisF); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - end; - if EtatSignal=3 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - end; - if EtatSignal=4 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - cercle(ACanvas,53,13,6,GrisF); - end; - if EtatSignal=5 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - cercle(ACanvas,53,13,6,clWhite); - end; -end; - -procedure dessine_dir6(Acanvas : Tcanvas;EtatSignal : word); -begin - if EtatSignal=0 then - begin - cercle(ACanvas,11,13,6,GrisF); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,GrisF); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - cercle(ACanvas,63,13,6,GrisF); - end; - if EtatSignal=1 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,GrisF); - cercle(ACanvas,33,13,6,grisF); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - cercle(ACanvas,63,13,6,GrisF); - end; - if EtatSignal=2 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,grisF); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - cercle(ACanvas,63,13,6,GrisF); - end; - if EtatSignal=3 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,GrisF); - cercle(ACanvas,53,13,6,GrisF); - cercle(ACanvas,63,13,6,GrisF); - end; - if EtatSignal=4 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - cercle(ACanvas,53,13,6,GrisF); - cercle(ACanvas,63,13,6,GrisF); - end; - if EtatSignal=5 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - cercle(ACanvas,53,13,6,clWhite); - cercle(ACanvas,63,13,6,GrisF); - end; - if EtatSignal=6 then - begin - cercle(ACanvas,11,13,6,clWhite); - cercle(ACanvas,22,13,6,clWhite); - cercle(ACanvas,33,13,6,clWhite); - cercle(ACanvas,43,13,6,clWhite); - cercle(ACanvas,53,13,6,clWhite); - cercle(ACanvas,63,13,6,clWhite); - end; -end; - - -// dessine les feux sur une cible directionnelle à 2 feux -procedure dessine_dir2(Acanvas : Tcanvas;EtatSignal : word); -begin - if EtatSignal=0 then - begin - cercle(ACanvas,12,13,6,GrisF); - cercle(ACanvas,25,13,6,GrisF); - end; - if EtatSignal=1 then - begin - cercle(ACanvas,12,13,6,clWhite); - cercle(ACanvas,25,13,6,GrisF); - end; - if EtatSignal=2 then - begin - cercle(ACanvas,12,13,6,clWhite); - cercle(ACanvas,25,13,6,clWhite); - end; - -end; - -procedure Affiche(s : string;lacouleur : TColor); -begin - with formprinc do - begin - FenRich.lines.add(s); - RE_ColorLine(FenRich,FenRich.lines.count-1,lacouleur); - //FenRich.SetFocus; - //FenRich.SelStart := FenRich.GetTextLen; - //FenRich.Perform(EM_SCROLLCARET, 0, 0); - end; -end; - -// renvoie l'index du feu dans le tableau feux[] en fonction de son adresse -//si pas de feu renvoie 0 -function Index_feu(adresse : integer) : integer; -var i : integer; - trouve : boolean; -begin -i:=1; - repeat - trouve:=feux[i].adresse=adresse; - if not(trouve) then inc(i); - until (trouve) or (i>=100); - if trouve then Index_feu:=i else Index_feu:=0 ; -end; - -// dessine l'aspect du feu en fonction de son adresse dans la partie droite de droite -procedure Dessine_feu_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer); -var i : integer; -begin - i:=Index_feu(adresse); - if i<>0 then - case feux[i].aspect of - // feux de signalisation - 2 : dessine_feu2(CanvasDest,x,y,frx,fry,EtatSignalCplx[adresse],orientation); - 3 : dessine_feu3(CanvasDest,x,y,frx,fry,EtatSignalCplx[adresse],orientation); - 4 : dessine_feu4(CanvasDest,x,y,frx,fry,EtatSignalCplx[adresse],orientation); - 5 : dessine_feu5(CanvasDest,x,y,frx,fry,EtatSignalCplx[adresse],orientation); - 7 : dessine_feu7(CanvasDest,x,y,frx,fry,EtatSignalCplx[adresse],orientation); - 9 : dessine_feu9(CanvasDest,x,y,frx,fry,EtatSignalCplx[adresse],orientation); - // indicateurs de direction - 12 : dessine_dir2(CanvasDest,EtatSignalCplx[adresse]); - 13 : dessine_dir3(CanvasDest,EtatSignalCplx[adresse]); - 14 : dessine_dir4(CanvasDest,EtatSignalCplx[adresse]); - 15 : dessine_dir5(CanvasDest,EtatSignalCplx[adresse]); - 16 : dessine_dir6(CanvasDest,EtatSignalCplx[adresse]); - end; -end; - -Procedure TFormprinc.ImageOnClick(Sender : Tobject); -var s : string; - P_image_pilote : Timage; - i,erreur : integer; - -begin - P_image_pilote:=Sender as TImage; // récupérer l'objet image de la forme pilote - s:=P_Image_pilote.Hint; - //Affiche(s,clyellow); - i:=pos('@',s); if i<>0 then delete(s,i,1); - i:=pos('=',s); if i<>0 then delete(s,i,1); - i:=pos(' ',s); - if i<>0 then s:=copy(s,1,i-1); - val(s,AdrPilote,erreur); - i:=Index_feu(AdrPilote); - - with Formpilote do - begin - TFormPilote.Create(Self); - show; - - ImagePilote.top:=40;ImagePilote.left:=220; - ImagePilote.Parent:=FormPilote; - ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto; - ImagePilote.Picture.Bitmap.TransparentColor:=clblue; - ImagePilote.Transparent:=true; - ImagePilote.Picture.BitMap:=Feux[i].Img.Picture.Bitmap; - LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(AdrPilote); - EtatSignalCplx[0]:=EtatSignalCplx[AdrPilote]; - if feux[i].aspect>10 then - begin - GroupBox1.Visible:=false; - GroupBox2.Visible:=false; - LabelNbFeux.Visible:=true; - EditNbreFeux.Visible:=true; - EditNbreFeux.Text:='1'; - end - else - begin - LabelNbFeux.Visible:=False; - EditNbreFeux.Visible:=false; - GroupBox1.Visible:=true; - GroupBox2.Visible:=true; - end; - end; -end; - -// créée une image dynamiquement pour un nouveau feu déclaré dans le fichier de config -procedure cree_image(rang : integer); -var TypeFeu : integer; - s : string; -const espY = 15;//40; // espacement Y entre deux lignes de feux -begin - TypeFeu:=feux[rang].aspect; - Feux[rang].Img:=Timage.create(Formprinc.ScrollBox1); - with Feux[rang].Img do - begin - Parent:=Formprinc.ScrollBox1; // dire que l'image est dans la scrollBox1 - Top:=(HtImg+espY+20)*((rang-1) div NbreImagePLigne); // détermine les dimensions - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); - //Left:=10+(LargImg+10)*((rang-1) mod (NbreImagePLigne)); - s:='@='+inttostr(feux[rang].Adresse)+' Decodeur='+intToSTR(feux[rang].Decodeur)+' Adresse détecteur associé='+intToSTR(feux[rang].Adr_det1)+ - ' Adresse élement suivant='+intToSTR(feux[rang].Adr_el_suiv1); - if feux[rang].Btype_suiv1=2 then s:=s+' (aig)'; - Hint:=s; - onClick:=Formprinc.Imageonclick; - //width:=100; - //Height:=100; - Picture.Bitmap.TransparentMode:=tmAuto; - Picture.Bitmap.TransparentColor:=clblue; - Transparent:=true; - - case TypeFeu of // charger le bit map depuis le fichier - 2 : picture.bitmap:=Formprinc.Image2feux.picture.Bitmap; - 3 : picture.bitmap:=Formprinc.Image3feux.picture.Bitmap; - 4 : picture.bitmap:=Formprinc.Image4feux.picture.Bitmap; - 5 : picture.bitmap:=Formprinc.Image5feux.picture.Bitmap; - 7 : picture.bitmap:=Formprinc.Image7feux.picture.Bitmap; - 9 : picture.bitmap:=Formprinc.Image9feux.picture.Bitmap; - - 12 : picture.bitmap:=Formprinc.Image2Dir.picture.Bitmap; - 13 : picture.bitmap:=Formprinc.Image3Dir.picture.Bitmap; - 14 : picture.bitmap:=Formprinc.Image4Dir.picture.Bitmap; - 15 : picture.bitmap:=Formprinc.Image5Dir.picture.Bitmap; - 16 : picture.bitmap:=Formprinc.Image6Dir.picture.Bitmap; - end; - - // mettre rouge par défaut - if TypeFeu=2 then EtatSignalCplx[feux[rang].adresse]:=violet_F; - if TypeFeu=3 then EtatSignalCplx[feux[rang].adresse]:=semaphore_F; - if (TypeFeu>3) and (TypeFeu<10) then EtatSignalCplx[feux[rang].adresse]:=carre_F; - if TypeFeu>10 then EtatSignalCplx[feux[rang].adresse]:=0; - - dessine_feu_mx(Feux[rang].Img.Canvas,0,0,1,1,feux[rang].adresse,1); - //if feux[rang].aspect=5 then cercle(Picture.Bitmap.Canvas,13,22,6,ClYellow); - end; - - // créée le label pour afficher son adresse - Feux[rang].Lbl:=Tlabel.create(Formprinc.ScrollBox1); - with Feux[rang].Lbl do - begin - caption:='@'+IntToSTR(Feux[rang].adresse); - Parent:=Formprinc.ScrollBox1; - width:=100;height:=20; - Top:=HtImg+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); - BringToFront; - end; - - // créée le checkBox si un feu blanc est déclaré sur ce feu - if feux[rang].FeuBlanc then - begin - 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(rang); // affecter l'index du feu dans le HINT pour pouvoir le retrouver plus tard - - with Feux[rang].Check do - begin - caption:='dem FB'; - Parent:=Formprinc.ScrollBox1; - width:=100;height:=15; - Top:=HtImg+15+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); - BringToFront; - end; - end; -end; - -// calcule le checksum d'une trame -Function Checksum(s : string) : string; -var i : integer; - check : byte; -begin - check:=0; - for i:=1 to length(s) do - begin - check:=check xor ord(s[i]); - end; - checksum:=s+char(check); -end; - -// renvoie une chaine ASCI Hexa affichable à partir d'une chaîne -function chaine_HEX(s: string) : string; -var i : integer; - sa_hex: string; -begin - sa_hex:=''; - for i:=1 to length(s) do - begin - sa_hex:=sa_hex+IntToHex(ord(s[i]),2)+' '; - end; - chaine_HEX:=sa_hex; -end; - -// Affiche une chaîne en Hexa Ascii -procedure affiche_chaine_hex(s : string;couleur : Tcolor); -begin - if traceTrames then AfficheDebug(chaine_HEX(s),couleur); -end; - -// temporisation en x 100 ms (0,1 s) -procedure Tempo(ValTemps : integer); -begin - temps:=Valtemps; - repeat - Application.ProcessMessages; - until (temps<=0); -end; - - -// envoi d'une chaîne à la centrale par USBLenz ou socket, n'attend pas l'ack -// ici on envoie pas à CDM -procedure envoi_ss_ack(s : string); -var i,timeout,valto : integer; -begin -// com:=formprinc.MSCommUSBLenz; - s:=entete+s+suffixe; - if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClGreen); - // par port com-usb - - if portCommOuvert then - begin - if (protocole=4) then // le protocole 4 contrôle simplement la ligne CTS avant de transmettre et temporise octet par octet - begin - i:=1; - valto:=10; - //Affiche('envoi en tenant compte cts',clyellow); - repeat - timeout:=0; - repeat - //Application.ProcessMessages; - inc(timeout); - Sleep(20); - until (Formprinc.MSCommUSBLenz.CTSHolding=true) or (timeout>valto); - if timeout<=valto then - begin - //if formprinc.MSCommUSBLenz.CTSHolding then sa:='CTS=1 ' else sa:='CTS=0 '; - FormPrinc.MSCommUSBLenz.Output:=s[i]; - //if terminal then Affiche(sa+s[i],clyellow) else Affiche(sa+chaine_hex(s[i]),clyellow); - inc(i); - end; - until (i=length(s)+1) or (timeout>valto); - if timeout>valto then affiche('Erreur attente interface trop longue',clred); - end; - // protocole Rts Cts ou sans temporisation - if (protocole=2) or (tempoOctet=0) then begin FormPrinc.MSCommUSBLenz.Output:=s;exit;end; - // sans procotole ou xon xoff ou xon-rts - if (protocole=0) or (protocole=1) or (protocole=3) then - begin - for i:=1 to length(s) do - begin - FormPrinc.MSCommUSBLenz.Output:=s[i]; - //if terminal then Affiche(s[i],clyellow) else Affiche(chaine_hex(s[i]),clyellow); - Application.ProcessMessages; - Sleep(TempoOctet); - end; - end; - end; - - // par socket (ethernet) - if parSocketLenz then Formprinc.ClientSocketLenz.Socket.SendText(s); -end; - -// envoi d'une chaîne à la centrale Lenz par USBLenz ou socket, puis attend l'ack ou le nack -function envoi(s : string) : boolean; -var temps : integer; -begin - if Hors_tension2=false then - begin - envoi_ss_ack(s); - // attend l'ack - ack:=false;nack:=false; - if portCommOuvert or parSocketLenz then - begin - temps:=0; - repeat - Application.processMessages; - inc(temps);Sleep(100); - until ferme or ack or nack or (temps>TimoutMaxInterface); // l'interface répond < 5s en mode normal et 1,5 mn en mode programmation - if not(ack) or nack then - begin - Affiche('Pas de réponse de l''interface',clRed);inc(pasreponse); - // &&&&if pasreponse>3 then hors_tension2:=true; - end; - if ack then begin pasreponse:=0;hors_tension2:=false;end; - end; - end; - envoi:=ack; -end; - -Function chaine_CDM_Func(fonction,etat : integer;train : string) : string; -var so,sx,s : string; -begin - { exemple de commande envoyée au serveur pour une fonction - C-C-00-0002-CMDTRN-DCCSF|029|03|NAME=nomdutrain;CSTEP=0;FXnumfonction=etat; - - C-C-00-0002-CMDTRN-DCCSF|029|03|NAME=train;CSTEP=0;FX0=0; - C-C-00-0002-CMDTRN-DCCSF|029|03|NAME=train;CSTEP=0;FX1=0; - C-C-00-0002-CMDTRN-DCCSF|047|06|NAME=train;CSTEP=0;FX0=1;FX1=1;FX2=1;FX3=1; - maxi=C-C-00-0002-CMDTRN-DCCSF|111|16|NAME=train;CSTEP=0;FX0=1;FX1=1;FX2=1;FX3=1;FX4=0;FX5=0;FX6=0;FX7=0;FX8=0;FX9=0;FX10=0;FX11=0;FX12=0;FX13=0; - } - so:=place_id('C-C-01-0004-CMDTRN-DCCSF'); - s:=s+'NAME='+train+';'; - s:=s+'CSTEP=0;'; - s:=s+'FX'+intToSTR(fonction)+'='+intToSTR(etat)+';'; - sx:=format('%.*d',[2,3])+'|'; // 3 paramètres - so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx; - chaine_CDM_Func:=so+s; -end; - -// chaîne pour vitesse train -function chaine_CDM_vitesse(vitesse:integer;train:string) : string; -var s,so,sx: string; -begin - { C-C-00-0002-CMDTRN-SPEED|0xx|02|NAME=nomdutrain;UREQ=vitesse; } - so:=place_id('C-C-01-0004-CMDTRN-SPEED'); - s:=s+'NAME='+train+';'; - s:=s+'UREQ='+intToSTR(vitesse)+';'; - sx:=format('%.*d',[2,2])+'|'; // 2 paramètres - so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx; - - chaine_CDM_vitesse:=so+s; -end; - -// prépare la chaîne de commande pour un accessoire via CDM -Function chaine_CDM_Acc(adresse,etat1 : integer) : string; -var so,sx,s : string; -begin - { exemple de commande envoyée au serveur pour un manoeuvrer accessoire - C-C-00-0004-CMDACC-DCCAC|018|02|AD=100;STATE=1; - " NAME : nom de l'aiguille - " OBJ: numéro CDM-Rail de l'aiguille (index) - " AD: adresse (DCC) de l'aiguille - " AD2: adresse #2 (DCC) de l'aiguille (TJD bi-moteurs ou aiguille triples) - " STATE: état de l'aiguille - o 0: position droite (non déviée) - o 1: dévié (TJD, bretelles doubles) - o 2: dévié droit - o 3: dévié gauche - o 4: pos. droite #2 (TJD 4 états) - o 5: pos. déviée #2 (TJD 4 états) - } - so:=place_id('C-C-01-0004-CMDACC-DCCAC'); - s:=s+'AD='+format('%.*d',[1,adresse])+';'; - s:=s+'STATE='+format('%.*d',[1,etat1])+';'; - - sx:=format('%.*d',[2,2])+'|'; // 2 paramètres - so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx; - - chaine_CDM_Acc:=so+s; -end; - -procedure envoie_fonction_CDM(fonction,etat : integer;train : string); -var s : string; -begin - s:=chaine_CDM_Func(fonction,etat,train); - envoi_cdm(s); -end; - - -// active ou désactive une sortie par xpressnet. Une adresse comporte deux sorties identifiées par "octet" -// Adresse : adresse de l'accessoire -// octet : numéro (1-2) de la sortie à cette adresse -// etat : false (désactivé) true (activé) -procedure pilote_direct(adresse:integer;octet : byte;etat : boolean); -var groupe : integer ; - fonction : byte; - s : string; -begin - groupe:=(adresse-1) div 4; - fonction:=((adresse-1) mod 4)*2 + (octet-1); - // pilotage - if etat then - s:=#$52+Char(groupe)+char(fonction or $80) - else - s:=#$52+Char(groupe)+char(fonction or $88); - - s:=checksum(s); - envoi(s); // envoi de la trame et attente Ack -end; - -procedure pilote_direct01(adresse:integer;octet:integer); -var groupe : integer ; - fonction : byte; - s : string; -begin - if octet=0 then octet:=2; - groupe:=(adresse-1) div 4; - fonction:=((adresse-1) mod 4)*2 + (octet-1); - // pilotage - if octet=2 then - s:=#$52+Char(groupe)+char(fonction or $80) - else - s:=#$52+Char(groupe)+char(fonction or $88); - - s:=checksum(s); - if envoi(s) then exit else envoi(s); // envoi de la trame et attente Ack sinon renvoyer -end; - - -// pilotage d'un accessoire (décodeur d'aiguillage, de signal) -// octet = 0 ou 1 ou 2 -// la sortie "octet" est mise à 1 puis à 0 -// acc = aig ou feu -procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire); -var groupe,temps : integer ; - fonction : byte; - s : string; -begin - //Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow); - // pilotage par CDM rail - if CDM_connecte then - begin - //AfficheDebug(intToSTR(adresse),clred); - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange); - s:=chaine_CDM_Acc(adresse,octet); - envoi_CDM(s); - if (acc=feu) and not(Raz_Acc_signaux) then exit; - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); - s:=chaine_CDM_Acc(adresse,0); - envoi_CDM(s); - exit; - end; - - // pilotage par USB ou par éthernet de la centrale - - // Affiche('Accessoire '+intToSTR(adresse),clLime); - if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then - begin - // test si pilotage aiguillage inversé - if aiguillage[adresse].inversion=1 then - begin - if octet=1 then octet:=2 else octet:=1; - end; - - if (octet=0) or (octet>2) then exit; - //if (octet>2) then exit; - groupe:=(adresse-1) div 4; - fonction:=((adresse-1) mod 4)*2 + (octet-1); - // pilotage à 1 - s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie - s:=checksum(s); - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange); - envoi(s); // envoi de la trame et attente Ack - // si l'accessoire est un feu et sans raz des signaux, sortir - if (acc=feu) and not(Raz_Acc_signaux) then exit; - - - // si aiguillage, faire une temporisation - //if (index_feu(adresse)=0) or (Acc=aig) then - if Acc=Aig then - begin - temps:=aiguillage[adresse].temps;if temps=0 then temps:=4; - if portCommOuvert or parSocketLenz then tempo(temps); - end; - sleep(50); - - // pilotage à 0 pour éteindre le pilotage de la bobine du relais - s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie - s:=checksum(s); - if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange); - envoi(s); // envoi de la trame et attente Ack - end; -end; - -// pilote accessoire en entrée 0->2 1->1 -procedure pilote_acc01(adresse : integer;octet : byte); -var groupe : integer ; - fonction : byte; - s : string; -begin - // test si pilotage inversé - if octet=0 then octet:=2; - if aiguillage[adresse].inversion=1 then - begin - if octet=1 then octet:=2 else octet:=1; - end; - if (octet=0) or (octet>2) then exit; - groupe:=(adresse-1) div 4; - fonction:=((adresse-1) mod 4)*2 + (octet-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 - sleep(10); // temps minimal pour ne pas avoir le défaut station occupée qd on pilote un signal leb - //temps:=aiguillage[adresse].temps;if temps=0 then temps:=4; - // si l'accessoire est un feu, fixer l tempo à 1 - //if index_feu(adresse)<>0 then temps:=1; - - //if portCommOuvert or parSocketLenz then tempo(temps); - // pilotage à 0 pour éteindre le pilotage de la bobine du relais - s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie - s:=checksum(s); - envoi(s); // envoi de la trame et attente Ack -end; - -procedure vitesse_loco(loco : integer;vitesse : integer;sens : boolean); -var s : string; -begin - if portCommOuvert or parSocketLenz then - begin - if sens then vitesse:=vitesse or 128; - s:=#$e4+#$13+#$0+char(loco)+char(vitesse); - s:=checksum(s); - envoi(s); - end; - if cdm_connecte then - begin - //s:=chaine_CDM_vitesse(0,'BB25531'); - s:=chaine_CDM_vitesse(1,'CC406526'); // 0 n'arrete pas le train - envoi_CDM(s); - end; -end; - -// fonctions sur les bits -function testBit(n : word;position : integer) : boolean; -begin - testBit:=n and (1 shl position) = (1 shl position); -end; - -Function RazBit(n : word;position : integer) : word; -begin - RazBit:=n and not(1 shl position); -end; - -Function SetBit(n : word;position : integer) : word; -begin - SetBit:=n or (1 shl position); -end; - -// renvoie la chaîne de l'état du signal -function chaine_signal(etat : word) : string; -var aspect,combine : word; - s : string; -begin - code_to_aspect(etat,aspect,combine); - s:=''; - if aspect=16 then s:='' else s:=etatSign[aspect]; - if combine<>16 then - begin - if aspect<>16 then s:=s+'+'; - s:=s+etatSign[combine]; - end; - chaine_signal:=s; -end; - -// mise à jour état signal complexe dans le tableau de bits du signal EtatSignalCplx */ -// adresse : adresse du signal complexe -// Aspect : code représentant l'état du signal de 0 à 15 -procedure Maj_Etat_Signal(adresse,aspect : integer); -var i : integer; -begin -// ('0carré','1sémaphore','2sémaphore cli','3vert','4vert cli','5violet', -// '6blanc','7blanc cli','8jaune','9jaune cli','10ral 30','11ral 60','12rappel 30','13rappel 60'); - if testBit((EtatSignalCplx[adresse]),aspect)=false then // si le bit dans l'état du signal n'est pas allumé, procéder. - begin - // effacement du motif de bits en fonction du nouvel état demandé suivant la règle des signaux complexes - if (aspect<=blanc_cli) then - begin - EtatSignalCplx[adresse]:=0; //Tout aspect <=7 efface les autres - end; - if (aspect=jaune) then // jaune - begin - EtatSignalCplx[adresse]:=RazBit(EtatSignalCplx[adresse],jaune_cli); // cas du jaune: efface le bit du jaune clignotant (bit 9) - EtatSignalCplx[adresse]:=RazBit(EtatSignalCplx[adresse],ral_30); // cas du jaune: efface le bit du ral_30 (bit 10) - EtatSignalCplx[adresse]:=RazBit(EtatSignalCplx[adresse],ral_60); // cas du jaune: efface le bit du ral_60 (bit 11) - EtatSignalCplx[adresse]:=EtatSignalCplx[adresse] and not($00FF); // et effacer les bits 0 à 7 - end; - if (aspect=jaune_cli) then // jaune clignotant - begin - EtatSignalCplx[adresse]:=RazBit(EtatSignalCplx[adresse],jaune); // cas du jaunecli: efface le bit du jaune (bit 8) - EtatSignalCplx[adresse]:=EtatSignalCplx[adresse] and $FF00; // et effacer les bits 0 à 7 - end; - if (aspect=ral_30) then // ralentissement 30 - begin - EtatSignalCplx[adresse]:=EtatSignalCplx[adresse] and not($3BFF); // cas du ral 30: efface les bits 0 1 2 3 4 5 6 7 8 9 11 12 et 13 : 11 1000 1111 1111 - end; - if (aspect=ral_60) then // ralentissement 60 - begin - EtatSignalCplx[adresse]:=EtatSignalCplx[adresse] and not($35FF); // cas du ral 60: efface les bits 8 10 12 et 13 et de 0 à 7 : 11 0100 1111 1111 - end; - if (aspect=rappel_30) then // rappel 30 - begin - EtatSignalCplx[adresse]:=EtatSignalCplx[adresse] and not($2cff); // cas du rappel 30: efface les bits 0 1 2 3 4 5 6 7 10 11 et 13 : 10 1100 1111 0000 - end; - if (aspect=rappel_60) then // rappel 60 - begin - EtatSignalCplx[adresse]:=EtatSignalCplx[adresse] and not($1Cff); // cas du rappel 60: efface les bits 0 1 2 3 4 5 6 7 10 11 et 12 1 1100 1111 0000 - end; - if (aspect=aspect8) then // ral_60_jaune_cli décodeur LDT - begin - EtatSignalCplx[adresse]:=jaune_cli_F or ral_60_F; // cas du ralentissement 60 + avertissement clignotant : efface les bits 10 11 et 12 - end; - if (aspect<>aspect8) then - begin - EtatSignalCplx[adresse]:=SetBit(EtatSignalCplx[adresse],aspect); // allume le numéro du bit de la fonction du signal - // Affiche(IntToSTR(EtatSignalCplx[adresse]),clyellow); - end; - end; - // mise à jour de l'état du signal dans le tableau Feux - i:=Index_feu(adresse); - feux[i].EtatSignal:=EtatSignalCplx[adresse]; -end; - - -{============================================= -envoie les données au décodeur digital bahn équipé du logiciel "led_schalten" -sur un panneau directionnel - adresse : adresse du signal - code de 1 à 3 pour allumer -; le panneau directionnel à 1, 2 ou 3 leds. -============================================== } -procedure envoi_directionBahn(adr : integer;code : integer); -var i : integer; -begin - if (EtatSignalCplx[adr]<>code) then - begin - if (traceSign) then Affiche('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange); - if AffSignal then AfficheDebug('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange); - - case code of - 0 : begin pilote_acc(adr,1,feu); // sortie 1 à 0 - sleep(tempoFeu); - pilote_acc(adr+1,1,feu); // sortie 2 à 0 - sleep(Tempofeu); - pilote_acc(adr+2,1,feu); // sortie 3 à 0 - sleep(TempoFeu); - end; - 1 : begin pilote_acc(adr,2,feu); // sortie 1 à 1 - sleep(tempoFeu); - pilote_acc(adr+1,1,feu); // sortie 2 à 0 - sleep(Tempofeu); - pilote_acc(adr+2,1,feu); // sortie 3 à 0 - sleep(TempoFeu); - end; - 2 : begin pilote_acc(adr,2,feu); // sortie 1 à 1 - sleep(tempoFeu); - pilote_acc(adr+1,2,feu); // sortie 2 à 1 - sleep(Tempofeu); - pilote_acc(adr+2,1,feu); // sortie 3 à 0 - sleep(TempoFeu); - end; - 3 : begin pilote_acc(adr,2,feu); // sortie 1 à 1 - sleep(tempoFeu); - pilote_acc(adr+1,2,feu); // sortie 2 à 1 - sleep(Tempofeu); - pilote_acc(adr+2,2,feu); // sortie 3 à 1 - sleep(TempoFeu); - end; - end; - EtatSignalCplx[adr]:=code; - Dessine_feu_mx(Feux[Index_Feu(adr)].Img.Canvas,0,0,1,1,adr,1); - end; -end; - - -{ ============================================= -envoie les données au signal de direction pour un décodeur CDF -adresse : adresse du signal - code de 1 à 3 pour allumer -le panneau directionnel à 1, 2, 3 ou 4 leds. -============================================== } -procedure envoi_directionCDF(adr : integer;code : integer); -begin - if (EtatSignalCplx[adr]<>code) then - begin - if traceSign then Affiche('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange); - if AffSignal then AfficheDebug('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange); - - case code of - // éteindre toutes les leds - 0 : - begin - pilote_acc(adr,1,feu) ; - sleep(200); - end; - // code 1 : allume le feu le plus à gauche - 1 : - begin - pilote_acc(adr,2,feu) ; - sleep(200); - end; - 2 : //allume 2 feux - begin - pilote_acc(adr+1,1,feu) ; - sleep(200); - end; - // code 3 : allume 3 feux - 3 : - begin - pilote_acc(adr+1,2,feu) ; - sleep(200); - end; - end; - EtatSignalCplx[adr]:=code; - end; -end; - -procedure Envoi_DirectionLEB(Adr : integer;code : integer); -begin - if (EtatSignalCplx[adr]<>code) then - begin - if traceSign then Affiche('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange); - if aFFsIGNAL then AfficheDebug('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange); - - case code of - 0 : begin pilote_acc(adr+5,2,feu) ; pilote_acc(adr+6,2,feu) ;end; //00 - 1 : begin pilote_acc(adr+5,1,feu) ; pilote_acc(adr+6,2,feu) ;end; //10 - 2 : begin pilote_acc(adr+5,2,feu) ; pilote_acc(adr+6,1,feu) ;end; //01 - 3 : begin pilote_acc(adr+5,1,feu) ; pilote_acc(adr+6,1,feu) ;end; //11 - end; - EtatSignalCplx[adr]:=code; - end; -end; - -{========================================================================== -envoie les données au décodeur CDF -===========================================================================*} -procedure envoi_CDF(adresse : integer); -var index : integer; - code,aspect,combine : word; - s : string; -begin - if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then //; && (stop_cmd==FALSE)) - begin - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal CDF: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - - if (aspect=carre) then pilote_acc(adresse,2,feu) ; - if (aspect=semaphore) then pilote_acc(adresse,1,feu) ; - if (aspect=vert) then pilote_acc(adresse+1,1,feu) ; - if (aspect=jaune) then pilote_acc(adresse+1,2,feu); - // signalisation non combinée rappel 30 seul - if (aspect=rappel_30) then pilote_acc(adresse+1,1,feu); - - // signalisation combinée - rappel 30 + avertissement - à tester...... - if (Combine=0) then pilote_acc(adresse+2,1,feu) ; // éteindre rappel 30 - if (Combine=rappel_30) then pilote_acc(adresse+2,2,feu) ; // allumer rappel 30 - end; -end; - -{========================================================================== -envoie les données au décodeur LEB -===========================================================================*} -procedure envoi_LEB(adresse : integer); -var code,aspect,combine : word; - s : string; - procedure envoi5_LEB(selection :byte); - var i : integer; - begin - s:=''; - for i:=0 to 4 do - begin - if (testBit(selection,i)) then begin pilote_acc(adresse+i,1,feu);s:=s+'1';end - else begin pilote_acc(adresse+i,2,feu) ; s:=s+'0';end; - //if (testBit(selection,i)) then begin pilote_acc(adresse+i,1);s:=s+'1';end - //else begin pilote_acc(adresse+i,2) ; s:=s+'0';end; - //Sleep(60); - end; - //Affiche(inttoStr(selection),clOrange); - //Affiche(s,clOrange); - end; -begin - -if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then //; && (stop_cmd==FALSE)) -begin - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal LEB: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - - Sleep(60); // si le feu se positionne à la suite d'un positionnement d'aiguillage, on peut avoir le message station occupée - //Affiche(IntToSTR(aspect)+' '+inttoSTR(combine),clOrange); - if (Combine=16) then - begin - if (aspect=carre) then envoi5_LEB(0); - if (aspect=violet) then envoi5_LEB(1); - if (aspect=blanc_cli) then envoi5_LEB(2); - if (aspect=blanc) then envoi5_LEB(3); - if (aspect=semaphore) then envoi5_LEB(4); - if (aspect=semaphore_cli) then envoi5_LEB(5); - if (aspect=jaune) then envoi5_LEB(8); - if (aspect=jaune_cli) then envoi5_LEB($a); - if (aspect=vert_cli) then envoi5_LEB($c); - if (aspect=vert) then envoi5_LEB($d); - if (aspect=rappel_30) then envoi5_LEB(6); - if (aspect=rappel_60) then envoi5_LEB(7); - if (aspect=ral_30) then envoi5_LEB(9); - if (aspect=ral_60) then envoi5_LEB($b); - end; - if (aspect=16) then - begin - if (Combine=rappel_30) then envoi5_LEB(6); - if (Combine=rappel_60) then envoi5_LEB(7); - if (Combine=ral_30) then envoi5_LEB(9); - if (Combine=ral_60) then envoi5_LEB($b); - end; - if ((Combine=rappel_30) and (aspect=jaune)) then envoi5_LEB($e); - if ((Combine=rappel_30) and (aspect=jaune_cli)) then envoi5_LEB($f); - if ((Combine=rappel_60) and (aspect=jaune)) then envoi5_LEB($10); - if ((Combine=rappel_60) and (aspect=jaune_cli)) then envoi5_LEB($11); - if ((Combine=ral_60) and (aspect=jaune_cli)) then envoi5_LEB($12); - end; - -end; - -(*========================================================================== -envoie les données au décodeur NMRA étendu - adresse=adresse sur le BUS DCC - code=code d'allumage : -0. Carré -1. Sémaphore -2. Sémaphore clignotant -3. Vert -4. Vert clignotant -5. Carré violet -6. Blanc -7. Blanc clignotant -8. Avertissement -9. Avertissement clignotant -10. Ralentissement 30 -11. Ralentissement 60 -12. Ralentissement 60 + avertissement clignotant -13. Rappel 30 -14. Rappel 60 -15. Rappel 30 + avertissement -16. Rappel 30 + avertissement clignotant -17. Rappel 60 + avertissement -18. rappel 60 + avertissement clignotant - -/*===========================================================================*) -procedure envoi_NMRA(adresse: integer); -var valeur : integer ; - aspect,combine,code : word; - s : string; -begin - //index:=Index_feu(adresse); // tranforme l'adresse du feu en index tableau - //code:=feux[index].aspect; // aspect du feu; - - if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then - begin - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal NMRA: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - - case aspect of - carre : valeur:=0; - semaphore : valeur:=1; - semaphore_cli : valeur:=2; - vert : valeur:=3; - vert_cli : valeur:=4; - violet : valeur:=5; - blanc : valeur:=6; - blanc_cli : valeur:=7; - jaune : valeur:=8; - jaune_cli : valeur:=9; - end; - case combine of - ral_30 : valeur:=10; - ral_60 : valeur:=11; - rappel_30 : valeur:=13; - rappel_60 : valeur:=14; - end; - - if (Combine=ral_60) and (aspect=jaune_cli) then valeur:=12; - if (Combine=rappel_30) and (aspect=jaune) then valeur:=15; - if (Combine=rappel_30) and (aspect=jaune_cli) then valeur:=16; - if (Combine=rappel_60) and (aspect=jaune) then valeur:=17; - if (Combine=rappel_60) and (aspect=jaune_cli) then valeur:=18; - - pilote_acc(adresse,valeur,feu); - end; -end; - -// décodeur unisemaf (paco) -procedure envoi_UniSemaf(adresse: integer); -var modele,index: integer ; - s : string; - code,aspect,combine : word; -begin - index:=Index_feu(adresse); // tranforme l'adresse du feu en index tableau - - if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then - begin - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal Unisemaf: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - - // pour Unisemaf, la cible est définie dans le champ Unisemaf de la structure feux - - modele:=feux[index].Unisemaf; - //Affiche('Adresse='+intToSTR(Adresse)+' code='+intToSTR(code)+' combine'+intToSTR(combine),clyellow); - if modele=2 then // 2 feux - begin - if aspect=blanc then pilote_acc(adresse,1,feu); - if aspect=blanc_cli then pilote_acc(adresse,1,feu); - if aspect=violet then pilote_acc(adresse,2,feu); - end; - - if modele=3 then // 3 feux - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - - if aspect=semaphore then pilote_acc(adresse,2,feu); - if aspect=semaphore_cli then pilote_acc(adresse,2,feu); - - if aspect=jaune then pilote_acc(adresse+1,1,feu); - if aspect=jaune_cli then pilote_acc(adresse+1,1,feu); - end; - - if modele=4 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - carre : pilote_acc(adresse+1,2,feu); - end; - end; - // 51=carré + blanc - if modele=51 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - carre : pilote_acc(adresse+1,2,feu); - blanc : pilote_acc(adresse+2,1,feu); - blanc_cli : pilote_acc(adresse+2,1,feu); - end; - end; - // 52=VJR + blanc + violet - if modele=52 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - violet : pilote_acc(adresse+2,1,feu); - blanc : pilote_acc(adresse+1,2,feu); - blanc_cli : pilote_acc(adresse+1,2,feu); - end; - end; - // 71=VJR + ralentissement 30 - if modele=71 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - end; - if combine=ral_30 then pilote_acc(adresse+1,2,feu); - end; - // 72=VJR + carré + ralentissement 30 - if modele=72 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - carre : pilote_acc(adresse+1,2,feu); - end; - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - end; - // 73=VJR + carré + ralentissement 60 - if modele=73 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - carre : pilote_acc(adresse+1,2,feu); - end; - if combine=ral_60 then pilote_acc(adresse+2,1,feu); - end; - // 91=VJR + carré + rappel 30 - if modele=91 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - carre : pilote_acc(adresse+1,2,feu); - end; - if combine=rappel_30 then pilote_acc(adresse+2,1,feu); - end; - - // 92=VJR + carré + rappel 60 - if modele=92 then - begin - case aspect of - vert : pilote_acc(adresse,1,feu); - vert_cli : pilote_acc(adresse,1,feu); - jaune : pilote_acc(adresse,2,feu); - jaune_cli : pilote_acc(adresse,2,feu); - semaphore : pilote_acc(adresse+1,1,feu); - semaphore_cli : pilote_acc(adresse+1,1,feu); - carre : pilote_acc(adresse+1,2,feu); - end; - if combine=rappel_60 then pilote_acc(adresse+2,1,feu); - end; - - // 93=VJR + carré + ral30 + rappel 30 - if modele=93 then - begin - if combine=16 then //pas de sig combinée - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=carre then pilote_acc(adresse+1,2,feu); - end; - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - if combine=rappel_30 then pilote_acc(adresse+2,2,feu); - if (aspect=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu); - end; - - // 94=VJR + carré + ral60 + rappel60 - if modele=94 then - begin - if combine=16 then - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=carre then pilote_acc(adresse+1,2,feu); - end; - if combine=ral_60 then pilote_acc(adresse+2,1,feu); - if combine=rappel_60 then pilote_acc(adresse+2,2,feu); - if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); - end; - - // 95=VJR + carré + ral30 + rappel 60 - if modele=95 then - begin - if combine=16 then - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=carre then pilote_acc(adresse+1,2,feu); - end; - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - if combine=rappel_60 then pilote_acc(adresse+2,2,feu); - if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); - end; - // 96=VJR + blanc + carré + ral30 + rappel30 - if modele=96 then - begin - if combine=16 then - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=carre then pilote_acc(adresse+1,2,feu); - if aspect=blanc then pilote_acc(adresse+3,2,feu); - if aspect=blanc_cli then pilote_acc(adresse+3,2,feu); - end; - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - if combine=rappel_30 then pilote_acc(adresse+2,2,feu); - if (aspect=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu); - end; - - // 97=VJR + blanc + carré + ral30 + rappel60 - if modele=97 then - begin - if combine=16 then - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=carre then pilote_acc(adresse+1,2,feu); - if aspect=blanc then pilote_acc(adresse+3,2,feu); - if aspect=blanc_cli then pilote_acc(adresse+3,2,feu); - end; - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - if combine=rappel_60 then pilote_acc(adresse+2,2,feu); - if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); - end; - - // 98=VJR + blanc + violet + ral30 + rappel30 - if modele=98 then - begin - if combine=16 then - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=violet then pilote_acc(adresse+1,2,feu); - if aspect=blanc then pilote_acc(adresse+3,2,feu); - if aspect=blanc_cli then pilote_acc(adresse+3,2,feu); - end; - if (aspect=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu); - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - if combine=rappel_30 then pilote_acc(adresse+2,2,feu); - end; - - // 99=VJR + blanc + violet + ral30 + rappel60 - if modele=99 then - begin - if combine=16 then - begin - if aspect=vert then pilote_acc(adresse,1,feu); - if aspect=vert_cli then pilote_acc(adresse,1,feu); - if aspect=jaune then pilote_acc(adresse,2,feu); - if aspect=jaune_cli then pilote_acc(adresse,2,feu); - if aspect=semaphore then pilote_acc(adresse+1,1,feu); - if aspect=semaphore_cli then pilote_acc(adresse+1,1,feu); - if aspect=violet then pilote_acc(adresse+1,2,feu); - if aspect=blanc then pilote_acc(adresse+3,2,feu); - if aspect=blanc_cli then pilote_acc(adresse+3,2,feu); - end; - if (aspect=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); - if combine=ral_30 then pilote_acc(adresse+2,1,feu); - if combine=rappel_60 then pilote_acc(adresse+2,2,feu); - end; - end; -end; - -{========================================================================== -envoie les données au décodeur LDT - adresse=adresse sur le BUS DCC - code=code d'allumage selon l'adressage (ex carre, vert, rappel_30 ..). - mode=mode du décodeur adressé, de 1 à 2 - un décodeur occupe 8 adresses - Le mode 1 permet la commande des signaux de 2, 3 et 4 feux - Le mode 2 permet la commande de signaux de plus de 4 feux -===========================================================================} -procedure envoi_LDT(adresse : integer); -var code,aspect,combine,mode : word; - s : string; -begin - if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then //; && (stop_cmd==FALSE)) - begin - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal LDT: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - - if (aspect=semaphore) or (aspect=vert) or (aspect=carre) or (aspect=jaune) then mode:=1 else mode:=2; - - if aspect>carre then mode:=2 else mode:=1; - case mode of - // pour les décodeurs en mode 0, il faut écrire la routine vous même car le pilotage dépend du cablage - // sauf pour le sémaphore, vert et jaune fixe - 1 : // mode 1: feux 2 3 & 4 feux - begin - if (aspect=semaphore) then pilote_acc(adresse,1,feu); - if (aspect=vert) then pilote_acc(adresse,2,feu); - if (aspect=carre) then pilote_acc(adresse+1,1,feu); - if (aspect=jaune) then pilote_acc(adresse+1,2,feu); - end; - 2 : // mode 2: plus de 4 feux - begin - if (aspect=semaphore) then begin pilote_acc(adresse+2,1,feu);sleep(tempoFeu);pilote_acc(adresse,1,feu);end; - if (aspect=vert) then begin pilote_acc(adresse+2,1,feu);sleep(tempoFeu);pilote_acc(adresse,2,feu);end; - if (aspect=carre) then begin pilote_acc(adresse+2,1,feu);sleep(tempoFeu);pilote_acc(adresse+1,1,feu);end; - if (aspect=jaune) then begin pilote_acc(adresse+2,1,feu);sleep(tempoFeu);pilote_acc(adresse+1,2,feu);end; - if (aspect=violet) then begin pilote_acc(adresse+2,2,feu);sleep(tempoFeu);pilote_acc(adresse,1,feu);end; - if (aspect=blanc) then begin pilote_acc(adresse+2,2,feu);sleep(tempoFeu);pilote_acc(adresse,2,feu);end; - if (aspect=semaphore) then begin pilote_acc(adresse+2,2,feu);sleep(tempoFeu);pilote_acc(adresse+1,1,feu);end; - if (combine=aspect8) then begin pilote_acc(adresse+2,2,feu);sleep(tempoFeu);pilote_acc(adresse+1,2,feu);end; - if (combine=ral_60_jaune_cli) then begin pilote_acc(adresse+3,1,feu);sleep(tempoFeu);pilote_acc(adresse,1,feu);end; // demande groupe 3 - if (aspect=vert_cli) then begin pilote_acc(adresse+3,1,feu);sleep(tempoFeu);pilote_acc(adresse,2,feu);end; // demande groupe 3 - if (combine=Disque_D) then begin pilote_acc(adresse+3,1,feu);sleep(tempoFeu);pilote_acc(adresse+1,1,feu);end;// demande groupe 3 - if (aspect=jaune_cli) then begin pilote_acc(adresse+3,1,feu);sleep(tempoFeu);pilote_acc(adresse+1,2,feu);end; - if (combine=ral_30) then begin pilote_acc(adresse+3,2,feu);sleep(tempoFeu);pilote_acc(adresse,1,feu);end; - if (combine=ral_60) then begin pilote_acc(adresse+3,2,feu);sleep(tempoFeu);pilote_acc(adresse,2,feu);end; - if (combine=rappel_30) then begin pilote_acc(adresse+3,2,feu);sleep(tempoFeu);pilote_acc(adresse+1,1,feu);end; - if (combine=rappel_60) then begin pilote_acc(adresse+3,2,feu);sleep(tempoFeu);pilote_acc(adresse+1,2,feu);end; - end; - end; - end; -end; - - -procedure envoi_virtuel(adresse : integer); -var - combine,aspect,code : word; - s : string; -begin - code:=etatsignalcplx[adresse]; - if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then //; && (stop_cmd==FALSE)) - begin - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal virtuel: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - end; -end; - -(*========================================================================== -envoie les données au décodeur digitalbahn équipé du logiciel "led_signal_10" - adresse=adresse sur le BUS DCC - codebin=motif de bits représentant l'état des feux L'allumage est fait en - adressant l'une des 14 adresses pour les 14 leds possibles du feu. - Ici on met le bit 1 à 1 (état "vert" du programme hexmanipu -===========================================================================*) -procedure envoi_signalBahn(adresse : integer); -var aspect,code,combine : word; - ralrap, jau ,Ancralrap,Ancjau : boolean; - s : string; -begin - if (ancien_tablo_signalCplx[adresse]<>EtatSignalCplx[adresse]) then //; && (stop_cmd==FALSE)) - begin - code:=EtatSignalCplx[adresse]; - code_to_aspect(code,aspect,combine); - s:='Signal Bahn: ad'+IntToSTR(adresse)+'='+chaine_signal(code); - if traceSign then affiche(s,clOrange); - if Affsignal then afficheDebug(s,clOrange); - //Affiche(IntToSTR(aspect)+' '+inttoSTR(combine),clOrange); - - // spécifique au décodeur digital bahn: - // si le signal affichait un signal combiné, il faut éteindre le signal avec un sémaphore - // avant d'afficher le nouvel état non combiné - Ancralrap:=(TestBit(ancien_tablo_signalCplx[adresse],ral_30)) or (TestBit(ancien_tablo_signalCplx[adresse],ral_60)) or - (TestBit(ancien_tablo_signalCplx[adresse],rappel_30)) or (TestBit(ancien_tablo_signalCplx[adresse],rappel_60)) ; - // si ancien état du signal=jaune ou jaune cli - Ancjau:=(TestBit(ancien_tablo_signalCplx[adresse],jaune)) or (TestBit(ancien_tablo_signalCplx[adresse],jaune_cli)) ; - - //***ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - - // si état demandé du signal=ralentissement ou rappel - ralrap:=(TestBit(code,ral_30)) or (TestBit(code,ral_60)) or - (TestBit(code,rappel_30)) or (TestBit(code,rappel_60)) ; - // si état demandé du signal=jaune ou cli - jau:=TestBit(code,jaune) or TestBit(code,jaune_cli) ; - - //effacement du signal combiné par sémaphore suivant condition - if (((Ancralrap and not(ralrap)) or (Ancjau and not(jau))) and (aspect>=8)) then - begin - Sleep(40); - pilote_acc(adresse+semaphore,2,feu) ; - // dessine_feu(adresse); - end; - - sleep(40); // les commandes entre 2 feux successifs doivent être séparées au minimum de 100 ms - // affichage du premier aspect du signal(1er bit à 1 dans codebin - if aspect<>16 then pilote_acc(adresse+aspect,2,feu) ; - - // affichage de la signalisation combinée (2ème bit à 1 dans codebin) - if (Combine<>16) then - begin - sleep(40); - pilote_ACC(adresse+Combine,2,feu) ; - end; - ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; - end; -end; - -//évaluation des signaux ancienne version==================================================================*/ -procedure signaux; -var Num_voie,signalCplx,i : integer; - PresTrain,a,b,c : boolean; -begin -// signal 176 =========================================================*/ -signalCplx:=176; -a:=MemZone[524,521] and (aiguillage[8].position=2); -b:=MemZone[514,522] and (aiguillage[8].position<>2); -PresTrain:=MemZone[527,520] or ((aiguillage[7].position<>2) and ( a or b or MemZone[521,527] or MemZone[522,527])); -if (((aiguillage[20].position<>2) and (aiguillage[12].position<>2)) or (PresTrain=FALSE)) then - Maj_Etat_Signal(signalCplx,carre) -else -begin - // si train quitte zone de détection du signal - if ( (MemZone[520,530] and (aiguillage[20].position=2) and (aiguillage[26].position=2)) or - (MemZone[520,529] and (aiguillage[20].position=2) and (aiguillage[26].position<>2)) or - (MemZone[520,517] and (aiguillage[20].position<>2)) ) then - begin - if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin // 26==0 : voie droite <>0 : voie gauche - a:=((aiguillage[20].position<>2) and (testBit(EtatSignalCplx[358],carre)) or (testbit(EtatSignalCplx[358],semaphore))); - b:=((aiguillage[20].position=2) and (testBit(EtatSignalCplx[420],carre)) or (testbit(EtatSignalCplx[420], semaphore))); - - if (a or b) then - begin // si signal complexe suivant est au carré ou sémaphore - Maj_Etat_Signal(signalCplx,jaune); // afficher un avertissement - end - else - begin - if ((aiguillage[11].position<>2) and (aiguillage[20].position<>2) - and (aiguillage[12].position=2) and (aiguillage[18].position<>2)) then // si aiguille suivante prise en pointe est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30); // afficher ralentissement - end - else - begin - a:=(aiguillage[20].position<>2) and testbit(EtatSignalCplx[358],jaune); - b:=((aiguillage[20].position=2) and testbit(EtatSignalCplx[420],jaune)); - if (a or b) then // si signal cplx suivant est jaune - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,jaune_cli); // afficher un avertissement clignotant sur le signal complexe - end - else Maj_Etat_Signal(signalCplx,vert); // sinon afficher un feu vert - end; - end; - end; -end; - -// signal 190 ================================================================ */ -signalCplx:=190; -if memZone[523,526]=true then // si train quite zone de détection du signal - begin - Maj_Etat_Signal(signalCplx,semaphore); // mettre un sémaphore} - end - else - begin - if testBit(EtatSignalCplx[302],carre) or testBit(EtatSignalCplx[302],semaphore) then // si signal complexe suivant= carré ou sémaphore - // Maj_Etat_Signal(signalCplx,jaune); // - Maj_Etat_Signal(signalCplx,semaphore_cli) - else - begin - if (aiguillage[9].position<>2) then // si aiguille suivante déviée? - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testBit(EtatSignalCplx[302],jaune) then // si signal suivant jaune ? - Maj_Etat_Signal(signalCplx,jaune_cli); - Maj_Etat_Signal(signalCplx,ral_60); // afficher ralentissement - end - else // aiguille 9 droite - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testBit(EtatSignalCplx[302],jaune_F) then // si signal cplx suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - - -// signal 204 ============================================================*/ - signalCplx:=204; - PresTrain:=(aiguillage[8].position=2) and (MemZone[521,527] or MemZone[524,521]) - or ((aiguillage[8].position<>2) and (MemZone[522,527] or MemZone[514,522] or MemZone[518,514])); - if (PresTrain=FALSE) then Maj_Etat_Signal(signalCplx,carre) // si pas de train avant le signal, mettre au carré - else - begin - if ( (MemZone[527,520] and (aiguillage[7].position<>2)) or - (MemZone[527,519] and (aiguillage[7].position=2)) ) then // si train quitte détection signal - begin - if (TestBit(EtatSignalCplx[signalCplx],carre)=FALSE) then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if (aiguillage[7].position<>2) then // aiguille locale prise en pointe déviée? - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,rappel_30); // afficher rappel ralentissement - if (TestBit(EtatSignalCplx[176],carre)) or (testBit(EtatSignalCplx[176],semaphore)) then // si signal complexe suivant rouge - Maj_Etat_Signal(signalCplx,jaune) - else - if TestBit(EtatSignalCplx[176],jaune) then // si signal complexe suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli); - end - else // pas aiguille locale déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - // si signal suivant est rouge - if TestBit(EtatSignalCplx[330],carre) or testBit(EtatSignalCplx[330],semaphore) then Maj_Etat_Signal(signalCplx,jaune) - else - begin - if TestBit(EtatSignalCplx[330],jaune) or TestBit(EtatSignalCplx[330],ral_30) - or TestBit(EtatSignalCplx[330],ral_60) then // si signal suivant est jaune ou ral_30 ou 60 - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; - -// signal 218 ============================================================*/ -signalCplx:=218; -if MemZone[525,528] or MemZone[525,535] then Maj_Etat_Signal(signalCplx,semaphore) // si train quitte zone détection du signal -else - // si signal suivant est rouge - begin - a:=(testBit(EtatSignalCplx[344],carre) or testBit(EtatSignalCplx[344],semaphore)) and (aiguillage[17].position<>2); - b:=(testBit(EtatSignalCplx[392],carre) or testBit(EtatSignalCplx[392],semaphore)) and (aiguillage[17].position=2); - if (a or b) then - begin - Maj_Etat_Signal(signalCplx,jaune); - end - else - begin - // si aiguille distante déviée - if ( ((aiguillage[19].position<>2) or ((aiguillage[19].position=2) and (aiguillage[22].position<>2))) and (aiguillage[17].position<>2) ) then - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30); - end - else - begin - // si signal suivant jaune - EtatSignalCplx[signalCplx]:=0; // raz état du signal - a:=testBit(EtatSignalCplx[344],jaune) and (aiguillage[17].position<>2); - b:=testBit(EtatSignalCplx[392],jaune) and (aiguillage[17].position=2); - if (a or b) then - begin - Maj_Etat_Signal(signalCplx,jaune_cli); - end - else - begin - Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; - -// signal 232 ============================================================*/ -signalCplx:=232; -if ((aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position=2) and (aiguillage[6].position<>0)) then -begin - if detecteur[516].etat then Maj_Etat_Signal(signalCplx,blanc) - else Maj_Etat_Signal(signalCplx,blanc_cli) -end -else Maj_Etat_Signal(signalCplx,violet); - -// signal 260 ============================================================*/ -signalCplx:=260; -// aiguilles vers manoeuvre -//i:=index_feu(SignalCplx); -//a:=(feux[i].check.checked=true) and (aiguillage[1].position<>2) and (aiguillage[3].position<>2) and (aiguillage[5].position=2) and detecteur[518]; -//b:=(aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position=2) and (aiguillage[6].position<>2); -//if (a or b) then Maj_Etat_Signal(signalCplx,blanc) // feu blanc -//else - begin - // équations de présence train avant signal - a:= MemZone[525,528] and (aiguillage[17].position<>2) and (aiguillage[10].position<>2); - b:= MemZone[526,513] and (aiguillage[10].position<>2); - PresTrain:=(a or b or MemZone[513,518] or MemZone[528,518]) and (aiguillage[19].position<>2); - - // équations d'aiguillages prises en talon mal positionnées - a:=((aiguillage[1].position<>2) and (aiguillage[3].position<>2) and (aiguillage[5].position<>2)); - b:=((aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position=2) and (aiguillage[6].position=2)); - a:=false;b:=false;prestrain:=true; - if (a or b or (PresTrain=FALSE)) then maj_Etat_Signal(signalCplx,carre) - else - begin //si train quitte zone 518 - a:=((MemZone[518,523] and (aiguillage[1].position=2)) or - (MemZone[518,515] and (aiguillage[1].position<>2) and (aiguillage[3].position<>2)) or - (MemZone[518,514] or MemZone[514,522]) and ((aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position<>2))); - if a then - begin - if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if feux[index_feu(signalCplx)].check.checked then Maj_Etat_Signal(signalCplx,blanc) - else - begin - if (aiguillage[1].position<>2) then // aiguille locale prise en pointe déviée? - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,rappel_30); // afficher rappel ralentissement - a:=((aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position<>2)) // vers voie 514 - and (testBit(EtatSignalCplx[288],carre) or testBit(EtatSignalCplx[288],semaphore)) ; // si signal complexe suivant rouge - b:=((aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position=2)) ; //ou voie en buttoir - if (a or b) then - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if testBit(EtatSignalCplx[288],jaune) then // si signal complexe suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli); - end; - end - else // pas aiguille locale déviée - begin - // si signal suivant est rouge - EtatSignalCplx[signalCplx]:=0; // raz état du signal - a:=(aiguillage[1].position=2) and testBit(EtatSignalCplx[190],semaphore) or testBit(EtatSignalCplx[190],semaphore_cli) or testbit(EtatSignalCplx[190],carre); - //a:=a or (aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position=2) and (aiguillage[6].position<>2); - //a:=a or (aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position<>2) and TestBit(EtatSignalCplx[288],semaphore) or testBit(EtatSignalCplx[288],carre); - if a then Maj_Etat_Signal(signalCplx,jaune) - else - begin - if testBit(EtatSignalCplx[190],jaune) or testBit(EtatSignalCplx[190],ral_30) - or testBit(EtatSignalCplx[190],ral_60) then // si signal cplx suivant est jaune ou ral_30 ou 60 - Maj_Etat_Signal(signalCplx,jaune_cli) - else - begin - i:=Index_feu(signalCplx); - if feux[i].FeuBlanc then - begin - if feux[i].check.Checked then - Maj_etat_signal(signalCplx,blanc) else Maj_etat_signal(signalCplx,vert); - end - else Maj_etat_signal(signalCplx,vert); - end; - end; - end; - end; - end; - end; - end; - -// signal 274 ============================================================*/ - signalCplx:=274; - if MemZone[524,521] then // si train quite détection du signal - Maj_Etat_Signal(signalCplx,semaphore) - else - begin - if TestBit(EtatSignalCplx[600],carre) or testBit(EtatSignalCplx[600],semaphore) then - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if testBit(EtatSignalCplx[600],ral_30) or testBit(EtatSignalCplx[600],jaune) then Maj_Etat_Signal(signalCplx,jaune_cli) - else - Maj_Etat_Signal(signalCplx,vert); - end; - end; - -// signal 288 =========================================================*/ -signalCplx:=288; -PresTrain:=MemZone[513,531] or MemZone[528,531] or MemZone[524,531] or MemZone[518,514] or MemZone[531,518] ; -//PresTrain:=(PresTrain and (aiguillage[1].position<>2) and (aiguillage[3].position=2) and (aiguillage[4].position<>2) ); -PresTrain:=PresTrain or MemZone[514,522]; - -if ((PresTrain=FALSE) or (aiguillage[8].position=2)) then Maj_Etat_Signal(signalCplx,carre) -else -begin - if MemZone[522,527] then - begin - if TestBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); // sinon mettre un sémaphore} - end - else - begin - if TestBit(EtatSignalCplx[204],carre) or testBit(EtatSignalCplx[204],semaphore) then // si signal complexe suivant est au carré ou sémaphore - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,jaune); // afficher un avertissement - end - else - begin - if (aiguillage[7].position<>2) then // si aiguille suivante prise en pointe est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30); // afficher ralentissement - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testBit(EtatSignalCplx[204],jaune) then // si signal suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli) // afficher un avertissement clignotant sur le signal complexe - else Maj_Etat_Signal(signalCplx,vert); // sinon afficher un feu vert - end; - end; - end; -end; - -// signal 302 ============================================================*/ -signalCplx:=302; -PresTrain:=((MemZone[513,518] or MemZone[528,518] or MemZone[524,518]) and (aiguillage[1].position=2)) or MemZone[518,523] or MemZone[523,526] ; -if PresTrain=FALSE then Maj_Etat_Signal(signalCplx,carre) -else -begin - if (MemZone[526,513] and (aiguillage[9].position=2)) or - (MemZone[526,515] and (aiguillage[9].position<>2)) then // si train quitte zone de détection du signal - begin - if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then - Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if (aiguillage[9].position<>2) then // si aiguille locale déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,rappel_60); // afficher rappel ralentissement - if (testBit(EtatSignalCplx[316],carre) or testBit(EtatSignalCplx[316],semaphore )) then // si signal suivant rouge - Maj_Etat_Signal(signalCplx,jaune); - // signal suivant jaune avec aiguille locale déviée - if testBit(EtatSignalCplx[316],jaune) then // si signal cplx suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli); - end - else // si aiguille locale non déviée - begin - // si signal suivant rouge - if testBit(EtatSignalCplx[462],semaphore) or testBit(EtatSignalCplx[462],carre) then - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,jaune); - end - else - begin - // si aiguille suivante prise en pointe déviée - if ((aiguillage[19].position<>2) or ((aiguillage[19].position=2) and (aiguillage[22].position<>2))) then - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,jaune); // le ral30 est remplacé par avertissement sur ce signal - end - else - // si signal suivant est jaune ou ralentissement 30 - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if (testBit(EtatSignalCplx[462],jaune) or testBit(EtatSignalCplx[462],ral_30)) then - Maj_Etat_Signal(signalCplx,jaune_cli) - else - Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; -end; - -// signal 316 ============================================================*/ -signalCplx:=316; -// aiguillages vers voies de garage -if ( (aiguillage[5].position=2) and (aiguillage[3].position<>2) and (aiguillage[1].position<>2) ) or - ( feux[index_feu(signalCplx)].check.checked) then - begin - if detecteur[518].etat then Maj_Etat_Signal(signalCplx,blanc_cli) else Maj_Etat_Signal(signalCplx,blanc) ; - end -else -begin - PresTrain:=MemZone[526,515] or (((MemZone[518,523] and (aiguillage[1].position=2)) or MemZone[523,526]) and (aiguillage[9].position<>2)) ; - // équations d'aiguillages mal positionnés - - a:=((aiguillage[5].position=2) and (aiguillage[3].position=2)) or - ((aiguillage[5].position=2) and (aiguillage[1].position=2)) or - ((aiguillage[5].position<>2) and (aiguillage[2].position=2)) or - ((aiguillage[5].position<>2) and (aiguillage[2].position<>2) and (aiguillage[12].position=2)) ; - if a or (PresTrain=FALSE) then Maj_Etat_Signal(signalCplx,carre) - else - begin // train quitte zone de détection du signal - if ( (MemZone[515,517] and (aiguillage[5].position<>2)) or - (MemZone[515,518] and (aiguillage[5].position=2)) ) then - begin - if TestBit(EtatSignalCplx[signalCplx],carre)=false then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if feux[index_feu(signalCplx)].check.checked then Maj_Etat_Signal(signalCplx,blanc) - else - begin - if ( ((aiguillage[5].position<>2) and (aiguillage[2].position<>2)) and - (testBit(EtatSignalCplx[358],carre) or testBit(EtatSignalCplx[358],semaphore)) ) then // si signalCplx suivant est carré - Maj_Etat_Signal(signalCplx,jaune) - else - if ( ((aiguillage[5].position=2) and (aiguillage[3].position<>2) and (aiguillage[1].position<>2)) and // si signal suivant est rouge - (testBit(EtatSignalCplx[497],carre) or testBit(EtatSignalCplx[497],semaphore)) ) then - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if (((aiguillage[11].position<>2) and (aiguillage[5].position<>2)) or - ((aiguillage[10].position<>2) and (aiguillage[5].position=2)) ) then - // si aiguille suivante prise en pointe est déviée - Maj_Etat_Signal(signalCplx,ral_30) // afficher ralentissement - - else - begin - // si aiguille suivante en pointe est déviée - if ((aiguillage[29].position<>2) and (aiguillage[5].position=2)) then// si aiguille suivante prise en pointe est déviée - begin - Maj_Etat_Signal(signalCplx,ral_60); // afficher ralentissement 60 - end - else - begin - // si signal suivant est jaune - if ( ((aiguillage[5].position=2) and (aiguillage[3].position<>2) and (aiguillage[1].position<>2)) and - (testBit(EtatSignalCplx[497],jaune)) ) then - Maj_Etat_Signal(signalCplx,jaune_cli) - else - if ( ((aiguillage[5].position<>2) and (aiguillage[2].position<>2)) and - (testBit(EtatSignalCplx[358],jaune)) ) then - Maj_Etat_Signal(signalCplx,jaune_cli) - else - Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; - end; - end; -end; - - -signalCplx:=330; //-------------------------------------------------------------------- -a:=MemZone[521,527] or MemZone[524,521] ; // and (aiguillage[8].position=0)) ; -b:=MemZone[522,527] or MemZone[514,522] or MemZone[518,514] or MemZone[514,522]; // and (aiguillage[8].position=0)) ; ///à voirrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr -PresTrain:=MemZone[527,519] or ( (aiguillage[7].position=2) and (a or b)); - -// aiguilles 2 et 12 mal positionnées ou pas de train - if (aiguillage[2].position=1) or (aiguillage[12].position=2) or (PresTrain=FALSE) then - Maj_Etat_Signal(signalCplx,carre) // mettre un carré} - else - begin - //if (Mem_519_517=true) then - if MemZone[519,517] then - begin - if (testbit(EtatSignalCplx[signalCplx],carre)=FALSE) then Maj_Etat_Signal(signalCplx,semaphore); // sinon mettre un sémaphore} - end - else - begin - if (testbit(EtatSignalCplx[358],carre)) or (testbit(EtatSignalCplx[358],semaphore)) then // si signal complexe suivant est au carré ou sémaphore - Maj_Etat_Signal(signalCplx,jaune) // afficher un avertissement - else - begin - if (aiguillage[11].position<>2) then // si aiguille suivante prise en pointe est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30); // afficher ralentissement - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testbit(EtatSignalCplx[358],jaune) then // si signal suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli) // afficher un avertissement clignotant sur le signal complexe - else Maj_Etat_Signal(signalCplx,vert); // sinon afficher un feu vert - end; - end; - end; - end; - - -// signal 344============================================================*/ -signalCplx:=344; -PresTrain:=(MemZone[525,528] or MemZone[517,525] or MemZone[534,525] or MemZone[538,525]) and (aiguillage[17].position<>2); - -if (((aiguillage[10].position=2) or (aiguillage[10].position<>2) and (aiguillage[19].position=2) and - (aiguillage[22].position<>2) and (aiguillage[24].position<>2)) - or (PresTrain=FALSE) ) then // si aiguillage 10 non dévié ou pas de train avant signal - Maj_Etat_Signal(signalCplx,carre) // mettre un carré} -else -begin - if ( (MemZone[528,518] and (aiguillage[19].position<>2)) or - (MemZone[528,537] and (aiguillage[19].position=2) and (aiguillage[22].position=2)) or - (MemZone[528,538] and (aiguillage[19].position=2) and (aiguillage[22].position<>2)) ) then - begin - if (testbit(EtatSignalCplx[signalCplx],carre)=FALSE) then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if ((aiguillage[19].position<>2) or (aiguillage[22].position<>2)) then // aiguilles locales déviées - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,rappel_30); - // si aiguilles distantes déviée ou signal distant rouge -> avertissement - a:=((aiguillage[19].position<>2) and ((aiguillage[1].position<>2) or testBit(EtatSignalCplx[260],semaphore) or testBit(EtatSignalCplx[260],carre))) ; - b:=((aiguillage[22].position<>2) and ((aiguillage[11].position<>2) or testBit(EtatSignalCplx[477],semaphore) or testBit(EtatSignalCplx[477],carre))) ; - if a or b then begin Maj_Etat_Signal(signalCplx,jaune);end - else - begin - // si signal suivant est jaune - a:=((aiguillage[19].position<>2) and testbit(EtatSignalCplx[260],jaune)) ; - b:=(((aiguillage[19].position=2) and (aiguillage[22].position=2)) and testBit(EtatSignalCplx[420],jaune)) ; - c:=(((aiguillage[19].position=2) and (aiguillage[22].position<>2)) and testBit(EtatSignalCplx[476],jaune)) ; - if (a or b or c) then begin Maj_Etat_Signal(signalCplx,jaune_cli);end; // si signal complexe suivant = jaune - end; - end - else - begin // aiguilles locales non déviées - EtatSignalCplx[signalCplx]:=0; // raz état du signal - a:=((aiguillage[19].position<>2) and (testBit(EtatSignalCplx[260],carre) or testBit(EtatSignalCplx[260],semaphore))) ; - b:=(((aiguillage[19].position=2) and (aiguillage[22].position=2)) and (testBit(EtatSignalCplx[420],carre) or testBit(EtatSignalCplx[434],semaphore))) ; - c:=(((aiguillage[19].position=2) and (aiguillage[22].position<>2)) and (testBit(EtatSignalCplx[476],carre) or testBit(EtatSignalCplx[476],semaphore))) ; - if (a or b or c) then // si signalCplx suivant au rouge - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if aiguillage[11].position<>2 then // avant : 11 si aiguille suivante prise en pointe est déviée - begin - Maj_Etat_Signal(signalCplx,ral_30); // afficher ralentissement - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - a:=((aiguillage[19].position<>2) and testBit(EtatSignalCplx[260],jaune)) ; - b:=((aiguillage[19].position=2) and (aiguillage[22].position=2) and testBit(EtatSignalCplx[420],jaune) ) ; - c:=((aiguillage[19].position=2) and (aiguillage[22].position<>2) and testBit(EtatSignalCplx[476],jaune) ) ; - if (a or b or c) then // si signal suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; -end; - -// signal 358============================================================*/ - signalCplx:=358; - PresTrain:=MemZone[519,517] or MemZone[515,517] or MemZone[520,517] or MemZone[521,527] or MemZone[522,527] or - (MemZone[527,519] and (aiguillage[7].position=2)) or - (MemZone[526,515] and (aiguillage[9].position<>2)) or - (MemZone[527,520] and (aiguillage[7].position<>2) and (aiguillage[20].position<>2) and (aiguillage[12].position=2)) ; - if ((PresTrain=FALSE) or (aiguillage[18].position=2)) then Maj_Etat_Signal(signalCplx,carre) - else - begin - if MemZone[517,524] or MemZone[517,525] then - begin - if (testBit(EtatSignalCplx[signalCplx],carre)=FALSE) then // si train quite zone de détection du signal - Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if (aiguillage[11].position<>2) then // si aiguille locale déviée - begin - EtatSignalCplx[signalCplx]:=0; - Maj_Etat_Signal(signalCplx,rappel_30); // afficher rappel ralentissement - if testBit(EtatSignalCplx[218],semaphore) then // si signal suivant rouge - Maj_Etat_Signal(signalCplx,jaune); - if testBit(EtatSignalCplx[218],jaune) then // si signal suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli); - end - else - begin - EtatSignalCplx[signalCplx]:=0; - if testBit(EtatSignalCplx[274],semaphore) or testBit(EtatSignalCplx[274],carre) then // si signal suivant est jaune - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if TestBit(EtatSignalCplx[274],jaune) then - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; - -// signal 392 ============================================================*/ -signalCplx:=392; -if MemZone[535,533] then // si train quite détection du signal - Maj_Etat_Signal(signalCplx,semaphore) -else - if testBit(EtatSignalCplx[448],carre) or testBit(EtatSignalCplx[448],semaphore) then Maj_Etat_Signal(signalCplx,jaune) - else - if testBit(EtatSignalCplx[448],ral_30) or testBit(EtatSignalCplx[448],jaune) then Maj_Etat_Signal(signalCplx,jaune_cli) - else - Maj_Etat_Signal(signalCplx,vert_cli); - - - -// signal 420 =================================================================== -// signal regroupant 3 voies à revoir -// numéro de la voie en fonction de le position de l'aiguillage -if (aiguillage[25].position=2) then num_voie:=1 else - if (aiguillage[27].position=2) then num_voie:=2 else num_voie:=3; -signalCplx:=420; - -PresTrain:=(num_voie<=2) and MemZone[527,520] and (aiguillage[7].position<>2); -PresTrain:=((num_voie=1) and MemZone[520,529]) or PresTrain; -PresTrain:=((num_voie=2) and MemZone[520,530]) or PresTrain; -PresTrain:=((MemZone[521,527] or MemZone[522,527]) and (aiguillage[7].position<>2)) or PresTrain; -PresTrain:=((num_voie=3) and (MemZone[513,537] or (MemZone[526,513] and (aiguillage[10].position=2) and (aiguillage[19].position=2) and (aiguillage[22].position=2)) or MemZone[528,537] or MemZone[524,537])) or PresTrain; - -//if (((Mem_520_529) &&(num_voie!=1)) || ((Mem_520_530) && (num_voie!=2)) || -// ((Mem_528_537 || Mem_513_537 || Mem_524_537) &&(num_voie!=3)) -// && (aiguillage[31]!=0) || -if (PresTrain=FALSE) then Maj_Etat_Signal(signalCplx,carre) -else -begin - if ( ((num_voie=1) and MemZone[529,534]) or - ((num_voie=2) and MemZone[530,534]) or - ((num_voie=3) and MemZone[537,534]) ) then - begin - if TestBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if testBit(EtatSignalCplx[406],semaphore) or testBit(EtatSignalCplx[406],carre) then // si signal cplx suivant est rouge Maj_Etat_Signal(signalCplx,jaune); - else - begin - if aiguillage[11].position<>2 then // si aiguille suivante est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30) ; - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testBit(EtatSignalCplx[406],jaune_F) or testBit(EtatSignalCplx[406],ral_60_F) then //si signal cplx suivant est jaune ou ralentissement----------- Maj_Etat_Signal(signalCplx,jaune_cli); - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; -end; - - -// signal 448 =================================================================== - signalCplx:=448; - PresTrain:=(MemZone[517,525] and (aiguillage[17].position=2)) or MemZone[525,535] or MemZone[535,533]; - if (aiguillage[24].position=2) or (PresTrain=FALSE) then Maj_Etat_Signal(signalCplx,carre) - else - begin - if MemZone[533,538] then //si train quitte zone de détection du signal - begin - if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if testBit(EtatSignalCplx[476],carre) or testBit(EtatSignalCplx[476],semaphore) then // si signal suivant rouge - begin - Maj_Etat_Signal(signalCplx,jaune); - end - else - begin - if (aiguillage[11].position<>2) then // si aiguille suivante prise en pointe est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30); // afficher ralentissement - end - else - begin // cas si aiguille suivante prise en pointe pas déviée - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testBit(EtatSignalCplx[476],jaune) then //si signal suivant est jaune----------- - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; -end; - -// signal 462 ============================================================*/ -signalCplx:=462; -PresTrain:=MemZone[526,513] or ((MemZone[523,526] or MemZone[518,523]) and (aiguillage[9].position=2)) ; -// si aiguillages pris en talon mal positionnés ou pas de train avant signal -if (aiguillage[10].position<>2) or (aiguillage[29].position<>2) or (PresTrain=FALSE) then - Maj_Etat_Signal(signalCplx,carre) // mettre un carré} -else -begin - // si présence train après le signal (3 directions à tester) et signal <> carré - if ( MemZone[513,518] and (aiguillage[19].position<>2)) or - ( MemZone[513,537] and (aiguillage[19].position=2) and (aiguillage[22].position=2)) or - ( MemZone[513,538] and (aiguillage[19].position=2) and (aiguillage[22].position<>2)) then - begin - if TestBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if (aiguillage[19].position<>0) or (aiguillage[22].position<>2) then // si aiguilles locales déviées - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,rappel_30); - // si aiguilles distantes déviées ou signal distant rouge -> avertissement - a:=(aiguillage[19].position<>2) and ((aiguillage[1].position<>2) or testBit(EtatSignalCplx[260],semaphore) or testBit(EtatSignalCplx[260],carre)); - b:=(aiguillage[22].position<>2) and ((aiguillage[11].position<>2) or testBit(EtatSignalCplx[477],semaphore) or testBit(EtatSignalCplx[477],carre)); - if (a or b) then - Maj_Etat_Signal(signalCplx,jaune) - else - begin // si signal distant est jaune - a:=((aiguillage[19].position<>2) and testBit(EtatSignalCplx[260],jaune)) ; - b:=(((aiguillage[19].position=2) and (aiguillage[22].position=2)) and testbit(EtatSignalCplx[420],jaune)) ; - c:=(((aiguillage[19].position=2) and (aiguillage[22].position<>2)) and testbit(EtatSignalCplx[476],jaune)) ; - if (a or b or c) then Maj_Etat_Signal(signalCplx,jaune_cli); // si signal complexe suivant = jaune - end; - end - else - begin // aiguilles locales en position droite - EtatSignalCplx[signalCplx]:=0; // raz état du signal - a:=((aiguillage[19].position<>0) and testBit(EtatSignalCplx[260],carre) or TestBit(EtatSignalCplx[260],semaphore)) ; - b:=(((aiguillage[19].position<>0) and (aiguillage[22].position=2)) and TestBit(EtatSignalCplx[420],carre) or TestBit(EtatSignalCplx[434],semaphore)) ; - c:=(((aiguillage[19].position=2) and (aiguillage[22].position<>0)) and testbit(EtatSignalCplx[476],carre) or TestBit(EtatSignalCplx[476],semaphore)) ; - if (a or b or c) then // si signalCplx suivant au rouge - Maj_Etat_Signal(signalCplx,jaune) - else - begin - // aiguilles locales en position droite - if (aiguillage[11].position<>2) then // si aiguille suivante prise en pointe est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30); // afficher ralentissement - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - a:=((aiguillage[19].position<>2) and TestBit(EtatSignalCplx[260],jaune)) ; - b:=((aiguillage[19].position=2) and (aiguillage[22].position=2) and TestBit(EtatSignalCplx[420],jaune) ) ; - c:=((aiguillage[19].position=2) and (aiguillage[22].position<>2) and TestBit(EtatSignalCplx[476],jaune) ) ; - if (a or b or c) then // si signal CDM suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; -end; - -// signal 476 ============================================================*/ - signalCplx:=476; - PresTrain:=MemZone[533,538] or MemZone[535,533] or MemZone[525,535]; - PresTrain:=MemZone[528,538] or MemZone[513,538] or MemZone[524,538] or PresTrain; - - if ((((aiguillage[23].position<>2) or (aiguillage[18].position<>2)) or - ((aiguillage[30].position<>2) or (aiguillage[11].position=2) or (aiguillage[23].position=2)) ) or (PresTrain=FALSE)) then Maj_Etat_Signal(signalCplx,carre) - else - begin - if MemZone[538,524] or MemZone[538,525] then //si train quitte signal - begin - if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if (aiguillage[11].position<>2) then // si aiguille locale déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état complet - Maj_Etat_Signal(signalCplx,rappel_30); // afficher rappel ralentissement - if testBit(EtatSignalCplx[218],semaphore) then // si signal suivant rouge - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if testbit(EtatSignalCplx[218],jaune) or testBit(EtatSignalCplx[218],ral_30) then // si signal suivant est jaune ou ral30 begin Maj_Etat_Signal(signalCplx,jaune_cli);end; - end; - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if testbit(EtatSignalCplx[274],jaune) then // si signal suivant est jaune - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end ; - - // signal 497 ============================================================*/ - signalCplx:=497; - //memZone[523,518]:=true; - PresTrain:=MemZone[518,531] or MemZone[523,518] or MemZone[515,518] or MemZone[514,518] or - MemZone[526,523]; - //PresTrain:=true; - //if PresTrain then Affiche('prestrain',clorange); - // équations aiguillages mal positionnés - if ((aiguillage[19].position<>1) or // 1 = dévié - ((aiguillage[19].position=1) and (aiguillage[10].position=2) and (aiguillage[29].position=1) and (aiguillage[30].position<>1)) or - (PresTrain=FALSE)) then - Maj_Etat_Signal(signalCplx,carre) - else - begin - if MemZone[531,528] or MemZone[531,528] or MemZone[531,513] or MemZone[531,524] then //si train quitte signal - begin - if testBit(EtatSignalCplx[signalCplx],carre)=FALSE then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if (aiguillage[10].position<>2) then // si aiguille locale déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état complet - Maj_Etat_Signal(signalCplx,rappel_30); // afficher rappel ralentissement - //if testBit(EtatSignalCplx[xx],semaphore) then // si signal suivant rouge - // Maj_Etat_Signal(signalCplx,jaune) - //else - //begin - // if testbit(EtatSignalCplx[218],jaune) or testBit(EtatSignalCplx[218],ral_30) then // si signal suivant est jaune ou ral30 // begin Maj_Etat_Signal(signalCplx,jaune_cli);end; - //end; - end - else - if (aiguillage[29].position<>2) then - begin - EtatSignalCplx[signalCplx]:=0; // raz état complet - Maj_Etat_Signal(signalCplx,rappel_60); // afficher rappel ralentissement - if testBit(EtatSignalCplx[274],semaphore) then // si signal suivant rouge - Maj_Etat_Signal(signalCplx,jaune) - else if testbit(EtatSignalCplx[274],jaune) then // si signal suivant est jaune ou ral30 - begin Maj_Etat_Signal(signalCplx,jaune_cli);end; - end - else - begin // aiguilles locales non déviées - //EtatSignalCplx[xx]:=0; // raz état du signal - //if testbit(EtatSignalCplx[xx],jaune) then // si signal suivant est jaune - // Maj_Etat_Signal(signalCplx,jaune_cli) - //else - Maj_Etat_Signal(signalCplx,vert); - end; - end; - end ; - - -// signal 600 =====================================================*/ -signalCplx:=600; -PresTrain:=MemZone[524,521] or MemZone[517,524] or MemZone[538,524] or MemZone[534,524]; - -//if ((aiguillage[8].position<>2) or (PresTrain=FALSE)) then Maj_Etat_Signal(signalCplx,carre) -//else - begin - if MemZone[521,527] then - begin - if (testBit(EtatSignalCplx[signalCplx],carre)=FALSE) then Maj_Etat_Signal(signalCplx,semaphore); - end - else - begin - if testBit(EtatSignalCplx[204],semaphore) or testBit(EtatSignalCplx[204],carre) then // si signal cplx suivant est rouge - Maj_Etat_Signal(signalCplx,jaune) - else - begin - if (aiguillage[7].position<>2) then// si aiguille suivante est déviée - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - Maj_Etat_Signal(signalCplx,ral_30) ; - end - else - begin - EtatSignalCplx[signalCplx]:=0; // raz état du signal - if TestBit(EtatSignalCplx[204],jaune) or testBit(EtatSignalCplx[204],ral_60) then //si signal cplx suivant est jaune ou ralentissement----------- - Maj_Etat_Signal(signalCplx,jaune_cli) - else Maj_Etat_Signal(signalCplx,vert); - end; - end; - end; - end; - -end; // de la procédure pilote signaux - -// pilotage d'un signal -procedure envoi_signal(Adr : integer); -var i,adresse,det,a,b,aspect,x,y,x0,y0,TailleX,TailleY,Orientation : integer; - ImageFeu : TImage; - frX,frY : real; - s : string; -begin - i:=index_feu(Adr); - if (ancien_tablo_signalCplx[adr]<>EtatSignalCplx[adr]) then //*** - begin - if feux[i].aspect<10 then // si signal non directionnel - begin - // envoie la commande au décodeur - case feux[i].decodeur of - 0 : envoi_virtuel(Adr); - 1 : envoi_signalBahn(Adr); - 2 : envoi_CDF(Adr); - 3 : envoi_LDT(Adr); - 4 : envoi_LEB(Adr); - 5 : envoi_NMRA(Adr); - 6 : envoi_UniSemaf(Adr); - end; - - // vérifier si on quitte le rouge - if Option_demarrage then - begin - a:=ancien_tablo_signalCplx[adr]; - b:=EtatSignalCplx[adr]; - if ((a=semaphore_F) or (a=carre_F) or (a=violet_F)) and ((b<>semaphore_F) and (b<>carre_F) and (b<>violet_F)) then - if not(Diffusion) then Affiche('On quitte le rouge du signal '+intToSTR(adr),clyellow); - // y a t il un train en face du signal - if cdm_connecte then - begin - det:=feux[i].Adr_det1; - if det<>0 then - begin - // test si train sur le détecteur det - if detecteur[det].etat then - begin - detecteur[det].tempo:=20; // armer la tempo à 2s - // arreter le train - s:=detecteur[det].train; - Affiche('et son détecteur '+IntToSTR(det)+'=1 tempo démarrage '+s,clYellow); - s:=chaine_CDM_vitesse(1,s); // 0% - envoi_cdm(s); - end; - end; - end; - end; - - ancien_tablo_signalCplx[adr]:=EtatSignalCplx[adr]; //*** - - // allume les signaux du feu dans la fenêtre de droite - Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adr,1); - - // allume les signaux du feu dans le TCO - if AvecTCO then - begin - for y:=1 to NbreCellY do - for x:=1 to NbreCellX do - begin - if TCO[x,y].Bimage=30 then - begin - adresse:=TCO[x,y].adresse; // vérifie si le feu existe dans le TCO - a:=EtatsignalCplx[adresse]; // a = état binaire du feu - aspect:=TCO[x,y].aspect; - case aspect of - 2 : ImageFeu:=Formprinc.Image2feux; - 3 : ImageFeu:=Formprinc.Image3feux; - 4 : ImageFeu:=Formprinc.Image4feux; - 5 : ImageFeu:=Formprinc.Image5feux; - 7 : ImageFeu:=Formprinc.Image7feux; - 9 : ImageFeu:=Formprinc.Image9feux; - else ImageFeu:=Formprinc.Image3feux; - end; - x0:=(tco[x,y].x-1)*LargeurCell; // coordonnées XY du feu - y0:=(tco[x,y].y-1)*HauteurCell; - TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) - TailleX:=ImageFeu.picture.BitMap.Width; - Orientation:=TCO[x,y].FeuOriente; - // réduction variable en fonction de la taille des cellules - calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); - - // décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G - if orientation=2 then - begin - if aspect=9 then x0:=x0+round(10*frX); - if aspect=7 then x0:=x0+round(10*frX); - if aspect=5 then begin x0:=x0+round(10*frX);y0:=y0+HauteurCell-round(tailleX*frY); end; - if aspect=4 then begin x0:=x0+round(10*frX);y0:=y0+HauteurCell-round(tailleX*frY); end; - if aspect=3 then begin x0:=x0+round(10*frX);y0:=y0+HauteurCell-round(tailleX*frY); end; - if aspect=2 then begin x0:=x0+round(10*frX);y0:=y0+HauteurCell-round(tailleX*frY); end; - end; - // Dessine_feu_mx(PCanvasTCO,x0,y0,frx,fry,adresse,orientation); - Dessine_feu_mx(PCanvasTCO,tco[x,y].x,tco[x,y].y,frx,fry,adresse,orientation); - end; - end; - end; - end; -end; -end; - -// pilotage des signaux -procedure envoi_signauxCplx; -var i,signalCplx : integer; -begin - //Affiche('Envoi des signaux (envoi_signaixCplx)',ClGreen); - //chaque signal doit être appellé en fonction de sa procédure suivant le décodeur - for i:=1 to NbreFeux do - begin - signalCplx:=feux[i].adresse; - if not(ferme) and (signalCplx<>0) then envoi_signal(signalCplx); - end; -end; - -function virgule_suiv(sl : string;o : integer) : integer; -var k : integer; -begin - o:=o+1; - for k:=o to length(sl) do - begin - // Affiche(sl[k],clGreen); - if sl[k]=',' then begin result:=k;exit;end; - end; - result:=0; -end; - - -// trouve l'enregistrement suivant après l'offset dans une branche -// en sortie : trouve_enregistrement= nouvel offset, enregistrement -// si 0 en sortie: fin de ligne -function trouve_enregistrement_suiv(num_branche : integer;offset : integer) : integer; -var j : integer; - ss : string; -begin - //Affiche(branche[num_branche],clWhite); - j:=virgule_suiv(branche[Num_Branche],offset); // pointe sur la virgule suivante - //Affiche('virgule suivante j='+IntToStr(j),ClOrange); - //Affiche(' j='+IntToStr(j),ClOrange); - if j<>0 then ss:=copy(branche[Num_Branche],offset,j-offset) // champ suivant - else ss:=copy(branche[Num_Branche],offset,length(branche[Num_Branche])-offset+1); // si j=0 c'est la fin de la chaîne - //affiche(ss,clGreen); - enregistrement:=ss; - if j=0 then result:=0 else result:=j+1; -end; - -// trouve l'index d'un détecteur dans une branche -// si pas trouvé, renvoie 0 -function index_detecteur(det,Num_branche : integer) : integer; -var i,adr : integer; - trouve : boolean; - procedure recherche; - begin - repeat - adr:=BrancheN[Num_Branche,i].adresse; - trouve:=(det=adr) and ((BrancheN[Num_Branche,i].Btype=1) or (BrancheN[Num_branche,i].BType=4)); // cherche un détecteur - //Affiche('cherche='+intToSTR(det)+'/explore='+intToSTR(adr)+' Branche='+intToStr(Num_branche)+' index='+intToStr(i),ClWhite); - if not(trouve) then inc(i); - //if trouve then Affiche('Trouvé en branche'+IntToSTR(Num_branche)+' index='+IntToSTR(i),clGreen); - until trouve or (adr=0) ; - end; -begin - i:=1;index2_det:=0; - recherche; - if trouve then result:=i else result:=0; - //affiche(inttostr(ai+1),clOrange); - i:=2; // à voir - //affiche('------------------------',clWhite); - recherche; - //affiche('------------------------',clGreen); - if trouve then index2_det:=i else index2_det:=0; - //affiche('index2='+IntToSTR(index2_det),clWhite); -end; - -// trouve l'index d'un aiguillage dans une branche -// si pas trouvé, renvoie 0 -function index_aiguillage(AdrAig,Num_branche : integer) : integer; -var i,adr : integer; - trouve : boolean; - procedure recherche; - begin - repeat - adr:=BrancheN[Num_Branche,i].adresse; - trouve:=(AdrAig=adr) and ((BrancheN[Num_Branche,i].Btype=2) or (BrancheN[Num_branche,i].BType=3)); // cherche un aiguillage - //Affiche('cherche='+intToSTR(det)+'/explore='+intToSTR(adr)+' Branche='+intToStr(Num_branche)+' index='+intToStr(i),ClWhite); - if not(trouve) then inc(i); - //if trouve then Affiche('Trouvé en branche'+IntToSTR(Num_branche)+' index='+IntToSTR(i),clGreen); - until trouve or (adr=0) ; - end; -begin - i:=1;index2_aig:=0; - recherche; - if trouve then result:=i else result:=0; - //affiche(inttostr(ai+1),clOrange); - i:=2; // à voir - //affiche('------------------------',clWhite); - recherche; - //affiche('------------------------',clGreen); - if trouve then index2_aig:=i else index2_aig:=0; - //affiche('index2='+IntToSTR(index2_det),clWhite); -end; - -// si pas trouvé, IndexBranche_trouve=0 -procedure trouve_detecteur(detecteur : integer); -var NBranche,i : integer; -begin - Nbranche:=1; - i:=1; - repeat - i:=index_detecteur(detecteur,Nbranche); - if i=0 then inc(NBranche); - until (Nbranche>NbreBranches) or (i<>0); - // if (i<>0) and traceDet then Affiche('Détecteur trouvé en branche '+intToSTR(NBranche)+' index='+IntToSTR(i),clYellow); - branche_trouve:=NBranche; - IndexBranche_trouve:=i; -end; - -// si pas trouvé, IndexBranche_trouve=0 -procedure trouve_aiguillage(adresse : integer); -var NBranche,i : integer; -begin - Nbranche:=1; - i:=1; - repeat - i:=index_aiguillage(Adresse,Nbranche); - if i=0 then inc(NBranche); - until (Nbranche>NbreBranches) or (i<>0); - //if (i<>0) then Affiche('aiguillage '+IntToSTR(adresse)+' trouvé en branche '+intToSTR(NBranche)+' index='+IntToSTR(i),clYellow); - branche_trouve:=NBranche; - IndexBranche_trouve:=i; -end; - -procedure lit_config; -var s,sa,chaine,SOrigine: string; - c,paig : char; - tec,tjd,tjs,s2,trouve,triple,debugConfig,multiple,fini,finifeux,trouve_NbDetDist,trouve_ipv4_PC,trouve_retro, - 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_NOTIF_VERSION,trouve_verif_version,trouve_fonte : boolean; - bd,virgule,i_detect,i,erreur,aig,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, - postjd,postjs,nv,it : integer; - function lit_ligne : string ; - begin - repeat - readln(fichier,s); - s:=uppercase(s); - if length(s)>0 then c:=s[1]; - until ((c<>'/') and (s<>'')) or eof(fichier) ; - lit_ligne:=s; - //Affiche(s,clWhite); - end; - procedure compile_section_init; - begin - //initialisation aiguillages - repeat - s:=lit_ligne; - j:=pos(',',s); - if j>1 then - begin - begin - adresse:=StrToINT(copy(s,1,j-1));Delete(s,1,j); // adresse aiguillage - if (adresse>0) and (AvecInitAiguillages=1) then - begin - j:=pos(',',s); - position:=StrToInt(copy(s,1,j-1));Delete(S,1,j);// position aiguillage - if (position<1) or (position>2) then position:=1; - aiguillage[adresse].position:=position; - - // temporisation aiguillage - j:=pos(',',s);if j=0 then j:=length(s); - val(s,temporisation,erreur);Delete(S,1,j); - if (temporisation<0) or (temporisation>10) then temporisation:=5; - aiguillage[adresse].temps:=temporisation; - - val(s,invers,erreur); - if (invers<0) or (invers>1) then invers:=0; // inversion commande - aiguillage[adresse].inversion:=invers; - end; - end; - end; - until (adresse=0); - end; - -begin - debugConfig:=false; - trouve_NbDetDist:=false; - trouve_ipv4_PC:=false; - trouve_retro:=false; - trouve_sec_init:=false; - trouve_init_aig:=false; - trouve_INTER_CAR:=false; - trouve_entete:=false; - trouve_IPV4_INTERFACE:=false; - trouve_lay:=false; - trouve_Tempo_maxi:=false; - trouve_PROTOCOLE_SERIE:=false; - trouve_TCO:=false; - trouve_Serveur_interface:=false; - trouve_cdm:=false; - trouve_NOTIF_VERSION:=false; - trouve_fenetre:=false; - trouve_verif_version:=false; - trouve_Fonte:=false; - - Nb_Det_Dist:=3; - // initialisation des aiguillages avec des valeurs par défaut - for i:=1 to MaxAcc do - begin - Aiguillage[i].modele:=0 ; // sans existence - Aiguillage[i].position:=9; // position inconnue - Aiguillage[i].temps:=5 ; - Aiguillage[i].inversion:=0; - Aiguillage[i].inversionCDM:=0; - Aiguillage[i].objet:=0; - end; - for i:=1 to 1024 do - begin - Detecteur[i].etat:=false; - Detecteur[i].train:='0'; - Ancien_detecteur[i]:=false; - end; - //ChDir(s); - Affiche('lecture du fichier de configuration client-GL.cfg',clyellow); - {$I-} - try - assign(fichier,'client-GL.cfg'); - reset(fichier); - except - Affiche('Fichier client-gl.cfg non trouvé',clred); - end; - {$I+} - nv:=0; it:=0; - {lecture du fichier de configuration} - // taille de fonte - repeat - s:=lit_ligne; - //affiche(s,cllime); - sa:=uppercase(Fonte_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_fonte:=true; - delete(s,i,length(sa)); - TailleFonte:=StrToINT(s); - with FormPrinc.FenRich do - begin - Font.Size:=TailleFonte; - end; - end; - - // adresse ip et port de CDM - sa:=uppercase(IpV4_PC_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_ipv4_PC:=true; - delete(s,i,length(sa)); - i:=pos(':',s); - if i<>0 then begin adresseIPCDM:=copy(s,1,i-1);Delete(s,1,i);portCDM:=StrToINT(s);end; - end; - - // adresse ip et port de la centrale - // AfficheDet:=true; - sa:=uppercase(IPV4_INTERFACE_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_IPV4_INTERFACE:=true; - delete(s,i,length(sa)); - i:=pos(':',s); - if i<>0 then begin adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);end - else begin adresseIP:='0';parSocketLenz:=false;end; - end; - - // configuration du port com - sa:=uppercase(PROTOCOLE_SERIE_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_PROTOCOLE_SERIE:=true; - delete(s,i,length(sa)); - if not(config_com(s)) then Affiche('Erreur port com mal déclaré : '+s,clred); - portcom:=s; - end; - - // temporisation entre 2 caractères - sa:=uppercase(INTER_CAR_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - delete(s,i,length(sa)); - trouve_INTER_CAR:=true; - val(s,TempoOctet,erreur); - if erreur<>0 then Affiche('Erreur temporisation entre 2 octets',clred); - end; - - // temporisation attente maximale interface - sa:=uppercase(TEMPO_MAXI_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - delete(s,i,length(sa)); - trouve_Tempo_maxi:=true; - val(s,TimoutMaxInterface,erreur); - if erreur<>0 then Affiche('Erreur temporisation maximale interface',clred); - end; - - // entete - sa:=uppercase(ENTETE_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - delete(s,i,length(sa)); - trouve_Entete:=true; - val(s,Valeur_entete,erreur); - entete:=''; - case Valeur_entete of - 0 : begin entete:='';suffixe:='';end; - 1 : begin entete:=#$FF+#$FE;suffixe:='';end; - 2 : begin entete:=#228;suffixe:=#13+#13+#10;end; - end; - if (erreur<>0) or (valeur_entete>2) then Affiche('Erreur déclaration variable '+entete_ch,clred); - end; - - // avec ou sans initialisation des aiguillages - sa:=uppercase(INIT_AIG_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - trouve_init_aig:=true; - inc(nv); - delete(s,i,length(sa)); - AvecInitAiguillages:=StrToINT(s); - end; - - sa:=uppercase(fenetre_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_fenetre:=true; - delete(s,i,length(sa)); - val(s,fenetre,erreur); - if fenetre=1 then Formprinc.windowState:=wsMaximized; - end; - - i:=pos(uppercase(section_init),s); - if i<>0 then - begin - inc(nv); - trouve_sec_init:=true; - compile_section_init; - end; - - sa:=uppercase(verif_version_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - trouve_verif_version:=true; - inc(nv); - delete(s,i,length(sa)); - // vérification de la version au démarrage - verifVersion:=true; - val(s,i,erreur); - if erreur=0 then verifVersion:=i=1; - end; - - sa:=uppercase(NOTIF_VERSION_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - delete(s,i,length(sa)); - trouve_NOTIF_VERSION:=true; - // vérification de la version au démarrage - i:=0; - val(s,i,erreur); - notificationVersion:=i=1; - end; - - sa:=uppercase(TCO_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - delete(s,i,length(sa)); - trouve_TCO:=true; - // vérification de la version au démarrage - i:=0; - val(s,i,erreur); - AvecTCO:=i=1; - end; - - sa:=uppercase(CDM_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_CDM:=true; - delete(s,i,length(sa)); - // vérification de la version au démarrage - i:=0; - val(s,i,erreur); - LanceCDM:=i=1; - end; - - sa:=uppercase(LAY_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_lay:=true; - delete(s,i,length(sa)); - lay:=s; - end; - - sa:=uppercase(SERVEUR_INTERFACE_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_serveur_interface:=true; - delete(s,i,length(sa)); - i:=0; - val(s,i,erreur); - ServeurInterfaceCDM:=i; - end; - - sa:=uppercase(RETRO_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_retro:=true; - delete(s,i,length(sa)); - i:=0; - val(s,i,erreur); - ServeurRetroCDM:=i; - end; - - sa:=uppercase(nb_det_dist_ch)+'='; - i:=pos(sa,s); - if i<>0 then - begin - inc(nv); - trouve_NbDetDist:=true; - delete(s,i,length(sa)); - i:=0; - val(s,i,erreur); - if i<2 then begin i:=2;Affiche('Attention '+nb_det_dist_ch+' ramené à '+IntToSTR(i),clOrange); end; - Nb_Det_Dist:=i; - end; - inc(it); - - until (Nv>=18) or (it>30); - - //affiche(IntToSTR(Nv)+' variables',cyan); - s:=''; - if (it>30) then s:='ERREUR: manque variables dans config-gl.cfg :'; - - if not(trouve_NbDetDist) then s:=s+' '+nb_det_dist_ch; - if not(trouve_ipv4_PC) then s:=s+' '+IpV4_PC_ch; - if not(trouve_retro) then s:=s+' '+retro_ch; - if not(trouve_sec_init) then s:=s+' '+section_init; - if not(trouve_init_aig) then s:=s+' '+INIT_AIG_ch; - if not(trouve_lay) then s:=s+' '+LAY_ch; - if not(trouve_INTER_CAR) then s:=s+' '+INTER_CAR_ch; - if not(trouve_Tempo_maxi) then s:=s+' '+Tempo_maxi_ch; - if not(trouve_Entete) then s:=s+' '+Entete_ch; - if not(trouve_TCO) then s:=s+' '+TCO_ch; - if not(trouve_CDM) then s:=s+' '+CDM_ch; - if not(trouve_Serveur_interface) then s:=s+' '+Serveur_interface_ch; - if not(trouve_fenetre) then s:=s+' '+fenetre_ch; - if not(trouve_NOTIF_VERSION) then s:=s+' '+NOTIF_VERSION_ch; - if not(trouve_verif_version) then s:=s+' '+verif_version_ch; - if not(trouve_fonte) then s:=s+' '+fonte_ch; - - if s<>'' then affiche(s,clred); - - //Affiche('Valeurs d''initialisation des aiguillages',clyellow); - - closefile(fichier); - - Affiche('lecture du fichier de configuration config.cfg',clyellow); - try - assign(fichier,'config.cfg'); - reset(fichier); - except - Affiche('Fichier config.cfg non trouvé',clred); - end; - - s:=Lit_ligne; //variable log non utilisée - s:=Lit_ligne; // trace_det - s:=Lit_ligne; // raz signaux - Raz_Acc_signaux:=pos('1',s)<>0; - if Raz_Acc_signaux then Affiche('Avec Raz commande signaux',clYellow); - Affiche('Définition des aiguillages',clyellow); - - // définition des aiguillages - maxaiguillage:=0; - Nligne:=1; - repeat - s:=lit_ligne;sOrigine:=s;inc(Nligne); - //Affiche(s,ClLime); - //chaine:=s; - if debugconfig then Affiche(s,ClLime); - if (s<>'0') then - begin - virgule:=pos(',',s); - enregistrement:=copy(s,1,virgule-1); // adresse de l'aiguillage [TRI] - delete(s,1,virgule); - postriple:=pos('TRI',enregistrement);triple:=postriple<>0;if triple then delete(enregistrement,postriple,3); - postjd:=pos('TJD',enregistrement);tjd:=postjd<>0;if tjd then delete(enregistrement,postjd,3); - postjs:=pos('TJS',enregistrement);tjs:=postjs<>0;if tjs then delete(enregistrement,postjs,3); - - // adresse de l'aiguillage - Val(enregistrement,aig,erreur); // aig = adresse de l'aiguillage - if erreur<>0 then Affiche('Erreur aiguillage '+intToSTR(aig)+' ; caractère '+enregistrement[erreur]+' inconnu',clred); - if aig>maxaiguillage then maxaiguillage:=aig; - if debugConfig then Affiche('Adresse='+IntToSTR(aig)+' enregistrement='+Enregistrement,clyellow); - - aiguillage[aig].AdroitB:='Z'; aiguillage[aig].AdevieB:='Z'; - aiguillage[aig].DdroitB:='Z'; aiguillage[aig].DdevieB:='Z'; - - aiguillage[aig].ApointeB:='Z'; - aiguillage[aig].Adevie2B:='Z'; - - if (triple) then aiguillage[aig].modele:=4; - if (tjs) then - begin - aiguillage[aig].modele:=3 - end; - if (tjd) then - begin - aiguillage[aig].modele:=2 ; - end; - if not(tjs) and not(tjd) and not(triple) then - begin - aiguillage[aig].modele:=1; - end; - //if debugConfig then Affiche(s,clyellow); - - if (triple) then - begin - Val(s,aig2,erreur); // aig = 2eme adresse de l'aiguillage - aiguillage[aig].AdrTriple:=aig2; - virgule:=pos(',',s); - delete(s,1,virgule); - end; - ComptEl:=0;Compt_It:=0;Num_element:=Num_element+1; - // préparer l'enregistrement pour la boucle de ligne - virgule:=pos(',',s); - if tjd then enregistrement:=s else - begin - enregistrement:=copy(s,1,virgule-1); - delete(s,1,virgule); - end; - - //Affiche('S='+s,clyellow); - //debugconfig:=true; - - repeat // parcoure la ligne - if (debugConfig) then Affiche('boucle de ligne: '+s,clYellow); - if (length(enregistrement)<>0) then - if (enregistrement[1]='P') then - begin - if tjd then begin affiche('Erreur P interdit dans une TJD : '+sOrigine,clred);closefile(fichier);exit; end; - if debugconfig then Affiche('Section P - enregistrement='+enregistrement,clYellow); - ComptEl:=ComptEl+1; - decodeAig(enregistrement,detect,c); - if c='' then c:='Z'; - aiguillage[aig].Apointe:=detect; - aiguillage[aig].ApointeB:=c; - - virgule:=pos(',',s);if virgule=0 then virgule:=length(s)+1; - enregistrement:=copy(s,1,virgule-1); - delete(s,1,virgule); - - end; - - if (length(enregistrement)<>0) then // section droite - if (enregistrement[1]='D') then - begin - if debugconfig then Affiche('Section D - enregistrement='+enregistrement,clYellow); - ComptEl:=ComptEl+1; - - if tjd then - begin - s:=Enregistrement; - Delete(s,1,2); - decodeAig(s,detect,c); - aiguillage[aig].Adroit:=detect; - aiguillage[aig].AdroitB:=c; - i:=pos(',',s);Delete(s,1,i); - decodeAig(s,detect,c); - aiguillage[aig].DDroit:=detect; - aiguillage[aig].DdroitB:=c; - i:=pos(')',enregistrement);if i=0 then begin Affiche('Erreur de syntaxe ligne '+SOrigine,clred);closefile(fichier);exit;end; - Delete(enregistrement,1,i+1); - i:=pos(')',s); delete(s,1,i); - // mettre en forme s - i:=pos(')',s); delete(s,1,i); - i:=pos(',',s); delete(s,1,i); - - //Affiche(enregistrement,clBlue); - end - else - begin - decodeAig(enregistrement,detect,c); - if c='' then c:='Z'; - aiguillage[aig].Adroit:=detect; - aiguillage[aig].AdroitB:=c; - - virgule:=pos(',',s);if virgule=0 then virgule:=length(s)+1; - enregistrement:=copy(s,1,virgule-1); - delete(s,1,virgule); - end; - end; - - if (length(enregistrement)<>0) then - if (enregistrement[1]='S') then - begin - if debugconfig then Affiche('Section S - enregistrement='+enregistrement,clYellow); - ComptEl:=ComptEl+1; - - if tjd then - begin - Delete(enregistrement,1,2); - decodeAig(enregistrement,detect,c); - aiguillage[aig].Adevie:=detect; - aiguillage[aig].AdevieB:=c; - i:=pos(',',enregistrement);Delete(enregistrement,1,i); - decodeAig(enregistrement,detect,c); - aiguillage[aig].DDevie:=detect; - aiguillage[aig].DDevieB:=c; - i:=pos(')',enregistrement);if i=0 then begin Affiche('Erreur de syntaxe ligne '+SOrigine,clred);closefile(fichier);exit;end; - Delete(enregistrement,1,i+1); - // mettre en forme s - i:=pos(')',s); delete(s,1,i); - i:=pos(',',s); delete(s,1,i); - - //Affiche(enregistrement,clBlue); - end - else - begin - delete(enregistrement,1,1); // supprime le S - erreur:=pos('2-',enregistrement); - S2:=erreur<>0; - if (S2) then delete(enregistrement,erreur,2); - - erreur:=pos('S2',enregistrement); // description d'un rattachement à la branche S2 d'un aiguillage triple - tec:=erreur<>0; // ne supprimer que le 2 - if (tec) then delete(enregistrement,erreur+1,1); - - val(enregistrement,detect,erreur); // extraction de l'adresse - //if ((detect=0) and (erreur=0)) then Affiche('Erreur pas d''adresse dans section S: '+s,clred); - c:='Z'; - if (erreur<>0) then begin delete(enregistrement,1,erreur-1);c:=enregistrement[1];end; - - if not(S2) and not(tec) then begin aiguillage[aig].Adevie:=detect;aiguillage[aig].AdevieB:=c;end; - if S2 and not(tec) then begin aiguillage[aig].Adevie2:=detect;aiguillage[aig].Adevie2B:=c;end; - if S2 and tec then begin aiguillage[aig].Adevie2:=detect;aiguillage[aig].Adevie2B:='T';end; - - virgule:=pos(',',s);if virgule=0 then virgule:=length(s)+1; - enregistrement:=copy(s,1,virgule-1); - delete(s,1,virgule); - end; - end; - - if (length(enregistrement)<>0) then - if (enregistrement[1]='I') then - begin - delete(enregistrement,1,1); - Val(enregistrement,adr,erreur); - enregistrement:=''; - //Affiche(intTostr(adr),clblue); - Aiguillage[aig].inversionCDM:=adr; - end; - - //Affiche(s+'/'+Enregistrement,clLime); - // si vitesse définie - Val(enregistrement,adr,erreur); - if erreur=0 then - begin - //Affiche('section vitesse définie aig='+intToSTR(aig)+'/'+intToSTR(adr),clyellow); - aiguillage[aig].vitesse:=adr; - enregistrement:=''; - virgule:=pos(',',s);if virgule=0 then virgule:=length(s)+1; - enregistrement:=copy(s,1,virgule-1); - delete(s,1,virgule); - s:='';enregistrement:=''; - end; - - until enregistrement='' ; - end; - // Affiche(s,clLime); - until (s='0'); - //Affiche(IntToSTR(maxaiguillage)+' Aiguillages',clYellow); - - - Affiche('définition des branches',clyellow); - // branches de réseau - NDetecteurs:=0; Nligne:=1; - i:=1;i_detect:=1; - repeat - s:=lit_ligne; - mod_Branches[Nligne]:=s;inc(Nligne); - //Affiche(s,clWhite); - - if s<>'0' then - begin - branche[i]:=s; - j:=1;offset:=1; - repeat - BrancheN[i,j].adresse:=0; // préparer le suivant à 0 - offset:=trouve_enregistrement_suiv(i,offset) ; - // décoder l'enregistrement - // si c'est un détecteur, fini trouvé - //affiche(enregistrement,clred); - Val(enregistrement,detect,erreur); // détermine si le champ est numérique ou pas (cad si aiguillage) - //Affiche(enregistrement+'detect='+intToSTR(detect),clyellow); - - // il y a un aiguillage ou un espace après le champ....en fin de ligne - if erreur<>0 then - begin - c:=enregistrement[1]; - delete(enregistrement,1,1); - if c='A' then - begin - Val(enregistrement,adresse,erreur2); - //Affiche(IntToSTR(adresse),clyellow); - BrancheN[i,j].adresse:=adresse; - k:=pos('B',enregistrement); - if k=0 then BrancheN[i,j].btype:=2 else BrancheN[i,j].btype:=3; // ident aiguillage - end - else erreur:=0; // forcer erreur à 0 pour obliger à passer sur un détecteur - end; - - // détecteur - if erreur=0 then - begin - //Affiche(IntToSTR(detect),clyellow); - //Affiche(s,clorange); Affiche(IntToStr(detect),clorange); - //if detect=0 then affiche('buttoir'+sOrigine,clyellow); - BrancheN[i,j].adresse:=detect; // adresse - BrancheN[i,j].btype:=1;// ident détecteur - if detect=0 then begin BrancheN[i,j].btype:=4;end; // buttoir - //if j=1 then Affiche('Erreur la ligne doit commencer par un aiguillage: '+s,clred); - //if (offset=-1) then Affiche('Erreur la ligne soit se terminer par un aiguillage:'+s,clred); - // vérifier si le détecteur est déja stocké - bd:=0; - repeat - inc(bd); - trouve:=Adresse_detecteur[bd]=detect; - until ((bd=NDetecteurs+1) or trouve) ; - if not(trouve) then - begin - Adresse_detecteur[bd]:=detect; - NDetecteurs:=bd; - end; - end; - inc(j); - BrancheN[i,j].adresse:=0; // préparer le suivant à 0 - //Affiche('branche '+intToSTR(i)+' index='+intToStr(j),clGreen); - until (offset=0); - inc(i); - end; - until (s='0'); - NbreBranches:=i-1; - // Affiche(IntToSTR(NbreBranches)+' branches',clYellow); - - // feux - Affiche('Définition des feux',clyellow); - i:=1;Nligne:=1; - repeat - s:=lit_ligne; - if s<>'0' then - begin - chaine:=s; inc(Nligne); - //Affiche(s,clYellow); - finifeux:=s[1]='0'; - if not(finifeux) then - begin - chaine:=s; - j:=pos(',',s); - if j>1 then - begin - adresse:=StrToINT(copy(s,1,j-1));Delete(s,1,j); // adresse de feu - feux[i].adresse:=adresse; - j:=pos(',',s); - if j>1 then - begin - sa:=copy(s,1,j-1); - if sa[1]='D' then - // feu directionnel ------------------------------------------ - begin - delete(sa,1,1); - j:=pos(',',s); - l:=StrToInt(sa); // nombre de feux du signal directionnel - if l>6 then - begin - Affiche('Ligne '+s+' 6 feux maximum pour un panneau directionnel',clred); - exit; - end; - feux[i].aspect:=l+10;Delete(s,1,j); - // décodeur - val(s,adr,erreur); - Feux[i].decodeur:=adr; - j:=pos(',',s);Delete(s,1,j); - //Affiche(s,clYellow); - //s:='(A19D,A22D)(A19D,A22S)'; - // liste des aiguillages - k:=1; // numéro de feu directionnel - repeat - // boucle de direction - delete(s,1,1); // supprimer ( ou le , - j:=1; // Nombre de descriptions d'aiguillages dans le feu - //Affiche('Boucle de Ligne',clyellow); - //Affiche(s,clOrange); - repeat - //Affiche('Boucle de direction',clyellow); - //Affiche(s,clOrange); - if s[1]<>'A' then begin Affiche('Erreur a la ligne '+s,clred);exit;end; - delete(s,1,1); - val(s,adr,erreur); // adresse - c:=s[erreur]; // type - setlength(feux[i].AigDirection[k],j+1); // augmenter le tableau dynamique - feux[i].AigDirection[k][j].PosAig:=c; - feux[i].AigDirection[k][j].Adresse:=adr; - - // Affiche(intToSTR(Adr)+c,clyellow); - // Affiche(intToSTR(erreur),clOrange); - delete(s,1,erreur); // supprime jusque S - //Affiche(s,clLime); - if s[1]=',' then delete(s,1,1); - inc(j); - until s[1]=')'; - delete(s,1,1); - inc(k); - until length(s)<1; - dec(k); - if k<>l+1 then - begin - Affiche('Ligne '+chaine,clred); - Affiche('Nombre incorrect de description des aiguillages: '+intToSTR(k)+' pour '+intToSTR(l)+' feux directionnels',clred); - end; - - end - else - // feu de signalisation--------------------------------- - begin - k:=StrToInt(sa); //aspect - feux[i].aspect:=k;Delete(s,1,j); - if (k=0) or (k=6) or (k>9) then - Affiche('Fichier config.cfg: configuration aspect ('+intToSTR(k)+') feu incorrecte à la ligne '+chaine,clRed); - j:=pos(',',s); - if j>1 then begin Feux[i].FeuBlanc:=(copy(s,1,j-1))='1';delete(s,1,j);end; - j:=pos(',',s); - if j=0 then begin Feux[i].decodeur:=StrToInt(s);end else begin Feux[i].decodeur:=StrToInt(copy(s,1,j-1));delete(s,1,j);end; - 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:=0;feux[i].Btype_Suiv2:=0;feux[i].Btype_Suiv3:=0;feux[i].Btype_Suiv4:=0; - feux[i].Adr_det1:=0;feux[i].Adr_det2:=0;feux[i].Adr_det3:=0;feux[i].Adr_det4:=0; - // éléments optionnels des voies supplémentaires - if j<>0 then - begin - //Affiche('Entrée:s='+s,clyellow); - sa:=s; - multiple:=s[1]='('; - if multiple then - begin - delete(s,1,1); - j:=0; - repeat - k:=pos(',',s); - if k>1 then - begin - val(s,adr,erreur); // extraire l'adresse - Delete(s,1,k); - end; - //Affiche('Adr='+IntToSTR(adr)+' ' +intToSTR(erreur),clyellow); - //Affiche('S avec premier champ supprimé='+s,clyellow); - inc(j); - if (j=1) then feux[i].Adr_det1:=adr; - if (j=2) then feux[i].Adr_det2:=adr; - if (j=3) then feux[i].Adr_det3:=adr; - if (j=4) then feux[i].Adr_det4:=adr; - //type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri - t:=0; - if s[1]='A' then - begin - t:=2; - //Affiche('détecté aiguillage',clyellow); - if (j=1) then feux[i].Btype_Suiv1:=2; - if (j=2) then feux[i].Btype_Suiv2:=2; - if (j=3) then feux[i].Btype_Suiv3:=2; - if (j=4) then feux[i].Btype_Suiv4:=2; - delete(s,1,1); - end; - l:=pos('TRI',s); - if l<>0 then - begin - t:=4; - delete(s,l,3); - //Affiche('détecté aiguillage tri',clyellow); - if (j=1) then feux[i].Btype_Suiv1:=4; - if (j=2) then feux[i].Btype_Suiv2:=4; - if (j=3) then feux[i].Btype_Suiv3:=4; - if (j=4) then feux[i].Btype_Suiv4:=4; - end; - - if t=0 then //détecteur - begin - if (j=1) then feux[i].Btype_Suiv1:=1; - if (j=2) then feux[i].Btype_Suiv2:=1; - if (j=3) then feux[i].Btype_Suiv3:=1; - if (j=4) then feux[i].Btype_Suiv4:=1; - end; - Val(s,adr,erreur); - //Affiche('Adr='+IntToSTR(Adr),clyellow); - if (j=1) then feux[i].Adr_el_suiv1:=Adr; - if (j=2) then feux[i].Adr_el_suiv2:=Adr; - if (j=3) then feux[i].Adr_el_suiv3:=Adr; - if (j=4) then feux[i].Adr_el_suiv4:=Adr; - delete(s,1,erreur-1); - if s[1]=',' then delete(s,1,1); - //Affiche('S en fin de traitement s='+s,clyellow); - fini:=s[1]=')'; - until (fini) or (j>4); - //if fini then Affiche('fini',clyellow); - end; - end; - if (j>4) or (not(multiple)) then begin Affiche('Erreur: fichier de configuration ligne erronnée : '+chaine,clred); closefile(fichier);exit;end; - - k:=pos(',',s); - delete(s,1,k); - //Affiche('s='+s,clyellow); - feux[i].VerrouCarre:=s[1]='1'; - delete(s,1,1); - // si décodeur UniSemaf (6) champ supplémentaire - if Feux[i].decodeur=6 then - begin - k:=pos(',',s); - if k=0 then begin Affiche('Ligne '+chaine,clred);Affiche('Manque définition de la cible pour le décodeur UniSemaf',clred);end - else - begin - Delete(S,1,k); - Val(s,k,erreur); - Feux[i].UniSemaf:=k; - end; - end; - end; - // voir si conditions supplémentaires de carré - l:=1; // nombre de parenthèses - repeat - t:=pos('(',s); - if t<>0 then - 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 - //Affiche(sa,clLime); - delete(s,1,k);//Affiche(s,clYellow); - // boucle dans la parenthèse - bd:=0; - repeat - inc(bd); - setlength(feux[i].condCarre[l],bd+1); // une condition en plus - k:=pos(',',sa); - if k<>0 then - chaine:=copy(sa,1,k-1) - else - chaine:=sa; - - if chaine[1]='A' then - begin - delete(chaine,1,1); - //Affiche(chaine,ClOrange); - val(chaine,adresse,erreur); - feux[i].condCarre[l][bd].Adresse:=adresse; - if erreur<>0 then feux[i].condCarre[l][bd].PosAig:=chaine[erreur] else - Affiche('Définition du feu '+IntToSTR(feux[i].adresse)+': Manque D ou S dans les conditions de carré des aiguillages',clred); - end; - - k:=pos(',',sa);if k<>0 then delete(sa,1,k); - //Affiche(sa,clyellow); - until k=0; - //Affiche('Longueur tableau '+IntToSTR(l)+':'+intToSTR(length(feux[i].condCarre[l])),clyellow); - inc(l); - end; - until t=0; - end; - inc(i); - end; - end; - end; - until (finifeux) or (s='0'); - NbreFeux:=i-1; if NbreFeux<0 then NbreFeux:=0; - //Affiche('Nombre de feux='+IntToSTR(NbreFeux),clYellow); - - configNulle:=(maxAiguillage=0) and (NbreBranches=0) and (Nbrefeux=0); - if configNulle then Affiche('Fonctionnement en config nulle',ClYellow); - - // raz des actionneurs - for i:=1 to maxTablo_act do - begin - Tablo_actionneur[i].train:=''; - Tablo_actionneur[i].etat:=0; - Tablo_actionneur[i].actionneur:=0; - Tablo_actionneur[i].accessoire:=0; - Tablo_actionneur[i].sortie:=0; - end; - - // définition des actionneurs - maxTablo_act:=1; - NbrePN:=0;Nligne:=1; - repeat - s:=lit_ligne; - // vérifier si F ou A au 4eme champ - sa:=s; - i:=pos(',',sa); - if i>0 then delete(sa,1,i) else s:='0'; - i:=pos(',',sa); - if i>0 then delete(sa,1,i) else s:='0'; - i:=pos(',',sa); - if i>0 then delete(sa,1,i) else s:='0'; - - mod_act[Nligne]:=s;inc(Nligne); - - if length(sa)>1 then if (sa[1]='A') then - // -----------------accessoire - begin - // 815,1,CC406526,A600,1 - i:=pos(',',s); - if i<>0 then - begin - val(copy(s,1,i-1),j,erreur); - Tablo_actionneur[maxTablo_act].actionneur:=j; - Delete(s,1,i); - i:=pos(',',s); - if i<>0 then - begin - i:=pos(',',s); - val(copy(s,1,i-1),j,erreur); - Tablo_actionneur[maxTablo_act].etat:=j; - Delete(s,1,i); - - i:=pos(',',s); - Tablo_actionneur[maxTablo_act].train:=copy(s,1,i-1); - Delete(s,1,i); - - i:=pos('A',s); - if i<>0 then - begin - Delete(s,1,1); - val(s,j,erreur); - Tablo_actionneur[maxTablo_act].Accessoire:=j; - - i:=pos(',',s); - if i<>0 then - begin - Delete(S,1,i); - val(s,j,erreur); - Tablo_actionneur[maxTablo_act].sortie:=j; - end; - - i:=pos(',',s); - if i<>0 then - begin - Delete(S,1,i); - Tablo_actionneur[maxTablo_act].RAZ:=s[1]='Z'; - inc(maxTablo_act); - end; - - end; - s:='';i:=0; - end; - end; - - end; - - if length(sa)>1 then if (sa[1]='F') then - // -----------------fonction - begin - // 815,1,CC406526,F2,450 - i:=pos(',',s); - if i<>0 then - begin - val(copy(s,1,i-1),j,erreur); - Tablo_actionneur[maxTablo_act].actionneur:=j; - Delete(s,1,i); - i:=pos(',',s); - if i<>0 then - begin - i:=pos(',',s); - val(copy(s,1,i-1),j,erreur); - Tablo_actionneur[maxTablo_act].etat:=j; - Delete(s,1,i); - - i:=pos(',',s); - Tablo_actionneur[maxTablo_act].train:=copy(s,1,i-1); - Delete(s,1,i); - - i:=pos('F',s); - if i<>0 then - begin - Delete(s,1,1); - val(s,j,erreur); - Tablo_actionneur[maxTablo_act].Fonction:=j; - - i:=pos(',',s); - if i<>0 then - begin - Delete(S,1,i); - val(s,j,erreur); - Tablo_actionneur[maxTablo_act].Tempo:=j; - inc(maxTablo_act); - end; - end; - s:='';i:=0; - end; - end; - end; - - // Passage à niveau - // (815,820),(830,810)...,PN(121+,121-) - // (815,809),PN(121+,121-) - if (pos('PN',s)<>0) then - begin - inc(NbrePN); - NbreVoies:=0; - repeat - inc(NbreVoies); - //Affiche('NbreVoies='+intToSTR(NbreVoies),clyellow); - //SetLength(Tablo_PN[1].Voie,1); - Delete(s,1,1); // supprime ( - val(s,j,erreur); - - Tablo_PN[NbrePN].voie[NbreVoies].ActFerme:=j; - - // Affiche('Ferme='+intToSTR(j),clyellow); - i:=pos(',',s);Delete(S,1,i); - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].ActOuvre:=j; - // Affiche('Ouvre='+intToSTR(j),clyellow); - 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); - - Tablo_PN[NbrePN].NbVoies:=NbreVoies; - Delete(s,1,3); // Supprime PN( - val(s,j,erreur); - Tablo_PN[NbrePN].Adresseferme:=j; - Delete(s,1,erreur-1); - if s[1]='+' then Tablo_PN[NbrePN].CommandeFerme:=2; - if s[1]='-' then Tablo_PN[NbrePN].CommandeFerme:=1; - Delete(s,1,2); // supprime +, - - val(s,j,erreur); - Tablo_PN[NbrePN].AdresseOuvre:=j; - Delete(s,1,erreur-1); - if s[1]='+' then Tablo_PN[NbrePN].CommandeOuvre:=2; - if s[1]='-' then Tablo_PN[NbrePN].CommandeOuvre:=1; - Delete(s,1,1); // supprime ) - inc(maxTablo_act); - i:=0; - end; - if pos('PN',s)<>0 then i:=0; - until (s='0'); - dec(maxTablo_act); - - closefile(fichier); - // vérification de la cohérence1 - // parcoure les branches jusqu'à trouver un aiguillage pour voir s'il a été décrit - for i:=1 to NbreBranches do - begin - j:=1; - repeat - detect:=BrancheN[i][j].Adresse; - modele:=BrancheN[i][j].BType; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir - j:=j+1; - until ( (modele=1) or (modele=2) or (modele=3) or ((modele=0) and (detect=0))); - // trouvé un aiguillage et récupéré son adresse dans detect - //if (type!=1) Display("Erreur aucun détecteur dans la déclaration du réseau\r\n"); - if (modele=1) or (modele=2) or (modele=3) then - begin - modele:=aiguillage[detect].modele; - if (modele=0) then Affiche('Erreur 1: Aiguillage='+intToStr(detect)+' non décrit mais présent dans la description des branches '+intToStr(i)+'/'+intToSTR(j),clred); - end; - end; - - // vérification de la cohérence2 - // parcoure les aiguillages pour voir si les détecteurs sont en branches des détecteurs - // et les tjd pour voir si pb de cohérence - for aig:=1 to maxaiguillage do - begin - // tjd - if aiguillage[aig].modele=2 then - begin - if aiguillage[aig].Ddroit<>aiguillage[aig].Ddevie then - Affiche('Erreur 7: la TJD '+IntToStr(aig)+' a des adresses de destination différentes ('+intToSTR(aiguillage[aig].Ddroit)+' et '+intToSTR(aiguillage[aig].Ddevie)+')',clred); - // vérifier si son homologue est une tjd - adr2:=aiguillage[aig].Ddroit; - if aiguillage[adr2].modele<>2 then Affiche('Erreur 8: l''aiguillage '+intToStr(Adr2)+' n''est pas une TJD, mais apparait dans la TJD '+IntToSTR(aig),clred); - end; - // vérifier si l'aiguillage est dans les branches - if aiguillage[aig].modele<>0 then - begin - trouve_aiguillage(aig); - if (IndexBranche_trouve=0) then - Affiche('Erreur 6: aiguillage '+intToSTR(aig)+' décrit dans les aiguillages mais absent dans la description des branches',clred); - end; - adr:=aiguillage[aig].Adroit; - if (aiguillage[aig].AdroitB='Z') then - begin - trouve_detecteur(adr); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - Affiche('Erreur 2: détecteur '+intToSTR(adr)+' décrit dans l''aiguillage '+intToSTR(aig)+' mais absent dans la description des branches',clred); - end; - adr:=aiguillage[aig].Adevie; - if (aiguillage[aig].AdevieB='Z') then - begin - trouve_detecteur(adr); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - Affiche('Erreur 3: détecteur '+intToSTR(adr)+' décrit dans l''aiguillage '+intToSTR(aig)+' mais absent dans la description des branches',clRed); - end; - adr:=aiguillage[aig].Apointe; - if ((aiguillage[aig].ApointeB='Z') and (aiguillage[aig].modele=1)) then - begin - trouve_detecteur(adr); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - Affiche('Erreur 4 : détecteur '+intToSTR(adr)+' décrit dans l''aiguillage '+intToSTR(aig)+' mais absent dans la description des branches',clRed); - end; - if (aiguillage[aig].modele=4) then // aiguillage triple - begin - if (aiguillage[aig].Adevie2B='Z') then - begin - adr:=aiguillage[aig].Adevie2; - trouve_detecteur(adr); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - Affiche('Erreur 5 : détecteur '+intToSTR(adr)+' décrit dans l''aiguillage '+intToSTR(aig)+' mais absent dans la description des branches',clRed); - end; - end; - end; -end; - -// front descendant sur un détecteur -function detecteur_0(adresse : integer) : boolean; -begin - detecteur_0:=(Ancien_detecteur[adresse]=true) and ((detecteur[adresse].etat)=false); - Ancien_detecteur[adresse]:=detecteur[adresse].etat; -end; - -function detecteur_1(adresse : integer) : boolean; -begin - detecteur_1:=(Ancien_detecteur[adresse]=false) and ((detecteur[adresse].etat)=true); - Ancien_detecteur[adresse]:=detecteur[adresse].etat; -end; - -// trouve un élément dans les branches à partir de la branche offset renvoie branche_trouve IndexBranche_trouve -// el : adresse de l'élément TypeEL=(1=détécteur 2=aig 3=aig Bis 4=aig triple) -procedure trouve_element(el, TypeEl, Offset : integer); -var i,Btype,adr,Branche : integer ; - s : string; - sort : boolean; -begin - //Affiche('cherche'+IntToSTR(el)+'/'+IntToSTR(TypeEl),clred); - Branche:=Offset; - branche_trouve:=0; - IndexBranche_trouve:=0; - i:=1; - repeat - adr:=BrancheN[Branche,i].Adresse; - Btype:=BrancheN[Branche,i].BType; - //Affiche(IntToSTR(adr)+'/'+IntToSTR(BType),clred); - if ((adr=0) and (Btype=0)) then begin inc(Branche);i:=0;end; - inc(i); - sort:=(Branche>NbreBranches) or // 1= détecteur 2= aiguillage 3=bis 4=Buttoir - ((adr=el) and (TypeEl=4) and (Btype=2)) or //typeEl=4=aig triple - ((adr=el) and (TypeEl=3) and (Btype=3)) or - ((adr=el) and (TypeEl=2) and (Btype=2)) or - ((adr=el) and (TypeEl=1) and (Btype=1)) or - ((adr=el) and (TypeEl=1) and (Btype=4)) ; //buttoir - until (sort); - if (adr=el) then - begin - branche_trouve:=Branche; - IndexBranche_trouve:=i-1; - //Affiche('trouvé',clgreen); - end - else begin s:='Erreur 175 - élément '+intToSTR(el); - s:=s+' non trouvé';Affiche(s,clred); - branche_trouve:=0; IndexBranche_trouve:=0; - if NivDebug>=1 then AfficheDebug(s,clred); - end; -end; - - -// renvoie élément suivant entre deux éléments quels qu'ils soient mais contigus -// et en variables globales: typeGen le type de l'élément -// s'ils ne sont pas contigus, on aura une erreur -// alg= algorithme : -// 1=arret sur suivant qu'il soit un détecteur ou un aiguillage -// 2=arret sur aiguillage en talon mal positionné -// 3=arret sur un aiguillage pris en pointe dévié et AdrDevie contient l'adresse de l'aiguillage dévié ainsi que typeGen -// code de sortie : élément suivant ou: -// 9999=erreur fatale ou itération trop longue -// 9998= arret sur aiguillage en talon mal positionnée -// 9997: arrêt sur aiguillage dévié -// 9996: arrêt sur position inconnue d'aiguillage -// typeGen : 1=detecteur 2=aiguillage 3=aiguillage bis -function suivant_alg3(prec : integer;typeELprec : integer;var actuel : integer;typeElActuel : integer;alg : integer) : integer; -var Btype,Adr,AdrPrec,BtypePrec,indexBranche_prec,branche_trouve_prec,indexBranche_actuel,branche_trouve_actuel, - tjsc1,tjsc2,AdrTjdP,Adr2,TypeEl,N_iteration : integer; - tjscourbe1,tjscourbe2,tjd,tjs : boolean; - A,Aprec,tjsc1B,tjsc2B: char; - s : string; - - procedure substitue; - begin - if (typeGen=2) then // si le précédent est une TJD/S et le suivant aussi , substituer pointe (chgt de actuel en VAR dans la déclaration de alg3) - begin - if ((aiguillage[Adr].modele=2) or (aiguillage[Adr].modele=3)) and - ((aiguillage[Actuel].modele=2) or (aiguillage[Actuel].modele=3)) then - begin - if nivDebug=3 then AfficheDebug('500 - Détection Précédent=TJD/S Suivant=TJD/S',clyellow); - // subsituer la pointe - Actuel:=aiguillage[Actuel].APointe; - end; - end; - end; - - -label recommence; -begin - n_iteration:=0; - recommence: - if (prec=29) and (actuel=31) then NivDebug:=3; - if (TypeELPrec=0) or (typeElActuel=0) then - begin - s:='Erreur 800 - Types nuls : '+intToSTR(prec)+'/'+intToSTR(TypeElPrec)+' '+IntToSTr(actuel)+'/'+IntToSTR(typeElActuel) ; - Affiche(s,clred); - AfficheDebug(s,clred); - Suivant_alg3:=9999;exit; - end; - if NivDebug=3 then AfficheDebug('Alg3 précédent='+intToSTR(prec)+'/'+intToStr(TypeElprec)+' actuel='+intToSTR(actuel)+'/'+IntToSTR(typeElActuel),clyellow); - // trouver les éléments du précédent - trouve_element(prec,TypeELPrec,1); // branche_trouve IndexBranche_trouve - if IndexBranche_trouve=0 then - begin - if NivDebug=3 then AfficheDebug('Element '+intToSTR(prec)+' non trouvé',clred); - suivant_alg3:=9999;exit; - end; - - indexBranche_prec:=IndexBranche_trouve; - branche_trouve_prec:=branche_trouve; - BtypePrec:=BrancheN[branche_trouve_prec,indexBranche_prec].Btype; - // if BTypePrec=2 then aiguillage[prec].A - - trouve_element(actuel,typeElActuel,1); // branche_trouve IndexBranche_trouve - if IndexBranche_trouve=0 then - begin - if NivDebug=3 then AfficheDebug('Element '+intToSTR(actuel)+' non trouvé',clred); - suivant_alg3:=9999;exit; - end; - - indexBranche_actuel:=IndexBranche_trouve; - branche_trouve_actuel:=branche_trouve; - - Adr:=actuel; - Btype:=BrancheN[branche_trouve_actuel,indexBranche_actuel].Btype; - - //Affiche('Btype='+intToSTR(Btype)+' Actuel='+inTToSTR(actuel),clyellow); - - if Btype=1 then // l'élément actuel est un détecteur - begin - // on part de l'actuel pour retomber sur le précédent - if BrancheN[branche_trouve_actuel,indexBranche_actuel-1].Adresse=prec then // c'est l'autre sens - begin - if NivDebug=3 then AfficheDebug('40 - trouvé détecteur '+intToSTR(adr)+' en + ',clwhite); - Prec:=Adr; - Aprec:=a; - A:='Z'; - Adr:=BrancheN[branche_trouve_actuel,indexBranche_actuel+1].Adresse; - typeGen:=BrancheN[branche_trouve_actuel,indexBranche_actuel+1].Btype; - if NivDebug=3 then - begin - s:='41 - Le suivant est :'+intToSTR(adr); - AfficheDebug(s,clwhite); - end; - suivant_alg3:=adr; - exit; - end; - if BrancheN[branche_trouve_actuel,indexBranche_actuel+1].Adresse=prec then - begin - if NivDebug=3 then AfficheDebug('42 - trouvé détecteur '+intToSTR(adr)+' en - ',clwhite); - Prec:=Adr; - Aprec:=a; - A:='Z'; - Adr:=BrancheN[branche_trouve_actuel,indexBranche_actuel-1].Adresse; - typeGen:=BrancheN[branche_trouve_actuel,indexBranche_actuel-1].Btype; - if NivDebug=3 then - begin - s:='43 - Le suivant est :'+intToSTR(adr); - AfficheDebug(s,clwhite); - end; - suivant_alg3:=adr; - exit; - end; - // ici, les éléments sont non consécutifs. voir si l'un des deux est une TJD/TJS - if (btypePrec=2) or (btypePrec=3) then - begin - // changer l'adresse du précédent par l'autre adresse de la TJD/S - prec:=Aiguillage[prec].Ddroit; - if NivDebug=3 then AfficheDebug('Le précedent est une TJD/S - substitution du precédent par la pointe de la TJD qui est '+intToSTR(prec),clYellow); - inc(n_iteration); - if n_iteration>50 then - begin - s:='Erreur fatale 9999, trop d''itérations'; - Affiche(s,clRed); - AfficheDebug(s,clRed); - suivant_alg3:=9999; - exit; - end; - goto recommence; - end; - - Affiche('44 - éléments non consécutifs: Prec='+intToSTR(prec)+' Actuel='+intTostr(Actuel),clred); - if NivDebug=3 then AfficheDebug('44 - éléments non consécutifs: Prec='+intToSTR(prec)+' Actuel='+intTostr(Actuel),clred); - end; - - if (Btype>=2) then // aiguillage ou bis ou buttoir - begin - if (aiguillage[Adr].modele=1) and (Btype=2) then // aiguillage normal non bis - begin - // aiguillage pris en pointe - if (aiguillage[adr].Apointe=prec) then - begin - if aiguillage[Adr].position=const_droit then - begin - if NivDebug=3 then AfficheDebug('130 - aiguillage '+intToSTR(Adr)+' Pris en pointe droit',clyellow); - AdrPrec:=Adr; - if Adr=0 then - begin - Affiche('131 - Erreur fatale',clRed);suivant_alg3:=9999;exit; - end; - BtypePrec:=Btype; - Aprec:=a; - A:=aiguillage[Adr].AdroitB; - Adr:=aiguillage[Adr].Adroit; - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(adr,typeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype; - suivant_alg3:=adr; - exit; - end; - if aiguillage[Adr].position<>const_droit then - begin - if NivDebug=3 then AfficheDebug('133 - aiguillage '+intToSTR(Adr)+' Pris en pointe dévié',clyellow); - AdrPrec:=Adr; - if alg=3 then // on demande d'arreter si l'aiguillage pris en pointe est dévié - begin - typeGen:=0; - AdrDevie:=Adr; - suivant_alg3:=9997;exit; - end; - if Adr=0 then - begin Affiche('134 - Erreur fatale',clRed); - if NivDebug>=1 then AfficheDebug('134 - Erreur fatale',clRed); - suivant_alg3:=9999;exit; - end; - BtypePrec:=Btype; - Aprec:=A; - A:=aiguillage[Adr].AdevieB; - Adr:=aiguillage[Adr].Adevie; - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype; - suivant_alg3:=adr;exit; - end; - end - else - begin - if NivDebug=3 then AfficheDebug('135 - aiguillage '+intToSTR(Adr)+' Pris en talon',clyellow); - if alg=2 then // on demande d'arreter si l'aiguillage en talon est mal positionné - begin - if aiguillage[adr].position=const_droit then - begin - if prec<>aiguillage[Adr].Adroit then - begin - if NivDebug=3 then AfficheDebug('135.1 - Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); - suivant_alg3:=9998;exit; - end - else - begin - if NivDebug=3 then AfficheDebug('135.2 - Aiguillage '+intToSTR(adr)+' bien positionné',clyellow); - end; - end - else - begin - if prec<>aiguillage[Adr].Adevie then - begin - if NivDebug=3 then AfficheDebug('135.3 Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); - suivant_alg3:=9998;exit; - end - else - begin - if NivDebug=3 then AfficheDebug('135.4 Aiguillage '+intToSTR(adr)+' bien positionné',clyellow); - end; - end; - end; - - AdrPrec:=Adr; - if Adr=0 then - begin Affiche('136 - Erreur fatale',clRed); - if NivDebug>=1 then AfficheDebug('136 - Erreur fatale',clRed); - suivant_alg3:=9999;exit; - end; - BtypePrec:=Btype; - APrec:=A; - A:=aiguillage[Adr].ApointeB; - Adr:=aiguillage[Adr].Apointe; - // Affiche('trouvé '+intToSTR(adr),clyellow); - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype; - suivant_alg3:=adr; - exit; - end; - Affiche('138 - Erreur fatale - Aucun cas Aiguillage',clred); - if NivDebug=3 then AfficheDebug('138 - Erreur fatale - Aucun cas Aiguillage',clred); - suivant_alg3:=9999;exit; - end; - - if (aiguillage[Adr].modele=2) or (aiguillage[Adr].modele=3) then // TJD ou TJS - begin - // récupérer les élements de la TJD/S - AdrTjdP:=aiguillage[Adr].Ddroit; // 2eme adresse de la TJD/S - tjd:=aiguillage[Adr].modele=2; - tjs:=aiguillage[Adr].modele=3; - tjsc1:=aiguillage[Adr].tjsint; // adresses de la courbe de la TJS - tjsc2:=aiguillage[AdrTjdP].tjsint; - tjsc1B:=aiguillage[Adr].tjsintB; - tjsc2B:=aiguillage[AdrTjdP].tjsintB; - if tjsc1<>0 then // si tjs - begin - tjscourbe1:=(aiguillage[Adr].tjsintB='S') and (aiguillage[tjsc1].position<>const_droit); - tjscourbe1:=((aiguillage[Adr].tjsintB='D') and (aiguillage[tjsc1].position=const_droit)) or tjscourbe1; - end; - if tjsc2<>0 then - begin - tjscourbe2:=(aiguillage[AdrTjdP].tjsintB='S') and (aiguillage[tjsc2].position<>const_droit); - tjscourbe2:=((aiguillage[AdrTjdP].tjsintB='D') and (aiguillage[tjsc2].position=const_droit)) or tjscourbe2; - end; - - if NivDebug=3 then - begin - s:='137 - TJD '+intToSTR(Adr)+'/'+IntToSTR(AdrTjdP)+' pos='; - if aiguillage[Adr].position=const_droit then s:=s+'droit' - else if aiguillage[Adr].position=const_devie then s:=s+'dévié' - else s:=s+'inconnu' ; - if aiguillage[AdrTJDP].position=const_droit then s:=s+'/droit' - else if aiguillage[AdrTJDP].position=const_devie then s:=s+'/dévié' - else s:=s+'/inconnu' ; - AfficheDebug(s,clyellow); - end; - - // rechercher le port de destination de la tjd - Adr2:=0;A:=#0; - if aiguillage[Adr].position=const_droit then - begin - A:=aiguillage[Adr].DDroitB; - adr2:=aiguillage[Adr].DDroit; - end; - if aiguillage[Adr].position=const_devie then - begin - A:=aiguillage[Adr].DDevieB; - adr2:=aiguillage[Adr].DDevie; - end; - if nivDebug=3 then Affichedebug('le port de destination de la tjd est '+IntToSTR(adr2)+a,clyellow); - - // extraire l'élément connecté au port de destination de la tjd - if A='S' then - begin - A:=aiguillage[adr2].AdevieB; - adr2:=aiguillage[adr2].Adevie; - //Affichedebug('element connecté:'+inttostr(adr)+A,clred); - end - else - if A='D' then - begin - A:=aiguillage[adr2].AdroitB; - adr2:=aiguillage[adr2].Adroit; - end - else - begin - if aiguillage[adr].position<>9 then - begin - s:='Erreur 1021 TJD '+intToSTR(adr)+' non résolue'; - affichedebug(s,clred); - Affiche(s,clred); - suivant_alg3:=9996; - exit; - end; - end; - - if nivDebug=3 then AfficheDebug('tjd: '+s+' Suiv='+intToSTR(adr2)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - suivant_alg3:=adr2; - exit; - - // determiner la position de la première section de la TJD (4 cas) - // cas 1 : droit droit - if (( aiguillage[AdrTJdP].position=const_droit) and - (aiguillage[Adr].position=const_droit) and tjd) then - begin - // d'où vient ton sur la tjd - if aiguillage[Adr].Adroit=prec then - begin - - A:=aiguillage[Adr].DdroitB; - Adr:=aiguillage[Adr].Ddroit; - if A='D' then - begin - Adr:=aiguillage[AdrTjDP].Adroit; - A:=aiguillage[AdrTjDP].AdroitB; - end; - if A='S' then - begin - Adr:=aiguillage[AdrTjDP].Adevie; - A:=aiguillage[AdrTjDP].AdevieB; - end; - if NivDebug=3 then AfficheDebug('cas1.1 tjd: '+s+' Adr='+intToSTR(adr)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - suivant_alg3:=adr; - substitue; - exit; - end; - if aiguillage[Adr].Adevie=prec then - begin - A:=aiguillage[AdrTjdP].AdroitB; - Adr:=aiguillage[AdrTjdP].Adroit; - if NivDebug=3 then AfficheDebug('cas1.2 tjd: '+s+' Suiv='+intToSTR(adr)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - suivant_alg3:=adr; - substitue; - exit; - end; - s:='Erreur 1021, TJD '+IntToSTR(Adr)+'/'+IntToSTR(AdrTjdP)+' mal positionnée'; - if nivDebug=3 then AfficheDebug(s,clred); - Affiche(s,clred); - Suivant_alg3:=9998;exit; - end; - // cas 2 TJD - if (aiguillage[Adr].position=const_devie) - and (aiguillage[AdrTjdP].position=const_droit) and tjd then - begin - if aiguillage[Adr].Adevie=prec then - begin - A:=aiguillage[AdrTjdP].AdroitB; - Adr:=aiguillage[AdrTJDP].Adroit; - if NivDebug=3 then AfficheDebug('cas2.1 tjd: '+s+' Suiv='+intToSTR(adr)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - substitue; - suivant_alg3:=adr; - exit; - end; - if (aiguillage[Adr].Adroit=prec) then - begin - A:=aiguillage[AdrTJDP].AdevieB; - Adr:=aiguillage[AdrTjdP].Adevie; - if NivDebug=3 then AfficheDebug('cas2.2 tjd: '+s+' Suiv='+intToSTR(adr)+A,clYellow); - - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - substitue; - suivant_alg3:=adr; - exit; - end; - s:='Erreur 1022, TJD '+IntToSTR(Adr)+'/'+IntToSTR(AdrTjdP)+' mal positionnée'; - if nivDebug=3 then AfficheDebug(s,clred); - Affiche(s,clred); - Suivant_alg3:=9998;exit; - end; - // cas 3 TJD - if (aiguillage[Adr].position=const_droit) - and (aiguillage[AdrTjdP].position=const_devie) and tjd then - begin - // si on vient de - if (aiguillage[Adr].Adroit=prec) then - begin - if NivDebug=3 then AfficheDebug('cas3.1 tjd: '+s,clYellow); - A:=aiguillage[Adr].DdroitB; - Adr:=aiguillage[Adr].Ddroit; - if A='D' then - begin - Adr:=aiguillage[AdrTjDP].Adroit; - A:=aiguillage[AdrTjDP].AdroitB; - end; - if A='S' then - begin - Adr:=aiguillage[AdrTjDP].Adevie; - A:=aiguillage[AdrTjDP].AdevieB; - end; - - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - //substitue; - suivant_alg3:=adr; - exit; - end; - // si on vient de - if (aiguillage[Adr].Adevie=prec) then - begin - A:=aiguillage[AdrTJDP].AdroitB; - Adr:=aiguillage[AdrTJDP].Adroit; - if NivDebug=3 then AfficheDebug('cas3.2 tjd: '+s+' Suiv='+intToSTR(adr)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - substitue; - suivant_alg3:=adr; - exit; - end; - s:='Erreur 1023, TJD '+IntToSTR(Adr)+'/'+IntToSTR(AdrTjdP)+' mal positionnée'; - if nivDebug=3 then AfficheDebug(s,clred); - Affiche(s,clred); - Suivant_alg3:=9998;exit; - end; - // cas 4 tjd - if (aiguillage[Adr].position=const_devie) - and (aiguillage[AdrTjdP].position=const_devie) then - begin - if aiguillage[Adr].Adevie=prec then - begin - A:=aiguillage[AdrtjdP].AdevieB; - Adr:=aiguillage[AdrtjdP].Adevie; - if NivDebug=3 then AfficheDebug('cas4.1 tjd: '+s+' Suiv='+intToSTR(adr)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - substitue; - suivant_alg3:=adr; - exit; - end; - if aiguillage[Adr].Adroit=prec then - begin - A:=aiguillage[AdrtjdP].AdevieB; - Adr:=aiguillage[AdrtjdP].Adevie; - if NivDebug=3 then AfficheDebug('cas4.2 tjd: '+s+' Suiv='+intToSTR(adr)+A,clYellow); - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - substitue; - suivant_alg3:=adr; - exit; - end; - s:='Erreur 1024, TJD '+IntToSTR(Adr)+'/'+IntToSTR(AdrTjdP)+' mal positionnée'; - if nivDebug=3 then AfficheDebug(s,clred); - Affiche(s,clred); - Suivant_alg3:=9998; - exit; - end; - // cas TJS prise dans sa position courbe - if ((aiguillage[Adr].Adevie=Prec) and (aiguillage[Adr].AdevieB=Aprec) and (aiguillage[Adr].position<>const_droit) - and (aiguillage[AdrTjdP].position=const_droit) and (tjs) and tjscourbe1 and tjscourbe2) then - begin - if NivDebug=3 then AfficheDebug('cas tjs en courbe1',clYellow); - A:=aiguillage[AdrTjdP].AdevieB; - Adr:=aiguillage[AdrTjdP].Adevie; - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - substitue; - suivant_alg3:=adr; - exit; - end; - // cas 3 TJS prise dans sa 2eme position courbe - if ((aiguillage[Adr].Adroit=Prec) and (aiguillage[Adr].AdroitB=Aprec) and (aiguillage[Adr].position=const_droit) - and (aiguillage[AdrTjdP].position<>const_droit) and (tjs) and tjscourbe1 and tjscourbe2 ) then - begin - if NivDebug=3 then AfficheDebug('cas1 tjs en courbe 2',clYellow); - A:=aiguillage[AdrTjdP].AdevieB; - Adr:=aiguillage[AdrTjdP].Adevie; - if A='Z' then typeGen:=1 else typeGen:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - suivant_alg3:=adr; - substitue; - exit; - end; - s:='1025 - Erreur fatale - position TJD/S '+IntToSTR(Adr)+'/'+intToSTR(AdrTJDP)+' inconnue'; - Affiche(s,clred); - AfficheDebug(s,clred); - suivant_alg3:=9999;exit; - end; - - if (aiguillage[Adr].modele=4) then // aiguillage triple - begin - Adr2:=aiguillage[Adr].AdrTriple; - if (aiguillage[adr].Apointe=prec) then - begin - // aiguillage triple pris en pointe - //Affiche('position='+intToSTR(aiguillage[Adr].position),clyellow); - if (aiguillage[Adr].position=const_droit) and (aiguillage[Adr2].position=const_droit) then - begin - if NivDebug=3 then AfficheDebug('Aiguillage triple pris en pointe droit',clYellow); - A:=aiguillage[Adr].AdroitB; - Adr:=aiguillage[Adr].Adroit; - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; - suivant_alg3:=adr;exit; - end; - if (aiguillage[Adr].position<>const_droit) and (aiguillage[Adr2].position=const_droit) then - begin - if NivDebug=3 then AfficheDebug('Aiguillage triple dévié1 (à gauche)',clYellow); - A:=aiguillage[Adr].AdevieB; - Adr:=aiguillage[Adr].Adevie; - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; - suivant_alg3:=adr;exit; - end; - if (aiguillage[Adr].position=const_droit) and (aiguillage[Adr2].position<>const_droit) then - begin - if NivDebug=3 then AfficheDebug('Aiguillage triple dévié2 (à droite)',clYellow); - A:=aiguillage[Adr].Adevie2B; - Adr:=aiguillage[Adr].Adevie2; - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; - suivant_alg3:=adr;exit; - end; - begin - if aiguillage[Adr].position=9 then begin suivant_alg3:=9996;exit;end; // pour échappement - s:='Aiguillage triple '+IntToSTR(Adr)+' : configuration des aiguilles interdite'; - if CDM_connecte then s:=s+': '+IntToSTR(aiguillage[Adr].position); - AfficheDebug(s,clYellow); - Affiche(s,clRed); - suivant_alg3:=9999; - exit; - end; - end - else - begin - if NivDebug=3 then AfficheDebug('Aiguillage triple pris en talon',clyellow); - if alg=2 then // on demande d'arreter si l'aiguillage en talon est mal positionné - begin - if (aiguillage[adr].position=const_droit) and (aiguillage[adr2].position=const_droit) then - begin - if prec<>aiguillage[Adr].Adroit then - begin - if NivDebug=3 then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow); - suivant_alg3:=9998;exit; - end - else - begin - if NivDebug=3 then AfficheDebug('135.4 - Aiguillage '+intToSTR(adr)+'triple bien positionné',clyellow); - end; - end; - if (aiguillage[adr].position<>const_droit) and (aiguillage[adr2].position=const_droit) then - begin - if prec<>aiguillage[Adr].Adevie then - begin - if NivDebug=3 then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow); - suivant_alg3:=9998;exit; - end - else - begin - if NivDebug=3 then AfficheDebug('135.4 - Aiguillage '+intToSTR(adr)+'triple bien positionné',clyellow); - end; - end; - if (aiguillage[adr].position=const_droit) and (aiguillage[adr2].position<>const_droit) then - begin - if prec<>aiguillage[Adr].Adevie2 then - begin - if NivDebug=3 then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow); - suivant_alg3:=9998;exit; - end - else - begin - if NivDebug=3 then AfficheDebug('135.4 - Aiguillage '+intToSTR(adr)+'triple bien positionné',clyellow); - end; - end; - end; - A:=aiguillage[Adr].ApointeB; - Adr:=aiguillage[Adr].Apointe; - if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis) - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve - typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; - suivant_alg3:=Adr;exit; - end; - end; - end; - suivant_alg3:=adr; -end; - -// trouve l'index du feu associé au détecteur adr -function index_feu_det(adr : integer) : integer ; - var i : integer; - trouve,trouve1,trouve2,trouve3,trouve4 : boolean; -begin - i:=1; - repeat - trouve1:=feux[i].Adr_det1=adr; - trouve2:=feux[i].Adr_det2=adr; - trouve3:=feux[i].Adr_det3=adr; - trouve4:=feux[i].Adr_det4=adr; - trouve:=trouve1 or trouve2 or trouve3 or trouve4; - if not(trouve) then inc(i); - until (trouve) or (i>=100); - if trouve then Index_feu_det:=i else Index_feu_det:=0; -end; - - -// renvoie l'adresse du détecteur suivant des deux éléments contigus -// TypeElprec/actuel: 1= détecteur 2= aiguillage 4=Buttoir -// algo= type d'algorythme pour suivant_alg3 -function detecteur_suivant(prec : integer;TypeElPrec : integer;actuel : integer;TypeElActuel,algo : integer) : integer ; -var actuelCalc,PrecCalc,etat,i,j,AdrSuiv , - TypeprecCalc,TypeActuelCalc : integer; -begin - if NivDebug>=2 then AfficheDebug('Proc Detecteur_suivant '+IntToSTR(prec)+','+IntToSTR(typeElPrec)+'/'+intToSTR(actuel)+','+intToSTR(TypeElActuel),clyellow); - j:=0; - - PrecCalc:=prec; - TypeprecCalc:=TypeElprec; - ActuelCalc:=actuel; - TypeActuelCalc:=TypeELActuel; - // étape 1 trouver le sens - repeat - inc(j); - AdrSuiv:=suivant_alg3(precCalc,TypeprecCalc,actuelCalc,TypeActuelCalc,algo); - if (typeGen=2) and false then // si le précédent est une TJD/S et le suivant aussi - begin - if ((aiguillage[AdrSuiv].modele=2) or (aiguillage[AdrSuiv].modele=3)) and - ((aiguillage[actuelCalc].modele=2) or (aiguillage[ActuelCalc].modele=3)) then - begin - if nivDebug=3 then AfficheDebug('501 - Détection Précédent=TJD/S Suivant=TJD/S',clyellow); - // subsituer la pointe - actuelCalc:=aiguillage[ActuelCalc].APointe; - end; - end; - precCalc:=actuelCalc; - TypeprecCalc:=TypeActuelCalc; - actuelCalc:=AdrSuiv; - TypeActuelCalc:=typeGen; - //Affiche('Suivant signalaig='+IntToSTR(AdrSuiv),clyellow); - until (j=10) or (typeGen=1) or (AdrSuiv=0) or (AdrSuiv>=9996); // arret si détecteur - - // si trouvé le sens, trouver le suivant - if AdrSuiv=actuel then - begin - AdrSuiv:=suivant_alg3(prec,TypeElPrec,actuel,TypeElActuel,1); - {if (typeGen=2) then // si le précédent est une TJD/S et le suivant aussi - begin - if ((aiguillage[AdrSuiv].modele=2) or (aiguillage[AdrSuiv].modele=3)) and - ((aiguillage[actuel].modele=2) or (aiguillage[Actuel].modele=3)) then - begin - if nivDebug=3 then AfficheDebug('501 - Détection Précédent=TJD/S Suivant=TJD/S',clyellow); - // subsituer la pointe - actuel:=aiguillage[Actuel].APointe; - end; - end; - } - end; - if (NivDebug=3) and (AdrSuiv<9996) then AfficheDebug('618 : Le suivant est le '+intToSTR(AdrSuiv),clYellow); - detecteur_suivant:=AdrSuiv; -end; - -// renvoie les adresses des détecteurs adjacents au détecteur "adresse" -// résultat dans adj1 et adj2 -procedure Det_Adj(adresse : integer); -var Adr,BtypePrec,AdrFonc,Branche,BtypeFonc,AdrPrec,IndexBranche,i,Dir : integer; - sortie : boolean; -begin - if TraceListe then AfficheDebug('Det_Adj '+IntToSTR(adresse),clyellow); - trouve_element(adresse,1,1); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - begin - Affiche('Erreur 380 : élément '+IntToSTR(adresse)+' non trouvé',clred); - exit; - end; - IndexBranche:=IndexBranche_trouve; - branche:=branche_trouve; - Dir:=1 ; //test direction - - repeat - if (Dir=1) then i:=IndexBranche-1 else i:=IndexBranche+1; - - AdrPrec:=Adresse; - BtypePrec:=1; - - AdrFonc:=BrancheN[branche,i].Adresse; - BtypeFonc:=BrancheN[branche,i].BType; - - i:=0; - repeat - if BtypeFonc<>1 then - begin - Adr:=suivant_alg3(AdrPrec,BtypePrec,AdrFonc,BtypeFonc,2); // élément suivant mais arret sur aiguillage en talon mal positionnée - end - else - begin Adr:=AdrFonc;TypeGen:=BtypeFonc;end; - if Adr>9990 then typeGen:=1; - if (NivDebug=3) then AfficheDebug('trouvé '+intToSTR(Adr)+' '+intToSTR(typeGen),clorange); - AdrPrec:=AdrFonc;BtypePrec:=BtypeFonc; - AdrFonc:=Adr;BtypeFonc:=typeGen; - i:=i+1; - sortie:=(i=20) or (Adr=0) or (Adr>=9996) or (TypeGen=1); - until (sortie) ; // boucle de parcours - if (typeGen=1) and (Dir=1) then begin Adj1:=Adr;end; - if (typeGen=1) and (Dir=2) then begin Adj2:=Adr;end; - inc(dir); - until dir=3; - if TraceListe then AfficheDebug('Fin Det_Adj ',clyellow); -end; - -// renvoie l'adresse du détecteur suivant des deux éléments -// El1 et El2 peuvent être séparés par des aiguillages, mais de pas plus de 3 détecteurs -// en sortie : 9999= det1 ou det2 non trouvé -// 9996 : non trouvé -function detecteur_suivant_El(el1: integer;TypeDet1 : integer;el2 : integer;TypeDet2 : integer) : integer ; -var IndexBranche_det1,IndexBranche_det2,branche_trouve_det1,branche_trouve_det2,i, - j,AdrPrec,Adr,AdrFonc,TypePrec,TypeFonc,i1,i2,index,N_det : integer; - Sortie : boolean; - s : string; - label reprise; - -begin - if NivDebug>=2 then - AfficheDebug('Proc Detecteur_suivant_EL '+intToSTR(el1)+','+intToSTR(Typedet1)+'/'+intToSTR(el2)+','+intToSTR(Typedet2)+'-------------------------',clLime); - if (el1>9000) or (el2>9000) then - begin - if NivDebug=3 then AfficheDebug('paramètres incorrects >9000',clred); - detecteur_suivant_El:=9999; - end; - - // trouver détecteur 1 - trouve_element(el1,Typedet1,1); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - begin - if NivDebug=3 then - begin - s:='611. '+IntToSTR(el1)+' non trouvé'; - AfficheDebug(s,clred); - AfficheDebug(s,clOrange); - end; - detecteur_suivant_El:=9999;exit; - end; - IndexBranche_det1:=IndexBranche_trouve; - branche_trouve_det1:=branche_trouve; - - // trouver détecteur 2 - trouve_element(el2,Typedet2,1); // branche_trouve IndexBranche_trouve - if (IndexBranche_trouve=0) then - begin - if NivDebug=3 then - begin - s:='612. '+IntToSTR(el2)+' non trouvé'; - AfficheDebug(s,clred); - AfficheDebug(s,clOrange); - end; - detecteur_suivant_El:=9999;exit; - end; - IndexBranche_det2:=IndexBranche_trouve; - branche_trouve_det2:=branche_trouve; - j:=1; // J=1 test en incrément J=2 test en décrément - - // étape 1 : trouver le sens de progression (en incrément ou en décrément) - - repeat - //préparer les variables - AdrPrec:=el1;TypePrec:=typeDet1; - if j=1 then i1:=IndexBranche_det1+1; - if j=2 then i1:=IndexBranche_det1-1; - if NivDebug=3 then - begin - s:='Test en '; - if (j=1) then s:=s+'incrément ' else s:=s+'décrément '; - s:=s+'- départ depuis élément '+IntToSTR(el1)+' trouvé en index='+intToSTR(IndexBranche_det1)+' Branche='+intToSTR(branche_trouve_det1); - AfficheDebug(s,clyellow); - end; - - AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse; - typeFonc:=BrancheN[branche_trouve_det1,i1].Btype ; - - - i:=0;N_Det:=0; - if AdrFonc<>El2 then // si pas déja trouvé le sens de progression - begin - repeat - //AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow); - if nivDebug=3 then AfficheDebug('i='+IntToSTR(i)+' NDet='+IntToSTR(N_det),clyellow); - Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,1); - //AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow); - if TypeGen=1 then inc(N_Det); - if NivDebug=3 then - begin - s:='613 : trouvé='+intToSTR(Adr); - case typeGen of - 1 : s:=s+' detecteur'; - 2 : s:=s+' aiguillage'; - 3 : s:=s+' aiguillage bis'; - end; - AfficheDebug(s,clorange); - end; - - AdrPrec:=AdrFonc;TypePrec:=TypeFonc; - AdrFonc:=Adr;TypeFonc:=typeGen; - inc(i); - sortie:=((typeDet2=TypeGen) and (Adr=el2)) or (Adr=0) or (Adr>=9996) or (i=15) or (N_Det=Nb_det_dist); - until sortie ; - if (i=15) and (Nivdebug=3) then afficheDebug('Pas trouvé',clyellow); - if (N_det=Nb_det_dist) and (Nivdebug=3) then afficheDebug('Détecteurs trop distants',clred); - end - - else - begin - // déja trouvé - adr:=el2;typeGen:=TypeDet2; - end; - - if (typeDet2=TypeGen) and (Adr=el2) and (N_Det<>Nb_det_dist) then - begin - if Nivdebug=3 then AfficheDebug('614 : Trouvé '+intToSTR(el2),clYellow); - i:=0; - repeat - //AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow); - Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,1); - //AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow); - - if NivDebug=3 then - begin - s:='614 : trouvé='+intToSTR(Adr); - case typeGen of - 1 : s:=s+' detecteur'; - 2 : s:=s+' aiguillage'; - 4 : s:=s+' buttoir'; - end; - AfficheDebug(s,clorange); - end; - - AdrPrec:=AdrFonc;TypePrec:=TypeFonc; - AdrFonc:=Adr;TypeFonc:=typeGen; - inc(i); - sortie:=(TypeGen=1) or (Adr=0) or (Adr>=9996) or (i=10); - until sortie; - - if (TypeGen=1) or (TypeGen=4) then - begin - if NivDebug=3 then - begin - AfficheDebug('le détecteur suivant est le '+IntToSTR(Adr),clyellow); - affichedebug('------------------',clyellow); - end; - detecteur_suivant_el:=Adr; - exit; - end; - end; - if (i=10) then if NivDebug=3 then AfficheDebug('201 : Itération trop longue',clred); - inc(j); - //AfficheDebug('j='+intToSTR(j),clyellow); - until j=3; // boucle incrément/décrément - - detecteur_suivant_el:=9996; - if NivDebug=3 then affichedebug('------------------',clyellow); -end; - - -// renvoie vrai si les aiguillages déclarés dans la définition du signal sont mal positionnés -function cond_carre(adresse : integer) : boolean; -var i,l,k,NCondCarre,adrAig : integer; - resultatET,resultatOU: boolean; - s : string; -begin - i:=index_feu(adresse); - NCondCarre:=Length(feux[i].condcarre[1]); - - l:=1; - resultatOU:=false; - - while NcondCarre<>0 do - begin - if Ncondcarre<>0 then dec(Ncondcarre); - resultatET:=true; - for k:=1 to NcondCarre do - begin - //s2:=s2+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig+' '; - AdrAig:=feux[i].condcarre[l][k].Adresse; - if nivDebug=3 then AfficheDebug('Contrôle aiguillage '+IntToSTR(AdrAig),clyellow); - resultatET:=((aiguillage[AdrAig].position=const_devie) and (feux[i].condcarre[l][k].PosAig='S') or (aiguillage[AdrAig].position=const_droit) and (feux[i].condcarre[l][k].PosAig='D')) - and resultatET; - end; - //if resultatET then Affiche('VRAI',clyellow) else affiche('FAUX',clred); - inc(l); - resultatOU:=resultatOU or resultatET; - NCondCarre:=Length(feux[i].condcarre[l]); - end; - //if resultatOU then Affiche('VRAI final',clyellow) else affiche('FAUX final',clred); - if NivDebug=3 then - begin - s:='Conditions de carré suivant aiguillages: '; - if ResultatOU then s:=s+'vrai : le signal doit afficher carré' else s:=s+'faux : le signal ne doit pas afficher de carré'; - AfficheDebug(s,clyellow); - end; - cond_carre:=ResultatOU; -end; - -// renvoi vrai si les aiguillages au delà du signal sont mal positionnés -function carre_signal(adresse : integer) : boolean; -var - i,j,prec,AdrFeu,AdrSuiv,actuel,TypeELPrec,TypeElActuel : integer; - multi, sort : boolean; - s : string; -begin - if (NivDebug>=1) then AfficheDebug('Test si signal '+IntToSTR(adresse)+' doit afficher un carré si aiguillage avals mal positionnés',clyellow); - - i:=Index_feu(adresse); - j:=0; - prec:=feux[i].Adr_det1; - TypeElPrec:=1; - actuel:=feux[i].Adr_el_suiv1; - if feux[i].Btype_suiv1=1 then TypeElActuel:=1; - if feux[i].Btype_suiv1=2 then TypeElActuel:=2; - if feux[i].Btype_suiv1=5 then TypeElActuel:=3; // le type du feu 1=détécteur 2=aig 5=bis - multi:=feux[i].Adr_det2<>0; - // trouver si une des voies présente un train - if (multi) then - begin - carre_signal:=FALSE; // pour l'instant verrouillé - exit; - end; - - //Affiche(IntToSTR(actuel),clyellow); - repeat - inc(j); - AdrSuiv:=suivant_alg3(prec,typeElPrec,actuel,typeELActuel,2); - {if (typeGen=2) then // si le précédent est une TJD/S et le suivant aussi - begin - if ((aiguillage[AdrSuiv].modele=2) or (aiguillage[AdrSuiv].modele=3)) and - ((aiguillage[actuel].modele=2) or (aiguillage[actuel].modele=3)) then - begin - if nivDebug=3 then AfficheDebug('505 - Détection Précédent=TJD/S Suivant=TJD/S',clyellow); - // subsituer la pointe - actuel:=aiguillage[actuel].APointe; - end; - end; } - - - if (AdrSuiv=9999) or (AdrSuiv=9996) then // élément non trouvé ou position aiguillage inconnu - begin - carre_signal:=true; - exit; - end; - if (AdrSuiv<>9998) then // arret sur aiguillage en talon mal positionnée - begin - prec:=actuel; - TypeElPrec:=TypeElActuel; - actuel:=AdrSuiv; - TypeElActuel:=typeGen; - end; - // si le suivant est un détecteur comporte t-il un signal? - AdrFeu:=0; - if (AdrSuiv>500) then - begin - AdrFeu:=index_feu_det(AdrSuiv); - //Affiche(IntToSTR(AdrFeu),clOrange); - end; - sort:=(j=10) or (AdrFeu<>0) or (AdrSuiv=9998) or (AdrSuiv=0); // arret si aiguillage en talon ou buttoir - until (sort); - // si trouvé un feu ou j=10, les aiguillages sont bien positionnés - // si trouvé 9998, aiguillages mal positionnés - if (NivDebug=3) then - begin - if (AdrSuiv=9998) then AfficheDebug('Le signal '+intToSTR(adresse)+' doit afficher un carré car l''aiguillage pris en talon '+IntToSTR(actuel)+' est mal positionné',clYellow) - else AfficheDebug('Le signal '+IntToSTR(adresse)+' ne doit pas être au carré',clYellow); - end; - carre_signal:=AdrSuiv=9998; -end; - - - -// renvoie l'état du signal suivant -// si renvoie 0, pas trouvé le signal suivant. -// rang=1 pour feu suivant, 2 pour feu suivant le 1, etc -// Dans AdresseFeuSuivant : adresse du feu suivant (variable globale) -function etat_signal_suivant(adresse,rang : integer) : integer ; -var num_feu,AdrDet,etat,AdrFeu,i,j,prec,AdrSuiv : integer; - aspect,combine : word; - TypePrec,TypeActuel : integer; - s : string; -begin - //traceDet:=true; - if NivDebug>=2 then AfficheDebug('Cherche état du signal suivant au '+IntToSTR(adresse),clyellow); - i:=Index_feu(adresse); - if feux[i].aspect>10 then - begin - s:='La demande de l''état du signal suivant depuis un feu directionnel '+IntToSTR(Adresse)+' est irrecevable'; - Affiche(s,clred); - AfficheDebug(s,clred); - etat_signal_suivant:=0; - exit; - end; - - if i=0 then - begin - Affiche('Erreur 600 - feu '+IntToSTR(adresse)+' non trouvé',clred); - if NivDebug=3 then AfficheDebug('Erreur 600 - feu '+IntToSTR(adresse)+' non trouvé',clred); - etat_signal_suivant:=0; - AdresseFeuSuivant:=0; - exit; - end; - Etat:=0; - j:=0; - num_feu:=0; - prec:=Feux[i].Adr_det1; // détecteur sur le courant - - if prec=0 then - begin - Affiche('Msg 601 - feu '+intToSTR(adresse)+' non renseigné ',clOrange); - if NivDebug=3 then AfficheDebug('Msg 601 - feu '+intToSTR(adresse)+' non renseigné ',clOrange); - etat_signal_suivant:=0; - AdresseFeuSuivant:=0; - exit; - end; - TypePrec:=1; // détecteur - actuel:=feux[i].Adr_el_suiv1; - if nivDebug=3 then AfficheDebug('Actuel ='+IntToSTR(actuel),clyellow); - if feux[i].Btype_suiv1=1 then TypeActuel:=1; - if feux[i].Btype_suiv1=2 then TypeActuel:=2; - if feux[i].Btype_suiv1=4 then TypeActuel:=2; // aiguillage triple - if feux[i].Btype_suiv1=5 then TypeActuel:=3; // le type du feu 1=détécteur 2=aig 5=bis - - repeat - inc(j); - if nivDebug=3 then AfficheDebug('Itération '+IntToSTR(j),clyellow); - - // à la première itération, si "actuel" est déja un détecteur, ne pas faire de recherche sur le suivant - if (j=1) and (TypeActuel=1) then - begin - AdrSuiv:=actuel; - end - else - begin - //if nivDebug=3 then AfficheDebug('Engagement j='+IntToSTR(j)+' '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); - AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1); - - if Nivdebug=3 then AfficheDebug('Suivant='+intToSTR(AdrSuiv),clyellow); - prec:=actuel;TypePrec:=TypeActuel; - actuel:=AdrSuiv;TypeActuel:=typeGen; - - if (AdrSuiv=9999) or (AdrSuiv=9996) then - begin - Etat_signal_suivant:=0; - AdresseFeuSuivant:=0; - exit; - end; - if (AdrSuiv=0) then - begin - if NivDebug=3 then AfficheDebug(intToSTR(j)+' Le suivant est un buttoir',clyellow); - Etat_signal_suivant:=carre_F; // faire comme si c'était un signal au carré - AdresseFeuSuivant:=0; - exit; - end; - end; - - // si le suivant est un détecteur comporte t-il un signal? - - AdrFeu:=0; - if (TypeActuel=1) then // détecteur? - begin - i:=Index_feu_det(Actuel); - AdrFeu:=Feux[i].Adresse; - if adrFeu<>0 then - begin - if nivdebug=3 then afficheDebug('Détecteur='+IntToSTR(AdrSuiv)+' AdrFeu='+IntToSTR(AdrFeu)+' prec='+IntToSTR(prec),clyellow ); - if (adrFeu=Adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant - begin - AdrFeu:=0;j:=10; // on ne trouve pas de suivant - end; - - if (AdrFeu<>0) then // si l'adresse est <>0 - begin - if (Feux[i].Adr_el_suiv1<>prec) then // le feu est-il dans le bon sens de progression? - begin - // oui - inc(num_feu); - Etat:=EtatSignalCplx[AdrFeu]; - code_to_aspect(Etat,aspect,combine); - Signal_suivant:=AdrFeu; - if NivDebug=3 then AfficheDebug('Trouvé feu suivant Adr='+IntToSTR(AdrFeu)+': '+IntToSTR(etat)+'='+EtatSign[aspect]+' '+EtatSign[combine],clorange); - end - else - begin - if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clOrange); - AdrFeu:=0; - end; - end - end - else if nivDebug=3 then AfficheDebug('Pas de feu pour le det '+IntToSTR(AdrSuiv),clyellow); - end; - until (j=10) or ((AdrFeu<>0) and (num_feu=rang)); - if etat=0 then Signal_Suivant:=0; - etat_signal_suivant:=Etat; - AdresseFeuSuivant:=Signal_suivant; - if (NivDebug=3) and (adrFeu=0) then AfficheDebug('Pas Trouvé de feu suivant au feu Adr='+IntToSTR(ADresse),clOrange); -end; - - -// renvoie l'adresse de l'aiguille si elle est déviée après le signal et ce jusqu'au prochain signal -// sinon renvoie 0 -// adresse=adresse du signal -function Aiguille_deviee(adresse : integer) : integer ; -var AdrDet,AdrFeu,etat,i,j,prec,AdrSuiv,Actuel : integer; - TypePrec,TypeActuel : integer; - s : string; -begin - //traceDet:=true; - if NivDebug>=2 then AfficheDebug('test si aiguille déviée après signal '+IntToSTR(Adresse),clyellow); - j:=0; - i:=Index_feu(adresse); - prec:=feux[i].Adr_det1; - TypePrec:=1; - actuel:=feux[i].Adr_el_suiv1; - if feux[i].Btype_suiv1=1 then TypeActuel:=1; - if feux[i].Btype_suiv1=2 then TypeActuel:=2; - if feux[i].Btype_suiv1=5 then TypeActuel:=3; // le type du feu 1=détécteur 2=aig 5=bis - - //Affiche(IntToSTR(actuel),clyellow); - AdrFeu:=0; - AdrDevie:=0; - if (TypeActuel=2) or (TypeActuel=3) then // aiguillage - begin - if (aiguillage[actuel].Apointe=prec) and (aiguillage[actuel].position<>const_droit) then Aiguille_deviee:=actuel; - end; - - repeat - inc(j); - // 3=demande si le suivant est un aiguillage en pointe dévié oui si AdrSuiv=9997 - // dans ce cas la variable globale AdrDevie est mise à jour - AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,3); - - if NivDebug=3 then AfficheDebug('701 - Suivant signalaig='+IntToSTR(AdrSuiv),clyellow); - if ADrSuiv<>9997 then - begin - prec:=actuel;TypePrec:=TypeActuel; - actuel:=AdrSuiv;TypeActuel:=typeGen; - // si le suivant est un détecteur comporte t-il un signal? - AdrFeu:=0; - if (TypeActuel=1) then // détecteur - begin - i:=Index_feu_det(AdrSuiv); - AdrFeu:=Feux[i].Adresse; - if NivDebug=3 then AfficheDebug('trouvé signal '+intToSTR(AdrFeu)+' associé au détecteur '+IntToSTR(AdrSuiv),clyellow); - end; - end; - until (j=10) or (AdrSuiv>=9996) or (AdrFeu<>0) ; - if (AdrSuiv=9997) then - begin - s:='le signal '+intToSTR(adresse)+' doit afficher un rappel car l''aiguillage '+intToSTR(AdrDevie); - if (typeGen=3) then s:=s+'bis'; - s:=s+' est dévié'; - if NivDebug=3 then AfficheDebug(s,clYellow); - end; - if ((AdrSuiv<>9997) or (j=10)) and (NivDebug=3) then - begin - S:='le signal '+intToSTR(adresse)+' ne doit pas afficher de rappel car '; - if j<>10 then s:=s+'trouvé un autre signal suivant et pas d''aiguillage dévié' - else s:=s+' signal trop éloigné'; - AfficheDebug(s,clYellow); - end; - Aiguille_deviee:=AdrDevie; -end; - -procedure pilote_direction(Adr,nbre : integer); -var i,j : integer; -begin - i:=index_feu(Adr); - j:=feux[i].decodeur; - case j of - // 0 : envoi_directionvirtuel(Adr,nbre); - 1 : envoi_DirectionBahn(Adr,nbre); - 2 : envoi_DirectionCDF(Adr,nbre); - //3 : envoi_DirectionLDT(Adr,nbre); - 4 : envoi_DirectionLEB(Adr,nbre); - //5 : envoi_DirectionNMRA(Adr,nbre); - end; -end; - -procedure Signal_direction(Adr : integer); -var NAig,i,id,j,NfeuxDir,AdrAigFeu,Position : integer; - PosAigFeu : char; - Positionok : boolean; -begin - id:=Index_feu(Adr); - NfeuxDir:=feux[id].aspect-10; - //Affiche(IntToSTR(NfeuxDir),clyellow); - i:=1; // i=1 position éteinte du feu ; pour les autres valeurs de i : nombre de feux allumés - repeat - NAig:=length(feux[id].AigDirection[i])-1; - if i=1 then positionok:=false else positionok:=true; - for j:=1 to Naig do - begin - // vérifier la position déclarée des aiguillages pour chaque feu - AdrAigFeu:=feux[id].AigDirection[i][j].Adresse; - PosAigFeu:=feux[id].AigDirection[i][j].posAig; - position:=aiguillage[AdrAigFeu].position; - // - if i=1 then positionok:=((position=const_droit) and (posAigFeu='D')) or ((position<>const_droit) and (posAigFeu='S')) or positionok; - if i>1 then positionok:=((position=const_droit) and (posAigFeu='D')) or ((position<>const_droit) and (posAigFeu='S')) and positionok; - - end; - //if positionok then Affiche('Signal directionnel '+IntToSTR(Adr)+' Position Ok sur feu '+intToSTR(i-1),clyellow); - inc(i); - until (i>NFeuxDir+1) or positionok; - - if positionok then - begin - // Affiche('i='+intToSTR(i),clyellow); - dec(i,2); // i correspond au nombre de feux à allumer - pilote_direction(Adr,i); - end; - -end; - -// renvoie vrai si une mémoire de zone est occupée du signal courant au signal suivant -// adresse=adresse du signal -function test_memoire_zones(adresse : integer) : boolean; -var - AdrSuiv,prec,TypePrec,TypeActuel,ife,actuel,AdrDet,Etat,AdrFeu,i,j,PresTrain01,PrecInitial : integer; - Pres_train,sort : boolean; - s : string; -begin - if NivDebug>=1 then AfficheDebug('Proc test_memoire_zones - Cherche mémoire à 1 du signal '+intToSTR(adresse)+' au signal suivant ',clyellow); - i:=Index_feu(adresse); - if (i=0) then - begin - Affiche('Erreur 650 - feu non trouvé',clred); - AfficheDebug('Erreur 650 - feu non trouvé',clred); - test_memoire_zones:=false; - end; - - Pres_train:=FALSE; - ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu - repeat - j:=0; - if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange); - if (ife=1) then - begin - prec:=feux[i].Adr_det1; - actuel:=feux[i].Adr_el_suiv1; - if feux[i].Btype_suiv1=1 then TypeActuel:=1; - if feux[i].Btype_suiv1=2 then TypeActuel:=2; - if feux[i].Btype_suiv1=4 then TypeActuel:=2; // aiguillage triple - if feux[i].Btype_suiv1=5 then TypeActuel:=3; // le type du feu 1=détecteur 2=aig 5=bis - end; //détecteur sur le signal courant - if (ife=2) then - begin - prec:=feux[i].Adr_det2;actuel:=feux[i].Adr_el_suiv2; - if feux[i].Btype_suiv2=1 then TypeActuel:=1; - if feux[i].Btype_suiv2=2 then TypeActuel:=2; - if feux[i].Btype_suiv2=4 then TypeActuel:=2; // aiguillage triple - if feux[i].Btype_suiv2=5 then TypeActuel:=3; // le type du feu 1=détecteur 2=aig 5=bis - end; // détecteur sur le signal courant - if (ife=3) then - begin - prec:=feux[i].Adr_det3; - actuel:=feux[i].Adr_el_suiv3; - if feux[i].Btype_suiv3=1 then TypeActuel:=1; - if feux[i].Btype_suiv3=2 then TypeActuel:=2; - if feux[i].Btype_suiv3=4 then TypeActuel:=2; // aiguillage triple - if feux[i].Btype_suiv3=5 then TypeActuel:=3; // le type du feu 1=détecteur 2=aig 5=bis - end; // détecteur sur le signal courant - if (ife=4) then - begin - prec:=feux[i].Adr_det4; - actuel:=feux[i].Adr_el_suiv4; - if feux[i].Btype_suiv4=1 then TypeActuel:=1; - if feux[i].Btype_suiv4=2 then TypeActuel:=2; - if feux[i].Btype_suiv4=4 then TypeActuel:=2; // aiguillage triple - if feux[i].Btype_suiv4=5 then TypeActuel:=3; // le type du feu 1=détecteur 2=aig 5=bis - end; // détecteur sur le signal courant - - TypePrec:=1; - if (prec=0) then - begin - // sortie si aucun détecteur déclaré sur le feu - test_memoire_zones:=Pres_train; - exit; - end; - - PrecInitial:=Prec; - repeat - inc(j); - // à la première itération, si "actuel" est déja un détecteur, ne pas faire de recherche sur le suivant - // et chaîner mémoire de zone - if (j=1) and (Typeactuel=1) then // si détecteur - begin - Pres_train:=MemZone[Prec,actuel]; - if Pres_Train and (NivDebug=3) then Affiche('Présence train de '+intToSTR(prec)+' à '+intToSTR(actuel),clyellow); - end - else - begin - AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1); - - prec:=actuel;TypePrec:=TypeActuel; - actuel:=AdrSuiv;TypeActuel:=typeGen; - if AdrSuiv>9990 then - begin - test_memoire_zones:=false;exit; - end; - - end; - - if NivDebug=3 then AfficheDebug('132 - suivant='+IntToSTR(adrsuiv),clYellow); - if actuel=0 then - begin - // si c'est un buttoir - test_memoire_zones:=false; - if NivDebug=3 then AfficheDebug('sortie car buttoir',clyellow); - exit; - end; - // si le suivant est un détecteur ; contrôler mémoire de zone et comporte t-il un signal? - AdrFeu:=0; - if (TypeActuel=1) then // détecteur - begin - if (NivDebug=3) and MemZone[PrecInitial][actuel] then AfficheDebug('Présence train de '+intToSTR(PrecInitial)+' à '+intToSTR(actuel),clyellow); - - Pres_train:=MemZone[PrecInitial][actuel] or Pres_train; // mémoire de zone - if Pres_Train then PresTrain01:=1 else PresTrain01:=0; - if NivDebug=3 then AfficheDebug('de '+IntToSTR(PrecInitial)+' à '+intToSTR(actuel)+'='+IntToSTR(PresTrain01),clyellow); - precInitial:=actuel; // pour préparer le suivant - - i:=index_feu_det(AdrSuiv); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal - AdrFeu:=feux[i].adresse; // adresse du feu - if (AdrFeu=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant - begin - AdrFeu:=0;j:=10; // on ne trouve pas de suivant - end; - if (AdrFeu<>0) then // si l'adresse est <>0 - begin - if (feux[i].Adr_el_suiv1<>prec) then // le feu est-il dans le bon sens de progression? - begin - s:='Trouvé feu '+IntToSTR(AdrFeu); - if (NivDebug=3) And Pres_Train then AfficheDebug(s+' et sortie proced:Mémoire de zone à 1',clyellow); - if (NivDebug=3) And (not(Pres_Train)) then AfficheDebug(s+' et sortie proced:Mémoire de zone à 0',clyellow); - test_memoire_zones:=Pres_train;exit; - - end - else - begin - if NivDebug=3 then AfficheDebug('Trouvé feu '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clOrange); - AdrFeu:=0; - end; - end - else - begin - //if (traceDet) {sprintf(Affiche,"Trouvé détecteur %d mais sans signal\r\n",AdrSuiv,Etat);Display(Affiche); - AdrFeu:=0; - end; - end - else - begin - if (NivDebug=3) then AfficheDebug('Trouvé aiguillage '+intToSTR(AdrSuiv),clyellow); - end; - sort:=(j=10) or (AdrFeu<>0) ; - until (sort); // on arrete jusqu'à trouver un signal ou si on va trop loin (10 itérations) - inc(ife); - until ife>=5; - if (NivDebug=3) and (Etat=0) then AfficheDebug('Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow); - test_memoire_zones:=Pres_train; -end; - - -Procedure affiche_Event_det; -var i : integer; -begin - with FormDebug.MemoEvtDet do - begin - //lines.clear; - lines.add('-------------'); - for i:=1 to N_event_det do - begin - lines.add(intToSTR(event_det[i])); - if traceListe then AfficheDebug(intToSTR(event_det[i]),clyellow); - end; - end; -end; - - -// supprime un évènement détecteur dans la liste Event_det[] -procedure supprime_event(i : integer); -var l : integer; -begin - for l:=i to N_Event_det do event_det[l]:=event_det[l+1]; - dec(N_event_det); -end; - -// trouve adresse d'un détecteur à "etat" avant "index" dans le tableau chrono -function trouve_index_det_chrono(Adr,etat,index : integer) : integer; -var i : integer; - trouve : boolean; -begin - if index<=0 then - begin - affiche('Erreur 784 index détecteur invalide',clred); - AfficheDebug('Erreur 784 index détecteur invalide',clred); - exit; - end; - i:=index; - if i>N_Event_tick then begin trouve_index_det_chrono:=0;exit; end; - inc(i); - repeat - dec(i); - trouve:=(event_det_tick[i].etat=etat) and (event_det_tick[i].detecteur=Adr) ; - until (trouve or (i=0)); - if trouve then - begin - trouve_index_det_chrono:=i;exit; - end; - trouve_index_det_chrono:=0; -end; - -// teste si la route est valide de det1, det2 à det3 -// les détecteurs doivent être consécutifs -// trouve le détecteur suivant de det1 à det2 si la route est correcte. (détecteurs en entrée obligatoires) -// transmis dans le tableau Event_det -// Résultat: -// si >=9996 : pas de route -// si 10 : ok route trouvée -function test_route_valide(det1,det2,det3 : integer) : integer; -var det_suiv,resultat : integer; -begin - if TraceListe then AfficheDebug('test route valide '+IntToSTR(det1)+' '+IntToSTR(det2)+' vers '+IntToSTR(det3)+' ',clyellow); - det_suiv:=detecteur_suivant_el(det1,1,det2,1); - if det_suiv=det3 then begin test_route_valide:=10;exit;end; - - test_route_valide:=9999; - exit; - - if (det_suiv>=9996) or (det3<>det_suiv) then begin resultat:=0; NivDebug:=0;end; - // test sens inverse.... - if resultat=0 then - begin - test_route_valide:=0;exit; - // si manipulation proche aiguillage - det_suiv:=detecteur_suivant_el(det3,1,det2,1); - if (det_suiv>=9996) or (det1<>det_suiv) then begin test_route_valide:=0; NivDebug:=0;exit;end; - end; - test_route_valide:=10 ; -end; - - -// présence train 3 détecteurs avant le feu -function PresTrainPrec(AdrFeu : integer) : boolean; -var PresTrain : boolean; - j,i,Det_initial,Adr_El_Suiv,Btype_el_suivant,DetPrec1,DetPrec2,DetPrec3,DetPrec4 : integer; -begin - i:=index_feu(Adrfeu); - if i=0 then - begin - Affiche('Erreur 602 - feu '+IntToSTR(adrFeu)+' non trouvé',clred); - if NivDebug=3 then AfficheDebug('Erreur 602 - feu '+IntToSTR(adrFeu)+' non trouvé',clred); - PresTrainPrec:=false; - exit; - end; - - // **** un feu peut être associé à 4 détecteurs (pour 4 voies convergentes) ***** - // il faut donc explorer les 4 détecteurs probables - PresTrain:=FALSE; - j:=1; - - repeat - if NivDebug=3 then afficheDebug('Séquence '+IntToSTR(j)+' de recherche des 4 détecteurs précédents-----',clOrange); - if (j=1) then - begin - det_initial:=feux[i].Adr_det1;Adr_El_Suiv:=feux[i].Adr_el_suiv1; - if feux[i].Btype_suiv1=1 then Btype_el_suivant:=1; - if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2; - if feux[i].Btype_suiv1=4 then Btype_el_suivant:=2; // BType_suiv: 1=détecteur 2=aig ou TJD ou TJS 4=tri - end; // Btye_el_suivant: 1= détecteur 2= aiguillage 4=Buttoir - if (j=2) then - begin - det_initial:=feux[i].Adr_det2;Adr_El_Suiv:=feux[i].Adr_el_suiv2; - if feux[i].Btype_suiv2=1 then Btype_el_suivant:=1; - if feux[i].Btype_suiv2=2 then Btype_el_suivant:=2; - if feux[i].Btype_suiv2=4 then Btype_el_suivant:=2; - end; - if (j=3) then - begin - det_initial:=feux[i].Adr_det3;Adr_El_Suiv:=feux[i].Adr_el_suiv3; - if feux[i].Btype_suiv3=1 then Btype_el_suivant:=1; - if feux[i].Btype_suiv3=2 then Btype_el_suivant:=2; - if feux[i].Btype_suiv3=4 then Btype_el_suivant:=2; - end; - if (j=4) then - begin - det_initial:=feux[i].Adr_det4;Adr_El_Suiv:=feux[i].Adr_el_suiv4; - if feux[i].Btype_suiv4=1 then Btype_el_suivant:=1; - if feux[i].Btype_suiv4=2 then Btype_el_suivant:=2; - if feux[i].Btype_suiv4=4 then Btype_el_suivant:=2; - end; - if (det_initial<>0) then - begin - DetPrec1:=detecteur_suivant(Adr_El_Suiv,Btype_el_suivant,det_initial,1,2); // 2= algo2 = arret sur aiguillage en talon mal positionné - if DetPrec1<1024 then // route bloquée par aiguillage mal positionné - begin - DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1); - if DetPrec2<1024 then - begin - DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1); - if DetPrec3<1024 then - begin - DetPrec4:=detecteur_suivant_El(DetPrec2,1,DetPrec3,1); - if DetPrec4<1024 then - begin - if AffSignal or (NivDebug=3) then AfficheDebug('Les détecteurs précédents au feu '+IntToSTR(Adrfeu)+' sont:'+intToSTR(Det_initial)+' '+intToSTR(DetPrec1)+' '+intToSTR(DetPrec2)+' '+intToSTR(DetPrec3)+' '+intToSTR(DetPrec4),clyellow); - PresTrain:=MemZone[DetPrec4,detPrec3] or - MemZone[DetPrec3,detPrec2] or MemZone[DetPrec2,detPrec1] or MemZone[DetPrec1,Det_initial] or presTrain ; - if AffSignal or (NivDebug=3) then - begin - if MemZone[DetPrec4,detPrec3] then AfficheDebug('0.présence train '+IntToSTR(DetPrec4)+' '+IntToSTR(detPrec3),clyellow); - if MemZone[DetPrec3,detPrec2] then AfficheDebug('1.présence train '+IntToSTR(DetPrec3)+' '+IntToSTR(detPrec2),clyellow); - if MemZone[DetPrec2,detPrec1] then AfficheDebug('2.présence train '+IntToSTR(DetPrec2)+' '+IntToSTR(detPrec1),clyellow); - if MemZone[DetPrec1,det_initial] then AfficheDebug('3.présence train '+IntToSTR(DetPrec1)+' '+IntToSTR(det_Initial),clyellow); - if PresTrain then AfficheDebug('présence train',clyellow) else afficheDebug('abscence train',clyellow); - end; - end; - //if AffSignal then AfficheDebug('MemZone'+intToSTR(DetPrec3)+' '+IntToSTR(detPrec2) = '+MemZone[DetPrec3,detPrec2] - end; - end; - end; - end; - inc(j); - until (j>=5); - if AffSignal or (NivDebug=3) then - begin - if presTrain Then afficheDebug('présence train feu '+intToSTR(AdrFeu),clorange) - else AfficheDebug('Absence train feu '+intToSTR(AdrFeu),clorange); - end; - PresTrainPrec:=presTrain; -end; - - -// mise à jour de l'état d'un feu en fontion de son environnement et affiche le feu -procedure Maj_Feu(Adrfeu : integer); -var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,Adr_El_Suiv, - Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ; - PresTrain,Aff_semaphore,car : boolean; - code,combine : word; - s : string; -begin - s:='Traitement du feu '+intToSTR(Adrfeu)+'------------------------------------'; - //if adrfeu=197 then affsignal:=true else affsignal:=false; - if AffSignal then AfficheDebug(s,clOrange); - i:=index_feu(Adrfeu); - if AdrFeu<>0 then - begin - modele:=Feux[i].aspect; - - Adr_det:=Feux[i].Adr_det1; // détecteur sur le signal - Adr_El_Suiv:=Feux[i].Adr_el_suiv1; // adresse élément suivant au feu - Btype_el_suivant:=Feux[i].Btype_suiv1; - - // signal directionnel ? - if (modele>10) then - begin - //Affiche('Signal directionnel '+IntToSTR(AdrFeu),clyellow); - Signal_direction(AdrFeu); - exit; - end; - - // signal non directionnel - etat:=etat_signal_suivant(AdrFeu,1) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant - if AffSignal then - begin - code_to_aspect(etat,code,combine); - s:='Etat signal suivant ('+intToSTR(AdresseFeuSuivant)+') est '; - s:=s+' à '+etatSign[code]; - if Combine<>0 then s:=s+' + '+etatSign[combine]; - AfficheDebug(s,clyellow); - end; - - // signaux traités spécifiquement - { - if (AdrFeu=201) then - begin - if ((aiguillage[28].position<>const_droit) and (aiguillage[29].position<>const_droit) and - (aiguillage[31].position=2)) then // attention spécial - Maj_Etat_Signal(AdrFeu,blanc) else Maj_Etat_Signal(AdrFeu,violet); - envoi_LEB(AdrFeu); - exit; - end; - if (AdrFeu=217) then - begin - if ((aiguillage[24].position<>const_droit) and (aiguillage[26].position<>const_droit)) then - Maj_Etat_Signal(AdrFeu,blanc) else Maj_Etat_Signal(AdrFeu,violet); - envoi_LEB(AdrFeu); - exit; - end; - } - - // signal à 2 feux = carré violet+blanc - if (Feux[i].aspect=2) then //or (feux[i].check<>nil) then // si carré violet - begin - // si aiguillage après signal mal positionnées - if carre_signal(AdrFeu) then - begin - Maj_Etat_Signal(AdrFeu,violet); - Envoi_signauxCplx; - exit; - end - else - begin - Maj_Etat_Signal(AdrFeu,blanc); - Envoi_signauxCplx; - exit; - end; - end; - - //if AffSignal then AfficheDebug('Debut du traitement général',clYellow); - // traitement des feux >3 feux différents de violet (cas général) - if (Feux[i].aspect>=3) and (EtatSignalCplx[AdrFeu]<>violet_F) then - begin - // détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré - if (Feux[i].VerrouCarre) and (Feux[i].aspect>=4) then presTrain:=PresTrainPrec(AdrFeu); - - if AffSignal then afficheDebug('Fin de la recherche des 4 détecteurs précédents-----',clOrange); - // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou que pas présence train avant signal et signal - // verrouillable au carré, afficher un carré - car:=carre_signal(AdrFeu); - // conditions supplémentaires de carré en fonction des aiguillages décrits - car:=cond_carre(AdrFeu) or car; - if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); - if (NivDebug>=1) and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); - if (Feux[i].aspect>=4) and ( (not(PresTrain) and Feux[i].VerrouCarre) or car) then Maj_Etat_Signal(AdrFeu,carre) - else - begin - // si on quitte le détecteur on affiche un sémaphore : attention tester le sens de circulation - // pour ne pas passer au rouge un feu à contresens. - // trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge - //if adrFeu=197 then NivDebug:=3; - if AffSignal then AfficheDebug('test du sémaphore',clYellow); - Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal - //Nivdebug:=0; - if Aff_Semaphore then - begin - if AffSignal then AfficheDebug('Présence train après signal'+intToSTR(AdrFeu)+' -> sémaphore ou carré',clYellow); - if testBit(EtatSignalCplx[Adrfeu],carre)=FALSE then Maj_Etat_Signal(AdrFeu,semaphore); - end - else - begin - // si aiguille locale déviée - Aig:=Aiguille_deviee(Adrfeu); - if (aig<>0) and (feux[i].aspect>=9) then // si le signal peut afficher un rappel et aiguille déviée - begin - if AffSignal then AfficheDebug('Aiguille '+intToSTR(aig)+' déviée',clYellow); - EtatSignalCplx[AdrFeu]:=0; - if (aiguillage[aig].vitesse=30) or (aiguillage[aig].vitesse=0) then Maj_Etat_Signal(AdrFeu,rappel_30); - if aiguillage[aig].vitesse=60 then Maj_Etat_Signal(AdrFeu,rappel_60); - - // si signal suivant affiche rappel ou rouge - if (TestBit(etat,rappel_60)) or (testBit(etat,rappel_30)) or (testBit(etat,carre)) or (testBit(etat,semaphore)) - then Maj_Etat_Signal(AdrFeu,jaune) - else - begin - // sinon si signal suivant=jaune - if (TestBit(etat,jaune)) then Maj_Etat_Signal(AdrFeu,jaune_cli); - end; - end - else - // aiguille locale non déviée ou aspect feu<9 - // si le signal suivant est rouge - begin - if AffSignal then AfficheDebug('pas d''aiguille déviée',clYellow); - // effacer la signbalisation combinée - EtatSignalCplx[adrFeu]:=EtatSignalCplx[adrFeu] and not($3c00); - if TestBit(etat,carre) or testBit(etat,semaphore) or testBit(etat,semaphore_cli )then Maj_Etat_Signal(AdrFeu,jaune) - else - begin - // si signal suivant affiche rappel - if TestBit(etat,rappel_30) or TestBit(etat,rappel_60) then - begin - EtatSignalCplx[AdrFeu]:=0; - if TestBit(etat,rappel_30) then Maj_Etat_Signal(AdrFeu,ral_30); - if TestBit(etat,rappel_60) then - begin - Maj_Etat_Signal(AdrFeu,ral_60); // si signal suivant est au rappel60, il faut tester s'il est à l'avertissement aussi - if TestBit(etat,jaune) then Maj_Etat_Signal(AdrFeu,jaune_cli); - end; - end - else - // si le signal suivant est jaune - if TestBit(etat,jaune) then Maj_Etat_Signal(AdrFeu,jaune_cli) - else Maj_Etat_Signal(AdrFeu,vert) - end; - end; - end; - end; - end; - end; - envoi_signauxCplx; -end; - -Procedure Maj_feux; -var i : integer; -begin - //Affiche('MAJ FEUX',clOrange); - Maj_feux_cours:=TRUE; - for i:=1 to NbreFeux do - begin - Maj_feu(Feux[i].Adresse); - end; - Maj_feux_cours:=FALSE; -end; - - -procedure rafraichit; -begin - //Affiche('Procédure rafraichit',cyan); - begin - Maj_feux; - //Maj_feux; - end -end; - -// trouve l'index d'un détecteur dans une branche depuis la fin de la branche -// si pas trouvé, renvoie 0 -function index_detecteur_fin(det,Num_branche : integer) : integer; -var dernier,i,j : integer; - trouve : boolean; - procedure recherche; - begin - repeat - if BrancheN[Num_Branche,i].Btype=1 then // cherche un détecteur - begin - j:=BrancheN[Num_Branche,i].adresse; - trouve:=det=j; - end; - if not(trouve) then dec(i); - until trouve or (j=0) - end; -begin - // déterminer la fin de la branche - i:=1; - repeat - inc(i); - until (BrancheN[Num_Branche,i].adresse=0) and (BrancheN[Num_Branche,i].btype=0); - dernier:=i-1; - // Affiche('dernier'+intToSTR(dernier),clwhite); - // rechercher le détecteur depuis l'index i - i:=dernier;index2_det:=0; - recherche; - if trouve then result:=i else result:=0; - //affiche(inttostr(ai+1),clOrange); - - //affiche('------------------------',clWhite); - recherche; - //affiche('------------------------',clGreen); - if trouve then index2_det:=i else index2_det:=0; - //affiche('index2='+IntToSTR(index2_det),clWhite); -end; - -// calcul des zones depuis le tableau des fronts descendants des évènements détecteurs -// transmis dans le tableau Event_det -procedure calcul_zones; -var AdrFeu,AdrDetFeu,Nbre,Nouveau_Det,i,resultat,det1,det2,det3,AdrSuiv,TypeSuiv,AdrPrec : integer ; - creer_tableau : boolean; - s : string; -begin - creer_tableau:=false; - det3:=event_det[N_event_det]; // c'est le nouveau détecteur - if det3=0 then exit; // pas de nouveau détecteur - FormDebug.MemoEvtDet.lines.add('Le nouveau détecteur est '+IntToSTR(det3)) ; - if TraceListe then AfficheDebug('Le nouveau détecteur est '+IntToSTR(det3),clyellow) ; - - // évaluer d'abord la route du nouveau détecteur sur tous les tableau déja rempli de 2 éléments - for i:=1 to N_trains do - begin - Nbre:=event_det_train[i].NbEl ; // Nombre d'éléments du tableau courant exploré - if Nbre=2 then - begin - if TraceListe or (NivDebug=3) then AfficheDebug('traitement Train n°'+intToSTR(i)+' 2 détecteurs',clyellow); - det1:=event_det_train[i].det[1]; - det2:=event_det_train[i].det[2]; - resultat:=test_route_valide(det1,det2,det3); - if resultat=10 then - begin - AdrSuiv:=detecteur_suivant_el(det2,1,det3,1); // ici on cherche le suivant à det2 det3 - if (Adrsuiv>=9996) then - begin - Affiche('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed); - if NivDebug=3 then AfficheDebug('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed); - end - else - begin - s:='route traitée de '+intToSTR(det2)+' à '+IntToSTR(det3)+' Mem '+intToSTR(det3)+' à '+IntToSTR(Adrsuiv); - FormDebug.MemoEvtDet.lines.add(s); - if traceListe then AfficheDebug(s,clyellow); - With FormDebug.RichEdit do - begin - s:='train '+IntToSTR(i)+' '+intToStr(det2)+' à '+intToStr(det3)+' => Mem '+IntToSTR(det3)+' à '+IntTOStr(AdrSuiv); - Lines.Add(s); - RE_ColorLine(FormDebug.RichEdit,lines.count-1,CouleurTrain[ ((i - 1) mod NbCouleurTrain) +1] ); - end; - if TraceListe then AfficheDebug(s,clyellow); - Affiche(s,clyellow); - if AffAigDet then AfficheDebug(s,clyellow); - - MemZone[det2,det3]:=FALSE; // efface zone précédente - MemZone[det3,AdrSuiv]:=TRUE; // valide la nouveau zone - // supprimer le 1er et décaler - event_det_train[i].det[1]:=event_det_train[i].det[2]; - event_det_train[i].det[2]:=det3; - event_det_train[i].NbEl:=2; - with FormDebug.MemoEvtDet do - begin - lines.add('Nouveau Tampon train '+intToStr(i)+'--------'); - lines.add(intToSTR(event_det_train[i].det[1])); - lines.add(intToSTR(event_det_train[i].det[2])); - end; - if TraceListe then - begin - AfficheDebug('Nouveau Tampon train '+intToStr(i)+'--------',clyellow); - AfficheDebug(intToSTR(event_det_train[i].det[1]),clyellow); - AfficheDebug(intToSTR(event_det_train[i].det[2]),clyellow); - end; - rafraichit; - rafraichit; - rafraichit; - if avecTCO then - begin - zone_TCO(det2,det3,0); // désactivation - zone_TCO(det3,AdrSuiv,1); // activation - end; - exit; // sortir absolument - end; - end; - end; - end; - - // traiter pour les cas avec 1 élément - for i:=1 to N_trains do - begin - Nbre:=event_det_train[i].NbEl ; // Nombre d'éléments du tableau courant exploré - if Nbre=1 then - begin - if traceListe then AfficheDebug('traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow); - // vérifier si l'élément du tableau et le nouveau sont contigus - det1:=event_det_train[i].det[1]; - Det_Adj(det1); // renvoie les adresses des détecteurs adjacents au détecteur "det1" résultat dans adj1 et adj2 - if (Adj1=det3) or (Adj2=det3) then - begin - event_det_train[i].det[2]:=det3; - event_det_train[i].NbEl:=2; - with FormDebug.MemoEvtDet do - begin - lines.add('Nouveau Tampon train '+intToStr(i)+'--------'); - lines.add(intToSTR(event_det_train[i].det[1])); - lines.add(intToSTR(event_det_train[i].det[2])); - end; - if TraceListe then - begin - AfficheDebug('Nouveau Tampon train '+intToStr(i)+'--------',clyellow); - AfficheDebug(intToSTR(event_det_train[i].det[1]),clyellow ); - AfficheDebug(intToSTR(event_det_train[i].det[2]),clyellow ); - end; - exit; // sortir absolument - end; - end; - end; - - // créer un train, donc un tableau - if N_Trains>=Max_Trains then - begin - Affiche('Erreur nombre de train maximal atteint',clRed); - end; - Inc(N_trains); - - // vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir - for i:=1 to NbreFeux do - begin - AdrFeu:=Feux[i].Adresse; - AdrDetfeu:=Feux[i].Adr_Det1; - if (AdrDetFeu=Det3) and (feux[i].aspect<10) then - begin - AdrSuiv:=Feux[i].Adr_el_suiv1;TypeSuiv:=Feux[i].Btype_suiv1; - AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,1,1) ; // détecteur précédent le feu ; algo 1 - if AdrPrec=0 then - begin - if TraceListe then Affiche('FD - Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow); - MemZone[0,AdrDetFeu]:=false; - //NivDebug:=3; - AffSignal:=true; - maj_feu(AdrFeu); - end; - end; - end; - - if TraceListe then AfficheDebug('Création Train n°'+intToSTR(i),clyellow); - Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains); - event_det_train[N_trains].det[1]:=det3; - event_det_train[N_trains].NbEl:=1; - with FormDebug.MemoEvtDet do - begin - lines.add('Nouveau Tampon train '+intToStr(N_trains)+'--------'); - lines.add(intToSTR(event_det_train[N_trains].det[1])); - end; - if TraceListe then - begin - AfficheDebug('Nouveau Tampon train '+intToStr(N_trains)+'--------',clyellow); - AfficheDebug(intToSTR(event_det_train[N_trains].det[1]),clyellow ); - end; -end; - - - -// demande l'état d'un accessoire à la centrale. Le résultat sera réceptionné sur évènement des informations -// de rétrosignalisation. -procedure demande_info_acc(adresse : integer); -var s : string; - n : integer; -begin - // uniquement si connecté directement à la centrale - if portCommOuvert or parSocketLenz then - begin - // envoyer 2 fois la commande, une fois avec N=0 pour récupérer le nibble bas, - // une autre fois avec N=1 pour récupérer le nibble haut - s:=#$42+char((adresse-1) div 4); - n:=$80+((adresse-1) mod 4) div 2; - s:=s+char(n); // N=0 (bit 0) - s:=checksum(s); - envoi(s); - - s:=#$42+char((adresse-1) div 4); - n:=$80+((adresse-1) mod 4) div 2; - s:=s+char(n or 1); // N=1 (bit 0) - s:=checksum(s); - envoi(s); - end; -end; - -// demande l'état de tous les accessoires par l'interface -procedure demande_etat_acc; -var i : integer; -begin - Affiche('Demande état des aiguillages',ClYellow); - for i:=1 to maxaiguillage do - begin - demande_info_acc(i); - end; -end; - - -// traitement des évènements actionneurs -procedure Event_act(adr,etat : integer;train : string); -var i,v,va,j,etatAct,Af,Ao,Access,sortie : integer; - s : string; - presTrain_PN : boolean; - Ts : TAccessoire; -begin - // vérifier si l'actionneur en évènement a été déclaré pour réagir - if AffActionneur then Affiche('Actionneur '+intToSTR(Adr)+'='+intToSTR(etat),clyellow); - - for i:=1 to maxTablo_act do - begin - s:=Tablo_actionneur[i].train; - etatAct:=Tablo_actionneur[i].etat ; - // actionneur pour fonction train - if (Tablo_actionneur[i].actionneur=adr) and (Tablo_actionneur[i].fonction<>0) and ((s=train) or (s='X')) and (etatAct=etat) then - begin - Affiche('Actionneur '+intToSTR(adr)+' Train='+train+' F'+IntToSTR(Tablo_actionneur[i].fonction)+':'+intToSTR(etat),clyellow); - // exécutione la fonction F vers CDM - envoie_fonction_CDM(Tablo_actionneur[i].fonction,etat,train); - TempoAct:=tablo_actionneur[i].Tempo div 100; - RangActCours:=i; - end; - // actionneur pour accessoire - if (Tablo_actionneur[i].actionneur=adr) and (Tablo_actionneur[i].accessoire<>0) and ((s=train) or (s='X')) and (etatAct=etat) then - begin - access:=Tablo_actionneur[i].accessoire; - sortie:=Tablo_actionneur[i].sortie; - - Affiche('Actionneur '+intToSTR(adr)+' Train='+train+' Accessoire '+IntToSTR(access)+':'+intToSTR(sortie),clyellow); - // exécution la fonction accessoire vers CDM - if Tablo_actionneur[i].RAZ then Ts:=aig else Ts:=Feu; - pilote_acc(access,sortie,Ts); // sans RAZ - RangActCours:=i; - end; - - - end; - - - - // dans le tableau des PN - for i:=1 to NbrePN do - begin - for v:=1 to Tablo_PN[i].nbvoies do - begin - aO:=Tablo_PN[i].voie[v].actOuvre; - aF:=Tablo_PN[i].voie[v].actFerme; - - if (aO=adr) and (etat=0) then // actionneur d'ouverture - begin - Tablo_PN[i].voie[v].PresTrain:=false; - // vérifier les présences train sur les autres voies du PN - presTrain_PN:=false; - for va:=1 to Tablo_PN[i].nbvoies do - begin - presTrain_PN:=presTrain_PN or Tablo_PN[i].voie[va].PresTrain; - end; - if not(presTrain_PN) then - begin - Affiche('Ouverture PN'+intToSTR(i),clOrange); - pilote_acc(Tablo_PN[i].AdresseOuvre,Tablo_PN[i].CommandeOuvre,Aig); - end; - end; - - if (aF=adr) and (etat=1) then // actionneur de fermeture - begin - Tablo_PN[i].voie[v].PresTrain:=true; - Affiche('Fermeture PN'+IntToSTR(i)+' (train voie '+IntToSTR(v)+')',clOrange); - pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,Aig); - end; - end; - end; -end; - -Procedure affiche_memoire; -var s: string; -begin - s:='Mémoire évènements '+IntToSTR( 100*N_Event_tick div Max_Event_det_tick)+' %'; - Formprinc.statictext.caption:=s; -end; - -procedure evalue; -begin - if not(configNulle) then - begin - //if CDM_connecte // and (length(recuCDM)<1000) then - Maj_feux; // on ne traite pas les calculs si CDM en envoie plusieurs - end; -end; - -// traitement sur les évènements détecteurs -procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); -var i,AdrSuiv,AdrFeu,AdrDetfeu,TrainActuel,Etat01,typeSuiv,AdrPrec : integer; - s : string; -begin - if Etat then Etat01:=1 else Etat01:=0; - - // vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état - // on reçoit un doublon dans deux index consécutifs. -(* - if N_Event_tick>=1 then - begin - if (event_det_tick[N_event_tick].etat=etat01) and (event_det_tick[N_event_tick].detecteur=Adresse) then - begin - //Affiche(IntToSTR(Adresse)+' déja stocké',clorange); - exit; // déja stocké - end; - end; - *) - if Traceliste then AfficheDebug('--------------------- détecteur '+intToSTR(Adresse)+' à '+intToSTR(etat01)+'-----------------------------',clOrange); - if AffAigDet then - begin - //s:='Evt Det '+intToSTR(adresse)+'='+intToSTR(etat01); - s:='Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01); - - Affiche(s,clyellow); - if not(TraceListe) then AfficheDebug(s,clyellow); - end; - - //if etat then Mem[Adresse]:=true; // mémoriser l'état à 1 - - ancien_detecteur[Adresse]:=detecteur[Adresse].etat; - detecteur[Adresse].etat:=etat; - detecteur[Adresse].train:=train; - detecteur_chgt:=Adresse; - - // stocke les changements d'état des détecteurs dans le tableau chronologique - if (N_Event_tick>=Max_Event_det_tick) then - begin - N_Event_tick:=0; - Affiche('Raz Evts détecteurs',clLime); - end; - inc(N_Event_tick); - event_det_tick[N_event_tick].tick:=tick; - event_det_tick[N_event_tick].detecteur:=Adresse; - event_det_tick[N_event_tick].etat:=etat01; - if (n_Event_tick mod 10) =0 then affiche_memoire; - // Affiche('stockage de '+intToSTR(N_event_tick)+' '+IntToSTR(Adresse)+' à '+intToSTR(etat01),clyellow); - - - // détection front montant - if not(ancien_detecteur[Adresse]) and detecteur[Adresse].etat then - begin - // explorer les feux pour déverrouiller les feux dont le trajets viennent d'un buttoir pour changer le feu qd un train se présente - // sur le détecteur - for i:=1 to NbreFeux do - begin - AdrFeu:=Feux[i].Adresse; - AdrDetfeu:=Feux[i].Adr_Det1; - if (AdrDetFeu=Adresse) and (feux[i].aspect<10) then - begin - AdrSuiv:=Feux[i].Adr_el_suiv1;TypeSuiv:=Feux[i].Btype_suiv1; - if AffSignal then AfficheDebug('Pour Feu '+intToSTR(AdrFeu)+' detecteursuivant('+intToSTR(AdrSuiv)+','+IntToSTR(typeSuiv)+','+intToSTR(AdrDetFeu)+',1)',clyellow); - AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,1,1) ; // détecteur précédent le feu, algo 1 - if AdrPrec=0 then - begin - If traceListe then AfficheDebug('Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow); - MemZone[0,AdrDetFeu]:=true; - maj_feu(AdrFeu); - end; - end; - - end; - - end; - - // détection fronts descendants - if ancien_detecteur[Adresse] and not(detecteur[Adresse].etat) and (N_Event_detAdresse then - begin - if AffFD then AfficheDebug('index='+intToSTR(N_event_tick)+' FD '+intToSTR(Adresse),clyellow); - inc(N_event_det); - event_det[N_event_det]:=Adresse; - // vérification de la connaissance de la position de tous les aiguillages au premier évènement FD détecteur - if not(PremierFD) then - begin - for i:=1 to MaxAiguillage do - begin - if aiguillage[i].modele<>0 then - begin - if aiguillage[i].position=9 then - begin - Affiche('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); - AfficheDebug('Attention : position de l''aiguillage '+IntToSTR(i)+' inconnue',clred); - end; - end; - end; - end; - premierFD:=True; - calcul_zones; - end; - end; - - if (N_event_det>=Max_event_det) then - begin - Affiche('Débordement d''évènements FD - Raz tampon',clred); - N_event_det:=0; - FormDebug.MemoEvtDet.lines.add('Raz sur débordement'); - end; - - // attention à partir de cette section le code est susceptible de ne pas être exécuté - - // Mettre à jour le TCO - if AvecTCO then - begin - formTCO.Maj_TCO(Adresse); - end; -end; - -// évènement d'aiguillage -procedure Event_Aig(adresse,pos,objet : integer); -var s: string; - faire_event: boolean; -begin - // ------------------- traitement du numéro d'objet ------------------------- - // init objet - if aiguillage[adresse].objet=0 then - begin - aiguillage[adresse].objet:=objet; - //affiche('stockage Aiguillage '+intToSTR(adresse)+' objet='+intToSTR(objet),clYellow); - end; - - // ne pas faire l'évaluation si l'ancien état de l'aiguillage est indéterminée (9) - // car le RUN vient de démarrer - faire_event:=aiguillage[adresse].position<>9; - aiguillage[adresse].position:=pos; - - // ------------- stockage évènement aiguillage dans tampon event_det_tick ------------------------- - if (N_Event_tick>=Max_Event_det_tick) then - begin - N_Event_tick:=0; - Affiche('Raz Evts détecteurs',clLime); - end; - s:='Tick='+IntToSTR(tick)+' Evt Aig '+intToSTR(adresse)+'='+intToSTR(pos); - if pos=const_droit then s:=s+' droit' else s:=s+' dévié'; - if AffAigDet then - begin - if objet<>0 then s:=s+' objet='+IntToSTR(objet); - Affiche(s,clyellow); - AfficheDebug(s,clyellow); - end; - FormDebug.MemoEvtDet.lines.add(s) ; - if (n_Event_tick mod 10) =0 then affiche_memoire; - inc(N_Event_tick); - event_det_tick[N_event_tick].tick:=tick; - event_det_tick[N_event_tick].aiguillage:=adresse; - event_det_tick[N_event_tick].etat:=pos; - event_det_tick[N_event_tick].objet:=objet; - - // Mettre à jour le TCO - if AvecTCO then - begin - formTCO.Maj_TCO(Adresse); - end; - - // l'évaluation des routes est à faire selon conditions - if faire_event then evalue; -end; - - -// le décodage de la rétro est appellée sur une réception d'une trame de la rétrosignalisation de la centrale. -// On déclenche ensuite les évènements détecteurs ou aiguillages. -procedure decode_retro(adresse,valeur : integer); -var s : string; - adraig,bitsITT,i : integer; -begin - //affiche(IntToSTR(adresse)+intToSTR(valeur),clorange); - bitsITT:=(valeur and $E0); - // bit à 010X XXXX = c'est un module de rétrosignalisation (pas un aiguillage) - // doc LENZ Xpressnet protocol description page 31 - detecteur_chgt:=0; - if (valeur and $10)=$10 then // si bit N=1, les 4 bits de poids faible sont les 4 bits de poids fort du décodeur - begin - // détermine le détecteur qui a changé d'état - // -------état du détecteur - if bitsITT=$40 then // module de rétro = détecteur - begin - // affecter l'état des détecteurs - i:=adresse*8+8; - if detecteur[i].etat<>((valeur and $8) = $8) then // si changement de l'état du détecteur bit 7 - begin - Event_detecteur(i,(valeur and $8) = $8,''); // pas de train affecté sur le décodage de la rétrosignalisation - end; - - i:=adresse*8+7; - if detecteur[i].etat<>((valeur and $4) = $4) then // si changement de l'état du détecteur bit 6 - begin - Event_detecteur(i,(valeur and $4) = $4,''); - end; - - i:=adresse*8+6; - if detecteur[i].etat<>((valeur and $2) = $2) then // si changement de l'état du détecteur bit 5 - begin - Event_detecteur(i,(valeur and $2) = $2,''); - end; - - i:=adresse*8+5; - if detecteur[i].etat<>((valeur and $1) = $1) then // si changement de l'état du détecteur bit 4 - begin - Event_detecteur(i,(valeur and $1) = $1,''); - end; - end; - - // état de l'aiguillage - if bitsITT=$00 then // module d'aiguillages, N=1 - begin - adraig:=((adresse * 4)+1 ); // *4 car N=1, c'est le "poids fort" - if (valeur and $C)=$8 then - begin - Event_Aig(adraig+3,const_droit,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=2';AfficheDebug(s,clYellow);end; - end; - if (valeur and $C)=$4 then - begin - Event_Aig(adraig+3,const_devie,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=1';AfficheDebug(s,clYellow);end; - end; - if (valeur and $3)=$2 then - begin - Event_Aig(adraig+2,const_droit,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=2';AfficheDebug(s,clYellow);end; - end; - if (valeur and $3)=$1 then - begin - Event_Aig(adraig+2,const_devie,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=1';AfficheDebug(s,clYellow);end; - end; - end; - end; - - if (valeur and $10)=$00 then // si bit N=0, les 4 bits de poids faible sont les 4 bits de poids faible du décodeur - begin - //Affiche('N=0',clYellow); - if bitsITT=$40 then // module de rétro - begin - // affecter l'état des détecteurs - i:=adresse*8+4; - if detecteur[i].etat<>((valeur and $8) = $8) then // si changement de l'état du détecteur bit 7 - begin - Event_detecteur(i,(valeur and $8) = $8,''); - end; - i:=adresse*8+3; - if detecteur[i].etat<>((valeur and $4) = $4) then // si changement de l'état du détecteur bit 6 - begin - Event_detecteur(i,(valeur and $4) = $4,''); - end; - - i:=adresse*8+2; - if detecteur[i].etat<>((valeur and $2) = $2) then // si changement de l'état du détecteur bit 5 - begin - Event_detecteur(i,(valeur and $2) = $2,''); - end; - - i:=adresse*8+1; - if detecteur[i].etat<>((valeur and $1) = $1) then // si changement de l'état du détecteur bit 4 - begin - Event_detecteur(i,(valeur and $1) = $1,''); - end; - - end; - if bitsITT=$00 then // module d'aiguillages - begin - adraig:=(adresse * 4)+1; - if (valeur and $C)=$8 then - begin - Event_Aig(adraig+1,const_droit,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=2';AfficheDebug(s,clYellow);end; - end; - if (valeur and $C)=$4 then - begin - Event_Aig(adraig+1,const_devie,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=1';AfficheDebug(s,clYellow);end; - end; - if (valeur and $3)=$2 then - begin - Event_Aig(adraig,const_droit,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=2';AfficheDebug(s,clYellow);end; - end; - if (valeur and $3)=$1 then - begin - Event_Aig(adraig,const_devie,0); - if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=1';AfficheDebug(s,clYellow);end; - end; - end; - end; -end; - - -// décodage d'une chaine simple de la rétrosignalisation de la centrale -function decode_chaine_retro(chaineINT : string) : string ; -var msg : string; - i,cvLoc : integer; -begin - //affiche(chaine_hex(chaine),clyellow); - msg:=''; - ack:=true;nack:=false; - // décodage du 3eme octet de la chaîne - if chaineINT[1]=#1 then - begin - case chaineINT[2] of // page 13 doc XpressNet - #1 : begin nack:=true;msg:='erreur timout transmission';end; - #2 : begin nack:=true;msg:='erreur timout centrale';end; - #3 : begin nack:=true;msg:='erreur communication inconnue';end; - #4 : begin succes:=true;msg:='succès';end; - #5 : begin nack:=true;msg:='plus de time slot';end; - #6 : begin nack:=true;msg:='débordement tampon LI100';end; - end; - if traceTrames and (chaineINT[2]=#4) then AfficheDebug(msg,clYellow); - if traceTrames and (chaineINT[2]<>#4) then AfficheDebug(msg,clRed); - delete(chaineINT,1,3); - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineINT[1]=#2 then - begin - msg:='Version matérielle '+intTohex(ord(chaineINT[2]),2)+' - Version soft '+intToHex(ord(chaineINT[3]),2); - Affiche(msg,clYellow); - delete(chaineINT,1,2); - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineINT[1]=#$61 then - begin - delete(chaineInt,1,1); - case chaineINT[1] of - #$00 : begin ack:=true;msg:='Voie hors tension';end; - #$01 : begin ack:=true;msg:='Reprise';end; - - #$02 : begin ack:=true;msg:='Mode programmation ';end; - - #$80 : begin nack:=true;msg:='erreurs de transferts- Voir doc XpressNet p29';end; - #$81 : begin nack:=true;msg:='Station occupée - Voir doc XpressNet p29';end; - #$82 : begin nack:=true;msg:='Commande non implantée';end; - else begin nack:=true;msg:='Réception inconnue';end; - end; - if nack then affiche(msg,clred) else affiche(msg,clyellow); - delete(chaineINT,1,2); - decode_chaine_retro:=chaineINT; - exit; - end; - - if ((chaineINT[1]=#$63) and (chaineINT[2]=#$14)) then // V3.6 uniquement - begin - // réception d'un CV. DocXpressNet p26 63 14 01 03 chk - - delete(chaineInt,1,2); - cvLoc:=ord(chaineINT[1]); - //Affiche('Réception CV'+IntToSTR(cvLoc)+' à '+IntToSTR(ord(chaineINT[2])),clyellow); - if cvLoc>255 then Affiche('Erreur Recu CV>255',clRed) - else - begin - tablo_cv[cvLoc]:=ord(chaineINT[2]); - inc(N_Cv); // nombre de CV recus - end; - recu_cv:=true; - delete(chaineInt,1,3); - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineINT[1]=#$42 then - begin - delete(chaineInt,1,1); - decode_retro(ord(chaineInt[1]),ord(chaineInt[2])); - delete(chaineInt,1,3); - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineINT[1]=#$81 then - begin - delete(chaineInt,1,2); - Affiche('Voie hors tension msg1',clRed); - Hors_tension2:=true; - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineINT[1]=#$61 then - begin - delete(chaineInt,1,2); - Affiche('Voie hors tension msg2',clRed); - Hors_tension2:=false; - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineINT[1]=#$46 then - begin - //FF FD 46 43 40 41 40 40 49 4D non documentée - //FF FD 46 43 50 41 50 40 50 54 non documentée - Affiche('Chaine non documentée recue: '+chaine_HEX(chaineINT),clred); - delete(chaineInt,1,8); - Hors_tension2:=false; - decode_chaine_retro:=chaineINT; - exit; - end; - - i:=pos(#$46+#$43+#$50,chaineInt); - if (i<>0) and (length(chaineInt)>=3) then - begin - delete(chaineInt,1,3); - Affiche('Reprise msg 2',clOrange); - Hors_tension2:=false; - decode_chaine_retro:=chaineINT; - exit; - end; - - if chaineInt[1]=#$81 then - begin - delete(chaineInt,1,2); - Affiche('Court circuit msg 1',clRed); - decode_chaine_retro:=chaineINT; - exit; - end; - - ack:=false; - nack:=true; - affiche('Erreur 7, chaîne rétrosig. inconnue recue:'+chaine_HEX(chaineINT),clred); - decode_chaine_retro:=''; -end; - -// procédure appellée après réception sur le port USB ou socket -procedure interprete_reponse(chaine : string); -var chaineInt,msg : string; - i,cv : integer; - -begin - chaineINT:=chaine; - - while length(chaineINT)>=3 do - begin - if length(chaineINT)>4 then - begin - // supprimer l'entete éventuelle - if (chaineINT[1]=#$ff) and (chaineINT[2]=#$fe) then Delete(chaineINT,1,2); - if (chaineINT[1]=#$ff) and (chaineINT[2]=#$fd) then Delete(chaineINT,1,2); - end; - chaineINT:=decode_chaine_retro(chaineINT); - end; - -end; - -function HexToStr(s: string) : string ; -// transforme une chaîne 0A FF CA.. en chaine d'octets -var i,long,erreur : integer; - st : string; - v : byte; -begin - long:=length(s); - st:=''; - i:=1; - repeat - val('$'+copy(s,i,2),v,erreur); - st:=st+char(v); - inc(i,3); - until (i>=long); - HexToStr:=st; -end; - - -procedure deconnecte_CDM; -begin - with Formprinc do - begin - ClientSocketCDM.close; - end; -end; - - -{$J+} -// vérifie si version OS32 bits ou OS64 bits -function IsWow64Process: Boolean; -type - TIsWow64Process=function(hProcess: THandle; var Wow64Process: Boolean): Boolean; stdcall; -var - DLL: THandle; - pIsWow64Process: TIsWow64Process; -const - IsWow64: Boolean=False; -begin - IsWow64:=false; - DLL:=LoadLibrary('kernel32.dll'); - if (DLL<>0) then - begin - pIsWow64Process:=GetProcAddress(DLL,'IsWow64Process'); - if (Assigned(pIsWow64Process)) then - begin - pIsWow64Process(GetCurrentProcess,IsWow64); - end; - FreeLibrary(DLL); - end; - Result:=IsWow64; -end; -{$J-} - -// initialisation de la comm USB -procedure connecte_USB; -var i,j : integer; -begin - if NumPort<>0 then - begin - With Formprinc.MSCommUSBLenz do - begin - i:=pos(':',portCom); - j:=pos(',',PortCom); - j:=posEx(',',PortCom,j+1); - j:=posEx(',',PortCom,j+1); - j:=posEx(',',PortCom,j+1); - - confStCom:=copy(portCom,i+1,j-i-1); //Affiche(ConfStCom,clred); - Settings:=ConfStCom; // COMx:vitesse,n,8,1 - Affiche('Demande ouverture COM'+intToSTR(NumPort)+':'+ConfStCom+' protocole '+IntToSTR(protocole),CLYellow); - if protocole>=4 then Handshaking:=0 {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff 4=5=protocoles "maison"} - else Handshaking:=protocole; - - SThreshold:=1; - RThreshold:=1; - CommPort:=NumPort; - DTREnable:=True; - if protocole=4 then RTSEnable:=True //pour la genli - else RTSenable:=False; - - InputMode:=comInputModeBinary; - end; - portCommOuvert:=true; - try - Formprinc.MSCommUSBLenz.portopen:=true; - except - portCommOuvert:=false; - end; - end - else - begin - portCommOuvert:=false; - Affiche('Port Com nul dans le fichier de configuration',clyellow); - end; - - if portCommOuvert then - begin - affiche('port COM'+intToSTR(NumPort)+' ouvert',clGreen); - With Formprinc do - begin - LabelTitre.caption:=titre+' Interface connectée au COM'+IntToSTR(NumPort); - MenuConnecterUSB.enabled:=false; - DeConnecterUSB.enabled:=true; - ConnecterCDMRail.enabled:=false; - DeConnecterCDMRail.enabled:=false; - end; - end - else - begin - Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clOrange) ; - end; -end; - - -Function GetWindowFromID(ProcessID : Cardinal): THandle; -Var TestID : Cardinal; - TestHandle : Thandle; -Begin - Result:=0; - TestHandle:=FindWindowEx(GetDesktopWindow,0,Nil,Nil); - while TestHandle>0 do - begin - if GetParent(TestHandle)=0 then GetWindowThreadProcessId(TestHandle,@TestID); - if TestID=ProcessID then - begin - Result:=TestHandle; - exit; - end; - TestHandle:=GetWindow(TestHandle,GW_HWNDNEXT) - end; -end; - -// renvoie si un process EXE tourne. Renvoie le Handle du process dans CDMHd et l'Id du process dans ProcessID -// sExeName : Nom de l'EXE sans le chemin, et sans EXE } -function ProcessRunning(sExeName: String) : Boolean; -var - hSnapShot : THandle; - ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 - processID : DWord; -begin - Result:=false; - hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); - Win32Check(hSnapShot <> INVALID_HANDLE_VALUE); - - sExeName:=LowerCase (sExeName); - FillChar(ProcessEntry32,SizeOf(TProcessEntry32),#0); - ProcessEntry32.dwSize:=SizeOf(TProcessEntry32); // contient la structure de tous les process - - if (Process32First(hSnapShot,ProcessEntry32)) then - repeat - //Affiche(ProcessEntry32.szExeFile,ClYellow); - if (Pos(sExeName,LowerCase(ProcessEntry32.szExeFile))=1) then - begin - processID:=ProcessEntry32.th32ProcessID; - CDMhd:=GetWindowFromID(processID); - Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); - Result:=true; - Break; - end; - until (Process32Next(hSnapShot,ProcessEntry32)=false); - CloseHandle(hSnapShot); -end; - - -// préparation du tampon pour SendInput -procedure KeybdInput(VKey: Byte; Flags: DWORD); -begin - SetLength(KeyInputs, Length(KeyInputs)+1); - KeyInputs[high(KeyInputs)].Itype := INPUT_KEYBOARD; - with KeyInputs[high(KeyInputs)].ki do - begin - wVk:=VKey; - wScan:=MapVirtualKey(wVk, 0); - dwFlags:=Flags; - end; -end; - - - -procedure SendKey(Wnd,VK : Cardinal; Ctrl,Alt,Shift : Boolean); -var - MC,MA,MS : Boolean; -begin - // Etats des touches spéciales - MC:=Hi(GetAsyncKeyState(VK_CONTROL))>127; - MA:=Hi(GetAsyncKeyState(VK_MENU))>127; - MS:=Hi(GetAsyncKeyState(VK_SHIFT))>127; - - // Simulation des touches de contrôle - if Ctrl<>MC then keybd_event(VK_CONTROL,0,Byte(MC)*KEYEVENTF_KEYUP,0); - if Alt<>MA then keybd_event(VK_MENU,0,Byte(MA)*KEYEVENTF_KEYUP,0); - if Shift<>MS then keybd_event(VK_SHIFT,0,Byte(MS)*KEYEVENTF_KEYUP,0); - - // Appui sur les touches - keybd_event(VK,0,0,0); - keybd_event(VK,0,KEYEVENTF_KEYUP,0); - -// keybd_event(MapVirtualKeyA(VK,0),0,0,0); -// keybd_event(MapVirtualKeyA(VK,0),0,KEYEVENTF_KEYUP,0); - - // Relâchement des touches si nécessaire - if Ctrl<>MC then keybd_event(VK_CONTROL,0,Byte(Ctrl)*KEYEVENTF_KEYUP,0); - if Alt<>MA then keybd_event(VK_MENU,0,Byte(Alt)*KEYEVENTF_KEYUP,0); - if Shift<>MS then keybd_event(VK_SHIFT,0,Byte(Shift)*KEYEVENTF_KEYUP,0); -end; - -// conversion d'une chaine standard en chaîne VK (virtual key) pour envoyer des évènements clavier -// 112=F1 .. 135=F20 136 à 143 rien 145 à 159 : spécifique ou non utilisé -// $A0 .. $B0 : contrôles curseur -// $BA : spécifique au pays -// $6A à $6F * + espace - . / -// BB à BE + - . attention la description diffère -function convert_VK(LAY : string) : string; -var i : integer; - s : string; -begin - s:=''; - for i:=1 to Length(Lay) do - begin - case Lay[i] of - '0' : s:=s+#96 ; - '1' : s:=s+'a'; - '2' : s:=s+'b'; - '3' : s:=s+'c'; - '4' : s:=s+'d'; - '5' : s:=s+'e'; - '6' : s:=s+'f'; - '7' : s:=s+'g'; - '8' : s:=s+'h'; - '9' : s:=s+'i'; - '*' : s:=s+#$6a; - '+' : s:=s+#$6b; - // ' ' : s:=s+#$6c; - '-' : s:=s+#$6d; - '.' : s:=s+#$6e; - '/' : s:=s+#$6f; - '_' : s:=s+'{8}'; - // '\' : s:=s+#$e2; - 'a'..'z' : s:=s+Upcase(lay[i]); - ' ','A'..'Z',#8..#$D : s:=s+lay[i]; - else Affiche('Erreur de conversion VK : '+lay,clred); - end; - end; - convert_VK:=s; -end; - -// Lance et connecte CDM rail. en sortie si CDM est lancé Lance_CDM=true, -function Lance_CDM : boolean; -var i : integer; - s : string; - cdm_lanceLoc : boolean; -begin - s:='CDR'; - if (ProcessRunning(s)) then - begin - // CDM déja lancé; - Lance_CDM:=true; - if CDM_connecte then exit; - deconnecte_USB; - connecte_CDM; - exit; - end; - - Affiche('Lancement de CDM '+lay,clyellow); - cdm_lanceLoc:=false; - // lancement depuis le répertoire 32 bits d'un OS64 - if ShellExecute(Formprinc.Handle, - 'open',PChar('C:\Program Files (x86)\CDM-Rail\cdr.exe'), - Pchar('-f '+lay), // paramètre - - PChar('C:\Program Files (x86)\CDM-Rail\') // répertoire - ,SW_SHOWNORMAL)>32 then - begin - cdm_lanceLoc:=true; - //Affiche('lancé1',clyellow); - end; - - if not(cdm_lanceLoc) then - begin - // si çà marche pas essayer depuis le répertoire de base sur un OS32 - Affiche('2eme lancement',clyellow); - if ShellExecute(Formprinc.Handle, - 'open',PChar('C:\Program Files\CDM-Rail\cdr.exe'), - Pchar('-f '+lay), // paramètre - PChar('C:\Program Files\CDM-Rail\') // répertoire - ,SW_SHOWNORMAL)<=32 then - begin - ShowMessage('répertoire CDM rail introuvable'); - lance_CDM:=false;exit; - end; - cdm_lanceLoc:=false; - end; - - if cdm_lanceLoc then - begin - Formprinc.caption:=af+' - '+lay; - // On a lancé CDM, déconnecter l'USB - deconnecte_USB; - Affiche('lance les fonctions automatiques de CDM',clyellow); - Sleep(3000); - ProcessRunning(s); // récupérer le handle de CDM - SetForegroundWindow(CDMhd); - Application.ProcessMessages; - - // démarre le serveur IP ------------------------------------ - KeybdInput(VK_MENU,0); // enfonce Alt - KeybdInput(Ord('C'),0); // enfonce C - KeybdInput(Ord('C'),KEYEVENTF_KEYUP); // relache C - - KeybdInput(VK_MENU,KEYEVENTF_KEYUP); // relache ALT - - KeybdInput(Ord('C'),0); - KeybdInput(Ord('C'),KEYEVENTF_KEYUP); - - KeybdInput(VK_RETURN,0); - KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); - KeybdInput(VK_RETURN,0); - KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); - - i:=SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); // la fenetre serveur démarré est affichée - Sleep(300); - - KeybdInput(VK_RETURN,0); - KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); - SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); //fermer la fenetre - Sleep(500); - - connecte_CDM; - Sleep(400); - Application.processMessages; - - // Serveur d'interface -------------------------------------- - if ServeurInterfaceCDM>0 then - begin - KeybdInput(VK_MENU,0); // enfonce ALT - KeybdInput(Ord('I'),0); // I - KeybdInput(Ord('I'),KEYEVENTF_KEYUP); - - KeybdInput(VK_MENU,KEYEVENTF_KEYUP); // relache ALT - KeybdInput(Ord('I'),0); - KeybdInput(Ord('I'),KEYEVENTF_KEYUP); - - KeybdInput(VK_RETURN,0); - KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); - KeybdInput(VK_RETURN,0); - KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); - SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); // affiche la fenetre d'interface - Sleep(300); - - // descendre le curseur n fois pour sélectionner le serveur - for i:=1 to ServeurInterfaceCDM-1 do - begin - KeybdInput(VK_DOWN, 0); - KeybdInput(VK_DOWN, KEYEVENTF_KEYUP); - end; - // 2x TAB pour pointer sur OK - KeybdInput(VK_TAB, 0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP); - KeybdInput(VK_TAB, 0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP); - KeybdInput(VK_SPACE, 0);KeybdInput(VK_SPACE, KEYEVENTF_KEYUP); - SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); - Sleep(200); - - // Interface - if (ServeurInterfaceCDM=1) or (ServeurInterfaceCDM=7) then - begin - for i:=1 to ServeurRetroCDM-1 do - begin - KeybdInput(VK_DOWN,0);KeybdInput(VK_DOWN,KEYEVENTF_KEYUP); - SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); - end; - // 2x TAB pour pointer sur OK - KeybdInput(VK_TAB,0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP); - KeybdInput(VK_TAB,0);KeybdInput(VK_TAB, KEYEVENTF_KEYUP); - KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE, KEYEVENTF_KEYUP); // valide la fenetre d'interface - SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); - - Sleep(200); - KeybdInput(VK_RETURN,0);KeybdInput(VK_RETURN, KEYEVENTF_KEYUP); // valide la fenetre finale - SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); - end; - end; - end; - Lance_CDM:=true; -end; - - -procedure TFormPrinc.FormCreate(Sender: TObject); -var - i,j : integer; - s,s2,Url,LocalFile : string; - trouve,AvecMaj : Boolean; - V_utile : real; - CibleHandle : Thandle; -begin - //DoubleBuffered:=true; - TraceSign:=True; - PremierFD:=false; - // services commIP CDM par défaut - Srvc_Aig:=true; - Srvc_Det:=true; - Srvc_Act:=true; - Srvc_PosTrain:=false; - Srvc_sig:=false; - - AF:='Client TCP-IP CDM Rail ou USB - système LENZ - Version '+Version; - Caption:=AF; - Application.onHint:=doHint; - - // version d'OS pour info - if IsWow64Process then s:='OS 64 Bits' else s:='OS 32 Bits'; - s:=DateToStr(date)+' '+TimeToStr(Time)+' '+s; - Affiche(s,clLime); - LabelEtat.Caption:='Initialisations en cours'; - - //Menu_interface(devalide); - - // créée la fenetre debug - FormDebug:=TFormDebug.Create(Self); - FormDebug.Caption:=AF+' debug'; - N_Trains:=0; - NivDebug:=0; - TempoAct:=0; - debugtrames:=false; - - AvecInit:=true; //&&&& - Option_demarrage:=false; - Diffusion:=AvecInit; - - Application.processMessages; - // créée la fenetre vérification de version - FormVersion:=TformVersion.Create(Self); - - ferme:=false; - CDM_connecte:=false; - pasreponse:=0; - recuCDM:=''; - Nbre_recu_cdm:=0; - AffMem:=true; - N_routes:=0; - N_trains:=0; - Application.HintHidePause:=30000; - - // Train[1].index:=0; - - // lecture fichiers de configuration client_GL.cfg et config.cfg - lit_config; - Application.processMessages; - - // lancer CDM rail et le connecte si on le demande - if LanceCDM then Lance_CDM; - ButtonAffTCO.visible:=AvecTCO; - Loco.Visible:=not(Diffusion); - - // tenter la liaison vers CDM rail - if not(CDM_connecte) then connecte_CDM; - - // si CDM n'est pas connecté, on ouvre la liaison vers la centrale - if not(CDM_connecte) then - begin - Affiche('CDM absent - Ouverture liaison vers centrale Lenz',clYellow); - // ouverture par USB - Affiche('demande connexion à la centrale Lenz par USB',clyellow); - connecte_USB; - if not(portCommOuvert) then - begin - // sinon ouvrir socket vers la centrale - // Initialisation de la comm socket LENZ - if AdresseIP<>'0' then - begin - Affiche('demande connexion à la centrale Lenz par Ethernet',clyellow); - ClientSocketLenz.port:=port; - ClientSocketLenz.Address:=AdresseIP; - ClientSocketLenz.Open; - end - end; - end; - - if portCommOuvert or parSocketLenz then - With Formprinc do - begin - ButtonEcrCV.Enabled:=true; - LireunfichierdeCV1.enabled:=true; - ButtonLitCV.Enabled:=true; - end - else - With Formprinc do - begin - ButtonEcrCV.Enabled:=false; - ButtonLitCV.Enabled:=false; - LireunfichierdeCV1.enabled:=false; - end ; - - // Initialisation des images des signaux - NbreImagePLigne:=Formprinc.ScrollBox1.Width div (largImg+5); - - if not(diffusion) then LireunfichierdeCV1.enabled:=true; - - // ajoute une image dynamiquement - for i:=1 to NbreFeux do - begin - cree_image(i); // et initialisation tableaux signaux - end; - Tempo_init:=5; // démarre les initialisation des signaux et des aiguillages dans 1 s - - // initialisation de la chronologie des évènements détecteurs - for i:=0 to Max_Event_det_tick do - begin - event_det_tick[i].aiguillage:=-1; - event_det_tick[i].detecteur:=-1; - event_det_tick[i].etat:=-1; - event_det_tick[i].aiguillage:=-1; - event_det_tick[i].actionneur:=-1; - event_det_tick[i].traite:=false ; // non traité - end; - - I_Simule:=0; - tick:=0; - - N_Event_tick:=0 ; // dernier index - NombreImages:=0; - - // TCO - if avectco then - begin - //créée la fenêtre TCO non modale - FormTCO:=TformTCO.Create(nil); - FormTCO.show; - end; - - //essai &&&&&&&&&& - Affiche('Fin des initialisations',clyellow); - LabelEtat.Caption:=' '; - Affiche_memoire; - //--------------------------------- - { - aiguillage[20].position:=const_droit; - aiguillage[21].position:=const_droit; - - NivDebug:=3; - FormDebug.show; - //i:=Detecteur_suivant_El(591,1,602,1); - //i:=Detecteur_suivant_El(597,1,601,1); - // posent pb: - // i:=Detecteur_suivant_El(598,1,599,1); - i:=Detecteur_suivant_El(520,1,20,2); - // AfficheDebug(IntToSTR(i),clyellow); - } - -end; - - -// évènement réception d'une trame sur le port COM USB (centrale Lenz) -procedure TFormPrinc.MSCommUSBLenzComm(Sender: TObject); -var i : integer; -begin - if MSCommUSBLenz.commEvent=comEvReceive then - begin - tablo:=MSCommUSBLenz.Input; - for i:=0 to length(tablo)-1 do - begin - chaine_recue:=chaine_recue+char(tablo[i]); - end; - if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+chaine_Hex(chaine_recue),Clwhite); - if terminal then Affiche(chaine_recue,clLime); - interprete_reponse(chaine_recue); - chaine_recue:=''; - end; -end; - -procedure TFormPrinc.FormClose(Sender: TObject; var Action: TCloseAction); -begin - Ferme:=true; - if portCommOuvert then begin portCommOuvert:=false;MSCommUSBLenz.Portopen:=false; end; - portCommOuvert:=false; - ClientSocketCDM.close; - ClientSocketLenz.close; - if TCO_modifie then - if MessageDlg('Le TCO a été modifié. Voulez vous le sauvegarder ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then - sauve_fichier_tco; -end; - - -// positionnement des aiguillages au démarrage : seulement en mode autonome -procedure init_aiguillages; -var i,pos : integer; - s : string; -begin - if portCommOuvert or parSocketLenz then - begin - Affiche('Positionnement aiguillages',cyan); - for i:=1 to maxaiguillage do - begin - if aiguillage[i].modele<>0 then // si l'aiguillage existe - begin - pos:=aiguillage[i].position; - s:='Init aiguillage '+intToSTR(i)+'='+intToSTR(pos); - if pos=1 then s:=s+' (dévié)' else s:=s+' (droit)'; - Affiche(s,cyan); - pilote_acc(i,pos,aig); - application.processMessages; - end; - end; - end; -end; - -// timer à 100 ms -procedure TFormPrinc.Timer1Timer(Sender: TObject); -var index,aspect,i,a,x,y,x0,y0,Bimage,adresse,TailleX,TailleY,orientation : integer; - imageFeu : Timage; - frx,fry : real; - s : string; -begin - inc(tick); - if Tempo_init>0 then dec(Tempo_init); - if (Tempo_init=1) and AvecInit then - begin - if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages=1) then - begin - Affiche('Positionnement des feux',clYellow); - envoi_signauxCplx; // initialisation des feux - init_aiguillages; // initialisation des aiguillages - end; - if (AvecInitAiguillages=0) and not(ferme) and (parSocketLenz or portCommOuvert) then - begin - demande_etat_acc; // demande l'état des accessoires (position des aiguillages) - end; - LabelEtat.Caption:=' '; - Menu_interface(valide); - end; - - if temps>0 then dec(temps); - - // gestion du clignotant des feux de la page principale - if tempsCli>0 then dec(tempsCli); - if tempsCli=0 then - begin - tempsCli:=4; - clignotant:=not(clignotant); // inversion du clignotant - //tester chaque feu pour voir s'il y a un code de clignotement - for i:=1 to NbreFeux do - begin - adresse:=feux[i].adresse; - a:=EtatsignalCplx[adresse]; // a = état binaire du feu - if TestBit(a,jaune_cli) or TestBit(a,ral_60) or - TestBit(a,rappel_60) or testBit(a,semaphore_cli) or - testBit(a,vert_cli) or testbit(a,blanc_cli) then - begin - //Affiche(IntToSTR(adresse),clOrange); - Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adresse,1); - //Affiche('Clignote feu '+IntToSTR(adresse),clyellow); - end; - end; - - // feux du TCO - if avecTCO then - begin - // parcourir les feux du TCO - for y:=1 to NbreCellY do - for x:=1 to NbreCellX do - begin - PcanvasTCO.pen.mode:=pmCOpy; - BImage:=TCO[x,y].bImage; - if Bimage=30 then - begin - adresse:=TCO[x,y].adresse; - a:=EtatsignalCplx[adresse]; // a = état binaire du feu - if TestBit(a,jaune_cli) or TestBit(a,ral_60) or - TestBit(a,rappel_60) or testBit(a,semaphore_cli) or - testBit(a,vert_cli) or testbit(a,blanc_cli) then - begin - aspect:=TCO[x,y].aspect; - case aspect of - 2 : ImageFeu:=Formprinc.Image2feux; - 3 : ImageFeu:=Formprinc.Image3feux; - 4 : ImageFeu:=Formprinc.Image4feux; - 5 : ImageFeu:=Formprinc.Image5feux; - 7 : ImageFeu:=Formprinc.Image7feux; - 9 : ImageFeu:=Formprinc.Image9feux; - else ImageFeu:=Formprinc.Image3feux; - end; - - TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) - TailleX:=ImageFeu.picture.BitMap.Width; - Orientation:=TCO[x,y].FeuOriente; - // réduction variable en fonction de la taille des cellules - calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); - Dessine_feu_mx(PCanvasTCO,tco[x,y].x,tco[x,y].y,frx,fry,adresse,orientation); - end; - end; - end; - end; - - // fenêtre de pilotage manuel du feu - if AdrPilote<>0 then - begin - a:=EtatsignalCplx[0]; - if TestBit(a,jaune_cli) or TestBit(a,ral_60) or - TestBit(a,rappel_60) or testBit(a,semaphore_cli) or - testBit(a,vert_cli) or testbit(a,blanc_cli) then - Dessine_feu_pilote; // dessiner le feu en fonction du bit "clignotant" - end; - end; - - if (not(Maj_feux_cours) and (Tempo_chgt_feux=1)) then Maj_feux(); // mise à jour des feux sur chgt aiguillage - - if (not(Maj_feux_cours) and (Tempo_chgt_feux>0)) then dec(Tempo_chgt_feux); - - // tempo retombée actionneur - if TempoAct<>0 then - begin - dec(tempoAct); - if tempoAct=0 then - begin - A:=Tablo_actionneur[RangActCours].actionneur; - s:=Tablo_actionneur[RangActCours].train; - Affiche('Actionneur '+intToSTR(a)+' F'+IntToSTR(Tablo_actionneur[RangActCours].fonction)+':0',clyellow); - envoie_fonction_CDM(Tablo_actionneur[RangActCours].fonction,0,s); - end; - end; - - //simulation - if (index_simule<>0) then - begin - if not(MsgSim) then - begin - Affiche('Simulation en cours ',Cyan);MsgSim:=true; - N_Event_tick:=0; - N_event_det:=0; - N_trains:=0; - for i:=1 to Max_Trains do Event_det_Train[i].NbEl:=0; - i_simule:=0; - FormDebug.MemoEvtDet.Clear; - FormDebug.Richedit.Clear; - // AffTickSimu:=true; - end; - while tick=Tablo_simule[i_simule+1].tick do - //while i_simule0 then - begin - s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' det='+intToSTR(Tablo_simule[i_simule].detecteur)+'='+IntToSTR(Tablo_simule[i_simule].etat); - Event_Detecteur(Tablo_simule[i_simule].detecteur, Tablo_simule[i_simule].etat=1,''); // créer évt détecteur - StaticText.caption:=s; - end; - - // evt aiguillage ? - if Tablo_simule[i_simule].aiguillage<>0 then - begin - s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' aig='+intToSTR(Tablo_simule[i_simule].aiguillage)+'='+IntToSTR(Tablo_simule[i_simule].etat); - Event_Aig(Tablo_simule[i_simule].Aiguillage,Tablo_simule[i_simule].etat,0); // créer évt aiguillage - StaticText.caption:=s; - end; - - end; - - if i_Simule>=Index_simule then - begin - Index_Simule:=0; // fin de simulation - I_Simule:=0; - MsgSim:=false; - Affiche('Fin de simulation',Cyan); - StaticText.caption:=''; - end; - end; - - // temporisations de démarrage des trains au feux - if Option_demarrage then - for i:=1 to 1024 do - begin - if detecteur[i].tempo<>0 then - begin - dec(detecteur[i].tempo); - if detecteur[i].tempo=0 then - begin - //Affiche('tempo 0 Detecteur '+intToSTR(i),clyellow); - s:=detecteur[i].train; - Affiche('Tempo 0 timer train '+s,clOrange); - s:=chaine_CDM_vitesse(100,s); // 100% - envoi(s); - end; - end; - - end; - - - -end; - -// bouton version centrale Lenz -procedure TFormPrinc.BoutVersionClick(Sender: TObject); -var s : string; -begin - s:=#$f0; - s:=checksum(s); - envoi(s); -end; - -// bouton de commande d'un accessoire -procedure TFormPrinc.ButtonCommandeClick(Sender: TObject); -var adr,valeur,erreur : integer; -begin - val(EditAdresse.text,adr,erreur); - if (erreur<>0) or (adr<1) or (adr>2048) then - begin - EditAdresse.text:='1'; - exit; - end; - - val(EditVal.Text,valeur,erreur); - if (erreur<>0) or (valeur<0) or (valeur>255) then - begin - EditVal.text:='1'; - exit; - end; - - pilote_acc(adr,valeur,aig); -end; - -procedure TFormPrinc.EditvalEnter(Sender: TObject); -begin - if (Editval.Text<>'1') and (Editval.Text<>'2') then editval.text:='1'; -end; - - -procedure TFormPrinc.BoutonRafClick(Sender: TObject); -begin - rafraichit; -end; - -// erreur sur socket Lenz -procedure TFormPrinc.ClientSocketLenzError(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; - var ErrorCode: Integer); -var s : string; -begin - s:='Erreur '+IntToSTR(ErrorCode)+' socket IP Lenz'; - case ErrorCode of - 10053 : s:=s+': Connexion avortée - Timeout'; - 10054 : s:=s+': Connexion avortée par tiers'; - 10060 : s:=s+': Timeout'; - 10061 : s:=s+': Connexion refusée'; - 10065 : s:=s+': Port non connecté'; - end; - affiche(s,clOrange); - if nivDebug=3 then afficheDebug(s,clOrange); - parSocketLenz:=false; - ErrorCode:=0; -end; - - -procedure TFormPrinc.ClientSocketCDMError(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); - var s : string; -begin - s:='Erreur '+IntToSTR(ErrorCode)+' socket IP CDM Rail'; - case ErrorCode of - 10053 : s:=s+': Connexion avortée - Timeout'; - 10054 : s:=s+': Connexion avortée par tiers'; - 10060 : s:=s+': Timeout'; - 10061 : s:=s+': Connexion refusée'; - 10065 : s:=s+': Port non connecté'; - end; - affiche(s,ClOrange); - afficheDebug(s,ClOrange); - CDM_connecte:=false; - if (portCommOuvert=false) and (parSocketLenz=false) then LabelTitre.caption:=titre; - caption:=AF; - ErrorCode:=0; -end; - -// lecture depuis socket -procedure TFormPrinc.ClientSocketLenzRead(Sender: TObject; - Socket: TCustomWinSocket); -var s : string; -begin - s:=ClientSocketLenz.Socket.ReceiveText; - if traceTrames then afficheDebug(chaine_hex(s),clWhite); - interprete_reponse(s); -end; - -procedure TFormPrinc.ButtonTestClick(Sender: TObject); -begin - demande_etat_acc; -end; - -// procédure Event appelée si on clique sur un checkbox des images des feux -procedure TFormprinc.proc_checkBoxFB(Sender : Tobject); -var Index,adr : integer; - coche : boolean; -begin - Maj_feux ; // évalue l'état des signaux -end; - - -procedure TFormPrinc.ButtonInfoClick(Sender: TObject); -begin - Affiche('Ce programme pilote des signaux complexes de façon autonome ou avec CDM rail ',ClYellow); - Affiche('En fonction des détecteurs mis à 1 ou 0 par des locomotives',ClYellow); - Affiche('en circulation sur le réseau',ClYellow); - Affiche('Il est nécessaire de renseigner les fichiers config.cfg et config-gl.cfg',ClOrange); - Affiche('En vert : Trames envoyées à l''interface',ClWhite); - Affiche('En violet : Trames brutes reçues de l''interface',ClWhite); - Affiche('En rouge : erreurs et défauts',ClWhite); - Affiche('En orange : pilotage des signaux / erreurs mineures',ClWhite); - Affiche('En bleu : pilotage des aiguillages',ClWhite); - Affiche('En jaune : rétrosignalisation reçue depuis l''interface',ClWhite); -end; - -procedure TFormPrinc.MenuConnecterUSBClick(Sender: TObject); -begin - Hors_tension2:=false; - connecte_USB; -end; - -procedure deconnecte_usb; -begin - if portCommOuvert then - begin - portCommOuvert:=false; - Formprinc.MSCommUSBLenz.Portopen:=false; - Affiche('Port USB déconnecté',clyellow); - end; - - portCommOuvert:=false; - with formprinc do - begin - ClientSocketLenz.close; - MenuConnecterUSB.enabled:=true; - DeConnecterUSB.enabled:=false; - ConnecterCDMRail.enabled:=true; - DeConnecterCDMRail.enabled:=false; - end; -end; - -procedure TFormPrinc.DeconnecterUSBClick(Sender: TObject); -begin - deconnecte_usb; -end; - -procedure TFormPrinc.MenuConnecterEthernetClick(Sender: TObject); -begin -if AdresseIP<>'0' then - begin - Affiche('Demande de connexion de l''interface Lenz en ethernet '+AdresseIP+':'+IntToSTR(Port),clyellow); - ClientSocketLenz.port:=port; - ClientSocketLenz.Address:=AdresseIP; - ClientSocketLenz.Open; - Hors_tension2:=false; - end; -end; - -procedure TFormPrinc.MenuDeconnecterEthernetClick(Sender: TObject); -begin - ClientSocketLenz.Close; -end; - -function cde_cdm(s : string) : string; -var i : integer; -begin - i:=length(s)-1; - cde_cdm:='0'+IntToSTR(i)+s; -end; - - - -procedure TFormPrinc.AffEtatDetecteurs(Sender: TObject); -var j,adr,NBranche : integer; - s : string; -begin - for j:=1 to NDetecteurs do - begin - adr:=Adresse_detecteur[j]; - s:='Dét '+intToSTR(adr)+'='; - if Detecteur[adr].etat then s:=s+'1' else s:=s+'0'; - s:=s+' '+Detecteur[Adr].train; - //s:=s+' Mem='; - //if Mem[adresse_detecteur[j]] then s:=s+'1' else s:=s+'0'; - Affiche(s,clYellow); - end; -end; - -procedure TFormPrinc.Etatdesaiguillages1Click(Sender: TObject); -var i,j,model,objet : integer; - s : string; -begin - for i:=1 to MaxAcc do - begin - model:=aiguillage[i].modele ; - if model<>0 then - begin - s:='Aiguillage '+IntToSTR(i)+' : '+intToSTR(aiguillage[i].position); - if aiguillage[i].position=const_devie then s:=s+' (dévié)' ; - if aiguillage[i].position=const_droit then s:=s+' (droit)'; - if aiguillage[i].position=9 then s:=s+' inconnue'; - - objet:=aiguillage[i].objet; - if objet<>0 then s:=s+' objet='+intToSTR(objet); - if model=4 then // aig triple - begin - j:=aiguillage[i].AdrTriple; - s:=s+' Aig '+IntToSTR(j)+': '+intToSTR(aiguillage[j].position); - if aiguillage[j].position=1 then s:=s+' (dévié)' else s:=s+' (droit)'; - end; - Affiche(s,clWhite); - end; - end; -end; - -procedure TFormPrinc.Codificationdesaiguillages1Click(Sender: TObject); -var i : integer ; - s : string; -begin - Affiche('Codification interne des aiguillages',Cyan); - Affiche('D=position droite S=position déviée P=pointe Z=détecteur',Cyan); - for i:=1 to MaxAiguillage do - begin - s:=IntToSTR(i); - if aiguillage[i].modele<>0 then - begin - if aiguillage[i].modele=1 then s:=s+' Pointe='; - if aiguillage[i].modele=2 then - begin - s:=s+' TJD:'; - if aiguillage[i].inversionCDM=1 then s:=s+'(INV) '; - end; - if aiguillage[i].modele=3 then s:=s+' TJS:'; - if aiguillage[i].modele=4 then s:=s+' Triple: Pointe='; - - if (aiguillage[i].modele=1) or (aiguillage[i].modele=4) then s:=s+IntToSTR(aiguillage[i].APointe)+aiguillage[i].APointeB; - s:=s+' Dévie='+IntToSTR(aiguillage[i].ADevie)+aiguillage[i].ADevieB+ - ' Droit='+IntToSTR(aiguillage[i].ADroit)+aiguillage[i].ADroitB; - if aiguillage[i].modele=2 then - begin - s:=s+' DestDroit='+intToSTR(aiguillage[i].Ddroit)+aiguillage[i].DdroitB; - s:=s+' DestDévié='+intToSTR(aiguillage[i].DDevie)+aiguillage[i].DdevieB; - end; - if aiguillage[i].modele=4 then s:=s+' Dévié2='+intToSTR(aiguillage[i].ADevie2)+aiguillage[i].ADevie2B; - if aiguillage[i].vitesse<>0 then s:=s+' Vitesse déviée='+intToSTR(aiguillage[i].vitesse); - if aiguillage[i].inversion<>0 then s:=s+' pilotage inversé'; - - Affiche(s,clYellow); - end; - end; - -end; - - -procedure TFormPrinc.ClientSocketLenzConnect(Sender: TObject;Socket: TCustomWinSocket); -begin - Affiche('Lenz connecté ',clYellow); - AfficheDebug('Lenz connecté ',clYellow); - parSocketLenz:=True; - ButtonEcrCV.Enabled:=true; - ButtonLitCV.Enabled:=true; - LireunfichierdeCV1.enabled:=true; - LabelTitre.caption:=titre+' Interface connectée par Ethernet'; -end; - -procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket); -var s : string; -begin - s:='Socket CDM rail connecté'; - LabelTitre.caption:=titre+' '+s; - Affiche(s,clYellow); - AfficheDebug(s,clYellow); - SocketCDM_connecte:=True; - MenuConnecterUSB.enabled:=false; - DeConnecterUSB.enabled:=false; - ConnecterCDMRail.enabled:=false; - DeConnecterCDMRail.enabled:=true; -end; - -procedure Interprete_trameCDM(trame_CDM:string); -var i,j,objet,posST,posAC,posDT,posSG,posXY,k,l,erreur, adr,adr2,etat,etataig, - vitesse,etatAig2,name,prv,nbre,nbreVir,long : integer ; - x,y,x2,y2 : longint ; - s,ss,train,commandeCDM : string; - traite,sort : boolean; -begin -{ - trame_CDM:='S-R-14-0004-CMDACC-__ACK|000|S-E-14-5162-CMDACC-ST_DT|052|05|NAME=2756;OBJ=2756;AD=518;TRAIN=CC406526;STATE=1;'; - trame_cdm:=trame_cdm+'S-E-14-5163-CMDACC-ST_DT|049|05|NAME=2757;OBJ=2757;AD=518;TRAIN=_NONE;STATE=1;'; - trame_cdm:=trame_cdm+'S-E-14-5164-CMDACC-ST_DT|049|05|NAME=2758;OBJ=2758;AD=519;TRAIN=_NONE;STATE=0;'; - trame_cdm:=trame_cdm+'S-E-14-5165-CMDACC-ST_DT|049|05|NAME=2759;OBJ=2759;AD=519;TRAIN=_NONE;STATE=0'; - trame_cdm:=trame_cdm+'S-E-14-5166-CMDACC-ST_DT|049|05|NAME=7060;OBJ=7060;AD=520;TRAIN=_NONE;STATE=0'; - trame_cdm:=trame_cdm+'S-E-14-5167-CMDACC-ST_DT|051|05|NAME=7061;OBJ=7061;AD=520;TRAIN=BB25531;STATE=0'; - trame_cdm:=trame_cdm+'S-E-14-5168-CMDACC-ST_DT|049|05|NAME=7057;OBJ=7057;AD=517;TRAIN=_NONE;STATE=0'; - trame_cdm:=trame_cdm+'S-E-14-5169-CMDACC-ST_DT|049|05|NAME=7058;OBJ=7058;AD=517;TRAIN=_NONE;STATE=0'; - } - - //debugtrames:=true; - AckCDM:=trame_CDM<>''; - if pos('ACK',trame_CDM)=0 then - begin - if pos('ERR=200',trame_CDM)<>0 then Affiche('Erreur CDM : réseau non chargé',clred); - end; - - k:=0; - //Affiche('L='+InTToSTR(length(recuCDM)),clyellow); - repeat - // trouver la longueur de la chaîne de paramètres - i:=pos('|',trame_CDM); - val(copy(trame_CDM,i+1,5),long,erreur); - //Affiche('long chaine param='+intToSTR(long),clyellow); - if long=0 then - begin - //if debugTrames then Affiche('Longueur nulle',clYellow); - if pos('ACK',trame_cdm)<>0 then Ack_cdm:=true; - i:=posEx('|',trame_CDM,i+1); - if i=0 then begin Affiche('Erreur trames CDM manque 2ème |',clred);exit;end; - delete(trame_cdm,1,i); - end; - - if long<>0 then - begin - // trouver le nombre de paramètres - i:=posEx('|',trame_CDM,i+1); - if i=0 then - begin - if debugTrames then AfficheDebug('0 paramètres '+trame_CDM,clyellow); - Nbre_recu_cdm:=0; - exit; - end; - - val(copy(trame_CDM,i+1,5),nbre,erreur); - //Affiche('nbre='+IntToSTR(nbre),clyellow); - // compter le nombre de virgules qui doit être égal au nombre de paramètres - NbreVir:=0; // nombre de virgules - repeat - i:=posEx(';',trame_CDM,i+1); - if i<>0 then inc(NbreVir); - until (i=0) or (NbreVir=nbre); - if i=0 then - begin - if debugTrames then AfficheDebug('tronqué : '+trame_CDM,clyellow); - residuCDM:=trame_CDM; - Nbre_recu_cdm:=0; - exit; - end; - - CommandeCDM:=copy(trame_CDM,1,i); - if debugTrames then AfficheDebug(commandeCDM,clorange); - Delete(trame_CDM,1,i); - - // évènement aiguillage. Le champ AD2 n'est pas forcément présent - posST:=pos('CMDACC-ST_TO',commandeCDM); - if posST<>0 then - begin - delete(commandeCDM,posST,12); - objet:=0; - i:=posEx('OBJ=',commandeCDM,posST);ss:=copy(commandeCDM,i+4,10); - if i<>0 then begin val(ss,objet,erreur);delete(commandeCDM,i,6);end else Affiche('Erreur 95 : pas d''objet ',clred); - - i:=posEx('AD=',commandeCDM,posST);ss:=copy(commandeCDM,i+3,10); //Affiche('j='+IntToSTR(j)+' i='+intToSTR(i),clred); - if i=0 then begin Affiche('Erreur 96 : absence AD aig '+intToSTR(adr),clred);Affiche(commandeCDM,clyellow);end; - val(ss,adr,erreur);Delete(commandeCDM,i,4); - - //Affiche(copy(recuCDM,j,i+80),clOrange); - i:=posEx('AD2=',commandeCDM,i);ss:=copy(commandeCDM,i+4,10); // Affiche('i='+intToSTR(i),clOrange); - if i=0 then begin Affiche('Erreur 97 : absence AD2 aig '+intToSTR(adr),clred);Affiche(commandeCDM,clyellow);end; - val(ss,adr2,erreur); //Affiche('adr2='+intToSTR(adr2),clyellow); - Delete(commandeCDM,i,5); - - i:=posEx('STATE=',commandeCDM,i);ss:=copy(commandeCDM,i+6,10); //Affiche('j='+IntToSTR(j)+' i='+intToSTR(i),clred); - if i=0 then begin Affiche('Erreur 98 : absence STATE aig '+intToSTR(adr),clred);Affiche(commandeCDM,clyellow);end; - val(ss,etat,erreur); - Delete(commandeCDM,i,7); - - //Affiche('Aig '+inttostr(adr)+' pos='+IntToSTR(etat),clyellow); - //Affiche(commandeCDM,clyellow); - - // aiguillage normal - if aiguillage[adr].modele=1 then - begin - //Affiche('Normal',clyellow); - if etat=0 then etatAig:=2 else etatAig:=1; - Event_Aig(adr,etatAig,objet); - end; - // TJD TJS - if (aiguillage[adr].modele=2) or (aiguillage[adr].modele=3) then - begin - //Affiche('TJD/S',clyellow); - //adr2:=aiguillage[adr].Apointe; // 2eme adresse de la TJD - case etat of - 1 : begin etatAig:=1;EtatAig2:=2;end; - 4 : begin etatAig:=1;EtatAig2:=1;end; - 5 : begin etatAig:=2;EtatAig2:=1;end; - 0 : begin etatAig:=2;EtatAig2:=2;end; - end; - if (aiguillage[adr].inversionCDM=1) or (aiguillage[adr2].inversionCDM=1) then - begin - //Affiche('inverse',clyellow); - prv:=adr; - adr:=adr2; - adr2:=prv; - end; - Event_Aig(adr,etatAig,objet); - Event_Aig(adr2,etatAig2,objet); - end; - if aiguillage[adr].modele=4 then // aiguillage triple - begin - //Affiche('Triple',clyellow); - // état de l'aiguillage 1 - if (etat=0) or (etat=2) then etatAig:=2; - if etat=3 then etatAig:=1; - // état de l'aiguillage 2 - adr2:=aiguillage[adr].AdrTriple; - if (etat=0) or (etat=3) then etatAig2:=2; - if etat=2 then etatAig2:=1; - Event_Aig(adr,etatAig,objet); - Event_Aig(adr2,etatAig2,objet); - end; - // Tempo_chgt_feux:=10; // demander la mise à jour des feux - end; - - - // évènement détecteur - posDT:=pos('CMDACC-ST_DT',commandeCDM); - if posDT<>0 then - begin - Delete(commandeCDM,posDT,12); - i:=posEx('AD=',commandeCDM,posDT); - if i<>0 then - begin - ss:=copy(commandeCDM,i+3,10);Delete(commandeCDM,i,4); - val(ss,adr,erreur); - end; - i:=posEx('TRAIN=',commandeCDM,posDT); - j:=PosEx(';',commandeCDM,i); - train:=copy(commandeCDM,i+6,j-i-6); - delete(commandeCDM,i,7); - - //Affiche('Train=*'+Train+'*',clOrange); - i:=posEx('STATE=',commandeCDM,posDT);ss:=copy(commandeCDM,i+6,10); - val(ss,etat,erreur); Delete(commandeCDM,i,7); - - if (train='_NONE') then train:=detecteur[Adr].train; - Event_detecteur(Adr,etat=1,train); - //AfficheDebug(IntToSTR(adr)+' '+IntToSTR(etat),clyellow); - if AfficheDet then Affiche('Rétro Détecteur '+intToSTR(adr)+'='+IntToStr(etat),clYellow); - end ; - - // évènement signal - non stocké ni interprété - posSG:=pos('CMDACC-ST_SG',commandeCDM); - if posSG<>0 then - begin - Delete(commandeCDM,posSG,12); - i:=posEx('AD=',commandeCDM,posDT);ss:=copy(commandeCDM,i+3,10); - val(ss,adr,erreur); - i:=posEx('STATE=',commandeCDM,posSG);ss:=copy(commandeCDM,i+6,10); - Delete(commandeCDM,posSG,i+5-posSG); - val(ss,etat,erreur); - //Affiche('SignalCDM '+intToSTR(adr)+'='+IntToStr(etat),clYellow); - end ; - - // évènement actionneur - // attention un actionneur qui repasse à 0 ne contient pas de nom de train - //S-E-03-0157-CMDACC-ST_AC|049|05|NAME=0;OBJ=7101;AD=815;TRAIN=CC406526;STATE=1; - posAC:=pos('CMDACC-ST_AC',commandeCDM); - if posAC<>0 then - begin - Delete(commandeCDM,posAC,12); - i:=posEx('AD=',commandeCDM,posAC);ss:=copy(commandeCDM,i+3,10); - val(ss,adr,erreur); - i:=posEx('NAME=',commandeCDM,posAC);ss:=copy(commandeCDM,i+5,10); - val(ss,name,erreur); - i:=posEx('TRAIN=',commandeCDM,posAC);l:=PosEx(';',commandeCDM,i); - train:=copy(commandeCDM,i+6,l-i-6); - i:=posEx('STATE=',commandeCDM,posAC);ss:=copy(commandeCDM,i+6,10); - val(ss,etat,erreur); - Delete(commandeCDM,posAC,i-posAC); - i:=pos(';',commandeCDM); - if i<>0 then Delete(commandeCDM,1,i); - if AfficheDet then - Affiche('Actionneur AD='+intToSTR(adr)+' Nom='+intToSTR(name)+' Train='+train+' Etat='+IntToSTR(etat),clyellow); - Event_act(adr,etat,train); // déclenche évent actionneur - end; - - // évènement position des trains - non stocké ni interprété - posXY:=pos('CMDTRN-SPDXY',commandeCDM); - if posXY<>0 then - begin - Delete(commandeCDM,posXY,12); - i:=posEx('AD=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - ss:=copy(commandeCDM,i+3,10); - val(ss,adr,erreur); - //Affiche('AD='+IntToSTR(adr),clyellow); - Delete(commandeCDM,i,l-i+1); - - i:=posEx('NAME=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - train:=copy(commandeCDM,i+5,l-i-5); - //Affiche('Train='+train,clyellow); - Delete(commandeCDM,i,l-i+1); - - i:=posEx('SPEED=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - ss:=copy(commandeCDM,i+6,10); - val(ss,vitesse,erreur); - //Affiche('Vitesse='+intToSTR(vitesse),clyellow); - Delete(commandeCDM,i,l-i+1); - - i:=posEx('X=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - ss:=copy(commandeCDM,i+2,10); - val(ss,x,erreur); - //Affiche('X='+IntTostr(x),clyellow); - Delete(commandeCDM,i,l-i+1); - - i:=posEx('Y=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - ss:=copy(commandeCDM,i+2,10); - val(ss,y,erreur); - //Affiche('Y='+IntTostr(y),clyellow);; - Delete(commandeCDM,i,l-i+1); - - i:=posEx('X2=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - ss:=copy(commandeCDM,i+3,10); - val(ss,x2,erreur); - //Affiche('X2='+IntTostr(x2),clyellow); - Delete(commandeCDM,i,l-i+1); - - i:=posEx('Y2=',commandeCDM,posXY);l:=posEx(';',commandeCDM,i); - ss:=copy(commandeCDM,i+3,10); - val(ss,y2,erreur); - //Affiche('Y2='+IntTostr(y2),clyellow); - Delete(commandeCDM,i,l-i+1); - - Delete(commandeCDM,posXY,12); - end; - - inc(k); - //Affiche('k='+intToSTR(k),clyellow); - end; - - sort:=(length(trame_CDM)<10) or (k>=2000);// or (posST=0) and (posDT=0) and (posAC=0) and (posSG=0); - until (sort); - - //Affiche('k='+IntToSTR(k)+' Ligne traitée '+recuCDM,clLime); - //if pos('_ACK',recuCDM)=0 then recuCDM:=''; // effacer la trame sauf si c'est une trame ACK car le trame est utilisée dans le process de connexion de cdm - if k>=2000 then begin Affiche('Erreur 90 : Longrestante='+IntToSTR(length(trame_CDM)),clred); Affiche(trame_CDM,clred); end; - - Nbre_recu_cdm:=0; -end; - -// réception d'un message de CDM rail -procedure TFormPrinc.ClientSocketCDMRead(Sender: TObject;Socket: TCustomWinSocket); - var i,l,n : integer ; - s,ss,train : string; - traite,sort : boolean; -begin - inc(Nbre_recu_cdm); - //if Nbre_recu_cdm>1 then Affiche('Empilement de trames CDM: '+intToSTR(Nbre_recu_cdm),clred); - recuCDM:=ClientSocketCDM.Socket.ReceiveText; // commandeCDM est le morceau tronquée de la fin de la réception précédente - - residuCDM:=''; - if traceTrames then AfficheDebug(recuCDM,clWhite); - - {begin - n:=80; - l:=length(recuCDM); - i:=0; - repeat - AfficheDebug(copy(recuCDM,(i*n)+1,n),clWhite); - inc(i); - until l0 do - begin - if condcarre<>0 then dec(condcarre); - for k:=1 to condCarre do - begin - s2:=s2+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig+' '; - end; - s2:=s2+'/'; - inc(l); - CondCarre:=Length(feux[i].condcarre[l]); - end; - - end - else - // feu directionnel - begin - s:=s+' DIR Nbre de feux='+IntToSTR(feux[i].aspect-10)+' '; - NfeuxDir:=feux[i].aspect-10; - for j:=1 to NfeuxDir+1 do - begin - s:=s+'('; - for k:=1 to Length(feux[i].AigDirection[j])-1 do - begin - s:=s+IntToSTR(feux[i].AigDirection[j][k].adresse) + feux[i].AigDirection[j][k].posaig+' '; - end; - s:=s+')'; - end; - end; - Affiche(s,clYellow); - if s2<>'' then Affiche('Conditions de carré : '+s2,clYellow); - end; -end; - - -procedure TFormPrinc.ClientSocketLenzDisconnect(Sender: TObject; - Socket: TCustomWinSocket); -begin - parSocketLenz:=False; -end; - - -procedure TFormPrinc.FichierSimuClick(Sender: TObject); -begin - FormSimulation.showModal; -end; - -procedure TFormPrinc.ButtonEcrCVClick(Sender: TObject); -var adr,valeur,erreur : integer; - s : string; -begin - // doc XpressNet page 55 - val(EditAdresse.text,adr,erreur); - if (erreur<>0) or (Adr>255) or (Adr<0) then - begin - EditAdresse.Text:='1'; - exit; - end; - - val(EditVal.Text,valeur,erreur); - if (erreur<>0) or (valeur<0) or (valeur>255) then - begin - EditAdresse.text:='1'; - exit; - end; - - //s:=#$ff+#$fe+#$23+#$1e+Char(adr)+Char(valeur); //CV de 512 à 767 V3.4 - //s:=#$ff+#$fe+#$23+#$1d+Char(adr)+Char(valeur); //CV de 256 à 511 V3.4 - s:=#$23+#$16+Char(adr)+Char(valeur); //CV de 1 à 256 - - s:=checksum(s); - envoi(s); // envoi de la trame et attente Ack - // la centrale passe en mode service (p23) - Affiche('CV'+intToSTR(Adr)+'='+intToSTR(valeur),clyellow); - -end; - -procedure TFormPrinc.ButtonRepriseClick(Sender: TObject); -var s : string; -begin - s:=#$21+#$81; - s:=checksum(s); - envoi(s); // envoi de la trame et attente Ack - -end; - -// lit un fichier de CV vers un accessoire -procedure Lire_fichier_CV; -var s: string; - fte : textfile; - cv,valeur,erreur : integer; -begin - s:=GetCurrentDir; - //s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL'; - with FormPrinc do - begin - OpenDialog.InitialDir:=s; - OpenDialog.DefaultExt:='txt'; - OpenDialog.Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*'; - if openDialog.Execute then - begin - s:=openDialog.FileName; - assignFile(fte,s); - reset(fte); - while not(eof(fte)) do - begin - readln(fte,s); - val(s,cv,erreur); - - if (cv<>0) then - begin - delete(s,1,erreur); - val(s,valeur,erreur); - Affiche('CV='+intToSTR(cv)+' Valeur='+IntToSTR(valeur),clLime); - if cv>255 then Affiche('Erreur CV '+IntToSTR(cv)+'>255',clred); - if valeur>255 then Affiche('Erreur valeur '+IntToSTR(valeur)+'>255',clred); - - if (cv<=255) and (valeur<=255) then - begin - s:=#$23+#$16+Char(cv)+Char(valeur); //CV de 1 à 256 - s:=checksum(s); - envoi(s); // envoi de la trame et attente Ack, la premiere trame fait passer la centrale en mode programmation (service) - tempo(5); - end; - end; - - end; - closeFile(fte); - end; - end; -end; - - -procedure TFormPrinc.LireunfichierdeCV1Click(Sender: TObject); -begin - Lire_fichier_CV; -end; - -procedure TFormPrinc.ButtonLitCVClick(Sender: TObject); -var s,sa: string; - fte : textfile; - i,cv,valeur,erreur : integer; -begin - s:=GetCurrentDir; - //s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL'; - N_Cv:=0; // nombre de CV recus à 0 - sa:=''; - Affiche('Lecture CV',clyellow); - - val(EditAdresse.Text,cv,erreur); - if (erreur<>0) or (cv>255) or (cv<0) then - begin - EditAdresse.Text:='1'; - exit; - end; - //trace:=true; - - - s:=#$22+#$15+Char(cv); //CV de 1 à 256 (V3.0) - //s:=#$22+#$18+Char(cv); //CV de 1 à 255 + 1024 (V3.6) - s:=checksum(s); - // envoi de la trame : fait passer la centrale en mode programmation (service) - envoi_ss_ack(s); - - // attendre la trame 01 04 05 (env 1s) - succes:=false;i:=0; - repeat - Application.processMessages; - Sleep(100); - inc(i); - until succes or (i>20); - - if succes then - begin - recu_cv:=false; - //Affiche('reçu trame succes',clyellow); - s:=#$21+#$10; // demande d'envoi du résultat du mode service - s:=checksum(s); - //envoi(s); - envoi_ss_ack(s); - Tempo(1); - // attente de la réponse de la centrale - i:=0; - repeat - Tempo(2); // attend 200 ms - inc(i); - until recu_cv or (i>4); - if (i>4) then - begin - Affiche('Erreur attente trop longue CV',clred); - exit; - end; - sa:=sa+'Cv'+IntToSTR(cv)+'='+IntToSTR(Tablo_cv[cv])+' '; - Affiche(sa,clyellow);sa:=''; - end - else - Affiche('Pas de réponse de l''interface après demande de passage en mode prog',clOrange); -end; - - -procedure TFormPrinc.Quitter1Click(Sender: TObject); -begin - close; -end; - -procedure TFormPrinc.ConfigClick(Sender: TObject); -begin - Tformconfig.create(nil); - formconfig.showmodal; - formconfig.close; -end; - - -procedure TFormPrinc.Codificationdesactionneurs1Click(Sender: TObject); -var i,adract,etatAct,fonction,v,acc,aO,aF,accessoire,sortie : integer; - s,s2 : string; -begin - if (maxTablo_act=0) and (NbrePN=0) then - begin - Affiche('Aucun actionneur déclaré',Cyan); - exit; - end; - - Affiche('Codification interne des actionneurs',Cyan); - for i:=1 to maxTablo_act do - begin - s:=Tablo_actionneur[i].train; - etatAct:=Tablo_actionneur[i].etat ; - AdrAct:=Tablo_actionneur[i].actionneur; - s2:=Tablo_actionneur[i].train; - acc:=Tablo_actionneur[i].accessoire; - sortie:=Tablo_actionneur[i].sortie; - fonction:=Tablo_actionneur[i].fonction; - if (s2<>'') then - begin - if fonction<>0 then - s:='FonctionF Actionneur='+intToSTR(adrAct)+':'+intToSTR(etatAct)+' Train='+s2+' F'+IntToSTR(fonction)+ - ' Temporisation='+intToSTR(tablo_actionneur[i].Tempo); - if acc<>0 then - s:='Accessoire Actionneur='+intToSTR(adrAct)+':'+intToSTR(etatAct)+' Train='+s2+' A'+IntToSTR(acc)+ - ' sortie='+intToSTR(sortie); - Affiche(s,clYellow); - end; - end; - - // dans le tableau des PN - for i:=1 to NbrePN do - begin - s:='PN'+intToSTR(i)+' Adresse fermeture PN='+IntToSTR(Tablo_PN[i].AdresseFerme); - s:=s+' Adresse ouverture PN='+IntToSTR(Tablo_PN[i].AdresseOuvre); - Affiche(s,clyellow); - s:=' Commande fermeture='+intToSTR(Tablo_PN[i].commandeFerme); - s:=s+' Commande ouverture='+intToSTR(Tablo_PN[i].commandeOuvre); - s:=s+' Nbre de voies='+intToSTR(Tablo_PN[i].nbVoies); - Affiche(s,clyellow); - for v:=1 to Tablo_PN[i].nbvoies do - begin - s:=' Voie '+IntToSTR(v)+': Actionneur de fermeture='+intToSTR(Tablo_PN[i].voie[v].ActFerme); - s:=s+' Actionneur d''ouverture='+intToSTR(Tablo_PN[i].voie[v].ActOuvre); - Affiche(s,clyellow); - end; - end; -end; - -procedure TFormPrinc.ButtonArretSimuClick(Sender: TObject); -begin - Index_Simule:=0; // fin de simulation - I_Simule:=0; - MsgSim:=false; - Affiche('Fin de simulation',Cyan); -end; - -procedure TFormPrinc.OuvrirunfichiertramesCDM1Click(Sender: TObject); -var s : string; - fte : textFile; -begin - s:=GetCurrentDir; - s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL'; - OpenDialog.InitialDir:=s; - OpenDialog.DefaultExt:='txt'; - OpenDialog.Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*'; - if openDialog.Execute then - begin - s:=openDialog.FileName; - assignFile(fte,s); - reset(fte); - while not(eof(fte)) do - begin - readln(fte,s); - Affiche(s,clLime); - RecuCDM:=s; - Interprete_trameCDM(s); - end; - closeFile(fte); - end; - -end; - -procedure TFormPrinc.ButtonAffTCOClick(Sender: TObject); -var hd : THandle; -begin - formTCO.windowState:=wsNormal; //Maximized; - formTCO.BringToFront; -end; - - -procedure TFormPrinc.ButtonLanceCDMClick(Sender: TObject); -begin - - // ButtonArretSimu.Setfocus; - Lance_CDM ; -// ButtonLanceCDM.unfocused; - -end; - -procedure TFormPrinc.Affichefentredebug1Click(Sender: TObject); -begin - formDebug.show; -end; - -procedure TFormPrinc.locoClick(Sender: TObject); -begin - // vitesse et direction 18 pas - - vitesse_loco(3,20,true); -end; - -// pour déplacer l'ascenseur de l'affichage automatiquement en bas -procedure TFormPrinc.FenRichChange(Sender: TObject); -begin - SendMessage(FenRich.handle, WM_VSCROLL, SB_BOTTOM, 0); -end; - -procedure TFormPrinc.Copier1Click(Sender: TObject); -begin - FenRich.CopyToClipboard; - FenRich.SetFocus; -end; - - - -procedure TFormPrinc.Etatdessignaux1Click(Sender: TObject); -var Adr,etat,i : integer; - aspect,combine : word; - s : string; -begin - for i:=1 to NbreFeux do - begin - Adr:=Feux[i].Adresse; - Etat:=Feux[i].EtatSignal; - s:='Feu '+IntToSTR(Adr)+' Etat='; - code_to_aspect(Etat,aspect,combine); - s:=s+IntToSTR(etat)+'='+EtatSign[aspect]+' '+EtatSign[combine]; - Affiche(s,clYellow); - - end; -end; - -begin - - - -end. diff --git a/UnitSimule.dcu b/UnitSimule.dcu index 20db947..669a328 100644 Binary files a/UnitSimule.dcu and b/UnitSimule.dcu differ diff --git a/UnitTCO.dcu b/UnitTCO.dcu index 462fe43..959ba78 100644 Binary files a/UnitTCO.dcu and b/UnitTCO.dcu differ diff --git a/verif_version.dcu b/verif_version.dcu index 23fb69a..840c510 100644 Binary files a/verif_version.dcu and b/verif_version.dcu differ diff --git a/verif_version.pas b/verif_version.pas index efdd4c8..c2cbb3f 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -23,7 +23,7 @@ var Lance_verif : integer; verifVersion,notificationVersion : boolean; -Const Version='2.3'; // sert à la comparaison de la version publiée +Const Version='2.31'; // sert à la comparaison de la version publiée implementation diff --git a/versions.txt b/versions.txt index 94bb25f..e35bf9d 100644 --- a/versions.txt +++ b/versions.txt @@ -44,6 +44,7 @@ version 2.21 : Param Correction d'un bug de la 2.2 version 2.3 : Changement de la méthode de réception des trames du protocole IPC de CDM-Rail Affichage au démarrage des variables manquantes du fichier config-gl.cfg +version 2.31 : Amélioration calcul des routes depuis buttoir