V2.3B

UnitConfig.dfm

@@ -1776,7 +1776,7 @@ object FormConfig: TFormConfig
     Top = 8
     Width = 585
     Height = 441
-    ActivePage = TabSheetSig
+    ActivePage = TabSheetAct
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clBackground
     Font.Height = -11
@@ -2783,7 +2783,7 @@ object FormConfig: TFormConfig
           Top = 48
           Width = 129
           Height = 21
-          ItemHeight = 13
+          ItemHeight = 0
           TabOrder = 1
           OnChange = ComboBoxDecChange
         end
@@ -2895,31 +2895,13 @@ object FormConfig: TFormConfig
           'Liste de mod'#233'lisation des actionneurs du fichier config.cfg - cl' +
           'iquez sur une ligne pour afficher la description de l'#39'action'
       end
-      object MemoAct: TMemo
-        Left = 0
-        Top = 24
-        Width = 289
-        Height = 369
-        Color = clInfoText
-        Font.Charset = DEFAULT_CHARSET
-        Font.Color = clAqua
-        Font.Height = -11
-        Font.Name = 'MS Sans Serif'
-        Font.Style = []
-        ParentFont = False
-        ReadOnly = True
-        ScrollBars = ssVertical
-        TabOrder = 0
-        WordWrap = False
-        OnClick = MemoActClick
-      end
       object GroupBox13: TGroupBox
         Left = 304
         Top = 32
         Width = 257
         Height = 345
         Caption = 'Description de l'#39'actionneur '
-        TabOrder = 1
+        TabOrder = 0
         object GroupBox14: TGroupBox
           Left = 16
           Top = 24
@@ -2957,7 +2939,7 @@ object FormConfig: TFormConfig
         end
         object GroupBoxAct: TGroupBox
           Left = 8
-          Top = 200
+          Top = 216
           Width = 225
           Height = 145
           Caption = 'Actionneur fonction de locomotive '
@@ -3011,6 +2993,7 @@ object FormConfig: TFormConfig
             Height = 21
             TabOrder = 0
             Text = 'EditAct'
+            OnChange = EditActChange
           end
           object EditTrain: TEdit
             Left = 112
@@ -3019,6 +3002,7 @@ object FormConfig: TFormConfig
             Height = 21
             TabOrder = 1
             Text = 'EditTrain'
+            OnChange = EditTrainChange
           end
           object EditEtatFoncSortie: TEdit
             Left = 160
@@ -3027,6 +3011,7 @@ object FormConfig: TFormConfig
             Height = 21
             TabOrder = 2
             Text = 'EditEtatFoncSortie'
+            OnChange = EditEtatFoncSortieChange
           end
           object EditFonctionAccess: TEdit
             Left = 112
@@ -3035,6 +3020,7 @@ object FormConfig: TFormConfig
             Height = 21
             TabOrder = 3
             Text = 'EditFonc'
+            OnChange = EditFonctionAccessChange
           end
           object EditTempo: TEdit
             Left = 112
@@ -3043,6 +3029,7 @@ object FormConfig: TFormConfig
             Height = 21
             TabOrder = 4
             Text = 'EditTempo'
+            OnChange = EditTempoChange
           end
           object EditEtatActionneur: TEdit
             Left = 184
@@ -3051,6 +3038,7 @@ object FormConfig: TFormConfig
             Height = 21
             TabOrder = 5
             Text = 'EditEtat'
+            OnChange = EditEtatActionneurChange
           end
           object CheckRAZ: TCheckBox
             Left = 48
@@ -3059,11 +3047,12 @@ object FormConfig: TFormConfig
             Height = 17
             Caption = 'Remise '#224' 0 apr'#232's pilotage'
             TabOrder = 6
+            OnClick = CheckRAZClick
           end
         end
         object GroupBoxPN: TGroupBox
-          Left = 72
+          Left = 56
-          Top = 8
+          Top = 56
           Width = 225
           Height = 193
           Caption = 'Actionneurs gestion passage '#224' niveau'
@@ -3207,6 +3196,16 @@ object FormConfig: TFormConfig
           end
         end
       end
+      object RichAct: TRichEdit
+        Left = 0
+        Top = 32
+        Width = 289
+        Height = 369
+        Color = clBlack
+        ScrollBars = ssVertical
+        TabOrder = 1
+        OnMouseDown = RichActMouseDown
+      end
     end
   end
 end

UnitConfig.pas

@@ -77,7 +77,6 @@ type
     Label15: TLabel;
     TabSheetAct: TTabSheet;
     Label16: TLabel;
-    MemoAct: TMemo;
     CheckBoxSrvSig: TCheckBox;
     Memo1: TMemo;
     Memo2: TMemo;
@@ -185,12 +184,12 @@ type
     GroupBox15: TGroupBox;
     EditNbDetDist: TEdit;
     Label31: TLabel;
+    RichAct: TRichEdit;
     procedure ButtonAppliquerEtFermerClick(Sender: TObject);
     procedure Button2Click(Sender: TObject);
     procedure FormActivate(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure MemoSignauxClick(Sender: TObject);
-    procedure MemoActClick(Sender: TObject);
     procedure PageControlChange(Sender: TObject);
     procedure RichAigMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
@@ -213,6 +212,15 @@ type
     procedure EditSuiv3Change(Sender: TObject);
     procedure EditDet4Change(Sender: TObject);
     procedure EditSuiv4Change(Sender: TObject);
+    procedure EditActChange(Sender: TObject);
+    procedure RichActMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure EditEtatActionneurChange(Sender: TObject);
+    procedure EditTrainChange(Sender: TObject);
+    procedure EditFonctionAccessChange(Sender: TObject);
+    procedure EditEtatFoncSortieChange(Sender: TObject);
+    procedure EditTempoChange(Sender: TObject);
+    procedure CheckRAZClick(Sender: TObject);
   private
     { Déclarations privées }
   public
@@ -267,7 +275,7 @@ var temps : integer;
 begin
     if SocketCDM_connecte=false then begin envoi_CDM:=false;exit;end;
     //Affiche('Envoi à CDM rail',clRed);Affiche(s,ClGreen);
-    if trace then affiche(s,clLime);
+    if traceTrames then afficheDebug(s,clLime);
     Formprinc.ClientSocketCDM.Socket.SendText(s);
     // attend l'ack
     ackCDM:=false;nackCDM:=false;
@@ -333,7 +341,7 @@ begin
 end;
 
 procedure connecte_CDM;
-var s , ss : string;
+var s : string;
     i : integer;
 begin
   // déconnexion de l'ancienne liaison éventuelle
@@ -389,7 +397,7 @@ end;
 
 // teste si une adresse IP V4 est ok
 function Ipok(s : string) : boolean;
-var i,k,posp,n,octet,erreur : integer;
+var i,k,octet,erreur : integer;
 begin
   for k:=1 to 3 do
   begin
@@ -405,7 +413,7 @@ end;
 // vérifie si la config de la com série/usb est ok
 function config_com(s : string) : boolean;
 var sa : string;
-    j,i,erreur : integer;
+    i,erreur : integer;
 begin
   sa:=s;
   protocole:=-1;
@@ -414,19 +422,15 @@ begin
   if i<>0 then
   begin
     delete(s,1,i);
-    j:=i;
     i:=pos(',',s);
-    j:=j+i;
     if i<>0 then
     begin
       delete(s,1,i);
       i:=pos(',',s);
-      j:=j+i;
       if i<>0 then
       begin
         delete(s,1,i);
         i:=pos(',',s);
-        j:=j+i;
         if i<>0 then
         begin
           delete(s,1,i);
@@ -564,6 +568,30 @@ begin
   encode_sig:=s;
 end;
 
+// transforme l'actionneur type loco ou actionneur du tableau en texte
+// paramètre d'entrée : index
+function encode_act_loc(i : integer): string;
+var s : string;
+    c : char;
+    adresse : integer;
+begin
+  // adresse
+  
+  adresse:=Tablo_Actionneur[i].actionneur;
+  if adresse=0 then begin encode_act_loc:='';exit;end;
+  if Formconfig.radioButtonLoc.Checked then
+    s:=IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].Etat)+','+Tablo_Actionneur[i].train+',F'+IntToSTR(Tablo_Actionneur[i].fonction)+','+intToSTR(Tablo_Actionneur[i].tempo);
+  if FormConfig.RadioButtonAccess.Checked then
+  begin
+    s:=IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].Etat)+','+Tablo_Actionneur[i].train+
+       ',A'+IntToSTR(Tablo_Actionneur[i].accessoire)+','+intToSTR(Tablo_Actionneur[i].sortie)+',';
+    if Tablo_Actionneur[i].Raz then s:=s+'Z' else s:=s+'S';
+  end;     
+
+  encode_act_loc:=s; 
+end;
+
+
 // modifie les fichiers de config en fonction du paramétrage
 procedure genere_config;
 var s: string;
@@ -1040,7 +1068,10 @@ begin
 
   // actionneurs
   for i:=1 to maxTablo_act do
-    MemoAct.Lines.Add(mod_Act[i]);
+  begin
+    RichAct.Lines.Add(mod_Act[i]);
+    RE_ColorLine(RichAct,RichAct.lines.count-1,ClAqua)
+  end;  
   PageControl.ActivePage:=TabSheetCDM;  // force le premier onglet sur la page
 
   for i:=1 to NbDecodeur do
@@ -1415,9 +1446,12 @@ var i,v, ligne,etatact,erreur, adresse,sortie,fonction,tempo,access : integer;
     s,s2,ss : string;
     trouve : bool;
 begin
-  with formConfig.MemoAct do
+  with formConfig.RichAct do
   begin
     ligne:=Perform(EM_LINEFROMCHAR,-1,0);  // numéro de la lignée cliquée
+    AncLigneCliquee:=Ligne;
+    ligneCliquee:=ligne;
+    //affiche(intToSTR(ligne),clLime);
     s:=Uppercase(Lines[ligne]);            
     if s='' then exit;
     SelStart:=Perform(EM_LINEINDEX,Ligne,0);  // début de la sélection
@@ -1578,11 +1612,6 @@ begin
   Aff_champs_sig;
 end;
 
-procedure TFormConfig.MemoActClick(Sender: TObject);
-begin
-  Aff_champs_act;
-end;
-
 procedure TFormConfig.PageControlChange(Sender: TObject);
 begin
   if PageControl.ActivePage=TabSheetAig then
@@ -2114,6 +2143,181 @@ begin
   end;
 end;
 
+procedure TFormConfig.EditActChange(Sender: TObject);
+var s : string;
+    act,erreur : integer;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin 
+    s:=EditAct.Text;
+    if radioButtonLoc.Checked or RadioButtonAccess.Checked then
+    begin
+      Val(s,act,erreur);
+      if erreur<>0 then
+      begin
+        LabelInfo.caption:='Erreur adresse actionneur';exit
+      end else LabelInfo.caption:=' ';
+      
+      tablo_actionneur[lignecliquee+1].actionneur:=act;
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+end;
+
+
+
+procedure TFormConfig.RichActMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  clicliste:=true;
+  LabelInfo.caption:='';
+  Aff_champs_Act;
+  clicliste:=false;
+end;
+
+procedure TFormConfig.EditEtatActionneurChange(Sender: TObject);
+var s : string;
+    etat,erreur : integer;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin 
+    s:=EditEtatActionneur.Text;
+    if radioButtonLoc.Checked or RadioButtonAccess.Checked then
+    begin
+      Val(s,etat,erreur);
+      if (erreur<>0) or (etat<0) or (etat>1) then
+      begin
+        LabelInfo.caption:='Erreur état actionneur';exit
+      end else LabelInfo.caption:=' ';
+      
+      tablo_actionneur[lignecliquee+1].etat:=etat;
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+end;
+  
+procedure TFormConfig.EditTrainChange(Sender: TObject);
+var s,train : string;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin 
+    if radioButtonLoc.Checked or RadioButtonAccess.Checked then
+    begin
+      train:=editTrain.Text;
+      if train='' then
+      begin
+        LabelInfo.caption:='Erreur train';exit
+      end else LabelInfo.caption:=' ';
+      
+      tablo_actionneur[lignecliquee+1].train:=train;
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+end;
+
+procedure TFormConfig.EditFonctionAccessChange(Sender: TObject);
+var s : string;
+    fonction,erreur : integer;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin
+    s:=EditFonctionAccess.Text;
+    if radioButtonLoc.Checked or RadioButtonAccess.Checked then
+    begin
+      Val(s,fonction,erreur);
+      if erreur<>0 then
+      begin
+        LabelInfo.caption:='Erreur fonction actionneur';exit
+      end else LabelInfo.caption:=' ';
+      
+      if radioButtonLoc.Checked then tablo_actionneur[lignecliquee+1].fonction:=fonction;
+      if RadioButtonAccess.Checked then Tablo_Actionneur[lignecliquee+1].accessoire:=fonction;
+      
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+end;
+
+procedure TFormConfig.EditEtatFoncSortieChange(Sender: TObject);
+var s : string;
+    Etat,erreur : integer;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin 
+    s:=EditEtatFoncSortie.Text;
+    if radioButtonAccess.Checked then
+    begin
+      Val(s,etat,erreur);
+      if (erreur<>0) or (etat<0) or (etat>2) then
+      begin
+        LabelInfo.caption:='Erreur Etat actionneur';exit
+      end else LabelInfo.caption:=' ';
+
+      tablo_actionneur[lignecliquee+1].sortie:=etat;
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+
+end;
+
+procedure TFormConfig.EditTempoChange(Sender: TObject);
+var s : string;
+    tempo,erreur : integer;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin 
+    s:=EditTempo.Text;
+    if radioButtonLoc.Checked then
+    begin
+      Val(s,tempo,erreur);
+      if erreur<>0 then
+      begin
+        LabelInfo.caption:='Erreur Tempo actionneur';exit
+      end else LabelInfo.caption:=' ';
+      
+      tablo_actionneur[lignecliquee+1].tempo:=tempo;
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+end;
+
+
+  
+procedure TFormConfig.CheckRAZClick(Sender: TObject);
+ var s : string;
+    Etat,erreur : integer;
+begin
+  if clicliste then exit;
+  if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
+  with Formconfig do
+  begin 
+    if radioButtonAccess.Checked then
+    begin
+      tablo_actionneur[lignecliquee+1].raz:=CheckRAZ.checked;
+      s:=encode_act_loc(lignecliquee+1);
+      RichAct.Lines[lignecliquee]:=s;
+    end;
+  end;
+end;
+
 end.
 
 

UnitDebug.dfm

@@ -1,7 +1,7 @@
 object FormDebug: TFormDebug
   Left = 329
   Top = 122
-  Width = 842
+  Width = 855
   Height = 762
   Caption = 'Fen'#234'tre de d'#233'bug'
   Color = clWindow
@@ -15,12 +15,12 @@ object FormDebug: TFormDebug
   Position = poMainFormCenter
   OnCreate = FormCreate
   DesignSize = (
-    826
+    839
     724)
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
-    Left = 642
+    Left = 655
     Top = 4
     Width = 108
     Height = 13
@@ -36,7 +36,7 @@ object FormDebug: TFormDebug
     ParentFont = False
   end
   object Label2: TLabel
-    Left = 474
+    Left = 487
     Top = 2
     Width = 131
     Height = 18
@@ -50,7 +50,7 @@ object FormDebug: TFormDebug
     ParentFont = False
   end
   object Label3: TLabel
-    Left = 472
+    Left = 485
     Top = 160
     Width = 99
     Height = 185
@@ -68,7 +68,7 @@ object FormDebug: TFormDebug
     WordWrap = True
   end
   object EditNivDebug: TEdit
-    Left = 754
+    Left = 767
     Top = 2
     Width = 49
     Height = 21
@@ -84,7 +84,7 @@ object FormDebug: TFormDebug
     OnKeyPress = EditNivDebugKeyPress
   end
   object MemoEvtDet: TMemo
-    Left = 578
+    Left = 591
     Top = 344
     Width = 239
     Height = 225
@@ -103,7 +103,7 @@ object FormDebug: TFormDebug
     TabOrder = 1
   end
   object ButtonEcrLog: TButton
-    Left = 474
+    Left = 487
     Top = 464
     Width = 97
     Height = 29
@@ -112,52 +112,40 @@ object FormDebug: TFormDebug
     TabOrder = 2
     OnClick = ButtonEcrLogClick
   end
-  object MemoDebug: TMemo
-    Left = 0
-    Top = 0
-    Width = 465
-    Height = 721
-    Anchors = [akLeft, akTop, akRight, akBottom]
-    Lines.Strings = (
-      'MemoDebug')
-    ScrollBars = ssBoth
-    TabOrder = 3
-    WordWrap = False
-  end
   object ButtonRazTampon: TButton
-    Left = 474
+    Left = 487
     Top = 536
     Width = 97
     Height = 33
     Anchors = [akTop, akRight]
     Caption = 'Raz Tampon Ev'#232'nements ---->'
-    TabOrder = 4
+    TabOrder = 3
     WordWrap = True
     OnClick = ButtonRazTamponClick
   end
   object ButtonCherche: TButton
-    Left = 474
+    Left = 487
     Top = 432
     Width = 97
     Height = 25
     Anchors = [akTop, akRight]
     Caption = 'Chercher erreurs'
-    TabOrder = 5
+    TabOrder = 4
     OnClick = ButtonChercheClick
   end
   object ButtonAffEvtChrono: TButton
-    Left = 474
+    Left = 487
     Top = 392
     Width = 97
     Height = 33
     Anchors = [akTop, akRight]
     Caption = 'Affiche Evts d'#233'tecteurs et aig'
-    TabOrder = 6
+    TabOrder = 5
     WordWrap = True
     OnClick = ButtonAffEvtChronoClick
   end
   object ButtonCop: TButton
-    Left = 474
+    Left = 487
     Top = 344
     Width = 97
     Height = 41
@@ -169,34 +157,40 @@ object FormDebug: TFormDebug
     Font.Name = 'MS Sans Serif'
     Font.Style = []
     ParentFont = False
-    TabOrder = 7
+    TabOrder = 6
     WordWrap = True
     OnClick = ButtonCopClick
   end
   object RichEdit: TRichEdit
-    Left = 578
+    Left = 591
     Top = 160
     Width = 239
     Height = 185
     Anchors = [akTop, akRight]
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWhite
+    Font.Height = -11
+    Font.Name = 'Arial'
+    Font.Style = []
     HideScrollBars = False
+    ParentFont = False
     PopupMenu = PopupMenuRE
     ScrollBars = ssVertical
-    TabOrder = 8
+    TabOrder = 7
   end
   object ButtonRazLog: TButton
-    Left = 474
+    Left = 487
     Top = 496
     Width = 97
     Height = 33
     Anchors = [akTop, akRight]
     Caption = 'Raz Tampon Log <-----'
-    TabOrder = 9
+    TabOrder = 8
     WordWrap = True
     OnClick = ButtonRazLogClick
   end
   object GroupBox1: TGroupBox
-    Left = 472
+    Left = 485
     Top = 576
     Width = 353
     Height = 145
@@ -210,7 +204,7 @@ object FormDebug: TFormDebug
     Font.Style = []
     ParentColor = False
     ParentFont = False
-    TabOrder = 10
+    TabOrder = 9
     object GroupBox3: TGroupBox
       Left = 8
       Top = 16
@@ -332,7 +326,7 @@ object FormDebug: TFormDebug
     end
   end
   object GroupBox2: TGroupBox
-    Left = 472
+    Left = 485
     Top = 20
     Width = 345
     Height = 137
@@ -346,7 +340,7 @@ object FormDebug: TFormDebug
     Font.Style = []
     ParentColor = False
     ParentFont = False
-    TabOrder = 11
+    TabOrder = 10
     object CheckAffSig: TCheckBox
       Left = 8
       Top = 16
@@ -455,6 +449,19 @@ object FormDebug: TFormDebug
       OnClick = CheckBoxAffDebDecSigClick
     end
   end
+  object RichDebug: TRichEdit
+    Left = 8
+    Top = 8
+    Width = 470
+    Height = 705
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Lines.Strings = (
+      'RichDebug')
+    PopupMenu = PopupMenuRD
+    ScrollBars = ssBoth
+    TabOrder = 11
+    OnChange = RichDebugChange
+  end
   object SaveDialog: TSaveDialog
     Left = 768
     Top = 488
@@ -467,4 +474,12 @@ object FormDebug: TFormDebug
       OnClick = copier1Click
     end
   end
+  object PopupMenuRD: TPopupMenu
+    Left = 808
+    Top = 360
+    object Copier2: TMenuItem
+      Caption = 'Copier'
+      OnClick = Copier2Click
+    end
+  end
 end

UnitDebug.pas

@@ -15,7 +15,6 @@ type
     SaveDialog: TSaveDialog;
     ButtonEcrLog: TButton;
     Label3: TLabel;
-    MemoDebug: TMemo;
     ButtonRazTampon: TButton;
     ButtonCherche: TButton;
     ButtonAffEvtChrono: TButton;
@@ -44,6 +43,9 @@ type
     EditActuel: TEdit;
     Button1: TButton;
     Button2: TButton;
+    RichDebug: TRichEdit;
+    PopupMenuRD: TPopupMenu;
+    Copier2: TMenuItem;
     procedure FormCreate(Sender: TObject);
     procedure ButtonEcrLogClick(Sender: TObject);
     procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
@@ -65,6 +67,8 @@ type
     procedure ButtonCanSuivSigClick(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
+    procedure Copier2Click(Sender: TObject);
+    procedure RichDebugChange(Sender: TObject);
   private
     { Déclarations privées }
   public
@@ -113,11 +117,6 @@ uses UnitPrinc;
 
 {$R *.dfm}
 
-procedure AfficheDebug(s : string;lacouleur : TColor);
-begin
-  FormDebug.MemoDebug.Lines.add(s);
-end;
-
 procedure RE_ColorLine(ARichEdit : TRichEdit;ARow : Integer;AColor : TColor);
 begin
   with ARichEdit do
@@ -129,6 +128,13 @@ begin
   end;
 end;
 
+procedure AfficheDebug(s : string;lacouleur : TColor);
+begin
+  FormDebug.RichDebug.Lines.add(s);
+  RE_ColorLine(FormDebug.RichDebug,FormDebug.RichDebug.lines.count-1,lacouleur);
+end;
+
+
 procedure TFormDebug.FormCreate(Sender: TObject);
 var s: string;
     i : integer;
@@ -138,14 +144,14 @@ begin
   s:=s+'comportement du programme. Positionner le niveau de 1 à 3 pour';
   s:=s+' afficher des informations plus ou moins détaillées.';
   Label3.caption:=s;
-  MemoDebug.WordWrap:=false;   // interdit la coupure des chaînes en limite du composant
+  RichDebug.WordWrap:=false;   // interdit la coupure des chaînes en limite du composant
-  MemoDebug.color:=$33;
+  RichDebug.color:=$33;
   initform:=false;
-  MemoDebug.clear;
+  RichDebug.clear;
   s:=DateToStr(date)+' '+TimeToStr(Time)+' ';
   if IsWow64Process then s:=s+' OS 64 Bits' else s:=s+' OS 32 Bits';
   RichEdit.color:=$111122;
-  MemoDebug.Lines.add(s);
+  RichDebug.Lines.add(s);
 end;
 
 procedure TFormDebug.ButtonEcrLogClick(Sender: TObject);
@@ -163,7 +169,7 @@ begin
     assignFile(fte,s);
     rewrite(fte);
     writeln(fte,s);
-    with MemoDebug do
+    with RichDebug do
     for i:=0 to Lines.Count do
     begin
       writeln(fte,Lines[i]);
@@ -186,7 +192,7 @@ begin
     end  
     else EditNivDebug.text:='0';
   end; 
-  MemoDebug.Lines.add('Niveau='+intToSTR(NivDebug));
+  RichDebug.Lines.add('Niveau='+intToSTR(NivDebug));
 end;
 
 
@@ -208,7 +214,7 @@ var i : integer;
     trouve : boolean;
 begin
 
-  with MemoDebug do
+  with RichDebug do
   begin
     i:=0;
     repeat
@@ -229,7 +235,7 @@ procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject);
 var i,j,etat : integer;
     s : string;
 begin
-  MemoDebug.Clear;
+  RichDebug.Clear;
   if N_event_tick=0 then
   begin
     AfficheDebug('Il n''y a aucun évènement détecteur ou aiguillage',clyellow);
@@ -269,17 +275,15 @@ end;
 
 procedure TFormDebug.CheckTrameClick(Sender: TObject);
 begin
-  trace:=CheckTrame.Checked;
+  traceTrames:=CheckTrame.Checked;
 end;
 
 procedure TFormDebug.ButtonCopClick(Sender: TObject);
 var i : integer;
 begin
-  MemoDebug.Lines:=Formprinc.ListBox1.Items
+  RichDebug.Lines:=Formprinc.FenRich.lines;
 end;
 
-
-
 procedure TFormDebug.copier1Click(Sender: TObject);
 begin
   RichEdit.SelectAll;
@@ -289,7 +293,7 @@ end;
 
 procedure TFormDebug.ButtonRazLogClick(Sender: TObject);
 begin
-  MemoDebug.Clear;
+  RichDebug.Clear;
 end;
 
 procedure TFormDebug.CheckBoxActClick(Sender: TObject);
@@ -376,4 +380,17 @@ begin
   NivDebug:=AncDebug;
 end;
 
+procedure TFormDebug.Copier2Click(Sender: TObject);
+begin
+  RichDebug.SelectAll;
+  RichDebug.CopyToClipboard;
+  RichDebug.SetFocus;
+end;
+
+// pour déplacer l'ascenseur de l'affichage automatiquement en bas
+procedure TFormDebug.RichDebugChange(Sender: TObject);
+begin
+  SendMessage(RichDebug.handle, WM_VSCROLL, SB_BOTTOM, 0);
+end;
+
 end.

UnitPrinc.dfm

@@ -1,6 +1,6 @@
 object FormPrinc: TFormPrinc
-  Left = 12
+  Left = 1296
-  Top = 210
+  Top = 222
   Width = 1212
   Height = 664
   Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
@@ -1201,24 +1201,6 @@ object FormPrinc: TFormPrinc
     Font.Style = []
     ParentFont = False
   end
-  object ListBox1: TListBox
-    Left = 8
-    Top = 48
-    Width = 609
-    Height = 505
-    Style = lbOwnerDrawFixed
-    Anchors = [akLeft, akTop, akRight, akBottom]
-    Color = clBlack
-    Font.Charset = ANSI_CHARSET
-    Font.Color = clBlue
-    Font.Height = 16
-    Font.Name = 'Arial'
-    Font.Style = []
-    ItemHeight = 16
-    ParentFont = False
-    TabOrder = 0
-    OnDrawItem = ListBox1DrawItem
-  end
   object ScrollBox1: TScrollBox
     Left = 631
     Top = 168
@@ -1231,7 +1213,7 @@ object FormPrinc: TFormPrinc
     Anchors = [akTop, akRight, akBottom]
     Color = clWhite
     ParentColor = False
-    TabOrder = 1
+    TabOrder = 0
   end
   object GroupBox1: TGroupBox
     Left = 631
@@ -1240,7 +1222,7 @@ object FormPrinc: TFormPrinc
     Height = 129
     Anchors = [akTop, akRight]
     Caption = 'Commande d'#39'accessoires'
-    TabOrder = 2
+    TabOrder = 1
     object Label2: TLabel
       Left = 7
       Top = 16
@@ -1339,7 +1321,7 @@ object FormPrinc: TFormPrinc
     Width = 281
     Height = 129
     Anchors = [akTop, akRight]
-    TabOrder = 5
+    TabOrder = 4
     object BoutonRaf: TButton
       Left = 8
       Top = 8
@@ -1439,7 +1421,7 @@ object FormPrinc: TFormPrinc
     Height = 25
     Anchors = [akTop, akRight]
     Caption = 'Panel2'
-    TabOrder = 6
+    TabOrder = 5
     object Label1: TLabel
       Left = 16
       Top = 4
@@ -1468,7 +1450,26 @@ object FormPrinc: TFormPrinc
     Height = 17
     Anchors = [akLeft, akRight, akBottom]
     Caption = 'xx'
+    TabOrder = 6
+  end
+  object FenRich: TRichEdit
+    Left = 8
+    Top = 48
+    Width = 617
+    Height = 497
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Color = clBlack
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clYellow
+    Font.Height = -13
+    Font.Name = 'MS Sans Serif'
+    Font.Style = []
+    ParentFont = False
+    PopupMenu = PopupMenuFenRich
+    ReadOnly = True
+    ScrollBars = ssBoth
     TabOrder = 7
+    OnChange = FenRichChange
   end
   object Timer1: TTimer
     Interval = 100
@@ -1499,6 +1500,10 @@ object FormPrinc: TFormPrinc
         Caption = 'Etat des aiguillages'
         OnClick = Etatdesaiguillages1Click
       end
+      object Etatdessignaux1: TMenuItem
+        Caption = 'Etat des signaux'
+        OnClick = Etatdessignaux1Click
+      end
       object N3: TMenuItem
         Caption = '-'
       end
@@ -1611,4 +1616,12 @@ object FormPrinc: TFormPrinc
     Left = 888
     Top = 16
   end
+  object PopupMenuFenRich: TPopupMenu
+    Left = 208
+    Top = 24
+    object Copier1: TMenuItem
+      Caption = 'Copier'
+      OnClick = Copier1Click
+    end
+  end
 end

UnitPrinc.pas

@@ -20,7 +20,6 @@ uses
 
 type
   TFormPrinc = class(TForm)
-    ListBox1: TListBox;
     Timer1: TTimer;
     LabelTitre: TLabel;
     ScrollBox1: TScrollBox;
@@ -91,6 +90,10 @@ type
     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);
@@ -98,8 +101,6 @@ type
     procedure BoutVersionClick(Sender: TObject);
     procedure ButtonCommandeClick(Sender: TObject);
     procedure EditvalEnter(Sender: TObject);
-    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
-      Rect: TRect; State: TOwnerDrawState);
     procedure BoutonRafClick(Sender: TObject);
     procedure ClientSocketLenzError(Sender: TObject; Socket: TCustomWinSocket;
       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
@@ -143,7 +144,9 @@ type
     procedure ButtonAffTCOClick(Sender: TObject);
     procedure ButtonLanceCDMClick(Sender: TObject);
     procedure Affichefentredebug1Click(Sender: TObject);
-    procedure Button1Click(Sender: TObject);
+    procedure FenRichChange(Sender: TObject);
+    procedure Copier1Click(Sender: TObject);
+    procedure Etatdessignaux1Click(Sender: TObject);
   private
     { Déclarations privées }
     procedure DoHint(Sender : Tobject);
@@ -236,7 +239,7 @@ var
   branche : array [1..100] of string;
 
   FormPrinc: TFormPrinc;
-  ack,portCommOuvert,trace,AffMem,AfficheDet,CDM_connecte,SocketCDM_connecte,
+  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
@@ -414,10 +417,8 @@ begin
   begin
     brush.Color:=couleur;
     Pen.Color:=clBlack;
-    //Affiche('clignote '+IntToSTR(x)+' '+intToSTR(y),clyellow);
     Ellipse(x-rayon,y-rayon,x+rayon,y+rayon);
   end;
-  //Affiche(IntToSTR(y),clyellow);
 end;
 
 // dessine les feux sur une cible à 2 feux dans le canvas spécifié
@@ -1045,7 +1046,7 @@ begin
     cercle(ACanvas,12,13,6,GrisF);
     cercle(ACanvas,25,13,6,GrisF);
   end;
-  if EtatSignal=1 then 
+  if EtatSignal=1 then
   begin
     cercle(ACanvas,12,13,6,clWhite);
     cercle(ACanvas,25,13,6,GrisF);
@@ -1058,19 +1059,18 @@ begin
 
 end;
 
-
-// affiche un texte dans la fenêtre
 procedure Affiche(s : string;lacouleur : TColor);
 begin
-  couleur:=lacouleur;
+  with formprinc do
-  with formprinc.ListBox1 do
   begin
-     Items.addObject(s,pointer(lacouleur));
+     FenRich.lines.add(s);
-     TopIndex:= Items.Count - 1;
+     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;
@@ -1265,7 +1265,7 @@ end;
 // Affiche une chaîne en Hexa Ascii
 procedure affiche_chaine_hex(s : string;couleur : Tcolor);
 begin
-  if trace then Affiche(chaine_HEX(s),couleur);
+  if traceTrames then AfficheDebug(chaine_HEX(s),couleur);
 end;
 
 // temporisation en x 100 ms (0,1 s)
@@ -1285,7 +1285,7 @@ var i,timeout,valto : integer;
 begin
 //  com:=formprinc.MSCommUSBLenz;
   s:=entete+s+suffixe;
-  if Trace then Affiche('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClGreen);
+  if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClGreen);
   // par port com-usb
 
   if portCommOuvert then
@@ -3570,10 +3570,9 @@ begin
       trouve_fonte:=true;
       delete(s,i,length(sa));
       TailleFonte:=StrToINT(s);
-      with FormPrinc.ListBox1 do
+      with FormPrinc.FenRich do
       begin
-        Font.Height:=TailleFonte;
+        Font.Size:=TailleFonte;
-        ItemHeight:=TailleFonte+1;
       end;
     end;
 
@@ -4041,8 +4040,7 @@ begin
     s:=lit_ligne;
     mod_Branches[Nligne]:=s;inc(Nligne);
     //Affiche(s,clWhite);
-    //adresse:=pos('0',s);
+ 
-    //s:='A16B,557,0'  ;
     if s<>'0' then
     begin
       branche[i]:=s;
@@ -4077,6 +4075,7 @@ begin
         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
@@ -5239,7 +5238,8 @@ end;
 
 // renvoie l'adresse du détecteur suivant des deux éléments contigus
 // TypeElprec/actuel: 1= détecteur  2= aiguillage 4=Buttoir
-function detecteur_suivant(prec : integer;TypeElPrec : integer;actuel : integer;TypeElActuel : integer) : integer ;
+// 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
@@ -5253,7 +5253,7 @@ begin
   // étape 1 trouver le sens
   repeat
     inc(j);
-    AdrSuiv:=suivant_alg3(precCalc,TypeprecCalc,actuelCalc,TypeActuelCalc,1);
+    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
@@ -5270,6 +5270,7 @@ begin
     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
@@ -5398,7 +5399,7 @@ begin
     if j=2 then i1:=IndexBranche_det1-1;
     if NivDebug=3 then
     begin
-      s:='Test 1 en ';
+      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);
@@ -5434,7 +5435,7 @@ begin
         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',clyellow);
+      if (N_det=Nb_det_dist) and (Nivdebug=3) then afficheDebug('Détecteurs trop distants',clred);
     end
 
     else
@@ -5443,7 +5444,7 @@ begin
       adr:=el2;typeGen:=TypeDet2;
     end;
   
-    if (typeDet2=TypeGen) and (Adr=el2) then
+    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;
@@ -5458,6 +5459,7 @@ begin
           case typeGen of
            1 : s:=s+' detecteur';
            2 : s:=s+' aiguillage';
+           4 : s:=s+' buttoir';
            end;
           AfficheDebug(s,clorange);
         end;
@@ -5468,7 +5470,7 @@ begin
         sortie:=(TypeGen=1) or (Adr=0) or (Adr>=9996) or (i=10);
       until sortie;
     
-      if TypeGen=1 then
+      if (TypeGen=1) or (TypeGen=4) then
       begin
         if NivDebug=3 then
         begin
@@ -5482,7 +5484,7 @@ begin
     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;
+  until j=3;  // boucle incrément/décrément
 
   detecteur_suivant_el:=9996;
   if NivDebug=3 then affichedebug('------------------',clyellow);
@@ -5866,7 +5868,7 @@ begin
   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',clred);
+    if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange);
     if (ife=1) then
     begin
       prec:=feux[i].Adr_det1;
@@ -5934,7 +5936,7 @@ begin
 
          end;
 
-      if NivDebug=3 then AfficheDebug('130 - suivant='+IntToSTR(adrsuiv),clred);
+      if NivDebug=3 then AfficheDebug('132 - suivant='+IntToSTR(adrsuiv),clYellow);
       if actuel=0 then
       begin
         // si c'est un buttoir
@@ -6072,13 +6074,13 @@ begin
   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);
-  //memZone[518,520]:=true;
   if i=0 then 
   begin
     Affiche('Erreur 602 - feu '+IntToSTR(adrFeu)+' non trouvé',clred);
@@ -6104,27 +6106,27 @@ begin
     if (j=2) then
     begin
       det_initial:=feux[i].Adr_det2;Adr_El_Suiv:=feux[i].Adr_el_suiv2;
-      if feux[i].Btype_suiv1=1 then Btype_el_suivant:=1;
+      if feux[i].Btype_suiv2=1 then Btype_el_suivant:=1;
-      if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
+      if feux[i].Btype_suiv2=2 then Btype_el_suivant:=2;
-      if feux[i].Btype_suiv1=4 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_suiv1=1 then Btype_el_suivant:=1;
+      if feux[i].Btype_suiv3=1 then Btype_el_suivant:=1;
-      if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
+      if feux[i].Btype_suiv3=2 then Btype_el_suivant:=2;
-      if feux[i].Btype_suiv1=4 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_suiv1=1 then Btype_el_suivant:=1;
+      if feux[i].Btype_suiv4=1 then Btype_el_suivant:=1;
-      if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
+      if feux[i].Btype_suiv4=2 then Btype_el_suivant:=2;
-      if feux[i].Btype_suiv1=4 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);
+      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);
@@ -6295,6 +6297,8 @@ begin
           // 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
@@ -6505,7 +6509,7 @@ begin
     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) ; // détecteur précédent le feu
+      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);
@@ -6726,7 +6730,7 @@ begin
       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) ; // détecteur précédent le feu
+        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);
@@ -6885,22 +6889,22 @@ begin
       if (valeur and $C)=$8 then
       begin      
         Event_Aig(adraig+3,const_droit,0);
-        if trace then begin s:='accessoire '+intToSTR(adraig+3)+'=2';Affiche(s,clYellow);end;
+        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 trace then begin s:='accessoire '+intToSTR(adraig+3)+'=1';Affiche(s,clYellow);end;
+        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 trace then begin s:='accessoire '+intToSTR(adraig+2)+'=2';Affiche(s,clYellow);end;
+        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 trace then begin s:='accessoire '+intToSTR(adraig+2)+'=1';Affiche(s,clYellow);end;
+        if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=1';AfficheDebug(s,clYellow);end;
       end;
     end;
   end;
@@ -6941,22 +6945,22 @@ begin
       if (valeur and $C)=$8 then
       begin
         Event_Aig(adraig+1,const_droit,0);
-        if trace then begin s:='accessoire '+intToSTR(adraig+1)+'=2';Affiche(s,clYellow);end;
+        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 trace then begin s:='accessoire '+intToSTR(adraig+1)+'=1';Affiche(s,clYellow);end;
+        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 trace then begin s:='accessoire '+intToSTR(adraig)+'=2';Affiche(s,clYellow);end;
+        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 trace then begin s:='accessoire '+intToSTR(adraig)+'=1';Affiche(s,clYellow);end;
+        if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=1';AfficheDebug(s,clYellow);end;
       end;
     end;
   end;
@@ -6982,8 +6986,8 @@ begin
     #5 :  begin nack:=true;msg:='plus de time slot';end;
     #6 :  begin nack:=true;msg:='débordement tampon LI100';end;
     end;
-    if trace and (chaineINT[2]=#4) then Affiche(msg,clYellow);
+    if traceTrames and (chaineINT[2]=#4) then AfficheDebug(msg,clYellow);
-    if trace and (chaineINT[2]<>#4) then Affiche(msg,clRed);
+    if traceTrames and (chaineINT[2]<>#4) then AfficheDebug(msg,clRed);
     delete(chaineINT,1,3);
     decode_chaine_retro:=chaineINT;
     exit;
@@ -7682,7 +7686,7 @@ begin
     begin
       chaine_recue:=chaine_recue+char(tablo[i]);
     end;
-    if trace then Affiche('Tick='+IntToSTR(tick)+'/Rec '+chaine_Hex(chaine_recue),Clwhite);
+    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:='';
@@ -7946,17 +7950,6 @@ begin
   if (Editval.Text<>'1') and (Editval.Text<>'2') then editval.text:='1';
 end;
 
-// gestion de la couleur des textes de la list box
-procedure TFormPrinc.ListBox1DrawItem(Control: TWinControl; Index: Integer;
-  Rect: TRect; State: TOwnerDrawState);
-begin
-  //with control as Tlistbox do
-  with listbox1.Canvas do
-  begin
-    Font.color:=Tcolor(ListBox1.Items.Objects[index]);
-    TextOut(Rect.Left,Rect.Top+4,ListBox1.Items[index]);
-  end;
-end;
 
 procedure TFormPrinc.BoutonRafClick(Sender: TObject);
 begin
@@ -8010,7 +8003,7 @@ procedure TFormPrinc.ClientSocketLenzRead(Sender: TObject;
 var s : string;
 begin
   s:=ClientSocketLenz.Socket.ReceiveText;
-  if trace then affiche(chaine_hex(s),clWhite);
+  if traceTrames then afficheDebug(chaine_hex(s),clWhite);
   interprete_reponse(s);
 end;
 
@@ -8035,7 +8028,6 @@ begin
   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 blanc : Trames reçues de 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);
@@ -8078,6 +8070,7 @@ 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;
@@ -8484,20 +8477,19 @@ 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
-  //if residuCDM<>'' then Affiche(recuCDM,clLime);
+
   residuCDM:='';
-  if trace then
+  if traceTrames then AfficheDebug(recuCDM,clWhite);
-  begin
+
+  {begin
     n:=80;
-    Affiche('recu de CDM Tick='+IntToSTR(tick)+' '+IntToSTR(length(recuCDM))+' car',clWhite);Affiche(copy(recuCDM,1,n),clWhite);
-    AfficheDebug(recuCDM,clWhite);
     l:=length(recuCDM);
-    i:=1;
+    i:=0;
     repeat
-      Affiche(copy(recuCDM,i*n,n),clWhite);
+      AfficheDebug(copy(recuCDM,(i*n)+1,n),clWhite);
       inc(i);
     until l<i*n;
-  end;
+  end;}
   Interprete_trameCDM(recuCDM);
 end;
 
@@ -8881,17 +8873,38 @@ begin
   vitesse_loco(3,20,true);
 end;
 
-
+// pour déplacer l'ascenseur de l'affichage automatiquement en bas
-procedure TFormPrinc.Button1Click(Sender: TObject);
+procedure TFormPrinc.FenRichChange(Sender: TObject);
 begin
-   Interprete_trameCDM('yfytrf');
+  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
 
 
 

verif_version.pas

@@ -130,12 +130,13 @@ begin
         begin
           i:=pos('.zip',s);
           trouve_zip:=i<>0;
-          if trouve_zip then s3:=s;
+          if trouve_zip then 
+            s3:=s;
         end;
        // Aff(s)
       end;
       closefile(fichier);
-      if trouve_version then
+      if trouve_version and trouve_zip then
       begin
         // isoler le champ version
         i:=pos('version ',s2);
@@ -190,7 +191,7 @@ begin
     end
     else
       begin
-        if notificationVersion then Affiche('Pas d''accès au site CDM rail',clorange);
+        if notificationVersion then Affiche('Pas d''accès au site CDM rail ou échec téléchargement',clorange);
       end;
 end;
 

verif_version.~dfm

@@ -1,35 +0,0 @@
-object FormVersion: TFormVersion
-  Left = 500
-  Top = 341
-  Width = 468
-  Height = 194
-  Caption = 'V'#233'rification de version'
-  Color = clBtnFace
-  Font.Charset = ANSI_CHARSET
-  Font.Color = clBlack
-  Font.Height = -16
-  Font.Name = 'Arial Narrow'
-  Font.Style = []
-  OldCreateOrder = False
-  Position = poScreenCenter
-  OnCreate = FormCreate
-  PixelsPerInch = 96
-  TextHeight = 20
-  object Memo1: TMemo
-    Left = 16
-    Top = 32
-    Width = 425
-    Height = 105
-    Font.Charset = ANSI_CHARSET
-    Font.Color = clBlack
-    Font.Height = -13
-    Font.Name = 'Arial Narrow'
-    Font.Style = []
-    ParentFont = False
-    ScrollBars = ssVertical
-    TabOrder = 0
-  end
-  object TimerVerif: TTimer
-    OnTimer = TimerVerifTimer
-  end
-end

verif_version.~pas

@@ -1,210 +0,0 @@
-unit verif_version;
-
-interface
-
-uses
-  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-      Dialogs, StdCtrls , ComCtrls ,WinInet, ExtCtrls;
-
-type
-  TFormVersion = class(TForm)
-    TimerVerif: TTimer;
-    Memo1: TMemo;
-    procedure FormCreate(Sender: TObject);
-    procedure TimerVerifTimer(Sender: TObject);
-  private
-    { Déclarations privées }
-  public
-    { Déclarations publiques }
-  end;
-
-var
-  FormVersion: TFormVersion;
-  Lance_verif : integer;
-  verifVersion,notificationVersion : boolean;
-
-Const  Version='2.11';  // sert à la comparaison de la version publiée
-
-implementation
-
-uses UnitPrinc;
-
-{$R *.dfm}
-
-Procedure Aff(s : string);
-begin
-  FormVersion.Memo1.lines.add(s);
-end;
-
-function GetCurrentProcessEnvVar(const VariableName: string): string;
-var
-  nSize: DWord;
-begin
-  nSize:=0;
-  nSize:=GetEnvironmentVariable(PChar(VariableName), nil, nSize);
-  if nSize=0 then
-  begin
-    result:='';
-  end
-  else
-  begin
-    SetLength(result,nSize-1);
-    if GetEnvironmentVariable(PChar(VariableName), PChar(result), nSize) <> nSize - 1 then
-      raise Exception.Create(SysErrorMessage(GetlastError))
-  end;
-end;
-
-
-// téléchargement d'une page internet sans cache dans un fichier
-function DownloadURL_NOCache(aUrl: string;s : string): Boolean;
-var
-  hSession: HINTERNET;
-  hService: HINTERNET;
-  Fs:TFileStream;
-  lpBuffer: array[0..1024 + 1] of byte;
-  dwBytesRead: DWORD;
-  dwTimeout : integer;
-begin
-  Result:=False;
-  DeleteFile(s);
-  Try Fs:=TFileStream.Create(s,fmCreate,fmShareDenyNone);
-    hSession:=InternetOpen('MyApp',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
-    try
-      if Assigned(hSession) then
-      begin
-        // fonction longue
-        dwTimeout:=2000; //2s
-        InternetSetOption(hSession,INTERNET_OPTION_CONNECT_TIMEOUT,@dwTimeOut, SizeOf(dwTimeOut));
-        hService:=InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
-        if Assigned(hService) then
-        try
-          while True do
-            begin
-              dwBytesRead:=1024;
-              InternetReadFile(hService,@lpBuffer,1024,dwBytesRead);
-              fs.WriteBuffer(lpBuffer,dwBytesRead);
-              if dwBytesRead=0 then break;
-            end;
-            Result:=True;
-        finally
-          InternetCloseHandle(hService);
-        end;
-      end;
-    finally
-      InternetCloseHandle(hSession);
-    end;
-  finally
-    fs.Free;
-  end;
-end;
-
-procedure verifie_version;
-var s,s2,s3,Version_p,Url,LocalFile : string;
-    trouve_version,trouve_zip : boolean;
-    fichier : text;
-    i,j,erreur : integer;
-    V_publie,V_utile : real;
-begin
-    //Affiche('vérifie version',clLime);
-    if not(AvecInit)  then exit ;
-    if not(verifVersion) then exit;
-    Url:='http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906#p50499';
-    LocalFile:='page.txt';
-    trouve_version:=false;
-    trouve_zip:=false;
-    if DownloadURL_NOCache(Url,localFile) then
-    begin
-      AssignFile(fichier,LocalFile);
-      reset(fichier);
-      while not(eof(fichier)) and  (not(trouve_version) or not(trouve_zip)) do
-      begin
-        readln(fichier,s);
-        s:=LowerCase(s);
-        if not(trouve_version) then
-        begin
-          i:=pos('version ',s);
-          trouve_version:=i<>0;
-          if trouve_version then s2:=s;
-        end;
-        if not(trouve_zip) then
-        begin
-          i:=pos('.zip',s);
-          trouve_zip:=i<>0;
-          if trouve_zip then s3:=s;
-        end;
-       // Aff(s)
-      end;
-      closefile(fichier);
-      if trouve_version then
-      begin
-        // isoler le champ version
-        i:=pos('version ',s2);
-        delete(s2,1,i+7);
-        j:=pos(' ',s2);
-        Version_p:=copy(s2,1,j-1);        // version dans version_p
-        // isoler l'url du zip
-        i:=pos('href="',s3);
-        delete(s3,1,i+5);
-        j:=pos('"',s3);
-        s3:=copy(s3,1,j-1);
-        i:=pos('.',s3);
-        if i<>0 then delete(s3,i,1); // supprimer le .
-        s3:='http://cdmrail.free.fr/ForumCDR'+s3 ;
-        aff(s3);               // lien dans s3
-
-        // changer le . en ,
-        s:=Version_p;
-        // i:=pos('.',s);if i<>0 then s[i]:=',';
-        s2:=version;
-       // i:=pos('.',s2);if i<>0 then s2[i]:=',';
-
-        val(s,V_publie,erreur); if erreur<>0 then exit;
-        val(s2,V_utile,erreur); if erreur<>0 then exit;
-      
-        if V_utile<V_publie then
-        begin
-          FormVersion.show;
-          s:='Vous utilisez la version '+version+' mais il existe la version '+Version_p;
-          Aff(s);
-          if MessageDlg(s+'. Voulez-vous la télécharger?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
-          begin
-            // récupérer depuis la variable d'environnement windows USERPROFILE le repertoire de la session ouverte
-            s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\Signaux_Complexes_GL.Zip';
-            Aff('Téléchargement de '+s3+' dans ');
-            Aff(s);
-
-            if DownloadURL_NOCache(s3,s) then
-            //if true then
-            begin
-              Aff('Téléchargement réussi');
-              Aff('Vous pouvez ouvrir le dossier de téléchargement, décomprimer le zip et l''installer');
-            end
-              else Aff('Echec de téléchargement');
-          end
-          else formVersion.Free;
-        end;
-
-        if (V_utile=V_publie) and notificationVersion then Affiche('Votre version '+Version_p+' est à jour',clLime);
-
-      end;
-    end
-    else
-      begin
-        if notificationVersion then Affiche('Pas d''accès au site CDM rail',clorange);
-      end;
-end;
-
-
-procedure TFormVersion.FormCreate(Sender: TObject);
-begin
-  Timerverif.Interval:=1000;    // timer à 1 seconde
-  Lance_verif:=2;               // lancer la vérification de version dans 1s
-end;
-
-procedure TFormVersion.TimerVerifTimer(Sender: TObject);
-begin
-  if lance_verif>0 then dec(lance_verif);
-  if lance_verif=1 then verifie_version;
-end;
-
-end.