diff --git a/Notice d'utilisation des signaux_complexes_GL_V1.2.pdf b/Notice d'utilisation des signaux_complexes_GL_V1.3.pdf similarity index 69% rename from Notice d'utilisation des signaux_complexes_GL_V1.2.pdf rename to Notice d'utilisation des signaux_complexes_GL_V1.3.pdf index 240a5e8..f075ed7 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V1.2.pdf and b/Notice d'utilisation des signaux_complexes_GL_V1.3.pdf differ diff --git a/Signaux_complexes_GL.cfg b/Signaux_complexes_GL.cfg index 096ce3f..69e7fa7 100644 --- a/Signaux_complexes_GL.cfg +++ b/Signaux_complexes_GL.cfg @@ -12,7 +12,7 @@ -$L+ -$M- -$N+ --$O- +-$O+ -$P+ -$Q- -$R- @@ -33,10 +33,3 @@ -K$00400000 -LE"c:\program files (x86)\borland\delphi7\Projects\Bpl" -LN"c:\program files (x86)\borland\delphi7\Projects\Bpl" --U"c:\program files (x86)\borland\delphi7\Lib\Debug" --O"c:\program files (x86)\borland\delphi7\Lib\Debug" --I"c:\program files (x86)\borland\delphi7\Lib\Debug" --R"c:\program files (x86)\borland\delphi7\Lib\Debug" --w-UNSAFE_TYPE --w-UNSAFE_CODE --w-UNSAFE_CAST diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index ca20497..f8b9493 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -15,7 +15,7 @@ K=0 L=1 M=0 N=1 -O=0 +O=1 P=1 Q=0 R=0 @@ -76,9 +76,9 @@ LocaleToUnicode=1 ImagebaseMultiple=1 SuspiciousTypecast=1 PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 +UnsafeType=1 +UnsafeCode=1 +UnsafeCast=1 [Linker] MapFile=0 OutputObjs=0 @@ -94,8 +94,8 @@ OutputDir= UnitOutputDir= PackageDLLOutputDir= PackageDCPOutputDir= -SearchPath=$(DELPHI)\Lib\Debug -Packages=vcl;rtl;vclx;VclSmp;vclshlctrls +SearchPath= +Packages= Conditionals= DebugSourceDirs= UsePackages=0 @@ -107,7 +107,7 @@ UseLauncher=0 DebugCWD= [Version Info] IncludeVerInfo=1 -AutoIncBuild=1 +AutoIncBuild=0 MajorVer=1 MinorVer=0 Release=0 @@ -130,9 +130,3 @@ OriginalFilename= ProductName= ProductVersion=1.0.0.0 Comments= -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=$(DELPHI)\Lib\Debug diff --git a/Signaux_complexes_GL.dpr b/Signaux_complexes_GL.dpr index 80848ba..ccea976 100644 --- a/Signaux_complexes_GL.dpr +++ b/Signaux_complexes_GL.dpr @@ -6,7 +6,9 @@ uses UnitDebug in 'UnitDebug.pas' {FormDebug}, verif_version in 'verif_version.pas' {FormVersion}, UnitPilote in 'UnitPilote.pas' {FormPilote}, - UnitSimule in 'UnitSimule.pas' {FormSimulation}; + UnitSimule in 'UnitSimule.pas' {FormSimulation}, + UnitTCO in 'UnitTCO.pas' {FormTCO}, + listeusb in 'listeusb.pas'; {$R *.res} @@ -16,5 +18,6 @@ begin Application.CreateForm(TFormDebug, FormDebug); Application.CreateForm(TFormPilote, FormPilote); Application.CreateForm(TFormSimulation, FormSimulation); + Application.CreateForm(TFormTCO, FormTCO); Application.Run; end. diff --git a/UnitDebug.dcu b/UnitDebug.dcu index bb116dc..3b281a4 100644 Binary files a/UnitDebug.dcu and b/UnitDebug.dcu differ diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 9860a7e..60da8bd 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -1,6 +1,6 @@ object FormDebug: TFormDebug - Left = 509 - Top = 108 + Left = 302 + Top = 166 BorderStyle = bsSingle Caption = 'Fen'#234'tre de d'#233'bug' ClientHeight = 639 @@ -19,8 +19,8 @@ object FormDebug: TFormDebug PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel - Left = 456 - Top = 36 + Left = 464 + Top = 28 Width = 108 Height = 13 Caption = 'Niveau du Debug (0-3)' @@ -64,8 +64,8 @@ object FormDebug: TFormDebug WordWrap = True end object EditNivDebug: TEdit - Left = 576 - Top = 36 + Left = 592 + Top = 20 Width = 73 Height = 21 Font.Charset = DEFAULT_CHARSET @@ -117,7 +117,7 @@ object FormDebug: TFormDebug end object CheckAffSig: TCheckBox Left = 448 - Top = 64 + Top = 48 Width = 297 Height = 17 Caption = 'Affichage du fonctionnement des signaux' @@ -176,10 +176,11 @@ object FormDebug: TFormDebug end object CheckAffAffecTrains: TCheckBox Left = 448 - Top = 88 + Top = 64 Width = 289 Height = 17 Caption = 'Affichage d'#39'affectation des trains aux d'#233'tecteurs' + Enabled = False Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -191,7 +192,7 @@ object FormDebug: TFormDebug end object CheckBoxTraceLIste: TCheckBox Left = 448 - Top = 112 + Top = 80 Width = 289 Height = 17 Caption = 'Affichage des '#233'valuations des routes' @@ -204,8 +205,33 @@ object FormDebug: TFormDebug TabOrder = 10 OnClick = CheckBoxTraceLIsteClick end - object SaveDialog: TSaveDialog - Left = 464 + object CheckTrame: TCheckBox + Left = 448 + Top = 96 + Width = 281 + Height = 17 + Caption = 'Affichage des trames '#233'chang'#233'es avec LENZ' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 11 + OnClick = CheckTrameClick + end + object ButtonCop: TButton + Left = 448 Top = 384 + Width = 97 + Height = 49 + Caption = 'Copie fen'#234'te principale dans debug' + TabOrder = 12 + WordWrap = True + OnClick = ButtonCopClick + end + object SaveDialog: TSaveDialog + Left = 680 + Top = 8 end end diff --git a/UnitDebug.pas b/UnitDebug.pas index 58891cb..780ec6b 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -23,6 +23,8 @@ type ButtonAffEvtChrono: TButton; CheckAffAffecTrains: TCheckBox; CheckBoxTraceLIste: TCheckBox; + CheckTrame: TCheckBox; + ButtonCop: TButton; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure ButtonEcrLogClick(Sender: TObject); @@ -33,6 +35,8 @@ type procedure ButtonAffEvtChronoClick(Sender: TObject); procedure CheckAffAffecTrainsClick(Sender: TObject); procedure CheckBoxTraceLIsteClick(Sender: TObject); + procedure CheckTrameClick(Sender: TObject); + procedure ButtonCopClick(Sender: TObject); private { Déclarations privées } public @@ -159,7 +163,7 @@ begin begin i:=0; repeat - trouve:= pos('erreur',Lines[i])<>0; + trouve:=pos('erreur',Lines[i])<>0; inc(i); until (i>=Lines.Count) or trouve; if trouve then @@ -172,7 +176,6 @@ begin end; end; - procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject); var i,j,etat : integer; s : string; @@ -201,4 +204,15 @@ begin TraceListe:=CheckBoxTraceLIste.checked; end; +procedure TFormDebug.CheckTrameClick(Sender: TObject); +begin + trace:=CheckTrame.Checked; +end; + +procedure TFormDebug.ButtonCopClick(Sender: TObject); +var i : integer; +begin + MemoDebug.Lines:=Formprinc.ListBox1.Items +end; + end. diff --git a/UnitPilote.dcu b/UnitPilote.dcu index 67ea13c..011d6ac 100644 Binary files a/UnitPilote.dcu and b/UnitPilote.dcu differ diff --git a/UnitPilote.dfm b/UnitPilote.dfm index 510dc3c..92ab3cf 100644 --- a/UnitPilote.dfm +++ b/UnitPilote.dfm @@ -4,7 +4,7 @@ object FormPilote: TFormPilote BorderStyle = bsDialog Caption = 'Pilotage' ClientHeight = 350 - ClientWidth = 542 + ClientWidth = 346 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -202,48 +202,4 @@ object FormPilote: TFormPilote Text = 'EditNbFeux' OnKeyPress = EditNbreFeuxKeyPress end - object GroupBox3: TGroupBox - Left = 328 - Top = 48 - Width = 209 - Height = 97 - Caption = 'pilotage unisemaf' - TabOrder = 4 - object RadioButton1: TRadioButton - Left = 8 - Top = 24 - Width = 145 - Height = 17 - Caption = 'Algo1 pilotage inverse' - TabOrder = 0 - OnClick = RadioButton1Click - end - object RadioButton2: TRadioButton - Left = 8 - Top = 40 - Width = 145 - Height = 17 - Caption = 'Algo2 pilotage normal' - TabOrder = 1 - OnClick = RadioButton2Click - end - object RadioButton3: TRadioButton - Left = 8 - Top = 56 - Width = 193 - Height = 17 - Caption = 'Algo3 pilotage bits '#224' 1 seuls normal' - TabOrder = 2 - OnClick = RadioButton3Click - end - object RadioButton4: TRadioButton - Left = 8 - Top = 72 - Width = 193 - Height = 17 - Caption = 'Algo4 pilotage bits '#224' 1 seuls inverse' - TabOrder = 3 - OnClick = RadioButton4Click - end - end end diff --git a/UnitPilote.pas b/UnitPilote.pas index 3d85a36..38ee7e2 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -31,11 +31,6 @@ type ButtonPilote: TButton; EditNbreFeux: TEdit; LabelNbFeux: TLabel; - GroupBox3: TGroupBox; - RadioButton1: TRadioButton; - RadioButton2: TRadioButton; - RadioButton3: TRadioButton; - RadioButton4: TRadioButton; procedure RadioVertClick(Sender: TObject); procedure RadioVertCliClick(Sender: TObject); procedure RadioJauneClick(Sender: TObject); @@ -54,10 +49,6 @@ type procedure FormCreate(Sender: TObject); procedure ButtonPiloteClick(Sender: TObject); procedure EditNbreFeuxKeyPress(Sender: TObject; var Key: Char); - procedure RadioButton1Click(Sender: TObject); - procedure RadioButton2Click(Sender: TObject); - procedure RadioButton3Click(Sender: TObject); - procedure RadioButton4Click(Sender: TObject); private { Déclarations privées } public @@ -263,36 +254,5 @@ if ord(Key) = VK_RETURN then end; end; -procedure TFormPilote.RadioButton1Click(Sender: TObject); -begin - uni1:=RadioButton1.checked; - uni2:=RadioButton2.checked; - uni3:=RadioButton3.checked; - uni4:=RadioButton4.checked; -end; - -procedure TFormPilote.RadioButton2Click(Sender: TObject); -begin - uni1:=RadioButton1.checked; - uni2:=RadioButton2.checked; - uni3:=RadioButton3.checked; - uni4:=RadioButton4.checked; -end; - -procedure TFormPilote.RadioButton3Click(Sender: TObject); -begin - uni1:=RadioButton1.checked; - uni2:=RadioButton2.checked; - uni3:=RadioButton3.checked; - uni4:=RadioButton4.checked; -end; - -procedure TFormPilote.RadioButton4Click(Sender: TObject); -begin - uni1:=RadioButton1.checked; - uni2:=RadioButton2.checked; - uni3:=RadioButton3.checked; - uni4:=RadioButton4.checked; -end; end. diff --git a/UnitPrinc.dcu b/UnitPrinc.dcu index 922ad14..dcfca65 100644 Binary files a/UnitPrinc.dcu and b/UnitPrinc.dcu differ diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index acb33f4..b47474c 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,9 +1,9 @@ object FormPrinc: TFormPrinc - Left = 33 - Top = 205 + Left = 34 + Top = 494 BorderStyle = bsSingle Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ' - ClientHeight = 607 + ClientHeight = 601 ClientWidth = 1196 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -33,9 +33,9 @@ object FormPrinc: TFormPrinc ParentFont = False end object LabelEtat: TLabel - Left = 440 + Left = 344 Top = 8 - Width = 80 + Width = 305 Height = 22 Caption = 'LabelEtat' Font.Charset = ANSI_CHARSET @@ -596,10 +596,10 @@ object FormPrinc: TFormPrinc Visible = False end object Image3feux: TImage - Left = 600 + Left = 616 Top = 0 - Width = 49 - Height = 105 + Width = 33 + Height = 57 Picture.Data = { 07544269746D617006090000424D060900000000000036040000280000001A00 00002C0000000100080000000000D0040000C40E0000C40E0000000100000000 @@ -678,7 +678,7 @@ object FormPrinc: TFormPrinc end object Image2feux: TImage Left = 1096 - Top = 104 + Top = 128 Width = 33 Height = 57 Picture.Data = { @@ -1090,8 +1090,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image6Dir: TImage - Left = 1120 - Top = 96 + Left = 1112 + Top = 128 Width = 81 Height = 25 Picture.Data = { @@ -1198,8 +1198,8 @@ object FormPrinc: TFormPrinc Visible = False end object BoutVersion: TButton - Left = 656 - Top = 0 + Left = 1008 + Top = 8 Width = 83 Height = 33 Caption = 'Dem version' @@ -1225,7 +1225,7 @@ object FormPrinc: TFormPrinc end object BoutonRaf: TButton Left = 912 - Top = 64 + Top = 8 Width = 89 Height = 33 Caption = 'Rafraichissement' @@ -1234,18 +1234,18 @@ object FormPrinc: TFormPrinc end object ScrollBox1: TScrollBox Left = 648 - Top = 164 + Top = 160 Width = 537 - Height = 401 + Height = 405 Color = clWhite ParentColor = False TabOrder = 3 end object GroupBox1: TGroupBox Left = 656 - Top = 40 + Top = 0 Width = 249 - Height = 65 + Height = 97 Caption = 'Commande d'#39'accessoires' TabOrder = 4 object Label2: TLabel @@ -1282,6 +1282,7 @@ object FormPrinc: TFormPrinc 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 @@ -1291,25 +1292,37 @@ object FormPrinc: TFormPrinc Top = 24 Width = 109 Height = 33 + Hint = 'Ecriture des accessoires DCC' Caption = 'Envoi commande' TabOrder = 2 WordWrap = True OnClick = ButtonCommandeClick end + object ButtonEcrCV: TButton + Left = 8 + Top = 64 + Width = 225 + Height = 25 + Hint = 'Ecriture CV en mode direct sur voie de programmation' + Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet' + TabOrder = 3 + WordWrap = True + OnClick = ButtonEcrCVClick + end end object ButtonTest: TButton - Left = 832 - Top = 0 - Width = 105 + Left = 912 + Top = 88 + Width = 89 Height = 33 - Caption = 'Demande '#233'tat de la r'#233'trosignalisation' + Caption = 'Demande '#233'tat r'#233'trosignalisation' TabOrder = 5 WordWrap = True OnClick = ButtonTestClick end object ButtonInfo: TButton Left = 1008 - Top = 64 + Top = 48 Width = 81 Height = 33 Caption = 'Informations' @@ -1318,11 +1331,12 @@ object FormPrinc: TFormPrinc end object GroupBox2: TGroupBox Left = 654 - Top = 111 - Width = 419 + Top = 103 + Width = 211 Height = 46 Caption = 'Trains' TabOrder = 6 + Visible = False object Label1: TLabel Left = 16 Top = 20 @@ -1342,15 +1356,15 @@ object FormPrinc: TFormPrinc end object StatusBar1: TStatusBar Left = 0 - Top = 577 + Top = 571 Width = 1196 Height = 30 Panels = <> SimplePanel = True end object MSCommUSBLenz: TMSComm - Left = 1120 - Top = 8 + Left = 880 + Top = 128 Width = 32 Height = 32 OnComm = MSCommUSBLenzComm @@ -1359,8 +1373,8 @@ object FormPrinc: TFormPrinc 00020000802500000000080000000000000000003F00000001000000} end object loco: TButton - Left = 944 - Top = 0 + Left = 1096 + Top = 8 Width = 75 Height = 33 Caption = 'loco' @@ -1368,19 +1382,31 @@ object FormPrinc: TFormPrinc OnClick = locoClick end object ButtonAffDebug: TButton - Left = 744 - Top = 0 - Width = 81 + Left = 912 + Top = 48 + Width = 89 Height = 33 Caption = 'Affiche debug' TabOrder = 11 OnClick = ButtonAffDebugClick end + object ButtonReprise: TButton + Left = 1096 + Top = 48 + Width = 75 + Height = 33 + Hint = + 'Relance du bus DCC apr'#232's une '#233'criture d'#39'un CV ou une mise hors t' + + 'ension de la centrale' + Caption = 'Reprise DCC' + TabOrder = 12 + OnClick = ButtonRepriseClick + end object Timer1: TTimer Interval = 100 OnTimer = Timer1Timer - Left = 1072 - Top = 8 + Left = 888 + Top = 80 end object ClientSocketLenz: TClientSocket Active = False @@ -1464,6 +1490,9 @@ object FormPrinc: TFormPrinc Caption = 'Divers' object FichierSimu: TMenuItem Caption = 'Ouvrir un fichier de simulation' + Hint = + 'Ouvre un fichier de simulation des d'#233'tecteurs pour simuler un fo' + + 'nctionnement' OnClick = FichierSimuClick end object Versions1: TMenuItem @@ -1471,6 +1500,23 @@ object FormPrinc: TFormPrinc Hint = 'Versions' OnClick = Versions1Click end + object N1: TMenuItem + Caption = '-' + end + object LireunfichierdeCV1: TMenuItem + Caption = 'Lire un fichier de CV vers un accessoire' + Hint = + 'Ouvre un fichier de CV pour l'#39'envoyer vers un accessoire branch'#233 + + ' sur la voie de programmation' + OnClick = LireunfichierdeCV1Click + end + object LireunaccessoireversunfichierdeCV1: TMenuItem + Caption = 'Lire un accessoire vers un fichier de CV' + Hint = + 'Lire les CV d'#39'un accessoire branch'#233' sur la voie de programmation' + + ' vers un fichier' + OnClick = LireunaccessoireversunfichierdeCV1Click + end end end object ClientSocketCDM: TClientSocket @@ -1483,4 +1529,12 @@ object FormPrinc: TFormPrinc OnError = ClientSocketCDMError Left = 352 end + object OpenDialog: TOpenDialog + Left = 1080 + Top = 88 + end + object SaveDialog: TSaveDialog + Left = 1120 + Top = 88 + end end diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 63ca4d3..d9d1ecf 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -14,9 +14,9 @@ Unit UnitPrinc; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, - ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB; + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ListeUSB, + ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB ; type TFormPrinc = class(TForm) @@ -76,6 +76,13 @@ type Label1: TLabel; EditNbTrains: TEdit; FichierSimu: TMenuItem; + ButtonEcrCV: TButton; + ButtonReprise: TButton; + OpenDialog: TOpenDialog; + N1: TMenuItem; + LireunfichierdeCV1: TMenuItem; + LireunaccessoireversunfichierdeCV1: TMenuItem; + SaveDialog: TSaveDialog; procedure FormCreate(Sender: TObject); procedure MSCommUSBLenzComm(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); @@ -120,6 +127,10 @@ type procedure ChronoDetectClick(Sender: TObject); procedure EditNbTrainsKeyPress(Sender: TObject; var Key: Char); procedure FichierSimuClick(Sender: TObject); + procedure ButtonEcrCVClick(Sender: TObject); + procedure ButtonRepriseClick(Sender: TObject); + procedure LireunfichierdeCV1Click(Sender: TObject); + procedure LireunaccessoireversunfichierdeCV1Click(Sender: TObject); private { Déclarations privées } @@ -185,10 +196,10 @@ TMA = (valide,devalide); var ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word; AvecInitAiguillages,tempsCli,combine,NbreFeux,pasreponse,AdrDevie,precedent , NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, - Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2 : integer; - Hors_tension2,traceSign,TraceZone,Ferme,ParUSB,parSocket,ackCdm, + Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,protocole : integer; + Hors_tension2,traceSign,TraceZone,Ferme,parSocket,ackCdm, NackCDM,MsgSim : boolean; - TraceListe,clignotant,nack,Maj_feux_cours,avecMSCom : boolean; + TraceListe,clignotant,nack,Maj_feux_cours : boolean; branche : array [1..100] of string; Train : array [1..100,1..MaxElParcours] of integer; @@ -204,9 +215,10 @@ const var FormPrinc: TFormPrinc; ack,portCommOuvert,trace,AffMem,AfficheDet,CDM_connecte,parSocketCDM, - DebugOuv,Raz_Acc_signaux,uni1,uni2,uni3,uni4 : boolean; + DebugOuv,Raz_Acc_signaux,AvecInit,AvecTCO : boolean; tablo : array of byte; - Enregistrement,AdresseIP,chaine_Envoi,chaine_recue,AdresseIPCDM,recuCDM,Id_CDM,Af : string; + Enregistrement,AdresseIP,chaine_Envoi,chaine_recue,AdresseIPCDM,recuCDM,Id_CDM,Af, + ConfStCom : string; maxaiguillage,detecteur_chgt,Temps,TpsRecuCom,NumPort,Tempo_init,Suivant,TypeGen, NbreImagePligne,Port,NbreBranches,Index2_det,branche_det,Index_det, portCDM,I_simule : integer; @@ -214,12 +226,13 @@ var 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_Simule : array[0..200] of + Tablo_Simule : array[0..200] of record tick : longint; Detecteur,etat : integer ; end; - index_simule,NDetecteurs,N_Trains : integer; + N_Cv,index_simule,NDetecteurs,N_Trains : integer; + tablo_CV : array [1..255] of integer; couleur : Tcolor; fichier : text; recuCDML : array of string; @@ -282,9 +295,10 @@ procedure Affiche(s : string;lacouleur : TColor); procedure envoi_signal(Adr : integer); procedure pilote_direction(Adr,nbre : integer); + implementation -uses UnitDebug, verif_version, UnitPilote, UnitSimule; +uses UnitDebug, verif_version, UnitPilote, UnitSimule, UnitTCO; procedure menu_interface(MA : TMA); var val : boolean; @@ -428,7 +442,7 @@ begin cercle(ACanvas,22,13,6,GrisF); cercle(ACanvas,33,13,6,grisF); end; - if EtatSignal=2 then + if EtatSignal=2 then begin cercle(ACanvas,11,13,6,clWhite); cercle(ACanvas,22,13,6,clWhite); @@ -922,17 +936,21 @@ begin end; - +// envoi d'une chaîne à la centrale Lenz par USBLenz ou socket, n'attend pas l'ack +procedure envoi_ss_ack(s : string); +begin + if Trace then affiche_chaine_Hex(s,ClGreen); + if portCommOuvert then FormPrinc.MSCommUSBLenz.Output:=s; + if parSocket 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 + //if Hors_tension2=false then begin - if Trace then affiche_chaine_Hex(s,ClGreen); - if portCommOuvert then FormPrinc.MSCommUSBLenz.Output:=s; - if parSocket then Formprinc.ClientSocketLenz.Socket.SendText(s); + envoi_ss_ack(s); // attend l'ack ack:=false;nack:=false; if portCommOuvert or ParSocket then @@ -1060,6 +1078,7 @@ var groupe,temps : integer ; fonction : byte; s : string; begin + //Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow); // pilotage par CDM rail if CDM_connecte then begin @@ -1486,7 +1505,7 @@ begin 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) 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; @@ -1498,106 +1517,6 @@ end; // décodeur unisemaf (paco) procedure envoi_UniSemaf(adresse: integer); -var bits : integer; - procedure envoie4_uni(motif : byte); - var i,j,bit2,bitM,bh : integer; - s : string; - begin - - s:=''; - if uni1 then - begin - j:=0; - bh:=(bits div 2) + (bits mod 2) ; - for i:=0 to bh-1 do - begin - bit2:=(motif and 3); - if bit2=0 then bitM:=0; - if bit2=2 then bitM:=1; - if bit2=1 then bitM:=2; - if bit2=3 then bitM:=3; - pilote_acc(adresse+i,bitM,feu); - - s:=IntToSTR(Adresse+i)+' ' +intToSTR(bitM); - if bitM=0 then s:=s+' (0)'; - if bitM=1 then s:=s+' (-)'; - if bitM=2 then s:=s+' (+)'; - if bitM=3 then s:=s+' (!)'; - - Affiche(s,clyellow); - motif:=motif shr 2; - inc(j); - end; - end; - - if uni2 then - begin - j:=0; - bh:=(bits div 2) + (bits mod 2) ; - for i:=0 to bh-1 do - begin - bit2:=(motif and 3); - pilote_acc(adresse+i,bit2,feu); - s:=IntToSTR(Adresse+i)+' ' +intToSTR(bit2); - if bit2=0 then s:=s+' (0)'; - if bit2=1 then s:=s+' (-)'; - if bit2=2 then s:=s+' (+)'; - if bit2=3 then s:=s+' (!)'; - - Affiche(s,clyellow); - motif:=motif shr 2; - inc(j); - end; - end; - - if uni3 then - begin - j:=0; - bh:=(bits div 2) + (bits mod 2) ; - for i:=0 to bh-1 do - begin - bit2:=(motif and 3); - if bit2<>0 then - begin - pilote_acc(adresse+i,bit2,feu); - s:=IntToSTR(Adresse+i)+' ' +intToSTR(bit2); - if bit2=1 then s:=s+' (-)'; - if bit2=2 then s:=s+' (+)'; - if bit2=3 then s:=s+' (!)'; - Affiche(s,clyellow); - end; - motif:=motif shr 2; - inc(j); - end; - end; - - if uni4 then - begin - j:=0; - bh:=(bits div 2) + (bits mod 2) ; - for i:=0 to bh-1 do - begin - bit2:=(motif and 3); - if bit2=0 then bitM:=0; - if bit2=2 then bitM:=1; - if bit2=1 then bitM:=2; - if bit2=3 then bitM:=3; - if bitM<>0 then - begin - pilote_acc(adresse+i,bitM,feu); - s:=IntToSTR(Adresse+i)+' ' +intToSTR(bit2); - if bitM=1 then s:=s+' (-)'; - if bitM=2 then s:=s+' (+)'; - if bitM=3 then s:=s+' (!)'; - Affiche(s,clyellow); - end; - motif:=motif shr 2; - inc(j); - end; - end; -end; - - var modele,index,code,codebin,aspect : integer ; s : string; begin @@ -1623,284 +1542,267 @@ begin //Affiche('Adresse='+intToSTR(Adresse)+' code='+intToSTR(code)+' combine'+intToSTR(combine),clyellow); if modele=2 then // 2 feux begin - bits:=2; - if code=blanc then envoie4_uni($01); - if code=blanc_cli then envoie4_uni($01); - if code=violet then envoie4_uni($02); + if code=blanc then pilote_acc(adresse,1,feu); + if code=blanc_cli then pilote_acc(adresse,1,feu); + if code=violet then pilote_acc(adresse,2,feu); end; if modele=3 then // 3 feux begin - bits:=3; - if code=vert then envoie4_uni($01); - if code=vert_cli then envoie4_uni($01); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); - if code=semaphore then envoie4_uni($02); - if code=semaphore_cli then envoie4_uni($02); + if code=semaphore then pilote_acc(adresse,2,feu); + if code=semaphore_cli then pilote_acc(adresse,2,feu); - if code=jaune then envoie4_uni($04); - if code=jaune_cli then envoie4_uni($04); + if code=jaune then pilote_acc(adresse+1,1,feu); + if code=jaune_cli then pilote_acc(adresse+1,1,feu); end; if modele=4 then begin - bits:=5; case code of - vert : envoie4_uni($14); - vert_cli : envoie4_uni($14); - jaune : envoie4_uni($11); - jaune_cli : envoie4_uni($11); - semaphore : envoie4_uni($12); - semaphore_cli : envoie4_uni($12); - carre : envoie4_uni($0A); + 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 - bits:=6; case code of - vert : envoie4_uni($24); - vert_cli : envoie4_uni($24); - jaune : envoie4_uni($21); - jaune_cli : envoie4_uni($21); - semaphore : envoie4_uni($22); - semaphore_cli : envoie4_uni($22); - carre : envoie4_uni($0A); - blanc : envoie4_uni($10); - blanc_cli : envoie4_uni($10); + 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 - bits:=6; case code of - vert : envoie4_uni($24); - vert_cli : envoie4_uni($24); - jaune : envoie4_uni($21); - jaune_cli : envoie4_uni($21); - semaphore : envoie4_uni($22); - semaphore_cli : envoie4_uni($22); - violet : envoie4_uni($10); - blanc : envoie4_uni($08); - blanc_cli : envoie4_uni($08); + 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 - bits:=4; case code of - vert : envoie4_uni($04); - vert_cli : envoie4_uni($04); - jaune : envoie4_uni($01); - jaune_cli : envoie4_uni($01); - semaphore : envoie4_uni($02); - semaphore_cli : envoie4_uni($02); - ral_30 : envoie4_uni($08); + 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); + ral_30 : pilote_acc(adresse+1,2,feu); end; end; // 72=VJR + carré + ralentissement 30 if modele=72 then begin - bits:=6; case code of - vert : envoie4_uni($24); - vert_cli : envoie4_uni($24); - jaune : envoie4_uni($21); - jaune_cli : envoie4_uni($21); - semaphore : envoie4_uni($22); - semaphore_cli : envoie4_uni($22); - carre : envoie4_uni($0A); - ral_30 : envoie4_uni($30); + 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); + ral_30 : pilote_acc(adresse+2,1,feu); end; end; // 73=VJR + carré + ralentissement 60 if modele=73 then begin - bits:=6; case code of - vert : envoie4_uni($24); - vert_cli : envoie4_uni($24); - jaune : envoie4_uni($21); - jaune_cli : envoie4_uni($21); - semaphore : envoie4_uni($22); - semaphore_cli : envoie4_uni($22); - carre : envoie4_uni($0A); - ral_60 : envoie4_uni($30); + 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); + ral_60 : pilote_acc(adresse+2,1,feu); end; end; // 91=VJR + carré + rappel 30 if modele=91 then begin - bits:=6; case code of - vert : envoie4_uni($24); - vert_cli : envoie4_uni($24); - jaune : envoie4_uni($21); - jaune_cli : envoie4_uni($21); - semaphore : envoie4_uni($22); - semaphore_cli : envoie4_uni($22); - carre : envoie4_uni($0A); - rappel_30 : envoie4_uni($30); + 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); + rappel_30 : pilote_acc(adresse+2,1,feu); end; end; - + // 92=VJR + carré + rappel 60 if modele=92 then begin - bits:=6; - case code of - vert : envoie4_uni($24); - vert_cli : envoie4_uni($24); - jaune : envoie4_uni($21); - jaune_cli : envoie4_uni($21); - semaphore : envoie4_uni($22); - semaphore_cli : envoie4_uni($22); - carre : envoie4_uni($0A); - rappel_60 : envoie4_uni($30); + case code 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); + rappel_60 : pilote_acc(adresse+2,1,feu); end; end; - + // 93=VJR + carré + ral30 + rappel 30 if modele=93 then begin - bits:=7; - if combine=0 then + if combine=0 then begin - if code=vert then envoie4_uni($44); - if code=vert_cli then envoie4_uni($44); - if code=jaune then envoie4_uni($41); - if code=jaune_cli then envoie4_uni($41); - if code=semaphore then envoie4_uni($42); - if code=semaphore_cli then envoie4_uni($42); - if code=carre then envoie4_uni($0A); - if code=ral_30 then envoie4_uni($50); - if code=rappel_30 then envoie4_uni($60); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=carre then pilote_acc(adresse+1,2,feu); + if code=ral_30 then pilote_acc(adresse+2,1,feu); + if code=rappel_30 then pilote_acc(adresse+2,2,feu); end; - if (code=jaune) and (combine=rappel_30) then envoie4_uni($61); + if (code=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu); end; - + // 94=VJR + carré + ral60 + rappel60 if modele=94 then begin - bits:=7; if combine=0 then begin - if code=vert then envoie4_uni($44); - if code=vert_cli then envoie4_uni($44); - if code=jaune then envoie4_uni($41); - if code=jaune_cli then envoie4_uni($41); - if code=semaphore then envoie4_uni($42); - if code=semaphore_cli then envoie4_uni($42); - if code=carre then envoie4_uni($0A); - if code=ral_60 then envoie4_uni($50); - if code=rappel_60 then envoie4_uni($60); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=carre then pilote_acc(adresse+1,2,feu); + if code=ral_60 then pilote_acc(adresse+2,1,feu); + if code=rappel_60 then pilote_acc(adresse+2,2,feu); end; - if (code=jaune) and (combine=rappel_60) then envoie4_uni($61); + if (code=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); end; - + // 95=VJR + carré + ral30 + rappel 60 if modele=95 then begin - bits:=7; if combine=0 then begin - if code=vert then envoie4_uni($44); - if code=vert_cli then envoie4_uni($44); - if code=jaune then envoie4_uni($41); - if code=jaune_cli then envoie4_uni($41); - if code=semaphore then envoie4_uni($42); - if code=semaphore_cli then envoie4_uni($42); - if code=carre then envoie4_uni($0A); - if code=ral_30 then envoie4_uni($50); - if code=rappel_60 then envoie4_uni($60); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=carre then pilote_acc(adresse+1,2,feu); + if code=ral_30 then pilote_acc(adresse+2,1,feu); + if code=rappel_60 then pilote_acc(adresse+2,2,feu); end; - if (code=jaune) and (combine=rappel_60) then envoie4_uni($61); + if (code=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); end; // 96=VJR + blanc + carré + ral30 + rappel30 if modele=96 then begin - bits:=8; - if combine=0 then + if combine=0 then begin - if code=vert then envoie4_uni($84); - if code=vert_cli then envoie4_uni($84); - if code=jaune then envoie4_uni($81); - if code=jaune_cli then envoie4_uni($81); - if code=semaphore then envoie4_uni($82); - if code=semaphore_cli then envoie4_uni($82); - if code=carre then envoie4_uni($0A); - if code=ral_30 then envoie4_uni($90); - if code=rappel_30 then envoie4_uni($A0); - if code=blanc then envoie4_uni($C1); - if code=blanc_cli then envoie4_uni($C1); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=carre then pilote_acc(adresse+1,2,feu); + if code=ral_30 then pilote_acc(adresse+2,1,feu); + if code=rappel_30 then pilote_acc(adresse+2,2,feu); + if code=blanc then pilote_acc(adresse+3,2,feu); + if code=blanc_cli then pilote_acc(adresse+3,2,feu); end; - if (code=jaune) and (combine=rappel_30) then envoie4_uni($A1); + if (code=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu); end; - + // 97=VJR + blanc + carré + ral30 + rappel60 if modele=97 then begin - bits:=8; if combine=0 then begin - if code=vert then envoie4_uni($84); - if code=vert_cli then envoie4_uni($84); - if code=jaune then envoie4_uni($81); - if code=jaune_cli then envoie4_uni($81); - if code=semaphore then envoie4_uni($82); - if code=semaphore_cli then envoie4_uni($82); - if code=carre then envoie4_uni($0A); - if code=ral_30 then envoie4_uni($90); - if code=rappel_60 then envoie4_uni($A0); - if code=blanc then envoie4_uni($40); - if code=blanc_cli then envoie4_uni($40); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=carre then pilote_acc(adresse+1,2,feu); + if code=ral_30 then pilote_acc(adresse+2,1,feu); + if code=rappel_60 then pilote_acc(adresse+2,2,feu); + if code=blanc then pilote_acc(adresse+3,2,feu); + if code=blanc_cli then pilote_acc(adresse+3,2,feu); end; - if (code=jaune) and (combine=rappel_60) then envoie4_uni($A1); + if (code=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); end; // 98=VJR + blanc + violet + ral30 + rappel30 if modele=98 then begin - bits:=8; - if combine=0 then + if combine=0 then begin - if code=vert then envoie4_uni($84); - if code=vert_cli then envoie4_uni($84); - if code=jaune then envoie4_uni($81); - if code=jaune_cli then envoie4_uni($81); - if code=semaphore then envoie4_uni($82); - if code=semaphore_cli then envoie4_uni($82); - if code=violet then envoie4_uni($40); - if code=ral_30 then envoie4_uni($90); - if code=rappel_30 then envoie4_uni($A0); - if code=blanc then envoie4_uni($08); - if code=blanc_cli then envoie4_uni($08); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=violet then pilote_acc(adresse+1,2,feu); + if code=ral_30 then pilote_acc(adresse+2,1,feu); + if code=rappel_30 then pilote_acc(adresse+2,2,feu); + if code=blanc then pilote_acc(adresse+3,2,feu); + if code=blanc_cli then pilote_acc(adresse+3,2,feu); end; - if (code=jaune) and (combine=rappel_30) then envoie4_uni($A1); + if (code=jaune) and (combine=rappel_30) then pilote_acc(adresse+3,1,feu); end; - + // 99=VJR + blanc + violet + ral30 + rappel60 if modele=99 then begin - bits:=8; - if combine=0 then + if combine=0 then begin - if code=vert then envoie4_uni($84); - if code=vert_cli then envoie4_uni($84); - if code=jaune then envoie4_uni($81); - if code=jaune_cli then envoie4_uni($81); - if code=semaphore then envoie4_uni($82); - if code=semaphore_cli then envoie4_uni($82); - if code=violet then envoie4_uni($40); - if code=ral_30 then envoie4_uni($90); - if code=rappel_60 then envoie4_uni($A0); - if code=blanc then envoie4_uni($08); - if code=blanc_cli then envoie4_uni($08); + if code=vert then pilote_acc(adresse,1,feu); + if code=vert_cli then pilote_acc(adresse,1,feu); + if code=jaune then pilote_acc(adresse,2,feu); + if code=jaune_cli then pilote_acc(adresse,2,feu); + if code=semaphore then pilote_acc(adresse+1,1,feu); + if code=semaphore_cli then pilote_acc(adresse+1,1,feu); + if code=violet then pilote_acc(adresse+1,2,feu); + if code=ral_30 then pilote_acc(adresse+2,1,feu); + if code=rappel_60 then pilote_acc(adresse+2,2,feu); + if code=blanc then pilote_acc(adresse+3,2,feu); + if code=blanc_cli then pilote_acc(adresse+3,2,feu); end; - if (code=jaune) and (combine=rappel_60) then envoie4_uni($A1); + if (code=jaune) and (combine=rappel_60) then pilote_acc(adresse+3,1,feu); end; dessine_feu(adresse); end; @@ -3060,10 +2962,45 @@ begin if i<>0 then begin adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);end else begin adresseIP:='0';parSocket:=false;end; - // numéro de port - s:=lit_ligne; - NumPort:=StrToINT(s); - + // configuration du port com + s:=lit_ligne; // COM3:57600,N,8,1,2 + sa:=s; + protocole:=-1; + // supprimer la dernier paramètre + i:=pos(',',s); + 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); + Val(s,protocole,erreur); + end; + end; + end; + end; + + ConfStCom:=copy(sa,1,j-1); + i:=pos(':',ConfStCom); + + val(ConfStCom[i-1],Numport,erreur); + if i<>0 then Delete(ConfStCom,1,i); + + if (protocole=-1) or (i=0) then Affiche('Erreur port com mal déclaré : '+sa,clred); + //avec ou sans initialisation des aiguillages s:=lit_ligne; AvecInitAiguillages:=StrToINT(s); @@ -3090,7 +3027,7 @@ begin if (temporisation<0) or (temporisation>10) then temporisation:=5; aiguillage[adresse].temps:=temporisation; aiguillageB[adresse].temps:=temporisation; - + invers:=StrToInt(s); if (invers<0) or (invers>1) then invers:=0; // inversion commande aiguillage[adresse].inversion:=invers; @@ -4848,7 +4785,7 @@ begin dec(N_event_det); end; -// trouve adresse d'un détecteur à "etat" avant "index" +// trouve adresse d'un détecteur à "etat" avant "index" dans le tableai chrono function trouve_index_det_chrono(Adr,etat,index : integer) : integer; var i : integer; trouve : boolean; @@ -4974,11 +4911,11 @@ begin AdrPrec:=detecteur_suivant_El(det2,1,det1,1); // le train vient de det1, quitte det2 et va vers Adr + // il faut vérifier si le détecteur précédent à été mis à 1 puis à 0 (on cherche 0) s:='Test route pour prec='+intToSTR(AdrPrec)+' det1='+intToSTR(det1)+' det2='+IntToSTR(det2) ; FormDebug.MemoDet.lines.add(s); if traceListe then AfficheDebug(s,clyellow); - // test avec ou sans mémoire précédente // trouver l'index du détecteur (det1) à 0 i:=trouve_index_det_chrono(det1,0,N_Event_tick); if TraceListe then AfficheDebug('Index det='+intToSTR(i),clyellow); @@ -5755,7 +5692,7 @@ var i : integer; chaineInt : string; begin chaineInt:=s; - i:=pos(#$FF+#$FD+#$42,chaineInt); + i:=pos(#$FF+#$FD+#$42,chaineInt); // réponse de l'information des accessoires if (i<>0) and (length(chaineInt)>=5) then begin delete(chaineInt,i,3); @@ -5813,7 +5750,7 @@ 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 : integer; + i,cv : integer; begin chaineInt:=chaine; @@ -5826,9 +5763,10 @@ begin begin msg:=''; delete(chaineINT,i,2); + // décodage du 3eme octet de la chaîne if chaineINT[1]=#1 then begin - case chaineINT[i+1] of + case chaineINT[i+1] 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; @@ -5865,14 +5803,30 @@ begin #$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; + end + else + begin + if ((chaineINT[1]=#$63) and (chaineINT[2]=#$14)) then // V3.6 uniquement + begin + // réception d'un CV. DocXpressNet p26 + delete(chaineInt,1,2); + cv:=ord(chaineINT[1]); + if cv>255 then Affiche('Erreur Recu CV>255',clRed) + else + begin + tablo_cv[cv]:=ord(chaineINT[2]); + inc(N_Cv); // nombre de CV recus + end; + end + else + Affiche(msg,clRed); end; - Affiche(msg,clRed); end; end; end; end; - if length(chaineINT)<=3 then delete(chaineINT,i,length(chaineINT)); - end + if length(chaineINT)<=3 then delete(chaineINT,i,length(chaineINT)) else begin i:=pos(#$ff+#$fd,chaineINT); @@ -5917,15 +5871,13 @@ end; procedure connecte_USB; begin // initialisation de la comm USB - if avecMSCom then - begin if NumPort<>0 then begin With Formprinc.MSCommUSBLenz do begin - Affiche('demande ouverture com'+intToSTR(nuMPort),CLYellow); - Settings:='57600,N,8,1'; - Handshaking:=2; {2=cts } + Affiche('demande ouverture com'+intToSTR(nuMPort)+':'+ConfStCom+','+IntToSTR(protocole),CLYellow); + Settings:=ConfStCom; + Handshaking:=protocole; {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff } SThreshold:=1; RThreshold:=1; CommPort:=NumPort; @@ -5944,14 +5896,14 @@ begin portCommOuvert:=false; Affiche('Port Com nul dans le fichier de configuration',clyellow); end; - if portCommOuvert then affiche('port COM'+intToSTR(NumPort)+' ouvert',clGreen) else - Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clRed) ; - if portCommOuvert then ParUSB:=true else ParUSB:=false; - end - else - begin - PortCommOuvert:=false;ParUSB:=false; - end; + + if portCommOuvert then + begin + affiche('port COM'+intToSTR(NumPort)+' ouvert',clGreen); + Formprinc.LabelEtat.caption:='Interface connectée au COM'+IntToSTR(NumPort); + end + else + Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clRed) ; end; procedure deconnecte_CDM; @@ -5978,10 +5930,6 @@ begin tempo(5); // connexion à CDM rail s:='C-C-00-0001-CMDGEN-_CNCT|000|'; - //s:='C-C-00-0001-CMDGEN-_CNCT|019|01|LAY=CAPDEBOUHEYRE;'; - //s:='|01|LAY=CAPDEBOUHEYRE;'; - //s:='|01|LAY=RESEAU_TEST;'; - //s:='C-C-00-0001-CMDGEN-_CNCT|'+format('%.*d',[3,length(s)-1])+s; envoi_cdm(s); if pos('_ACK',recuCDM)<>0 then begin @@ -5998,11 +5946,6 @@ begin // demande les trains ////s:=place_id('C-C-01-0002-DSCTRN-DLOAD|000|'); //envoi_CDM(s); - - s:=chaine_CDM_Acc(23,2); - envoi_CDM(s); - s:=chaine_CDM_Acc(23,0); - envoi_CDM(s); end; end else @@ -6048,9 +5991,9 @@ begin TraceSign:=True; AF:='Client TCP-IP CDM Rail ou USB - système LENZ - Version '+Version; Caption:=AF; - avecMSCom:=false; Application.onHint:=doHint; LabelEtat.Caption:='Initialisations en cours'; + Menu_interface(devalide); // créée la fenetre debug @@ -6060,6 +6003,13 @@ begin NivDebug:=0; DebugOuv:=True; + //LireunaccessoireversunfichierdeCV1.Visible:=false; + + AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& + AvecTCO:=false; + + + EditNbTrains.Text:=IntToSTR(N_Trains); // créée la fenetre vérification de version @@ -6079,6 +6029,17 @@ begin // lecture fichier de configuration config.cfg lit_config; + // TCO + if avectco then + begin + //créée la fenêtre TCO + FormTCO:=TformTCO.Create(Self); + FormTCO.show; + construit_TCO; + affiche_TCO; + end; + + // tenter la liaison vers CDM rail ou vers la centrale Lenz Affiche('Test présence CDM',clYellow); connecte_CDM; @@ -6087,12 +6048,10 @@ begin Affiche('CDM absent - Ouverture liaison vers centrale Lenz',clYellow); // ouverture par USB Affiche('demande connexion à la centrale Lenz par USB',clyellow); - AvecMsCom:=True; // indicateur de connexion USB - connecte_USB; // connecte si avecMSCom=True; - if not(ParUSB) then + connecte_USB; + if not(portCommOuvert) then begin // sinon ouvrir socket vers la centrale - avecMScom:=false; // Initialisation de la comm socket LENZ if AdresseIP<>'0' then begin @@ -6100,12 +6059,25 @@ begin ClientSocketLenz.port:=port; ClientSocketLenz.Address:=AdresseIP; ClientSocketLenz.Open; - avecMSCom:=false; end - end - else avecMScom:=true; + end; end; + if portCommOuvert or parsocket then + With Formprinc do + begin + ButtonEcrCV.Enabled:=true; + LireunfichierdeCV1.enabled:=true; + LireunaccessoireversunfichierdeCV1.Enabled:=true; + end + else + With Formprinc do + begin + ButtonEcrCV.Enabled:=false; + LireunfichierdeCV1.enabled:=false; + LireunaccessoireversunfichierdeCV1.Enabled:=false; + end ; + // Initialisation des images des signaux NbreImagePLigne:=Formprinc.ScrollBox1.Width div (largImg+5); @@ -6127,11 +6099,15 @@ begin I_Simule:=0; tick:=0; - N_Event_tick:=0 ; // dernier index - NombreImages:=0; + // énumération des ports USB + //EnumerateDevices; + //for i:=1 to NumLine do + //begin + // if pos('Ports',Line[i])<>0 then Affiche(Line[i],clyellow); + //end; //essai // event_det[1]:=527; @@ -6162,6 +6138,7 @@ begin //test_memoire_zones(218); //Det_Adj(520); //Affiche(' Adj1='+intToStr(Adj1)+' Adj2='+intToStr(Adj2),clyellow); + Affiche('Fin des initialisations',clyellow); end; @@ -6219,13 +6196,6 @@ begin end; -procedure simulation; -var s : string; - adr,ts : integer; -begin - - -end; // timer à 100 ms @@ -6235,13 +6205,13 @@ begin inc(tick); if Tempo_init>0 then dec(Tempo_init); - if Tempo_init=1 then + if (Tempo_init=1) and AvecInit then begin Affiche('Positionnement des feux',clYellow); if not(ferme) then envoi_signauxCplx; // initialisation des feux if not(ferme) and (AvecInitAiguillages=1) then init_aiguillages else // initialisation des aiguillages if not(ferme) and (parSocket or portCommOuvert) then demande_etat_acc; // demande l'état des accessoires (position des aiguillages) - LabelEtat.Caption:=' '; + //LabelEtat.Caption:=' '; Menu_interface(valide); end; @@ -6383,7 +6353,6 @@ begin afficheDebug(s,ClRed); CDM_connecte:=false; ErrorCode:=0; - LabelEtat.caption:=Titre; end; // lecture depuis socket @@ -6392,8 +6361,8 @@ procedure TFormPrinc.ClientSocketLenzRead(Sender: TObject; var s : string; begin s:=ClientSocketLenz.Socket.ReceiveText; - interprete_reponse(s); if trace then affiche(chaine_hex(s),clWhite); + interprete_reponse(s); end; procedure TFormPrinc.ButtonTestClick(Sender: TObject); @@ -6555,6 +6524,10 @@ begin Affiche('Lenz connecté ',clYellow); AfficheDebug('Lenz connecté ',clYellow); parSocket:=True; + ButtonEcrCV.Enabled:=true; + LireunfichierdeCV1.enabled:=true; + LireunaccessoireversunfichierdeCV1.Enabled:=true; + LabelEtat.caption:='Interface connectée par Ethernet'; end; procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket); @@ -6718,6 +6691,8 @@ begin Affiche('Version 1.11 : compatibilité pour la rétrosignalisation non XpressNet (intellibox)',clLime); Affiche(' verrouillages routes pour trains consécutifs',clLime); Affiche('Version 1.2 : Renforcement de l''algorithme de suivi des trains',clLime); + Affiche('Version 1.3 : Décodeur Unisemaf fonctionnel - Lecture/écriture des CV',clLime); + Affiche(' Protocoles variables de l''interface',clLime); end; procedure TFormPrinc.ClientSocketLenzDisconnect(Sender: TObject; @@ -6760,13 +6735,167 @@ if ord(Key) = VK_RETURN then N_trains:=StrToint(EditNbTrains.Text); Affiche(IntToSTR(N_trains)+' trains',clyellow); end; -end; +end; procedure TFormPrinc.FichierSimuClick(Sender: TObject); begin FormSimulation.showModal; - TraceListe:=true; + //TraceListe:=true; end; +procedure TFormPrinc.ButtonEcrCVClick(Sender: TObject); +var adr,valeur,erreur : integer; + s : string; +begin + // doc XpressNet page 55 + if (Adr>255) or (valeur>255) then exit; + val(EditAdresse.text,adr,erreur); + val(EditVal.Text,valeur,erreur); + //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:=#$ff+#$fe+#$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:=#$ff+#$fe+#$21+#$81; + s:=checksum(s); + envoi(s); // envoi de la trame et attente Ack + +end; + +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); + // s:=' 35 63'; + 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:=#$ff+#$fe+#$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.LireunaccessoireversunfichierdeCV1Click(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:=''; + //for cv:=1 to 255 do + begin + cv:=3; + trace:=true; + //s:=#$ff+#$fe+#$22+#$15+Char(cv); //CV de 1 à 256 (V3.0) + s:=#$ff+#$fe+#$22+#$18+Char(cv); //CV de 1 à 255 + 1024 (V3.6) + s:=checksum(s); + // envoi(s); // envoi de la trame et attente Ack, la premiere trame fait passer la centrale en mode programmation (service) + envoi_ss_ack(s); + Tempo(1); + + s:=#$ff+#$fe+#$21+#$10+Char(cv); // 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 + tablo_CV[cv]:=0; + i:=0; + repeat + Tempo(2); // attend 200 ms + inc(i); + // N_cv:=cv; + until (N_cv=cv) or (i>4); + if (i>4) then + begin + Affiche('Erreur attente trop longue CV',clred); + exit; + end; + //tablo_cv[cv]:=123; + sa:=sa+'Cv'+IntToSTR(cv)+'='+IntToSTR(Tablo_cv[cv])+' '; + if cv mod 9=0 then + begin + Affiche(sa,clyellow);sa:=''; + end; + end; + Affiche(sa,clyellow);sa:=''; + + with FormPrinc.SaveDialog do + begin + InitialDir:=s; + title:='Ecrire un nom de fichier dans lequel sauvegarder les CV'; + DefaultExt:='txt'; + Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*'; + + if Execute then + begin + s:=FileName; + assignFile(fte,s); + rewrite(fte); + Writeln(fte,'cv valeur'); + for cv:=1 to 255 do + begin + s:=IntToSTR(cv)+' '+intToSTR(tablo_CV[cv]); + Writeln(fte,s); + end; + closeFile(fte); + end; + end; + +end; + + + end. diff --git a/UnitSimule.dcu b/UnitSimule.dcu index 89d51c2..b4149b7 100644 Binary files a/UnitSimule.dcu and b/UnitSimule.dcu differ diff --git a/UnitTCO.dcu b/UnitTCO.dcu new file mode 100644 index 0000000..c908971 Binary files /dev/null and b/UnitTCO.dcu differ diff --git a/UnitTCO.dfm b/UnitTCO.dfm new file mode 100644 index 0000000..44067f1 --- /dev/null +++ b/UnitTCO.dfm @@ -0,0 +1,94 @@ +object FormTCO: TFormTCO + Left = 1549 + Top = 156 + Width = 928 + Height = 590 + Caption = 'FormTCO' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnActivate = FormActivate + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object LabelX: TLabel + Left = 32 + Top = 16 + Width = 53 + Height = 19 + Caption = 'LabelX' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label2: TLabel + Left = 16 + Top = 16 + Width = 13 + Height = 13 + Caption = 'X=' + end + object Label3: TLabel + Left = 104 + Top = 16 + Width = 13 + Height = 13 + Caption = 'X=' + end + object LabelY: TLabel + Left = 120 + Top = 16 + Width = 51 + Height = 19 + Caption = 'Label1' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object DrawGrid: TDrawGrid + Left = 48 + Top = 408 + Width = 521 + Height = 137 + Color = clBlack + DefaultColWidth = 30 + DefaultRowHeight = 30 + FixedCols = 0 + FixedRows = 0 + TabOrder = 0 + OnDrawCell = DrawGridDrawCell + end + object Button1: TButton + Left = 320 + Top = 16 + Width = 75 + Height = 25 + Caption = 'Button1' + TabOrder = 1 + OnClick = Button1Click + end + object ScrollBox: TScrollBox + Left = 16 + Top = 40 + Width = 865 + Height = 353 + TabOrder = 2 + object ImageTCO: TImage + Left = 0 + Top = 0 + Width = 857 + Height = 345 + OnClick = ImageTCOClick + end + end +end diff --git a/UnitTCO.pas b/UnitTCO.pas new file mode 100644 index 0000000..7c8307b --- /dev/null +++ b/UnitTCO.pas @@ -0,0 +1,323 @@ +unit UnitTCO; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls; + +type + TFormTCO = class(TForm) + DrawGrid: TDrawGrid; + Button1: TButton; + LabelX: TLabel; + Label2: TLabel; + Label3: TLabel; + LabelY: TLabel; + ScrollBox: TScrollBox; + ImageTCO: TImage; + procedure FormCreate(Sender: TObject); + procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; + Rect: TRect; State: TGridDrawState); + procedure Button1Click(Sender: TObject); + procedure ImageTCOClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + private + { Déclarations privées } + public + { Déclarations publiques } + end; + + +var + FormTCO: TFormTCO; + NbreCellX,NbreCellY,HtImageTCO,LargImageTCO,XclicCell,YclicCell : integer; + LargeurCell,HauteurCell,Xclic,Yclic : integer; + tco : array[1..20,1..20] of Tbranche; + +procedure construit_TCO; +procedure affiche_TCO; + +implementation + +{$R *.dfm} + + + +procedure grille; +var x,y : integer; + r : Trect; +begin + HtImageTCO:=FormTCO.ImageTCO.Height; + HtImageTCO:=FormTCO.ImageTCO.Height; + LargImageTCO:=FormTCO.ImageTCO.Width; + + With FormTCO.ImageTCO.canvas do + begin + Brush.Style:=bsSolid; + Brush.Color:=clBlack; + pen.color:=clyellow; + r:=rect(1,1,LargImageTCO,HtImageTco); + FillRect(r); + + + pen.color:=$707070; + for x:=1 to NbreCellx do + begin + moveto(x*LargeurCell,1); + LineTo(x*LargeurCell,HtImageTCO); + end; + for y:=1 to NbreCelly do + begin + moveto(1,y*HauteurCell); + LineTo(LargimageTCO,y*HauteurCell); + end; + end; +end; + +procedure dessin_voie(x,y : integer); +var x1,y1 : integer; + r : Trect; +begin + with FormTCO.ImageTCO.Canvas do + begin + x1:=x*LargeurCell; + y1:=y*HauteurCell; + end; + with formTCO.ImageTCO.canvas do + begin + r:=Rect(x1,y1+(HauteurCell div 2)-5,x1+LargeurCell,y1 + (HauteurCell div 2)+5); + Brush.COlor:=ClRed; + FillRect(r); + end; +end; + +// aiguillage pointe à gauche, monte gauche +procedure dessin_AigPGMG(x,y : integer;couleur : Tcolor); +var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; + r : Trect; +begin + x0:=x*LargeurCell; + y0:=y*HauteurCell; + + with formTCO.ImageTCO.canvas do + begin + Brush.COlor:=couleur; + pen.color:=couleur; + + jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup + jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + + + r:=Rect(x0,jy1,x0+LargeurCell,jy2); + FillRect(r); + + //brush.color:=clblue; + x1:=x0+(largeurCell div 2); + y1:=jy1; + x2:=x0+largeurCell-3; + y2:=y0; + x3:=x0+largeurCell; + y3:=y0+3; + x4:=x0+(largeurCell div 2)+7; + y4:=jy1; + Polygon([point(x1,y1),Point(x2,y2),Point(x3+2,y3-2),Point(x4+2,y4-2)]); + + end; +end; + +// courbe bas gauche vers droit +procedure dessin_cbgd(x,y : integer;couleur : Tcolor); +var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer; + r : Trect; +begin + x0:=x*LargeurCell; + y0:=y*HauteurCell; + + with formTCO.ImageTCO.canvas do + begin + Brush.COlor:=Couleur; + pen.color:=Couleur; + + jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup + jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf + r:=Rect(x0+(largeurCell div 2),jy1,x0+LargeurCell,jy2); + FillRect(r); + + // brush.color:=clblue; + x1:=x0; + y1:=y0+HauteurCell-3; + x2:=x0+(LargeurCell div 2) -0; + y2:=jy1; + x3:=x0+(LargeurCell div 2) +2; + y3:=jy2; + x4:=x0+3; + y4:=y0+HauteurCell; + Polygon([point(x1-2,y1+2),Point(x2,y2),Point(x3,y3),Point(x4-2,y4+2)]); + + end; +end; + + +procedure construit_TCO; +var x,y,i,j,Max,indexMax : integer; +begin + // étape 0 Raz du TCO + for y:=1 to 20 do + for x:=1 to 20 do + begin + TCO[x,y].Adresse:=0; + TCO[x,y].Btype:=0; + end; + + //étape 1 trouver la branche la plus longue + Max:=0; + for i:=1 to NbreBranches do + begin + j:=0; + repeat + inc(j); + until BrancheN[i,j].Adresse=0; + if j>Max then begin Max:=j-1;IndexMax:=i;end; + end; + Affiche('La branche la plus grande a pour index '+IntToSTR(IndexMax),clOrange); + + // stocker cette branche au milieu du TCO (en 5) + for i:=1 to Max do + begin + TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse; + TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype; + end; + + +end; + +procedure Affiche_TCO ; +var i,j,x,y,xOrg,Yorg,btype : integer; + s : string; +begin + with formTCO.ImageTCO.Canvas do + begin + Brush.color:=ClBlack; + font.color:=clWhite; + end; + for y:=1 to 10 do + for x:=1 to 20 do + begin + i:=tco[x,y].Adresse; + btype:=tco[x,y].Btype; + with formTCO.ImageTCO.Canvas do + begin + Xorg:=(x-1)*LargeurCell; + Yorg:=(y-1)*HauteurCell; + + s:=IntToSTR(i); + if Btype=2 then s:='A'+s; + if Btype=3 then s:='A'+s+'B'; + + Textout(Xorg+2,Yorg+2,s); + end; + end; +end; + + +procedure TFormTCO.FormCreate(Sender: TObject); +begin + + caption:='TCO'; + NbreCellX:=20; + NbreCellY:=10; + LargeurCell:=35; + HauteurCell:=35; + //grille; + // HtImageTCO:=ImageTCO.Height; + +end; + +// x y = numéro cellule +Procedure dessine(x,y : integer); +Var Xorg,Yorg : integer; +begin + Xorg:=x*LargeurCell; + Yorg:=y*HauteurCell; + with FormTCO.DrawGrid.Canvas do + begin + Pen.width:=3; + Pen.Color:=clyellow; + Brush.Style:=bsSolid; + MoveTo(xorg,yorg);LineTo(xorg+120,yorg+150) ; + Pen.Color:=clred; + MoveTo(1,1);LineTo(120,160) ; + + end; + formTCO.refresh; + +end; + + + +procedure TFormTCO.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; + Rect: TRect; State: TGridDrawState); +var s : string; + aCanvas : Tcanvas; +begin + exit; + dessine(2,2); + + if (Acol=3) and (ARow=3) then with Sender as TDrawGrid do Canvas.Draw(Rect.left,Rect.Top,Formprinc.Image6Dir.picture.bitmap); + + if (Acol=2) and (Arow=1) then + begin + with Sender as TDrawGrid do + begin + //Canvas.Pen:=psSolid; + With canvas do + begin + Pen.width:=3; + Pen.Color:=clyellow; + MoveTo(1,1);LineTo(150,150) ; + end; + end; + + end; + +end; + + + +procedure TFormTCO.Button1Click(Sender: TObject); +begin + grille; + dessin_voie(3,3); + dessin_voie(10,4); + dessin_AigPGMG(7,6,clyellow); +end; + + +procedure TFormTCO.ImageTCOClick(Sender: TObject); +var Position: TPoint; +begin + GetCursorPos(Position); + Position:=ImageTCO.screenToCLient(Position); + Xclic:=position.X;YClic:=position.Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + LabelX.caption:=IntToSTR(XclicCell); + LabelY.caption:=IntToSTR(YclicCell); + + +end; + +procedure TFormTCO.FormActivate(Sender: TObject); +begin + + grille; + dessin_voie(3,3); + dessin_voie(10,4); + dessin_AigPGMG(7,6,clyellow); + dessin_cbgd(8,5,clyellow); + + formprinc.Hide; +end; + +end. diff --git a/client-GL.cfg b/client-GL.cfg index 6f56ecd..4ddfaf1 100644 --- a/client-GL.cfg +++ b/client-GL.cfg @@ -29,12 +29,14 @@ 192.168.1.23:5550 / / port COM de l'adresse USB de l'interface LI100 -/ attention de 1 à 9 - Si le port de l'interface USB LI100 >9, il faut le changer +/ attention de COM1 à 9 - Si le port de l'interface USB LI100 >9, il faut le changer / manuellement dans le gestionnaire des périphériques / mettre 0 si inutilisée ou si CDM est utilisé en parallèle de ce programme (car CDM utilise la liaison USB) / Le programme ne tentera pas de se connecter à la centrale si CDM rail est détécté +/ COMx:57600,N,8,1,2 = interfaces LENZ LI-USB et compatibles (le dernier paramètre est le protocole matériel: 0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff) +/ COMx:9600,N,8,1,0 = interfaces GENLI USB-RS232 et compatibles (0=pas de protocole) / -3 +COM3:57600,N,8,1,2 / / Avec (1) ou sans (0) initialisation des aiguillages au démarrage selon le tableau ci après 0 diff --git a/config.cfg b/config.cfg index 8db7571..0e82d69 100644 --- a/config.cfg +++ b/config.cfg @@ -107,7 +107,6 @@ A31,0 476,9,0,1,(538,A23),1 497,9,0,4,(531,A19),1 600,7,0,0,(521,A8),1 -197,5,0,6,(520,A20),0,51 0 / diff --git a/liste_cv.txt b/liste_cv.txt new file mode 100644 index 0000000..613db8b --- /dev/null +++ b/liste_cv.txt @@ -0,0 +1,30 @@ +Fichier décodeur unisemaf +cible de forme 51 +CV valeur +----aspect1 +35 63 affecte les sorties aspect +36 36 +37 0 +38 0 +-----aspect2 +39 63 +40 33 +41 0 +42 0 +-----aspect3 +43 63 +44 34 +45 0 +46 0 +-----aspect4 +47 63 +48 10 +49 0 +50 0 +-----aspect5 +51 63 +52 16 +53 0 +54 0 + + diff --git a/listeusb.dcu b/listeusb.dcu new file mode 100644 index 0000000..f4af299 Binary files /dev/null and b/listeusb.dcu differ diff --git a/listeusb.pas b/listeusb.pas new file mode 100644 index 0000000..ab79e08 --- /dev/null +++ b/listeusb.pas @@ -0,0 +1,167 @@ +unit listeusb; + +//=================================================// +// Nicolas Paglieri (ni69) // +// www.ni69.info // +// & www.delphifr.com // +//=================================================// +// Merci à DelphiProg pour son aide précieuse ! ;) // +//=================================================// + + +interface + +uses Registry,ShellAPI, ComCtrls, + Windows, Messages, SysUtils, Variants, Classes;// Graphics, Controls, + + +var + line : array of string; + NumLine : integer; + +procedure EnumerateDevices; + +implementation + + +//============================================================================// +// Fonction de traduction en français des noms anglais des catégories de périphériques +// On ajoute ici l'index de l'icône de catégorie après un # pour gérer l'affichage +//============================================================================// +function Translate(English: string): string; +begin + if English = 'CDROM' then result := 'Lecteurs de CD-ROM/DVD-ROM#09' + else if English = 'Computer' then result := 'Ordinateur#14' + else if English = 'DiskDrive' then result := 'Lecteurs de disque#10' + else if English = 'Display' then result := 'Cartes Graphiques#01' + else if English = 'fdc' then result := 'Contrôleur de lecteur de disquettes#04' + else if English = 'FloppyDisk' then result := 'Lecteurs de disquettes#11' + else if English = 'hdc' then result := 'Contrôleurs ATA/ATAPI IDE#05' + else if English = 'Image' then result := 'Périphériques d''image#15' + else if English = 'Keyboard' then result := 'Claviers#03' + else if English = 'LegacyDriver' then result := 'Pilotes non Plug-and-Play#17' + else if English = 'MEDIA' then result := 'Contrôleurs audio, vidéo et jeu#06' + else if English = 'Modem' then result := 'Modems#12' + else if English = 'Monitor' then result := 'Moniteurs#13' + else if English = 'Mouse' then result := 'Souris et autres périphériques de pointage#20' + else if English = 'Net' then result := 'Cartes réseau#02' + else if English = 'NtApm' then result := 'Prise en charge NT APM/hérité#19' + else if English = 'Ports' then result := 'Ports (COM et LPT)#18' + else if English = 'Printer' then result := 'Imprimantes#08' + else if English = 'System' then result := 'Périphériques Système#14' + else if English = 'USB' then result := 'Contrôleurs de bus USB#07' + else if English = 'Volume' then result := 'Volumes de stockage#21' + else result := English+'#22'; // Périphérique inconnu +end; +//============================================================================// + + + + +//============================================================================// +// PROCEDURE D'ENUMERATION DES PERIPHERIQUES SUR WINDOWS XP-7 // +// ne marche pas avec W10 +//============================================================================// +procedure EnumerateDevices; +var + CategoriesList, SubCatList, SubSubCatList, FinalList : TStringList; + nb, nb2, nb3 ,num: integer; + Reg1, Reg2, Reg3 : TRegistry; + HasBeenFound : boolean; + listeCles : Tstrings; + +begin + + + CategoriesList := TStringList.Create; // Liste des catégories principales du registre + SubCatList := TStringList.Create; // Liste intermédiaire + SubSubCatList := TStringList.Create; // Liste intermédiaire + FinalList := TStringList.Create; // Liste finale comprenant les périphériques + + // On crée les objets TRegistry qui serviront à parcourir l'arborescence + Reg1 := TRegistry.Create; + Reg2 := TRegistry.Create; + Reg3 := TRegistry.Create; + + try + // Définition de la clé racine + Reg1.RootKey := HKEY_LOCAL_MACHINE; + Reg2.RootKey := HKEY_LOCAL_MACHINE; + Reg3.RootKey := HKEY_LOCAL_MACHINE; + + //---------------------------------------------------------------------------------------- + // 1ère ETAPE : ENUMARTION DES CATEGORIES DU REGISTRE (différentes des catégories finales) + with TRegistry.Create do try + RootKey := HKEY_LOCAL_MACHINE; + + //! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! + // IMPORTANT : DROITS D'ACCES + // On ouvre les clés en lecture seule avec OpenKeyReadOnly + // car on dispose de la valeur de sécurité d'accès KEY_READ. + // En effet, seul SYSTEM a le droit d'ouvrir cette clé en écriture en temps normal. + //! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! + + OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum'); + GetKeyNames(CategoriesList); // Récupération des catégories + CloseKey; + finally + free; + end; + + num:=1;Setlength(line,num+1); + //----------------------------------------------------------------------------------------------------------------------------------- + // 2eme ETAPE : PARCOURS DE L'ARBORESCENCE DU REGISTRE (les clés contenant les informations utiles sont contenues dans d'autres clés) + for nb := 0 to CategoriesList.Count-1 do begin + Reg1.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]); + Reg1.GetKeyNames(SubCatList); + Reg1.CloseKey; + for nb2 := 0 to SubCatList.Count-1 do begin + Reg2.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]); + Reg2.GetKeyNames(SubSubCatList); + Reg2.CloseKey; + for nb3 := 0 to SubSubCatList.Count-1 do begin + Reg3.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]+'\'+SubSubCatList[nb3]); + + // Si on ne dispose ni du type de périphérique, ni de son nom, + // Ou alors si le périphérique n'est plus disponible (si la clé "Control" n'est pas présente), on ne l'ajoute pas + if ((Reg3.ReadString('Class')='') and (Reg3.ReadString('DeviceDesc')='')) or (not Reg3.KeyExists('Control')) then begin + Reg3.CloseKey; + continue; + // Si il s'agit d'un lecteur CD, d'un disque dur ou d'un port (COM ou LPT), on remplace la description du périphérique par un nom plus parlant + end else if (Reg3.ReadString('Class')='CDROM') or (Reg3.ReadString('Class')='DiskDrive') or (Reg3.ReadString('Class')='Ports') then + line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('FriendlyName') + else line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('DeviceDesc'); + // Ajout des informations si elles sont présentes dans le registre + if Reg3.ValueExists('DeviceDesc') then Line[num] := Line[num] + '§Description@'+Reg3.ReadString('DeviceDesc'); + if Reg3.ValueExists('FriendlyName') then Line[num] := Line[num] + '§FriendlyName@'+Reg3.ReadString('FriendlyName'); + if Reg3.ValueExists('Mfg') then Line[num] := Line[num] + '§Fabriquant@'+Reg3.ReadString('Mfg'); + if Reg3.ValueExists('Service') then Line[num] := Line[num] + '§Service@'+Reg3.ReadString('Service'); + if Reg3.ValueExists('LocationInformation') then Line[num] := Line[num] + '§Emplacement@'+Reg3.ReadString('LocationInformation'); + if Reg3.ValueExists('Class') then Line[num] := Line[num] + '§Enumérateur@'+Reg3.ReadString('Class'); + FinalList.Add(line[num]); + inc(num); + //Affiche(line,clyellow); + Reg3.CloseKey;Setlength(line,num+1); + end; + end; + end; + + NumLine:=num-1; + + finally + // On libère les éléments créés au départ + Reg3.Free; + Reg2.Free; + Reg1.Free; + FinalList.Free; + SubSubCatList.Free; + SubCatList.Free; + CategoriesList.Free; + end; +end; + +end. + + + + \ No newline at end of file diff --git a/verif_version.dcu b/verif_version.dcu index ffa2af9..7582b3a 100644 Binary files a/verif_version.dcu and b/verif_version.dcu differ diff --git a/verif_version.pas b/verif_version.pas index 6c9224c..6c4d5f2 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -22,7 +22,7 @@ var FormVersion: TFormVersion; Lance_verif : integer; -Const Version='1.2';// sert à la comparaison de la version publiée +Const Version='1.3'; //Version='1.2';// sert à la comparaison de la version publiée implementation @@ -97,7 +97,7 @@ procedure verifie_version; var s,s2,s3,Version_p,Url,LocalFile : string; trouve_version,trouve_zip : boolean; fichier : text; - i,j : integer; + i,j,erreur : integer; V_publie,V_utile : real; begin //Affiche('vérifie version',clLime); @@ -147,12 +147,13 @@ begin // changer le . en , s:=Version_p; - i:=pos('.',s);if i<>0 then s[i]:=','; + // i:=pos('.',s);if i<>0 then s[i]:=','; s2:=version; - i:=pos('.',s2);if i<>0 then s2[i]:=','; + // 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; - V_publie:=StrToFloat(s); - V_utile:=StrToFloat(s2); if V_utile