V6.0

Signaux_complexes_GL.dpr

@@ -15,7 +15,8 @@ uses
   UnitConfigCellTCO in 'UnitConfigCellTCO.pas' {FormConfCellTCO},
   UnitCDF in 'UnitCDF.pas' {FormCDF},
   Unitplace in 'Unitplace.pas' {FormPlace},
-  UnitPareFeu in 'UnitPareFeu.pas';
+  UnitPareFeu in 'UnitPareFeu.pas',
+  UnitAnalyseSegCDM in 'UnitAnalyseSegCDM.pas' {FormAnalyseCDM};
 
 {$R *.res}
 
@@ -33,5 +34,6 @@ begin
   Application.CreateForm(TFormCDF, FormCDF);
   Application.CreateForm(TFormPlace, FormPlace);
   Application.CreateForm(TFormDebug, FormDebug);
+  Application.CreateForm(TFormAnalyseCDM, FormAnalyseCDM);
   Application.Run;
 end.

UnitAnalyseSegCDM.dfm

@@ -0,0 +1,124 @@
+object FormAnalyseCDM: TFormAnalyseCDM
+  Left = 216
+  Top = 23
+  Hint = '(aiguillages uniquement)'
+  Anchors = [akLeft, akTop, akRight, akBottom]
+  AutoScroll = False
+  Caption = 'FormAnalyseCDM'
+  ClientHeight = 660
+  ClientWidth = 1032
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ShowHint = True
+  OnCreate = FormCreate
+  OnResize = FormResize
+  DesignSize = (
+    1032
+    660)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object ScrollBox1: TScrollBox
+    Left = 8
+    Top = 16
+    Width = 977
+    Height = 553
+    HorzScrollBar.Tracking = True
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    AutoScroll = False
+    Color = clBlack
+    ParentColor = False
+    TabOrder = 0
+    object ImageCDM: TImage
+      Left = 0
+      Top = 0
+      Width = 937
+      Height = 512
+    end
+  end
+  object GroupBox1: TGroupBox
+    Left = 16
+    Top = 576
+    Width = 457
+    Height = 73
+    Anchors = [akLeft, akBottom]
+    Caption = 'Affichages '
+    TabOrder = 1
+    object Label1: TLabel
+      Left = 216
+      Top = 16
+      Width = 81
+      Height = 13
+      Caption = 'Afficher le port n'#176
+    end
+    object CheckConnexions: TCheckBox
+      Left = 24
+      Top = 16
+      Width = 97
+      Height = 17
+      Caption = 'Connexions'
+      TabOrder = 0
+      OnClick = CheckConnexionsClick
+    end
+    object CheckAdresses: TCheckBox
+      Left = 24
+      Top = 32
+      Width = 97
+      Height = 17
+      Caption = 'Adresses'
+      TabOrder = 1
+      OnClick = CheckAdressesClick
+    end
+    object CheckSegments: TCheckBox
+      Left = 112
+      Top = 16
+      Width = 81
+      Height = 17
+      Caption = 'segments'
+      TabOrder = 2
+      OnClick = CheckSegmentsClick
+    end
+    object CheckPorts: TCheckBox
+      Left = 112
+      Top = 32
+      Width = 121
+      Height = 17
+      Caption = 'Ports'
+      TabOrder = 3
+      OnClick = CheckSegmentsClick
+    end
+    object EditPort: TEdit
+      Left = 304
+      Top = 16
+      Width = 57
+      Height = 21
+      TabOrder = 4
+    end
+    object ButtonAffPort: TButton
+      Left = 368
+      Top = 16
+      Width = 73
+      Height = 25
+      Caption = 'Afficher le port'
+      TabOrder = 5
+      OnClick = ButtonAffPortClick
+    end
+  end
+  object TrackBar1: TTrackBar
+    Left = 992
+    Top = 16
+    Width = 37
+    Height = 553
+    Anchors = [akTop, akRight]
+    Max = 200
+    Min = 50
+    Orientation = trVertical
+    Position = 200
+    TabOrder = 2
+    OnChange = TrackBar1Change
+  end
+end

UnitConfig.dfm

@@ -1571,7 +1571,7 @@ object FormConfig: TFormConfig
     Top = 8
     Width = 633
     Height = 505
-    ActivePage = TabSheetCDM
+    ActivePage = TabSheetSig
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clBlack
     Font.Height = -11
@@ -3128,7 +3128,7 @@ object FormConfig: TFormConfig
           Width = 129
           Height = 21
           Style = csDropDownList
-          ItemHeight = 0
+          ItemHeight = 13
           TabOrder = 1
           OnChange = ComboBoxDecChange
         end

UnitConfig.pas

@@ -840,25 +840,37 @@ begin
      end;
    end;
 
-   // tjd 2/4 états ou tjs 
+   // tjd 2/4 états ou tjs
    if (tjdC or tjsC) then
    begin
      s:=s+'D('+intToSTR(aiguillage[index].Adroit);
-     c:=aiguillage[index].AdroitB;if c<>'Z' then s:=s+c;
+
-     s:=s+','+intToSTR(aiguillage[index].DDroit)+aiguillage[index].DDroitB+'),';
+     c:=aiguillage[index].AdroitB;if (c<>'Z') and (c<>#0) then s:=s+c;
+     s:=s+','+intToSTR(aiguillage[index].DDroit);
+
+     c:=aiguillage[index].DDroitB;if (c<>'Z') and (c<>#0) then s:=s+c;
+     s:=s+'),';
      s:=s+'S('+intToSTR(aiguillage[index].Adevie);
-     c:=aiguillage[index].AdevieB;if c<>'Z' then s:=s+c;
+
-     s:=s+','+intToSTR(aiguillage[index].DDevie)+aiguillage[index].DDevieB+')';
+     c:=aiguillage[index].AdevieB;if (c<>'Z') and (c<>#0) then s:=s+c;
+     s:=s+','+intToSTR(aiguillage[index].DDevie);
+
+     c:=aiguillage[index].DDevieB;if (c<>'Z') and (c<>#0) then s:=s+c;
+     s:=s+')';
    end;
 
    if croi then
-   begin      
+   begin
      s:=s+'D('+intToSTR(aiguillage[index].Adroit);
-     c:=aiguillage[index].AdroitB;if c<>'Z' then s:=s+c;
+     c:=aiguillage[index].AdroitB;if (c<>'Z') and (c<>#0) then s:=s+c;
-     s:=s+','+intToSTR(aiguillage[index].DDroit)+aiguillage[index].DDroitB+'),';
+     s:=s+','+intToSTR(aiguillage[index].DDroit);
+     c:=aiguillage[index].DDroitB;if (c<>'Z') and (c<>#0) then s:=s+c;
+     s:=s+'),';
      s:=s+'S('+intToSTR(aiguillage[index].Adevie);
-     c:=aiguillage[index].AdevieB;if c<>'Z' then s:=s+c;
+     c:=aiguillage[index].AdevieB;if (c<>'Z') and (c<>#0) then s:=s+c;
-     s:=s+','+intToSTR(aiguillage[index].DDevie)+aiguillage[index].DDevieB+')';
+     s:=s+','+intToSTR(aiguillage[index].DDevie);
+     c:=aiguillage[index].DDevieB;if (c<>'Z') and (c<>#0) then s:=s+c;
+     s:=s+')';
    end;
 
    if tjsC then
@@ -874,20 +886,20 @@ begin
      if aiguillage[index].vitesse=60 then s:=s+',V60';
      if aiguillage[index].inversionCDM=1 then s:=s+',I1' else s:=s+',I0';
    end;
-   
+
    // valeur d'initialisation
    if not(croi) then
    begin
      s:=s+',INIT(';
      s:=s+IntToSTR(aiguillage[index].posInit)+',';
-     s:=s+IntToSTR(aiguillage[index].temps)+')'; 
+     s:=s+IntToSTR(aiguillage[index].temps)+')';
    end;
-  
+
    if tjdC then
    begin
      if aiguillage[index].EtatTJD=2 then s:=s+',E2' else s:=s+',E4';
    end;
-  
+
    encode_aig:=s;
 end;
 

UnitDebug.dfm

@@ -1,6 +1,6 @@
 object FormDebug: TFormDebug
-  Left = 306
+  Left = 209
-  Top = 21
+  Top = 192
   Width = 864
   Height = 788
   VertScrollBar.Increment = 67
@@ -482,6 +482,22 @@ object FormDebug: TFormDebug
       TabOrder = 10
       OnClick = CheckDetSIgClick
     end
+    object CheckImporteCDM: TCheckBox
+      Left = 256
+      Top = 96
+      Width = 129
+      Height = 17
+      Alignment = taLeftJustify
+      Caption = 'Importation CDM Rail'
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clBlack
+      Font.Height = -11
+      Font.Name = 'MS Sans Serif'
+      Font.Style = []
+      ParentFont = False
+      TabOrder = 11
+      OnClick = CheckImporteCDMClick
+    end
   end
   object RichDebug: TRichEdit
     Left = 8

UnitDebug.pas

@@ -63,6 +63,7 @@ type
     Button0: TButton;
     MemoEvtDet: TRichEdit;
     CheckDetSIg: TCheckBox;
+    CheckImporteCDM: TCheckBox;
     procedure FormCreate(Sender: TObject);
     procedure ButtonEcrLogClick(Sender: TObject);
     procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
@@ -101,6 +102,7 @@ type
     procedure FormActivate(Sender: TObject);
     procedure MemoEvtDetChange(Sender: TObject);
     procedure CheckDetSIgClick(Sender: TObject);
+    procedure CheckImporteCDMClick(Sender: TObject);
   private
     { Déclarations privées }
   public
@@ -110,7 +112,7 @@ type
 var
   FormDebug: TFormDebug;
   NivDebug,signalDebug,compt_erreur,positionErreur,LigneErreur : integer;
-  AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg : boolean;
+  AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg,debugAnalyse : boolean;
   N_event_det : integer; // index du dernier évènement (de 1 à 20)
   N_Event_tick : integer ; // dernier index
 
@@ -625,5 +627,9 @@ begin
   AFfDetSIg:=checkDetSig.checked;
 end;
 
+procedure TFormDebug.CheckImporteCDMClick(Sender: TObject);
 begin
+  debugAnalyse:=checkImporteCDM.checked;
+end;
+
 end.

UnitPrinc.dfm

@@ -1,8 +1,8 @@
 object FormPrinc: TFormPrinc
-  Left = 66
+  Left = 68
-  Top = 209
+  Top = 194
-  Width = 1213
+  Width = 1227
-  Height = 670
+  Height = 671
   Caption = 'Signaux complexes'
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
@@ -17,8 +17,8 @@ object FormPrinc: TFormPrinc
   OnClose = FormClose
   OnCreate = FormCreate
   DesignSize = (
-    1197
+    1211
-    611)
+    612)
   PixelsPerInch = 96
   TextHeight = 13
   object LabelTitre: TLabel
@@ -35,7 +35,7 @@ object FormPrinc: TFormPrinc
     ParentFont = False
   end
   object Image9feux: TImage
-    Left = 384
+    Left = 416
     Top = 0
     Width = 57
     Height = 105
@@ -815,7 +815,7 @@ object FormPrinc: TFormPrinc
     Visible = False
   end
   object Image3Dir: TImage
-    Left = 968
+    Left = 928
     Top = 168
     Width = 49
     Height = 25
@@ -981,8 +981,8 @@ object FormPrinc: TFormPrinc
     Visible = False
   end
   object Image5Dir: TImage
-    Left = 1096
+    Left = 960
-    Top = 120
+    Top = 0
     Width = 65
     Height = 25
     Picture.Data = {
@@ -1187,7 +1187,7 @@ object FormPrinc: TFormPrinc
     Visible = False
   end
   object LabelEtat: TLabel
-    Left = 440
+    Left = 454
     Top = 8
     Width = 152
     Height = 18
@@ -1203,13 +1203,13 @@ object FormPrinc: TFormPrinc
   object SplitterH: TSplitter
     Left = 0
     Top = 0
-    Height = 589
+    Height = 590
   end
   object ScrollBox1: TScrollBox
-    Left = 632
+    Left = 646
     Top = 200
     Width = 546
-    Height = 391
+    Height = 392
     HorzScrollBar.Increment = 48
     HorzScrollBar.Tracking = True
     VertScrollBar.Smooth = True
@@ -1220,7 +1220,7 @@ object FormPrinc: TFormPrinc
     TabOrder = 0
   end
   object GroupBox1: TGroupBox
-    Left = 632
+    Left = 646
     Top = 5
     Width = 266
     Height = 52
@@ -1268,8 +1268,8 @@ object FormPrinc: TFormPrinc
   end
   object StatusBar1: TStatusBar
     Left = 0
-    Top = 589
+    Top = 590
-    Width = 1197
+    Width = 1211
     Height = 22
     Panels = <>
     SimplePanel = True
@@ -1285,22 +1285,22 @@ object FormPrinc: TFormPrinc
       00020000802500000000080000000000000000003F00000011000000}
   end
   object Panel1: TPanel
-    Left = 904
+    Left = 918
-    Top = 13
+    Top = 5
     Width = 282
-    Height = 108
+    Height = 148
     Anchors = [akTop, akRight]
     TabOrder = 4
     object Label1: TLabel
-      Left = 56
+      Left = 64
-      Top = 88
+      Top = 128
       Width = 89
       Height = 13
       Caption = 'Nombre de trains : '
     end
     object LabelNbTrains: TLabel
       Left = 240
-      Top = 84
+      Top = 124
       Width = 9
       Height = 19
       Caption = '0'
@@ -1376,10 +1376,30 @@ object FormPrinc: TFormPrinc
       WordWrap = True
       OnClick = BoutonRazTrainsClick
     end
+    object ButtonAffAnalyseCDM: TButton
+      Left = 184
+      Top = 88
+      Width = 89
+      Height = 33
+      Caption = 'Affiche fen'#234'tre analyse CDM'
+      TabOrder = 6
+      Visible = False
+      WordWrap = True
+      OnClick = ButtonAffAnalyseCDMClick
+    end
+    object Button2: TButton
+      Left = 48
+      Top = 96
+      Width = 75
+      Height = 25
+      Caption = 'Button2'
+      TabOrder = 7
+      OnClick = Button2Click
+    end
   end
   object StaticText: TStaticText
     Left = 16
-    Top = 567
+    Top = 568
     Width = 14
     Height = 17
     Anchors = [akLeft, akBottom]
@@ -1387,7 +1407,7 @@ object FormPrinc: TFormPrinc
     TabOrder = 5
   end
   object GroupBox2: TGroupBox
-    Left = 633
+    Left = 647
     Top = 64
     Width = 265
     Height = 105
@@ -1449,7 +1469,7 @@ object FormPrinc: TFormPrinc
     end
   end
   object GroupBox3: TGroupBox
-    Left = 632
+    Left = 646
     Top = 64
     Width = 265
     Height = 129
@@ -1685,8 +1705,8 @@ object FormPrinc: TFormPrinc
     end
   end
   object ButtonEnv: TButton
-    Left = 1064
+    Left = 1078
-    Top = 144
+    Top = 160
     Width = 113
     Height = 33
     Anchors = [akTop, akRight]
@@ -1696,8 +1716,8 @@ object FormPrinc: TFormPrinc
     OnClick = ButtonEnvClick
   end
   object EditEnvoi: TEdit
-    Left = 936
+    Left = 950
-    Top = 152
+    Top = 168
     Width = 121
     Height = 21
     Anchors = [akTop, akRight]
@@ -1705,7 +1725,7 @@ object FormPrinc: TFormPrinc
     Text = '<1>'
   end
   object Button1: TButton
-    Left = 360
+    Left = 494
     Top = 0
     Width = 75
     Height = 25
@@ -1914,6 +1934,14 @@ object FormPrinc: TFormPrinc
       object N1: TMenuItem
         Caption = '-'
       end
+      object Analyser1: TMenuItem
+        Caption = 'Importer le r'#233'seau CDM Rail'
+        Hint = 'Importer le r'#233'seau CDM rail (aiguillages)'
+        OnClick = Analyser1Click
+      end
+      object N9: TMenuItem
+        Caption = '-'
+      end
       object LireunfichierdeCV1: TMenuItem
         Caption = 'Lire un fichier de CV vers un accessoire'
         Hint = 
@@ -1953,7 +1981,7 @@ object FormPrinc: TFormPrinc
     OnDisconnect = ClientSocketCDMDisconnect
     OnRead = ClientSocketCDMRead
     OnError = ClientSocketCDMError
-    Left = 352
+    Left = 344
   end
   object OpenDialog: TOpenDialog
     Left = 944
@@ -1970,6 +1998,10 @@ object FormPrinc: TFormPrinc
       Caption = 'Copier'
       OnClick = Copier1Click
     end
+    object Coller1: TMenuItem
+      Caption = 'Coller'
+      OnClick = Coller1Click
+    end
   end
   object PopupMenuFeu: TPopupMenu
     OnPopup = PopupMenuFeuPopup

UnitPrinc.pas

@@ -47,7 +47,7 @@ uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32,
   ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB, MMSystem , registry,
-  Buttons;
+  Buttons, NB30 ;
 
 type
   TFormPrinc = class(TForm)
@@ -164,6 +164,11 @@ type
     FenRich: TRichEdit;
     SplitterV: TSplitter;
     Vrifiernouvelleversion1: TMenuItem;
+    N9: TMenuItem;
+    Analyser1: TMenuItem;
+    Coller1: TMenuItem;
+    ButtonAffAnalyseCDM: TButton;
+    Button2: TButton;
     procedure FormCreate(Sender: TObject);
     procedure MSCommUSBLenzComm(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -243,6 +248,10 @@ type
     procedure SplitterVMoved(Sender: TObject);
     procedure PopupMenuFeuPopup(Sender: TObject);
     procedure Vrifiernouvelleversion1Click(Sender: TObject);
+    procedure Analyser1Click(Sender: TObject);
+    procedure Coller1Click(Sender: TObject);
+    procedure ButtonAffAnalyseCDMClick(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
   private
     { Déclarations privées }
     procedure DoHint(Sender : Tobject);
@@ -624,7 +633,7 @@ function testBit(n : word;position : integer) : boolean;
 implementation
 
 uses UnitDebug, UnitPilote, UnitSimule, UnitTCO, UnitConfig,
-  Unitplace, verif_version , UnitCDF;
+  Unitplace, verif_version , UnitCDF, UnitAnalyseSegCDM;
 
 {
 procedure menu_interface(MA : TMA);
@@ -720,7 +729,7 @@ begin
     if aspect=8 then result:=9;  // jaune
     if aspect=9 then result:=10; // jaune cli
   end;   
-  if aspect=-1 then         
+  if aspect=-1 then
   begin
     if combine=10 then result:=11; // ralen 30
     if combine=11 then result:=12; // ralen 60
@@ -3694,7 +3703,7 @@ begin
     Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adr,1);
 
     // allume les signaux du feu dans le TCO
-    if TCOouvert then
+    if TCOACtive then
     begin
      for y:=1 to NbreCellY do
      for x:=1 to NbreCellX do
@@ -7437,7 +7446,7 @@ begin
             AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur);
             AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur);
           end;
-          if TCOouvert then
+          if TCOActive then
           begin
             zone_TCO(det2,det3,0);    // désactivation
             // activation
@@ -7636,7 +7645,7 @@ begin
           Affiche_evt(s,couleur);
           if dupliqueEvt or traceliste then AfficheDebug(s,clyellow);
 
-          if TCOouvert then
+          if TCOActive then
           begin
             // activation
             if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
@@ -7698,7 +7707,7 @@ begin
             if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
             s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i);
             Affiche_Evt(s,clWhite);
-            if TCOouvert then
+            if TCOActive then
             begin
               // activation
               if ModeCouleurCanton=0 then zone_TCO(det1,det3,1)
@@ -7883,7 +7892,7 @@ begin
             AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur);
             AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur);
           end;
-          if TCOouvert then
+          if TCOActive then
           begin
             zone_TCO(det2,det3,0);    // désactivation
             // activation
@@ -7998,7 +8007,7 @@ begin
         Affiche_evt(s,couleur);
         if traceListe then AfficheDebug(s,Couleur);
         if AffAigDet then AfficheDebug(s,couleur);
-        if TCOouvert then
+        if TCOActive then
         begin
           zone_TCO(det1,det2,0);    // désactivation
           // activation
@@ -8315,7 +8324,7 @@ begin
         Affiche_evt(s,couleur);
         if dupliqueEvt or traceliste then AfficheDebug(s,clyellow);
 
-        if TCOouvert then
+        if TCOActive then
         begin
           // activation
           if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
@@ -8377,7 +8386,7 @@ begin
             if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc);
             s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i);
             Affiche_Evt(s,clWhite);
-            if TCOouvert then
+            if TCOActive then
             begin
               // activation
               if ModeCouleurCanton=0 then zone_TCO(det1,det3,1)
@@ -8547,7 +8556,7 @@ begin
             AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur);
             AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur);
           end;
-          if TCOouvert then
+          if TCOActive then
           begin
             zone_TCO(det2,det3,0);    // désactivation
             // activation
@@ -8675,7 +8684,7 @@ begin
         Affiche_evt(s,couleur);
         if traceListe then AfficheDebug(s,Couleur);
         if AffAigDet then AfficheDebug(s,couleur);
-        if TCOouvert then
+        if TCOActive then
         begin
           zone_TCO(det1,det2,0);    // désactivation
           // activation
@@ -9315,7 +9324,7 @@ begin
   // attention à partir de cette section le code est susceptible de ne pas être exécuté??
 
   // Mettre à jour le TCO
-  if TcoOuvert then
+  if TcoActive then
   begin
     formTCO.Maj_TCO(Adresse);
   end;
@@ -9378,7 +9387,7 @@ begin
     event_det_tick[N_event_tick].etat:=pos;
 
     // Mettre à jour le TCO
-    if TCOouvert then formTCO.Maj_TCO(Adresse);
+    if TCOActive then formTCO.Maj_TCO(Adresse);
 
     // l'évaluation des routes est à faire selon conditions
     if faire_event and not(confignulle) then begin evalue;evalue;end;
@@ -10617,8 +10626,8 @@ begin
   convert_VK:=s;
 end;
 
-// Lance et connecte CDM rail. en sortie si CDM est lancé Lance_CDM=true,
+// Lance et connecte CDM rail si avecsocket=true. en sortie si CDM est lancé Lance_CDM=true,
-function Lance_CDM : boolean;
+function Lance_CDM(avecSocket : boolean) : boolean;
 var i,retour : integer;
     repertoire,s : string;
     cdm_lanceLoc : boolean;
@@ -10659,7 +10668,7 @@ begin
     exit;
   end;
 
-  if cdm_lanceLoc then
+  if AvecSocket and cdm_lanceLoc then
   begin
     Formprinc.caption:=af+' - '+lay;
     // On a lancé CDM, déconnecter l'USB
@@ -10786,6 +10795,7 @@ begin
     detecteur[i].etat:=false;
     detecteur[i].train:='';
     detecteur[i].adrTrain:=0;
+    detecteur[i].IndexTrain:=0;
     ancien_detecteur[i]:=false;
   end;
   for i:=1 to NbMemZone do
@@ -10831,6 +10841,10 @@ begin
     Tablo_Pn[i].compteur:=0;
   end;
 
+  for i:=1 to NbreCellx do
+    for j:=1 to NbreCelly do tco[i,j].mode:=0;
+      if TCOActive then affiche_TCO;
+
   {  ralentit au démarrage
   for i:=1 to NbreFeux do
   begin
@@ -10897,6 +10911,125 @@ begin
   init_aig_cours:=false;
 end;
 
+// renvoyer date heure, MAC, version SC , verif_version, avec_roulage
+
+// ex 1
+function GetMACAdress: string;
+var
+  NCB: PNCB;
+  Adapter: PAdapterStatus;
+
+  URetCode: PChar;
+  RetCode: char;
+  I: integer;
+  Lenum: PlanaEnum;
+  _SystemID: string;
+  TMPSTR: string;
+begin
+  Result    := '';
+  _SystemID := '';
+  Getmem(NCB, SizeOf(TNCB));
+  Fillchar(NCB^, SizeOf(TNCB), 0);
+
+  Getmem(Lenum, SizeOf(TLanaEnum));
+  Fillchar(Lenum^, SizeOf(TLanaEnum), 0);
+
+  Getmem(Adapter, SizeOf(TAdapterStatus));
+  Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);
+
+  Lenum.Length    := chr(0);
+  NCB.ncb_command := chr(NCBENUM);
+  NCB.ncb_buffer  := Pointer(Lenum);
+  NCB.ncb_length  := SizeOf(Lenum);
+  RetCode         := Netbios(NCB);
+
+  i := 0;
+  repeat
+    Fillchar(NCB^, SizeOf(TNCB), 0);
+    Ncb.ncb_command  := chr(NCBRESET);
+    Ncb.ncb_lana_num := lenum.lana[I];
+    RetCode          := Netbios(Ncb);
+
+    Fillchar(NCB^, SizeOf(TNCB), 0);
+    Ncb.ncb_command  := chr(NCBASTAT);
+    Ncb.ncb_lana_num := lenum.lana[I];
+    // Must be 16
+    Ncb.ncb_callname := '*               ';
+
+    Ncb.ncb_buffer := Pointer(Adapter);
+
+    Ncb.ncb_length := SizeOf(TAdapterStatus);
+    RetCode        := Netbios(Ncb);
+    //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
+    if (RetCode = chr(0)) or (RetCode = chr(6)) then
+    begin
+      _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
+        IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
+        IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
+        IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
+        IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
+        IntToHex(Ord(Adapter.adapter_address[5]), 2);
+    end;
+    Inc(i);
+  until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
+  FreeMem(NCB);
+  FreeMem(Adapter);
+  FreeMem(Lenum);
+  GetMacAdress := _SystemID;
+end;
+
+// ex2
+function GetAdapterInfo(Lana: Char): String;
+var
+  Adapter: TAdapterStatus;
+  NCB: TNCB;
+begin
+  FillChar(NCB, SizeOf(NCB), 0);
+  NCB.ncb_command := Char(NCBRESET);
+  NCB.ncb_lana_num := Lana;
+  if Netbios(@NCB) <> Char(NRC_GOODRET) then
+  begin
+    Result := 'mac not found';
+    Exit;
+  end;
+
+  FillChar(NCB, SizeOf(NCB), 0);
+  NCB.ncb_command := Char(NCBASTAT);
+  NCB.ncb_lana_num := Lana;
+  NCB.ncb_callname := '*';
+
+  FillChar(Adapter, SizeOf(Adapter), 0);
+  NCB.ncb_buffer := @Adapter;
+  NCB.ncb_length := SizeOf(Adapter);
+  if Netbios(@NCB) <> Char(NRC_GOODRET) then
+  begin
+    Result := 'mac not found';
+    Exit;
+  end;
+  Result :=
+    IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +
+    IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +
+    IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +
+    IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +
+    IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +
+    IntToHex(Byte(Adapter.adapter_address[5]), 2);
+end;
+
+function GetMACAddress: string;
+var
+  AdapterList: TLanaEnum;
+  NCB: TNCB;
+begin
+  FillChar(NCB, SizeOf(NCB), 0);
+  NCB.ncb_command := Char(NCBENUM);
+  NCB.ncb_buffer := @AdapterList;
+  NCB.ncb_length := SizeOf(AdapterList);
+  Netbios(@NCB);
+  if Byte(AdapterList.length) > 0 then
+    Result := GetAdapterInfo(AdapterList.lana[0])
+  else
+    Result := 'mac not found';
+end;
 
 // démarrage principal du programme signaux_complexes
 procedure TFormPrinc.FormCreate(Sender: TObject);
@@ -10963,6 +11096,7 @@ begin
   AvecInit:=true;           // &&&&    avec initialisation des aiguillages ou pas
   Diffusion:=AvecInit;      // mode diffusion publique
   roulage1.visible:=false;
+  FenRich.MaxLength:=$7FFFFFF0;
 
   OsBits:=0;
   if IsWow64Process then 
@@ -11140,7 +11274,7 @@ begin
     repeat
       application.processmessages;
       inc(i);
-    until (TcoOuvert) or (i>20);
+    until (TcoCree) or (i>20);
     Application.processmessages;
     if avecTCO then FormTCO.show;    // créer fiche dynamique (projet/fichier)
   end;
@@ -11160,11 +11294,10 @@ begin
 
   // lancer CDM rail et le connecte si on le demande ; à faire après la création des feux et du tco
   procetape('Test CDM et son lancement');
-  if LanceCDM then Lance_CDM;
+  if LanceCDM then Lance_CDM(true);
   procetape('Fin cdm');
   Loco.Visible:=true;
 
-
   // tenter la liaison vers CDM rail
   procetape('Test connexion CDM');
   if not(CDM_connecte) then connecte_CDM;
@@ -11250,6 +11383,17 @@ begin
   decode_chaine_retro_dcc('<y 0A0147405801CE>');   }
   procetape('Terminé !!');
   Maj_feux(false);
+
+ { With FenRich do
+  begin
+    ReadOnly:=false;
+    clear;
+    Affiche('',clYellow);
+    PasteFromClipboard;
+    SetFocus;
+    ReadOnly:=true;
+  end; }
+  //Affiche(GetMACAddress,clred);
 end;
 
 
@@ -11377,7 +11521,7 @@ begin
     end;
 
     // signaux du TCO
-    if TCOouvert then  // évite d'accéder à la variable FormTCO si elle est pas encore ouverte
+    if TCOActive then  // évite d'accéder à la variable FormTCO si elle est pas encore ouverte
     begin
       // parcourir les feux du TCO
       for y:=1 to NbreCellY do
@@ -13127,7 +13271,7 @@ end;
 
 procedure TFormPrinc.ButtonLanceCDMClick(Sender: TObject);
 begin
-  Lance_CDM;
+  Lance_CDM(true);
 end;
 
 procedure TFormPrinc.Affichefentredebug1Click(Sender: TObject);
@@ -13534,7 +13678,7 @@ end;
 
 procedure TFormPrinc.LancerCDMrail1Click(Sender: TObject);
 begin
-  Lance_CDM ;
+  Lance_CDM(true) ;
 end;
 
 procedure TFormPrinc.TrackBarVitChange(Sender: TObject);
@@ -13749,5 +13893,94 @@ begin
   else Affiche('Site CDM-Rail inateignable',clred);
 end;
 
+procedure TFormPrinc.Analyser1Click(Sender: TObject);
+var s1,s2 : string;
+    i : integer;
+begin
+  s1:=lowercase(fenRich.Lines[0]);
+  if pos('module',s1)=0 then
+  begin
+    Affiche('Pas de module détecté',clyellow);
+    Affiche('Procédure: dans CDM RAIL ouvrez votre réseau ; Menu ... / TrackDrawing  / Module Display',clLime);
+    Affiche('Cela ouvre une fenêtre DEBUG dans cdm',clLime);
+    Affiche('Dans cette fenêtre, faire Clic droit puis "sélectionner tout" et "copier"',clLime);
+    Affiche('Dans Signaux complexes, clic droit et "coller ; puis menu divers / Analyse des modules ',clLime);
+
+    if lance_cdm(false) then
+    begin
+      sleep(400);
+      s2:='CDR';
+      ProcessRunning(s2); // récupérer le handle de CDM
+      SetForegroundWindow(CDMhd);
+      Application.ProcessMessages;
+      sleep(300);
+
+      KeybdInput(VK_MENU,0);                 // enfonce Alt
+      KeybdInput(vk_decimal,0);
+      KeybdInput(vk_decimal,KEYEVENTF_KEYUP);
+      KeybdInput(VK_MENU,KEYEVENTF_KEYUP);   // relache ALT
+
+      KeybdInput(VK_DOWN,0);                
+      KeybdInput(VK_DOWN,KEYEVENTF_KEYUP);                
+      KeybdInput(VK_RETURN,0);                
+      KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);    
+      KeybdInput(VK_RETURN,0);                // valide le menu "track drawing"
+      KeybdInput(VK_RETURN,KEYEVENTF_KEYUP);  
+
+      // envoie les touches
+      i:=SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);  // la fenetre serveur démarré est affichée
+      Sleep(500);
+      Application.ProcessMessages;
+
+
      // clic droit valider le menu
+
      KeybdInput(VK_RBUTTON,0);                // VK_APPS = menu droit
+      KeybdInput(VK_RBUTTON,KEYEVENTF_KEYUP); 
+
      i:=SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0);
+      Application.ProcessMessages; 
+    end;
+    exit;
+
+  end;
+  Analyse_seg;
+
+end;
+
+procedure TFormPrinc.Coller1Click(Sender: TObject);
+begin
+  With FenRich do
+  begin
+    ReadOnly:=false;
+    clear;
+    Affiche('',clYellow);
+    PasteFromClipboard;
+    SetFocus;
+    ReadOnly:=true;
+  end;  
+end;
+
+procedure TFormPrinc.ButtonAffAnalyseCDMClick(Sender: TObject);
+begin
+  formAnalyseCDM.Show;
+end;
+
+procedure TFormPrinc.Button2Click(Sender: TObject);
+var i : integer;
+begin
+  i:=index_aig(26);
+  Affiche(intToSTR(aiguillage[i].ADroit)+aiguillage[i].AdroitB,clred);
+  Affiche(intToSTR(aiguillage[i].ADevie)+aiguillage[i].AdevieB,clred);
+  Affiche(intToSTR(aiguillage[i].DDroit)+aiguillage[i].DDroitB,clred);
+  Affiche(intToSTR(aiguillage[i].Ddevie)+aiguillage[i].DdevieB,clred);
+
+  i:=index_aig(28);
+  Affiche(intToSTR(aiguillage[i].ADroit)+aiguillage[i].AdroitB,clorange);
+  Affiche(intToSTR(aiguillage[i].ADevie)+aiguillage[i].AdevieB,clorange);
+  Affiche(intToSTR(aiguillage[i].DDroit)+aiguillage[i].DDroitB,clorange);
+  Affiche(intToSTR(aiguillage[i].Ddevie)+aiguillage[i].DDevieB,clorange);
+
+
+
+end;
+
 end.
 

UnitTCO.dfm

@@ -1,6 +1,6 @@
 object FormTCO: TFormTCO
-  Left = 82
+  Left = 155
-  Top = 129
+  Top = 53
   Width = 1142
   Height = 678
   VertScrollBar.Visible = False

UnitTCO.pas

@@ -384,8 +384,8 @@ var
   FormTCO: TFormTCO;
 
   Forminit,sourisclic,SelectionAffichee,TamponAffecte,entoure,Diffusion,TCO_modifie,
-  clicTCO,piloteAig,BandeauMasque,eval_format,TCOouvert,sauve_tco,formConfCellTCOAff,
+  clicTCO,piloteAig,BandeauMasque,eval_format,sauve_tco,formConfCellTCOAff,
-  drag : boolean;
+  drag,TCOActive,TCOCree : boolean;
 
   HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris,
   XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel ,AncienYMiniSel,AncienYMaxiSel,
@@ -3657,7 +3657,7 @@ begin
   oldbmp.width:=100;
   oldbmp.Height:=100;
   //controlStyle:=controlStyle+[csOpaque];
-
+  TCOCree:=true;
 end;
 
 
@@ -4320,7 +4320,7 @@ begin
       ScrollBox.Height:=ClientHeight-Panel1.Height-30;
     end;
   end;
-  TCOouvert:=true;
+  TCOActive:=true;
 end;
 
 // evt qui se produit quand on clic droit dans l'image

verif_version.pas

@@ -23,7 +23,7 @@ var
   Lance_verif : integer;
   verifVersion,notificationVersion : boolean;
 
-Const  Version='5.75';  // sert à la comparaison de la version publiée
+Const  Version='6.0';  // sert à la comparaison de la version publiée
        SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace
 
 function GetCurrentProcessEnvVar(const VariableName: string): string;

versions.txt

@@ -162,5 +162,6 @@ version 5.73 : Ajout d'un bouton d'autorisation pour le pare-feu windows.
 version 5.74 : Correction bug création nouveau TCO.
                Nouvel installeur-> Signaux complexes s'installe dans c:\programmes\signaux_complexes.
                avec un raccourci sur le bureau.
-version      : Gestion du décodeur de signaux Arcomora.
+version 6.0  : Gestion du décodeur de signaux Arcomora.
-
+               Importation des aiguillages depuis CDM Rail. 
+               Nécessite la version >=23.04 de CDM rail.