diff --git a/Notice d'utilisation des signaux_complexes_GL_V9.2.pdf b/Notice d'utilisation des signaux_complexes_GL_V9.3.pdf similarity index 73% rename from Notice d'utilisation des signaux_complexes_GL_V9.2.pdf rename to Notice d'utilisation des signaux_complexes_GL_V9.3.pdf index 8c57693..125c3d7 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V9.2.pdf and b/Notice d'utilisation des signaux_complexes_GL_V9.3.pdf differ diff --git a/Signaux_complexes_GL.cfg b/Signaux_complexes_GL.cfg index 2d571d5..326b5d5 100644 --- a/Signaux_complexes_GL.cfg +++ b/Signaux_complexes_GL.cfg @@ -14,8 +14,8 @@ -$N+ -$O- -$P- --$Q+ --$R+ +-$Q- +-$R- -$S- -$T- -$U- diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index 290450a..73b43da 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -17,8 +17,8 @@ M=0 N=1 O=0 P=0 -Q=1 -R=1 +Q=0 +R=0 S=0 T=0 U=0 diff --git a/Signaux_complexes_GL.dpr b/Signaux_complexes_GL.dpr index 9eab824..1b9c077 100644 --- a/Signaux_complexes_GL.dpr +++ b/Signaux_complexes_GL.dpr @@ -25,7 +25,8 @@ uses selection_train in 'selection_train.pas' {FormSelTrain}, UnitRoute in 'UnitRoute.pas' {FormRoute}, UnitRouteTrains in 'UnitRouteTrains.pas' {FormRouteTrain}, - UnitInfo in 'UnitInfo.pas' {FormInfo}; + UnitInfo in 'UnitInfo.pas' {FormInfo}, + UnitIntro in 'UnitIntro.pas' {FormIntro}; {$R *.res} @@ -54,6 +55,7 @@ begin Application.CreateForm(TFormRoute, FormRoute); Application.CreateForm(TFormRouteTrain, FormRouteTrain); Application.CreateForm(TFormInfo, FormInfo); + Application.CreateForm(TFormIntro, FormIntro); fin_preliminaire; Application.Run; end. diff --git a/Signaux_complexes_GL.map b/Signaux_complexes_GL.map index 51b66c5..cd05fb8 100644 --- a/Signaux_complexes_GL.map +++ b/Signaux_complexes_GL.map @@ -1,8 +1,8 @@ Start Length Name Class - 0001:00000000 001F241CH .text CODE - 0002:00000000 00002F18H .data DATA - 0002:00002F18 06A55901H .bss BSS + 0001:00000000 001FAE24H .text CODE + 0002:00000000 00002F38H .data DATA + 0002:00002F38 0F197EE5H .bss BSS Detailed map of segments @@ -78,38 +78,40 @@ Detailed map of segments 0001:0009AFA4 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 0001:0009AFE4 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 0001:0009B01C 00000038 C=CODE S=.text G=(none) M=DateUtils ACBP=A9 - 0001:0009B054 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 - 0001:0009B940 000005A0 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 - 0001:0009BEE0 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 - 0001:0009C8F8 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 - 0001:0009EA00 000092A4 C=CODE S=.text G=(none) M=Grids ACBP=A9 - 0001:000A7CA4 00001BFC C=CODE S=.text G=(none) M=Spin ACBP=A9 - 0001:000A98A0 00003762 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 - 0001:000AD004 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 - 0001:000AD580 000196A8 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 - 0001:000C6C28 00002E3F C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 - 0001:000C9A68 00000D84 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 - 0001:000CA7EC 000011F4 C=CODE S=.text G=(none) M=UnitFicheHoraire ACBP=A9 - 0001:000CB9E0 00000038 C=CODE S=.text G=(none) M=ShellConsts ACBP=A9 - 0001:000CBA18 000004E0 C=CODE S=.text G=(none) M=ShellCtrls ACBP=A9 - 0001:000CBEF8 00001A20 C=CODE S=.text G=(none) M=UnitRoute ACBP=A9 - 0001:000CD918 00002A44 C=CODE S=.text G=(none) M=UnitRouteTrains ACBP=A9 - 0001:000D035C 00000298 C=CODE S=.text G=(none) M=UnitInfo ACBP=A9 - 0001:000D05F4 00003300 C=CODE S=.text G=(none) M=selection_train ACBP=A9 - 0001:000D38F4 000067FC C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 - 0001:000DA0F0 00001908 C=CODE S=.text G=(none) M=UnitClock ACBP=A9 - 0001:000DB9F8 000580FC C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 - 0001:00133AF4 000039DC C=CODE S=.text G=(none) M=UnitSR ACBP=A9 - 0001:001374D0 00002BF8 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 - 0001:0013A0C8 0000899C C=CODE S=.text G=(none) M=UnitModifAction ACBP=A9 - 0001:00142A64 00000F64 C=CODE S=.text G=(none) M=UnitHorloge ACBP=A9 - 0001:001439C8 000025FB C=CODE S=.text G=(none) M=verif_version ACBP=A9 - 0001:00145FC4 00001190 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 - 0001:00147154 00000F10 C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 - 0001:00148064 00059854 C=CODE S=.text G=(none) M=Unitprinc ACBP=A9 - 0001:001A18B8 0004D544 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 - 0001:001EEDFC 0000305C C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 - 0001:001F1E58 000005C4 C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 + 0001:0009B054 00000038 C=CODE S=.text G=(none) M=PsAPI ACBP=A9 + 0001:0009B08C 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 + 0001:0009B978 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 + 0001:0009BF10 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 + 0001:0009C928 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 + 0001:0009EA30 000092A4 C=CODE S=.text G=(none) M=Grids ACBP=A9 + 0001:000A7CD4 00001BFC C=CODE S=.text G=(none) M=Spin ACBP=A9 + 0001:000A98D0 00003762 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 + 0001:000AD034 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 + 0001:000AD5B0 000196A8 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 + 0001:000C6C58 00002E8B C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 + 0001:000C9AE4 00000EB0 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 + 0001:000CA994 00001070 C=CODE S=.text G=(none) M=UnitFicheHoraire ACBP=A9 + 0001:000CBA04 00000038 C=CODE S=.text G=(none) M=ShellConsts ACBP=A9 + 0001:000CBA3C 000004E0 C=CODE S=.text G=(none) M=ShellCtrls ACBP=A9 + 0001:000CBF1C 00002D94 C=CODE S=.text G=(none) M=UnitRoute ACBP=A9 + 0001:000CECB0 00002C68 C=CODE S=.text G=(none) M=UnitRouteTrains ACBP=A9 + 0001:000D1918 0000028C C=CODE S=.text G=(none) M=UnitInfo ACBP=A9 + 0001:000D1BA4 00003438 C=CODE S=.text G=(none) M=selection_train ACBP=A9 + 0001:000D4FDC 00006808 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 + 0001:000DB7E4 00001634 C=CODE S=.text G=(none) M=UnitClock ACBP=A9 + 0001:000DCE18 00000274 C=CODE S=.text G=(none) M=UnitIntro ACBP=A9 + 0001:000DD08C 00059C48 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 + 0001:00136CD4 000039DC C=CODE S=.text G=(none) M=UnitSR ACBP=A9 + 0001:0013A6B0 00002BF8 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 + 0001:0013D2A8 00008C48 C=CODE S=.text G=(none) M=UnitModifAction ACBP=A9 + 0001:00145EF0 00000F84 C=CODE S=.text G=(none) M=UnitHorloge ACBP=A9 + 0001:00146E74 0000261B C=CODE S=.text G=(none) M=verif_version ACBP=A9 + 0001:00149490 00001190 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 + 0001:0014A620 00000F48 C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 + 0001:0014B568 0005D258 C=CODE S=.text G=(none) M=Unitprinc ACBP=A9 + 0001:001A87C0 0004F190 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 + 0001:001F7950 00002EE8 C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 + 0001:001FA838 000005EC C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 0002:00000000 000000CC C=DATA S=.data G=DGROUP M=System ACBP=A9 0002:000000CC 00000020 C=DATA S=.data G=DGROUP M=SysInit ACBP=A9 0002:000000EC 00000254 C=DATA S=.data G=DGROUP M=SysUtils ACBP=A9 @@ -214,37 +216,39 @@ Detailed map of segments 0002:00003E48 00000004 C=BSS S=.bss G=DGROUP M=MMSystem ACBP=A9 0002:00003E4C 00000004 C=BSS S=.bss G=DGROUP M=Nb30 ACBP=A9 0002:00003E50 00000004 C=BSS S=.bss G=DGROUP M=DateUtils ACBP=A9 - 0002:00003E54 00000004 C=BSS S=.bss G=DGROUP M=OleServer ACBP=A9 - 0002:00003E58 00000004 C=BSS S=.bss G=DGROUP M=MSCommLib_TLB ACBP=A9 - 0002:00003E5C 00000004 C=BSS S=.bss G=DGROUP M=MaskUtils ACBP=A9 - 0002:00003E60 00000004 C=BSS S=.bss G=DGROUP M=Mask ACBP=A9 - 0002:00003E64 00000004 C=BSS S=.bss G=DGROUP M=Grids ACBP=A9 - 0002:00003E68 00000004 C=BSS S=.bss G=DGROUP M=Spin ACBP=A9 - 0002:00003E6C 00002494 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 - 0002:00006300 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 - 0002:00006310 000148B0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 - 0002:0001ABC0 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 - 0002:0001ABD4 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 - 0002:0001ABE8 0000190C C=BSS S=.bss G=DGROUP M=UnitFicheHoraire ACBP=A9 - 0002:0001C4F4 00000004 C=BSS S=.bss G=DGROUP M=ShellConsts ACBP=A9 - 0002:0001C4F8 0000001C C=BSS S=.bss G=DGROUP M=ShellCtrls ACBP=A9 - 0002:0001C514 00000CA4 C=BSS S=.bss G=DGROUP M=UnitRoute ACBP=A9 - 0002:0001D1B8 00000008 C=BSS S=.bss G=DGROUP M=UnitRouteTrains ACBP=A9 - 0002:0001D1C0 0000000C C=BSS S=.bss G=DGROUP M=UnitInfo ACBP=A9 - 0002:0001D1CC 00000CB0 C=BSS S=.bss G=DGROUP M=selection_train ACBP=A9 - 0002:0001DE7C 00000020 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 - 0002:0001DE9C 00000034 C=BSS S=.bss G=DGROUP M=UnitClock ACBP=A9 - 0002:0001DED0 004CD3C0 C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 - 0002:004EB290 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 - 0002:004EB2A0 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 - 0002:004EB2B4 00000018 C=BSS S=.bss G=DGROUP M=UnitModifAction ACBP=A9 - 0002:004EB2CC 00000038 C=BSS S=.bss G=DGROUP M=UnitHorloge ACBP=A9 - 0002:004EB304 000001EC C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 - 0002:004EB4F0 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 - 0002:004EB4F4 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 - 0002:004EB500 0656CE08 C=BSS S=.bss G=DGROUP M=Unitprinc ACBP=A9 - 0002:06A58308 000005CC C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 - 0002:06A588D4 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 + 0002:00003E54 00000004 C=BSS S=.bss G=DGROUP M=PsAPI ACBP=A9 + 0002:00003E58 00000004 C=BSS S=.bss G=DGROUP M=OleServer ACBP=A9 + 0002:00003E5C 00000004 C=BSS S=.bss G=DGROUP M=MSCommLib_TLB ACBP=A9 + 0002:00003E60 00000004 C=BSS S=.bss G=DGROUP M=MaskUtils ACBP=A9 + 0002:00003E64 00000004 C=BSS S=.bss G=DGROUP M=Mask ACBP=A9 + 0002:00003E68 00000004 C=BSS S=.bss G=DGROUP M=Grids ACBP=A9 + 0002:00003E6C 00000004 C=BSS S=.bss G=DGROUP M=Spin ACBP=A9 + 0002:00003E70 00002494 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 + 0002:00006304 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 + 0002:00006314 000148B0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 + 0002:0001ABC4 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 + 0002:0001ABD8 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 + 0002:0001ABEC 0000190C C=BSS S=.bss G=DGROUP M=UnitFicheHoraire ACBP=A9 + 0002:0001C4F8 00000004 C=BSS S=.bss G=DGROUP M=ShellConsts ACBP=A9 + 0002:0001C4FC 0000001C C=BSS S=.bss G=DGROUP M=ShellCtrls ACBP=A9 + 0002:0001C518 00000DF4 C=BSS S=.bss G=DGROUP M=UnitRoute ACBP=A9 + 0002:0001D30C 00000008 C=BSS S=.bss G=DGROUP M=UnitRouteTrains ACBP=A9 + 0002:0001D314 0000000C C=BSS S=.bss G=DGROUP M=UnitInfo ACBP=A9 + 0002:0001D320 00000CB4 C=BSS S=.bss G=DGROUP M=selection_train ACBP=A9 + 0002:0001DFD4 00000020 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 + 0002:0001DFF4 00000034 C=BSS S=.bss G=DGROUP M=UnitClock ACBP=A9 + 0002:0001E028 0000000C C=BSS S=.bss G=DGROUP M=UnitIntro ACBP=A9 + 0002:0001E034 004CD3BC C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 + 0002:004EB3F0 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 + 0002:004EB400 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 + 0002:004EB414 00000018 C=BSS S=.bss G=DGROUP M=UnitModifAction ACBP=A9 + 0002:004EB42C 00000038 C=BSS S=.bss G=DGROUP M=UnitHorloge ACBP=A9 + 0002:004EB464 000001EC C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 + 0002:004EB650 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 + 0002:004EB654 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 + 0002:004EB660 0ECAF278 C=BSS S=.bss G=DGROUP M=Unitprinc ACBP=A9 + 0002:0F19A8D8 000005E0 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 + 0002:0F19AEB8 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 Bound resource files @@ -264,6 +268,7 @@ UnitInfo.dfm selection_train.dfm UnitConfigCellTCO.dfm UnitClock.dfm +UnitIntro.dfm UnitTCO.dfm UnitSR.dfm UnitCDF.dfm @@ -278,4 +283,4 @@ Signaux_complexes_GL.res Signaux_complexes_GL.drf -Program entry point at 0001:001F21C0 +Program entry point at 0001:001FABB0 diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 5036909..363a2ee 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -682,7 +682,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabAvance + ActivePage = TabSheetActionneurs Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -1198,11 +1198,11 @@ object FormConfig: TFormConfig object Label5: TLabel Left = 16 Top = 75 - Width = 152 + Width = 151 Height = 26 Caption = - '3. Temporisation d'#39'attente de la r'#233'ponse de l'#39'interface (x 100 m' + - 's)' + '3. Temporisation d'#39'attente de la r'#233'ponse de l'#39'interface (x 50 ms' + + ')' WordWrap = True end object EditcomUSB: TEdit @@ -1297,19 +1297,20 @@ object FormConfig: TFormConfig Left = 312 Top = 8 Width = 297 - Height = 49 + Height = 65 BevelInner = bvLowered BevelKind = bkFlat Lines.Strings = ( '1. Port COM de l'#39'adresse USB de l'#39'interface XpressNet. ' 'COM de 1 '#224' 255 - Si COMX : Signaux complexes d'#233'tecte le ' - 'port automatiquement (mais le d'#233'marrage est plus long)') + 'port automatiquement (mais le d'#233'marrage est plus long)' + 'COMX , vitesse, parit'#233' , Nbre_bits , Bits_stop, protocole') ReadOnly = True TabOrder = 3 end object Memo2: TMemo Left = 312 - Top = 64 + Top = 80 Width = 297 Height = 81 BevelInner = bvLowered @@ -1325,7 +1326,7 @@ object FormConfig: TFormConfig end object Memo3: TMemo Left = 312 - Top = 152 + Top = 168 Width = 297 Height = 89 BevelInner = bvLowered @@ -1409,7 +1410,7 @@ object FormConfig: TFormConfig end object GroupBox22: TGroupBox Left = 312 - Top = 248 + Top = 264 Width = 297 Height = 65 Caption = 'Protocole de connexion '#224' la centrale ou '#224' l'#39'interface' @@ -1835,9 +1836,10 @@ object FormConfig: TFormConfig Top = 20 Width = 33 Height = 21 + Color = clLime TabOrder = 6 Visible = False - OnChange = EditAigTripleChange + OnKeyPress = EditAigTripleKeyPress end object GroupBox21: TGroupBox Left = 8 @@ -2350,6 +2352,9 @@ object FormConfig: TFormConfig Top = 120 Width = 41 Height = 21 + Hint = 'D'#233'tecteur 1 (obligatoire) associ'#233' au signal' + ParentShowHint = False + ShowHint = True TabOrder = 3 OnChange = EditDet1Change end @@ -2358,6 +2363,9 @@ object FormConfig: TFormConfig Top = 120 Width = 41 Height = 21 + Hint = + 'El'#233'ment imm'#233'diatement suivant apr'#232's le d'#233'tecteur 1 (aiguillage o' + + 'u d'#233'tecteur) - Obligatoire' ParentShowHint = False ShowHint = True TabOrder = 4 @@ -2368,6 +2376,9 @@ object FormConfig: TFormConfig Top = 144 Width = 41 Height = 21 + Hint = 'D'#233'tecteur 2 (optionnel) associ'#233' au signal' + ParentShowHint = False + ShowHint = True TabOrder = 5 OnChange = EditDet2Change end @@ -2376,6 +2387,9 @@ object FormConfig: TFormConfig Top = 144 Width = 41 Height = 21 + Hint = + 'El'#233'ment imm'#233'diatement suivant apr'#232's le d'#233'tecteur 2 (aiguillage o' + + 'u signal) - Optionnel' ParentShowHint = False ShowHint = True TabOrder = 6 @@ -2386,6 +2400,9 @@ object FormConfig: TFormConfig Top = 168 Width = 41 Height = 21 + Hint = 'D'#233'tecteur 3 (optionnel) associ'#233' au signal' + ParentShowHint = False + ShowHint = True TabOrder = 7 OnChange = EditDet3Change end @@ -2394,6 +2411,9 @@ object FormConfig: TFormConfig Top = 168 Width = 41 Height = 21 + Hint = + 'El'#233'ment imm'#233'diatement suivant apr'#232's le d'#233'tecteur 3 (aiguillage o' + + 'u d'#233'tecteur) - Optionnel' ParentShowHint = False ShowHint = True TabOrder = 8 @@ -2404,6 +2424,9 @@ object FormConfig: TFormConfig Top = 192 Width = 41 Height = 21 + Hint = 'D'#233'tecteur 4 (optionnel) associ'#233' au signal' + ParentShowHint = False + ShowHint = True TabOrder = 9 OnChange = EditDet4Change end @@ -2412,6 +2435,9 @@ object FormConfig: TFormConfig Top = 192 Width = 41 Height = 21 + Hint = + 'El'#233'ment imm'#233'diatement suivant apr'#232's le d'#233'tecteur 4 (aiguillage o' + + 'u d'#233'tecteur) - Optionnel' ParentShowHint = False ShowHint = True TabOrder = 10 @@ -3598,6 +3624,12 @@ object FormConfig: TFormConfig Font.Style = [fsBold] ParentFont = False end + object ImageTrain: TImage + Left = 16 + Top = 400 + Width = 257 + Height = 49 + end object GroupBox24: TGroupBox Left = 296 Top = 16 @@ -3642,20 +3674,14 @@ object FormConfig: TFormConfig end object Label16: TLabel Left = 16 - Top = 352 + Top = 400 Width = 27 Height = 13 Caption = 'Ic'#244'ne' end - object ImageTrain: TImage - Left = 16 - Top = 376 - Width = 257 - Height = 49 - end object SpeedButtonOuvre: TSpeedButton Left = 120 - Top = 344 + Top = 392 Width = 23 Height = 22 Hint = 'Charger ic'#244'ne' @@ -3665,7 +3691,7 @@ object FormConfig: TFormConfig OnClick = SpeedButtonOuvreClick end object Label45: TLabel - Left = 26 + Left = 10 Top = 232 Width = 111 Height = 39 @@ -3675,6 +3701,13 @@ object FormConfig: TFormConfig 'nt)' WordWrap = True end + object Label46: TLabel + Left = 24 + Top = 328 + Width = 34 + Height = 13 + Caption = 'Routes' + end object EditNomTrain: TEdit Left = 136 Top = 24 @@ -3732,7 +3765,7 @@ object FormConfig: TFormConfig end object EditIcone: TEdit Left = 168 - Top = 344 + Top = 392 Width = 121 Height = 21 TabOrder = 5 @@ -3766,9 +3799,9 @@ object FormConfig: TFormConfig OnClick = CheckBoxSensClick end object StringGridArr: TStringGrid - Left = 144 + Left = 136 Top = 192 - Width = 169 + Width = 177 Height = 113 TabOrder = 8 OnSelectCell = StringGridArrSelectCell @@ -3780,6 +3813,15 @@ object FormConfig: TFormConfig 24 24) end + object MemoRoutes: TMemo + Left = 120 + Top = 312 + Width = 185 + Height = 57 + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 9 + end end object ButtonNT: TButton Left = 8 diff --git a/UnitConfig.pas b/UnitConfig.pas index a37bea4..3d3e756 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -328,7 +328,6 @@ type PopupMenuActions: TPopupMenu; ModifAction: TMenuItem; Label16: TLabel; - ImageTrain: TImage; EditIcone: TEdit; SpeedButtonOuvre: TSpeedButton; LabeledEditTempoD: TLabeledEdit; @@ -351,6 +350,9 @@ type RadioGroupLEB: TRadioGroup; Label45: TLabel; StringGridArr: TStringGrid; + ImageTrain: TImage; + Label46: TLabel; + MemoRoutes: TMemo; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton; @@ -404,7 +406,6 @@ type procedure EditDet4Change(Sender: TObject); procedure EditSuiv4Change(Sender: TObject); procedure EditSpecUniChange(Sender: TObject); - procedure EditAigTripleChange(Sender: TObject); procedure EditPointe_BGChange(Sender: TObject); procedure EditDroit_BDChange(Sender: TObject); procedure EditDevie_HDChange(Sender: TObject); @@ -537,6 +538,7 @@ type var CanSelect: Boolean); procedure StringGridArrSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); + procedure EditAigTripleKeyPress(Sender: TObject; var Key: Char); private { Déclarations privées } @@ -566,6 +568,7 @@ PortServeur_ch='Port_Serveur'; AntiTimeoutEthLenz_ch='AntiTimeoutEthLenz'; TempoTC_ch='TempoTC'; Verif_AdrXpressNet_ch='Verif_AdrXpressNet'; +debugRoulage_ch='debugRoulage'; Filtrage_det_ch='Filtrage_det'; nCantons_Res_ch='nCantonsRes'; MaxSignalSens_ch='Max_Signal_Sens'; @@ -629,7 +632,8 @@ HauteurFC_ch='HauteurFC'; OffsetXFC_ch='OffsetXC'; // .Left de la fenêtre clock OffsetYFC_ch='OffsetYC'; option_demitour_ch='Option_demiTour'; - +MaxParcours_ch='MaxParcours'; +MaxRoutes_ch='MaxRoutes'; PosSplitter_ch='Splitter'; horlogeInterne_ch='HorlogeInterne'; LanceHorl_ch='LanceHorl'; @@ -683,7 +687,8 @@ var // composants dynamiques Gp1,GroupBoxAvance,GroupBoxExpert,GroupBoxChemin,GroupBoxAff : TGroupBox; - CheckBoxCR,Cb1,Cb2,Cb3,CbVis,cbDTR,cbRTS,cbAffSig,cbres,cbAck,CheckBoxOptionDemiTour : TCheckBox; + CheckBoxCR,Cb1,Cb2,Cb3,CbVis,cbDTR,cbRTS,cbAffSig,cbres,cbAck,CheckBoxOptionDemiTour, + cbDebugRoulage : TCheckBox; MemoPeriph : Tmemo; @@ -693,8 +698,9 @@ var EditZdet1V3F,EditZdet2V3F,EditZdet1V3O,EditZdet2V3O, EditZdet1V4F,EditZdet2V4F,EditZdet1V4O,EditZdet2V4O, EditZdet1V5F,EditZdet2V5F,EditZdet1V5O,EditZdet2V5O,EditOuvreEcran, - EditNbDetDist,EditNbCantons,EditFiltrDet,EditAlgo,EditChemin, - EditMaxSignalSens,EditnCantonsRes,EditAntiTO,EditRep,EditTempoTC : Tedit; + EditNbDetDist,EditNbCantons,EditFiltrDet,EditAlgo,EditChemin,EditMaxParcours, + EditMaxSignalSens,EditnCantonsRes,EditAntiTO,EditRep,EditTempoTC, + EditMaxRoutes : Tedit; EditT : Array[1..10] of Tedit; TextBoxCde : array[1..19] of Tedit; @@ -703,7 +709,7 @@ var LbZTitre,LbZPnVoie1,LbZPnVoie2,LbZPnVoie3,LbZPnVoie4,LbZPnVoie5,LabelMP,LabelNumeroP, LabelStyle,LabelOuvreEcran,LabelAvance1,LabelAvance2,LabelAntiTO,LabelCDM, LabelTD,LabelNC,LabelFiltre,LabelAlgo,LabelNbSignBS,LabelnCantonsRes,LabelTempoTC, - LabelChemin : Tlabel; + LabelChemin,LabelMaxParcours,LabelRoutes : Tlabel; RadioReserve,RadioServeurCDM,rgPilTrains : TradioGroup; @@ -1279,7 +1285,7 @@ begin // adresse de signal val(s,adresse,erreur); if adresse=0 then begin affiche('Erreur 671 ligne '+s,clred);exit;end; - // vérifier si le signal existe pour ne pas le stocker + // vérifier si le signal existe déja pour ne pas le restocker for id:=1 to NbreSignaux do begin if Signaux[id].adresse=adresse then @@ -1878,7 +1884,6 @@ end; function Train_tablo(index : integer) : string; var s: string; nc,i : integer; - begin with trains[index] do begin @@ -1890,13 +1895,13 @@ begin for i:=1 to ncantons do begin nc:=DetecteurArret[i].detecteur; - if nc<>0 then + if nc<>0 then begin s:=s+',P'; if detecteurArret[i].TPrec=aig then s:=s+'A'; s:=s+intToSTR(detecteurArret[i].Prec); s:=s+',D'+intToSTR(nc)+',T'+intToSTR(DetecteurArret[i].temps); - end; + end; end; end; result:=s; @@ -1935,6 +1940,8 @@ begin writeln(fichierN,debug_ch+'=',debug); if sombre then s:='1' else s:='0'; writeln(fichierN,sombre_ch+'=',s); + if debugRoulage then s:='1' else s:='0'; + writeln(fichierN,debugRoulage_ch+'=',s); writeln(fichierN,couleur_fond_ch+'='+IntToHex(couleurFond,6)); if serveurIPCDM_Touche then s:='1' else s:='0'; writeln(fichierN,serveurIPCDM_Touche_ch+'='+s); @@ -1993,6 +2000,9 @@ begin // temporisation initialisation des aiguillages writeln(fichierN,Tempo_aig_ch+'=',IntToSTR(Tempo_aig)); + writeln(fichierN,MaxParcours_ch+'=',IntToSTR(MaxParcours)); + writeln(fichierN,MaxRoutes_ch+'=',IntToSTR(MaxRoutes)); + // connexion de l'interface en COM/USB if AvecDemandeInterfaceUSB then s:='1' else s:='0'; writeln(fichierN,Init_dem_interfaceUSBCOM_ch+'='+s); @@ -2176,18 +2186,6 @@ begin end; writeln(fichierN,'0'); - // Fonctions Fx - // actionneurs Train ou accessoire - { - writeln(fichierN,'/------------'); - writeln(fichierN,section_act_ch); - for i:=1 to maxTablo_act do - begin - s:=encode_act_loc_son(i); - if s<>'' then writeln(fichierN,s); - end; - } - writeln(fichierN,'/------------'); writeln(fichierN,section_PN_ch); // PN @@ -2199,7 +2197,7 @@ begin writeln(fichierN,'0'); writeln(fichierN,'/------------'); - // actionnneurs V2 + // actions writeln(fichierN,section_actV2_ch); for i:=1 to maxTablo_act do begin @@ -2228,7 +2226,9 @@ begin writeln(fichierN,section_trains_ch); for i:=1 to ntrains do begin + // route du train : writeln(fichierN,Train_tablo(i)); + if trains[i].route[0].adresse<>0 then Writeln(fichierN,'{'+route_totale_to_string(trains[i].routePref)+'}'); end; writeln(fichierN,'0'); @@ -2368,7 +2368,7 @@ end; // trier les aiguillages par adresses croissantes procedure trier_aig; -var i,j : integer; +var i,j,adr : integer; temp : TAiguillage; s : string; begin @@ -2385,8 +2385,25 @@ begin end; end; + // attribue les index for i:=1 to MaxAiguillage do - tablo_index_aiguillage[aiguillage[i].adresse]:=i; + begin + adr:=aiguillage[i].adresse; + tablo_index_aiguillage[adr]:=i; + aiguillage[i].visible:=true; + end; + + // trouve les triple + // attribue les index + for i:=1 to MaxAiguillage do + begin + if aiguillage[i].modele=triple then + begin + j:=index_aig(aiguillage[i].adrTriple); + aiguillage[j].visible:=false; + end; + end; + // réaffecte la listebox aiguillages if formconfig<>nil then @@ -2475,7 +2492,7 @@ var train,s,sa,SOrigine: string; trouve_section_branche,trouve_section_sig,trouve_section_act,trouve_tempo_signal, trouve_algo_uni,croi,trouve_Nb_cantons_Sig,trouve_dem_aig,trouve_demcnxCOMUSB,trouve_demcnxEth : boolean; - virgule,i_detect,i,erreur,aig2,detect,offset,j,position, + virgule,i_detect,erreur,aig2,detect,offset,j,position,i, ComptEl,Compt_IT,Num_Element,adr,Nligne,postriple,itl,vers, postjd,postjs,nv,it,Num_Champ,asp,adraig,poscroi,idtrain : integer; tabloDet : TTabloDet; @@ -3316,6 +3333,8 @@ var train,s,sa,SOrigine: string; if debugConfig then Affiche('Adresse='+IntToSTR(adraig)+' enregistrement='+Enregistrement,clyellow); aiguillage[maxaiguillage].Adresse:=adraig; aiguillage[maxaiguillage].AncienAdresse:=adraig; + aiguillage[maxaiguillage].visible:=true; + tablo_index_aiguillage[adrAig]:=maxaiguillage; // stockage index avant tri aiguillage[maxaiguillage].AdroitB:='Z'; aiguillage[maxaiguillage].AdevieB:='Z'; aiguillage[maxaiguillage].DdroitB:='Z'; aiguillage[maxaiguillage].DdevieB:='Z'; @@ -3537,6 +3556,7 @@ var train,s,sa,SOrigine: string; inc(itl); until (enregistrement='') or (itl>3); if itl>4 then begin Affiche('Erreur 400 ligne '+sOrigine,clred);exit;end; + end; until (sOrigine='0'); end; @@ -3709,12 +3729,49 @@ var train,s,sa,SOrigine: string; until eof(fichier) or (s='0'); end; + procedure compile_route(s : string); + var v,i,erreur,n : integer; + begin + s:=lowercase(s); + if s[1]='{' then delete(s,1,1); + n:=0;i:=1; + with trains[ntrains] do + repeat + val(s,v,erreur); //{540->91 dev->92 droit->105 droit->106 droit->566} + routePref[i].adresse:=v; + delete(s,1,erreur-1); + if (s[1]='-') or (s[1]='}') then begin routePref[i].typ:=det;routePref[i].pos:=0;end + else + begin + if s[1]=' ' then delete(s,1,1); + routePref[i].typ:=aiguillage[index_aig(v)].modele; // type de l'aiguillage; + if copy(s,1,3)='dev' then begin delete(s,1,3);routePref[i].pos:=const_devie;end; + if copy(s,1,5)='droit' then begin delete(s,1,5);routePref[i].pos:=const_droit;end; + end; + delete(s,1,2); + inc(i); + + until length(s)<2; + trains[ntrains].routePref[0].adresse:=i-1; + end; + procedure compile_trains; var i,erreur : integer; begin ntrains:=0; repeat lit_ligne; + + if length(s)>0 then + if s[1]='{' then + begin + compile_route(s); + while (pos('}',s)<>0) do + begin + lit_ligne; + end; + end; + if s<>'0' then begin inc(ntrains); @@ -4421,6 +4478,15 @@ var train,s,sa,SOrigine: string; PilotageTrainsCDMNom:=s='1'; end; + sa:=uppercase(debugRoulage_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + inc(nv); + delete(s,i,length(sa)); + debugRoulage:=s='1'; + end; + // avec demande de position des aiguillages en mode autonome au démarrage sa:=uppercase(Init_dem_aig_ch)+'='; i:=pos(sa,s); @@ -4534,6 +4600,30 @@ var train,s,sa,SOrigine: string; val(s,Tempo_Aig,erreur); end; + sa:=uppercase(MaxParcours_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + inc(nv); + trouve_Tempo_aig:=true; + delete(s,i,length(sa)); + val(s,MaxParcours,erreur); + if MaxParcours<50 then MaxParcours:=50; + if MaxParcours>MaxParcoursTablo then maxParcours:=MaxParcoursTablo; + end; + + sa:=uppercase(MaxRoutes_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + inc(nv); + trouve_Tempo_aig:=true; + delete(s,i,length(sa)); + val(s,MaxRoutes,erreur); + if MaxRoutes<5000 then MaxRoutes:=5000; + if MaxRoutes>MaxRoutesCte then maxRoutes:=MaxRoutesCte; + end; + // temporisation décodeurs de signal sa:=uppercase(Tempo_Signal_ch)+'='; i:=pos(sa,s); @@ -4778,7 +4868,6 @@ var train,s,sa,SOrigine: string; compile_PN; end; - // section actionneurs sa:=uppercase(section_actV2_ch); if pos(sa,s)<>0 then @@ -4786,7 +4875,6 @@ var train,s,sa,SOrigine: string; compile_actions; end; - // section dcc++ sa:=uppercase(section_dccpp_ch); if pos(sa,s)<>0 then @@ -5163,6 +5251,16 @@ begin if (i<0) or (i>10) then i:=1; TempoTC:=i; + val(EditMaxParcours.Text,i,erreur); + MaxParcours:=i; + if MaxParcours<50 then MaxParcours:=50; + if MaxParcours>MaxParcoursTablo then maxParcours:=MaxParcoursTablo; + + val(EditMaxRoutes.Text,i,erreur); + MaxRoutes:=i; + if MaxRoutes<5000 then MaxRoutes:=5000; + if MaxRoutes>MaxRoutesCte then maxRoutes:=MaxRoutesCte; + Val(editTempoAig.Text,i,erreur); if i>3000 then begin labelInfo.Caption:='Temporisation de séquencement incorrecte ';ok:=false;end; Tempo_Aig:=i; @@ -5271,6 +5369,7 @@ begin AvecDemandeInterfaceEth:=CheckBoxDemarEth.checked; AffSig:=cbAffSig.Checked; AffRes:=cbRes.checked; + DebugRoulage:=cbDebugRoulage.Checked; AvecAck:=cbAck.Checked; Option_DemiTour:=CheckBoxOptionDemiTour.checked; sombre:=CheckBoxSombre.Checked; @@ -6018,7 +6117,7 @@ begin ColWidths[0]:=0; // colonne grise invisible ColWidths[1]:=55; // Précédent ColWidths[2]:=55; // détecteur - ColWidths[3]:=35; // temps + ColWidths[3]:=38; // temps Cells[1,0]:='Précédent'; Cells[2,0]:='Détecteur'; @@ -6058,8 +6157,7 @@ begin labelD12.Caption:='D12 x64'; LabelD12.Left:=730; {$ENDIF} - - + rgPilTrains:=TRadioGroup.Create(FormConfig.TabSheetPeriph); with rgPilTrains do begin @@ -7143,7 +7241,7 @@ begin GroupBoxAvance:=TGroupBox.Create(FormConfig.TabAvance); with GroupBoxAvance do begin - Left:=3;Top:=40;Width:=300;Height:=190; // maxi=580 + Left:=3;Top:=40;Width:=300;Height:=220; // maxi=580 caption:='Jeu de paramètres avancés'; name:='GroupBoxAvance'; parent:=TabAvance; @@ -7226,7 +7324,7 @@ begin text:=''; parent:=GroupBoxAvance; hint:='Nombre de cantons à réserver (1 à 5) en avant du train.'+#13+ - 'Utilisé en mode roulage ou réservation [sous mode réservation par canton (ci-dessous)].'+#13+ + 'Utilisé en mode roulage.'+#13+ 'Cette valeur dépend de la taille du réseau.'; ShowHint:=true; end; @@ -7272,10 +7370,50 @@ begin ShowHint:=true; end; + LabelMaxParcours:=TLabel.Create(FormConfig.TabAvance); + with LabelMaxParcours do + begin + Left:=10;Top:=152;Width:=170;Height:=12; + caption:='Nombre maximal d''éléments par route'; + name:='LabelMaxParcours'; + parent:=GroupBoxAvance; + end; + EditMaxParcours:=TEdit.Create(FormConfig.TabAvance); + with EditMaxParcours do + begin + Left:=x;Top:=152;Width:=30;Height:=15; + name:='EditMaxParcours'; + text:=''; + parent:=GroupBoxAvance; + s:='Nombre maximal d''éléments par route lors de la proposition du calcul des routes'+#13+'Maxi='+IntToSTR(MaxParcoursTablo); + hint:=s; + ShowHint:=true; + end; + + LabelRoutes:=TLabel.Create(FormConfig.TabAvance); + with LabelRoutes do + begin + Left:=10;Top:=173;Width:=170;Height:=12; + caption:='Nombre maximal de routes'; + name:='LabelRoutes'; + parent:=GroupBoxAvance; + end; + EditMaxRoutes:=TEdit.Create(FormConfig.TabAvance); + with EditMaxRoutes do + begin + Left:=x-10;Top:=173;Width:=40;Height:=15; + name:='EditMaxRoutes'; + text:=''; + parent:=GroupBoxAvance; + s:='Nombre maximal de routes lors de la proposition du calcul des routes'+#13+'Maxi='+intToSTR(MaxRoutesCte); + hint:=s; + ShowHint:=true; + end; + CheckBoxOptionDemiTour:=TCheckBox.Create(FormConfig.TabAvance); with CheckBoxOptionDemiTour do begin - Left:=10;Top:=152;Width:=170;Height:=12; + Left:=10;Top:=194;Width:=170;Height:=17; caption:='Option demi tour des trains'; name:='CheckBoxOptionDemiTour'; parent:=GroupBoxAvance; @@ -7349,7 +7487,7 @@ begin cbAck:=tCheckBox.Create(FormConfig.TabAvance); with cbAck do begin - Left:=10;Top:=85;Width:=200;Height:=15; + Left:=10;Top:=85;Width:=200;Height:=17; name:='cbAck'; caption:='Attendre ACK de la centrale'; parent:=GroupBoxExpert; @@ -7437,15 +7575,25 @@ begin showHint:=true; parent:=GroupBoxAff; end; + cbDebugRoulage:=TcheckBox.Create(formconfig.TabAvance); + with cbDebugRoulage do + begin + Left:=15;Top:=70;Width:=200;Height:=17; + caption:='Debug roulage'; + name:='cbDebugRoulage'; + hint:='Affiche des messages en mode roulage des trains en mode autonome'; + showHint:=true; + parent:=GroupBoxAff; + end; ImageSignaux.picture.Assign(formpilote.ImageSignaux.Picture); EditComUSB.Hint:='COMX:vitesse,parité,nombre de bits,bits de stop,protocole'+#13+ - 'procotole = 0 : sans protocole, avec temporisation d''envoi entre trames (Genli, LZV200)'+#13+ + 'procotole = 0 : sans protocole, avec temporisation d''envoi entre trames (LZV200)'+#13+ ' = 1 : protocole logiciel XON-XOFF avec temporisation d''envoi'+#13+ ' = 2 : protocole matériel RTS-CTS sans temporisation d''envoi (Interfaces Lenz LI)'+#13+ ' = 3 : Non utilisé'+#13+ - ' = 4 : contrôle de la ligne CTS avant d''émettre un caractère avec temporisation d''envoi'; + ' = 4 : contrôle de la ligne CTS avant d''émettre un caractère avec temporisation d''envoi (Genli)'; EditComUSB.showHint:=true; ListBoxAig.Height:=382; @@ -7623,6 +7771,11 @@ begin GroupBox10.Visible:=true; checkInverse.Visible:=true; + GroupBox16.Enabled:=aiguillage[ind].visible; + EditAdrAig.Enabled:=aiguillage[ind].visible; + BoutSupAig.enabled:=aiguillage[ind].visible; + ComboBoxAig.Enabled:=aiguillage[ind].visible; + // tjd if tjd or tjs or croi then begin @@ -7803,6 +7956,8 @@ begin EditDroit_BD.Hint:=TypeElAIg_to_char(aiguillage[index].Adroit,aiguillage[index].AdroitB); if tri then begin + Label20.Visible:=true; + ComboBoxAig.ItemIndex:=3; // index de la combobox 0=aiguillage 1=TJD 2=TJS 3=aiguillage triple EditAigTriple.Visible:=true; labelTJD1.Visible:=false; @@ -7816,7 +7971,6 @@ begin EditDevieS2.text:=intToSTR(aiguillage[index].Adevie2)+aiguillage[index].Adevie2B; i:=aiguillage[index].Adrtriple; EditAigTriple.Text:=intToSTR(i); - if i=0 then EditAigTriple.Color:=clred else EditAigTriple.Color:=clWindow; end; end; end; @@ -9820,8 +9974,65 @@ begin supprime_pn; end; +function nombre_adresses_signal(adr : integer) : integer; +var x,dec,nc,i,j : integer; +begin + nc:=0; + i:=index_Signal(adr); + dec:=Signaux[i].decodeur; + x:=Signaux[i].aspect; + + // signal directionnel + if isDirectionnel(i) then + begin + nombre_adresses_signal:=x-10; + exit; + end; + + // nc=nombre d'adresses du signal + if dec=0 then nc:=1; // rien, occupe quand meme une adresse + if dec=1 then nc:=14; // digitalbahn + if dec=2 then nc:=signaux[i].Na; // cdf + if dec=3 then nc:=8; // ldt LS dec sncf + if dec=4 then nc:=8; // leb + if dec=5 then nc:=Signaux[i].Na; // digikeijs + if dec=6 then // paco unisemaf + begin + x:=Signaux[index].Unisemaf; // modèle + case x of + 2 : nc:=1; + 3,4 : nc:=2; + 51,52 : nc:=3; + 71 : nc:=2; + 72,73 : nc:=3; + 91,92 : nc:=3; + 93,94,95,96,97,98,99 : nc:=4; + end; + end; + if dec=7 then nc:=Signaux[i].Na; // SR + if dec=8 then // arcomora + begin + case x of + 3 : nc:=3; + 4,5 : nc:=4; + 7 : nc:=5; + 9 : nc:=5; + end; + end; + if dec=9 then nc:=2; // LS-DEC-NMBS + if dec=10 then nc:=Signaux[i].Na; // Bmodels + if dec>=NbDecodeurdeBase then + begin + j:=dec-NbDecodeurdeBase+1; + nc:=decodeur_pers[j].NbreAdr; + end; + + nombre_adresses_signal:=nc; +end; + + procedure ajoute_signal; -var i,AdrMax : integer; +var i,na,AdrMax : integer; s : string; begin clicliste:=true; @@ -9836,14 +10047,25 @@ begin inc(NbreSignaux); - AdrMax:=0; + AdrMax:=0;na:=0; for i:=1 to NbreSignaux do begin - if AdrMax0 then na:=Nombre_adresses_signal(AdrMax); i:=NbreSignaux; - Signaux[i].Adresse:=AdrMax+20; + if AdrMax+na>=MaxAcc then + begin + s:='L''adresse maximale de '+intToSTR(AdrMax)+' pour les signaux a été atteinte.'+#13+ + 'Veuillez compacter la liste des signaux sur leurs adresses'; + Application.MessageBox(pchar(s),pchar('Erreur'), MB_Ok or MB_ICONERROR ); + exit; + end; + Signaux[i].Adresse:=AdrMax+na; Signaux[i].Aspect:=3; Signaux[i].decodeur:=0; Signaux[i].verrouCarre:=false; @@ -9864,16 +10086,6 @@ begin Signaux[i].SR[8].sortie0:=19; Signaux[i].SR[8].sortie1:=0; Signaux[i].Na:=4; - - - - - - - - - - cree_image(i); s:=encode_signal(i); @@ -9883,7 +10095,7 @@ begin items.add(s); selected[i-1]:=true; SetFocus; - perform(WM_VSCROLL,SB_BOTTOM,0); + perform(WM_VSCROLL,SB_BOTTOM,0); end; formCOnfig.LabelInfo.caption:=''; @@ -10083,62 +10295,6 @@ begin verif_extr_branches:=Erreur; end; -function nombre_adresses_signal(adr : integer) : integer; -var x,dec,nc,i,j : integer; -begin - nc:=0; - i:=index_Signal(adr); - dec:=Signaux[i].decodeur; - x:=Signaux[i].aspect; - - // signal directionnel - if isDirectionnel(i) then - begin - nombre_adresses_signal:=x-10; - exit; - end; - - // nc=nombre d'adresses du signal - if dec=0 then nc:=0; // rien - if dec=1 then nc:=14; // digitalbahn - if dec=2 then nc:=signaux[i].Na; // cdf - if dec=3 then nc:=8; // ldt LS dec sncf - if dec=4 then nc:=8; // leb - if dec=5 then nc:=Signaux[i].Na; // digikeijs - if dec=6 then // paco unisemaf - begin - x:=Signaux[index].Unisemaf; // modèle - case x of - 2 : nc:=1; - 3,4 : nc:=2; - 51,52 : nc:=3; - 71 : nc:=2; - 72,73 : nc:=3; - 91,92 : nc:=3; - 93,94,95,96,97,98,99 : nc:=4; - end; - end; - if dec=7 then nc:=Signaux[i].Na; // SR - if dec=8 then // arcomora - begin - case x of - 3 : nc:=3; - 4,5 : nc:=4; - 7 : nc:=5; - 9 : nc:=5; - end; - end; - if dec=9 then nc:=2; // LS-DEC-NMBS - if dec=10 then nc:=Signaux[i].Na; // Bmodels - if dec>=NbDecodeurdeBase then - begin - j:=dec-NbDecodeurdeBase+1; - nc:=decodeur_pers[j].NbreAdr; - end; - - nombre_adresses_signal:=nc; -end; - //vérifie si il n'y a pas de doublon dans l'adresse des trains function verif_trains : boolean; var i,j,adr : integer; @@ -10168,7 +10324,7 @@ end; function verif_coherence : boolean; var AncAdr,i,j,k,l,Indexaig,adr,adr2,extr,detect,condcarre,nc,index2,SuivAdr,indexTCO,AdrAig, - x,y,extr2,adr3,index3,det1Br,det2Br,det1index,det2index,adresse,Adresse2,dec,nc2,op, + x,y,extr2,adr3,adr4,index3,det1Br,det2Br,det1index,det2index,adresse,Adresse2,dec,nc2,op, delta : integer; modAig,AncModel,model,km,SuivModel,model2,t1,t2: TEquipement; c : char; @@ -10313,10 +10469,13 @@ begin else begin AdrAig:=aiguillage[IndexAig].Adresse; + //Affiche(intToSTR(adrAig),clred); + delta:=0; - repeat - inc(delta); - until (brancheN[branche_trouve,indexBranche_trouve-delta].BType<>act) or (indexBranche_trouve-delta=0); // pour passer un actionneur éventuel + if indexBranche_trouve>1 then + repeat + inc(delta); + until (brancheN[branche_trouve,indexBranche_trouve-delta].BType<>act) or (indexBranche_trouve-delta=0); // pour passer un actionneur éventuel if indexBranche_trouve-delta>0 then det1br:=brancheN[branche_trouve,indexBranche_trouve-delta].Adresse // adresse avant détecteur else det1br:=0; @@ -10326,7 +10485,7 @@ begin until (brancheN[branche_trouve,indexBranche_trouve+delta].BType<>act); // pour passer un actionneur éventuel det2br:=brancheN[branche_trouve,indexBranche_trouve+delta].Adresse; // adresse après détecteur - if (det1br<>AdrAig) and (det2br<>AdrAig) and (adr<>0) then + if (det1br<>AdrAig) and (det2br<>AdrAig) and (adr<>0) and (aiguillage[indexAig].visible) then begin Affiche('Erreur 22.2: Le détecteur '+intToSTR(adr)+' est décrit dans l''aiguillage '+intToSTR(aiguillage[Indexaig].adresse)+' mais déclaré dans la ',clred); s:='branche '+intToSTR(Branche_trouve)+' entre'; @@ -10689,7 +10848,7 @@ begin begin adr:=aiguillage[indexaig].Adresse; model:=aiguillage[indexaig].modele; - + if adr>NbMaxDet then begin Affiche('Erreur 9.11: adresse aiguillage trop grand: '+intToSTR(adr),clred); @@ -10697,7 +10856,7 @@ begin end; // on ne vérifie pas les tjd tjs crois - if (model<>tjd) and (model<>tjd) and (model<>crois) then + //if (model<>tjd) and (model<>tjd) and (model<>crois) then begin adr2:=aiguillage[indexaig].ADroit; // adresse de ce qui est connecté sur la position droite @@ -10707,6 +10866,7 @@ begin if adr2=adr then affiche('Erreur 10.0 : la position droite de l''aiguillage '+intToSTR(adr)+' pointe sur elle même',clred); index2:=Index_aig(adr2); // adresse de l'aiguillage connecté model2:=aiguillage[index2].modele; // modèle de l'aiguillage connecté + begin // tjs ou tjs à 2 états ou croisement if ( ((model2=tjs) or (model2=tjd)) and (aiguillage[index2].EtatTJD=2) ) or (model2=crois) then @@ -10737,7 +10897,7 @@ begin if c='D' then begin extr:=aiguillage[index2].ADroit; - if adr<>extr then + if adr<>extr then begin Affiche('Erreur 10.23: Discordance de déclaration aiguillages '+intToSTR(adr)+'D: '+intToSTR(adr2)+'D différent de '+intToSTR(extr),clred); ok:=false; @@ -10746,7 +10906,7 @@ begin if c='S' then begin extr:=aiguillage[index2].ADevie; - if adr<>extr then + if adr<>extr then begin Affiche('Erreur 10.24: Discordance de déclaration aiguillages '+intToSTR(adr)+'D: '+intToSTR(adr2)+'S différent de '+intToSTR(extr),clred); ok:=false; @@ -10755,7 +10915,7 @@ begin if c='P' then begin extr:=aiguillage[index2].APointe; - if adr<>extr then + if adr<>extr then begin Affiche('Erreur 10.25: Discordance de déclaration aiguillages '+intToSTR(adr)+'D: '+intToSTR(adr2)+'P différent de '+intToSTR(extr),clred); ok:=false; @@ -11069,6 +11229,7 @@ begin adr:=TCO[indexTCO,x,y].adresse; if (index_aig(adr)=0) and (adr<>0) then begin + Affiche('Un aiguillage '+IntToSTR(adr)+' est déclaré dans le TCO'+intToSTR(indexTCO)+' ['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred); ok:=false; end; @@ -11099,6 +11260,66 @@ begin end; end; + // vérifier la cohérence des TJD 4 états avec les branches + for Indexaig:=1 to maxaiguillage do + //indexaig:=index_aig(93); + begin + adr:=aiguillage[indexaig].Adresse; + model:=aiguillage[indexaig].modele; + + if (model=tjd) or (model=tjs) and (aiguillage[indexAig].EtatTJD=4) then + begin + l:=1; // offset branche commence la recherche en 1 + j:=0; // offset dans branche + adresse:=aiguillage[indexAig].ADroit; // élements de la tjd + adresse2:=aiguillage[indexAig].ADevie; + Adrok:=false; + Branche_trouve:=0; + repeat + j:=1; + repeat + k:=branche_trouve; // ancien + trouve_element_V1(adr,tjd,l,0,j,false,0); // indexs de la tjd dans les branches + if branche_trouve<>0 then + begin + if indexBranche_Trouve>1 then Adrok:=Adrok or (BrancheN[Branche_trouve,indexBranche_Trouve-1].Adresse=adresse); + + // pour la rechercher en +, incrémenter l'indexbranche jusqu'à trouve un non actionneur + repeat + sort:=BrancheN[Branche_trouve,indexBranche_Trouve+1].BType<>act; + if not(sort) then inc(IndexBranche_trouve); + if sort then Adrok:=Adrok or (BrancheN[Branche_trouve,indexBranche_Trouve+1].Adresse=adresse) ; + until sort; + + if indexBranche_Trouve>1 then Adrok:=Adrok or (BrancheN[Branche_trouve,indexBranche_Trouve-1].Adresse=adresse2); + + repeat + sort:=BrancheN[Branche_trouve,indexBranche_Trouve+1].BType<>act; + if not(sort) then inc(IndexBranche_trouve); + if sort then Adrok:=Adrok or (BrancheN[Branche_trouve,indexBranche_Trouve+1].Adresse=adresse2) ; + until sort; + + if not(Adrok) then + begin + Affiche('La TJD '+intToSTR(adr)+' décrite n''est pas cohérente avec les élements contigus dans la branche '+intToSTR(Branche_trouve)+' :',clred); + s:='TJD extrémités -> '+intToSTR(adresse)+','+intToSTR(adresse2)+' mais trouvé '; + extr:=BrancheN[Branche_trouve,indexBranche_Trouve-1].Adresse; + if extr<>0 then s:=s+intToSTR(extr); + extr:=BrancheN[Branche_trouve,indexBranche_Trouve+1].Adresse; + if extr<>0 then s:=s+' '+intToSTR(extr); + s:=s+' dans la branche '+intToSTR(Branche_trouve); + Affiche(s,clred); + ok:=false; + end; + j:=IndexBranche_trouve+1; + l:=branche_trouve; + end; + until (branche_trouve=0) ; + l:=Branche_trouve+1; + until (Branche_trouve=0); + end; + end; + // 10 trains if not(verif_trains) then ok:=false; @@ -11107,6 +11328,8 @@ begin val(copy(portcom,i+1,j-i),vitesse,l); if (protocole=2) and (vitesse<>115200) then Affiche('La vitesse COM/USB en procotole DCC++ doit être de 115200 bauds',clred); + + // si xpressnet, pas d'accesoires interférant avec les détecteurs AdrOk:=True; if Verif_AdrXpressNet=1 then @@ -11368,8 +11591,9 @@ end; // supprime le ou les aiguillages sélectionnés dans le richEdit procedure supprime_aig; -var n,i,j : integer; +var n,i,j,AdrTri : integer; s,ss : string; + trouve : boolean; begin ss:=''; n:=0; @@ -11377,7 +11601,22 @@ begin begin if formconfig.ListBoxAig.selected[i] then begin - ss:=ss+ intToSTR(aiguillage[i+1].adresse)+' '; + // si triple, supprimer aussi l'homologue + if Aiguillage[i+1].modele=triple then + begin + AdrTri:=aiguillage[i+1].Adrtriple; + j:=0; + repeat + trouve:=Aiguillage[j+1].Adresse=adrTri; + if trouve then + begin + formconfig.ListBoxAig.selected[j]:=true; + ss:=ss+intToSTR(adrTri)+' '; + end; + inc(j); + until (j>MaxAiguillage-1) or trouve; + ss:=ss+ intToSTR(aiguillage[i+1].adresse)+' '; + end; inc(n); end; end; @@ -11394,6 +11633,7 @@ begin Aig_sauve.adresse:=0; // dévalider sa définition Formconfig.editAdrAig.text:=''; // annule l'adresse, ce qui évite le plantage quand on clique sur un champ de l'aiguillage + // suppression n:=0; i:=1; @@ -12309,47 +12549,10 @@ begin ListBoxSig.Items[ligneClicSig]:=s; LabelInfo.Caption:=''; clicListe:=false; -end; - - -procedure TFormConfig.EditAigTripleChange(Sender: TObject); - var s : string; - i,erreur,index : integer; - model: TEquipement; -begin - if clicliste then exit; - if ligneclicAig<0 then exit; - if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAig then - with Formconfig do - begin - s:=EditAigTriple.Text; - Val(s,i,erreur); - index:=ligneclicAig+1; - if index=0 then exit; - - model:=aiguillage[index].modele; - if (model=triple) then - begin - if (erreur<>0) then begin LabelInfo.caption:='Erreur adresse aiguillage ';exit;end; - // vérifier si l'adresse de l'aiguillage existe déja - if (aiguillage[Index_Aig(i)].modele<>rien) then - begin - LabelInfo.caption:='aiguillage '+IntToSTR(i)+' existe déja - ne sera pas écrasé' ; - EditAigTriple.Color:=clred; - exit; - end ; - if i=0 then EditAigTriple.Color:=clred else EditAigTriple.Color:=clWindow; - LabelInfo.caption:=''; - - aiguillage[index].AdrTriple:=i; - aiguillage[index].modifie:=true; - s:=encode_aig(index); - formconfig.ListBoxAig.items[ligneclicAig]:=s; - formconfig.ListBoxAig.selected[ligneclicAig]:=true; - end; - end; end; + + procedure TFormConfig.ComboBoxDDChange(Sender: TObject); var s: string; i,pos: integer; @@ -12905,6 +13108,10 @@ begin StringGridArr.Cells[3,i]:=''; end; end; + + // routepref + MemoRoutes.Lines.Add(route_restreinte_to_string(trains[index].routePref)); + end; end; @@ -15045,6 +15252,8 @@ begin EditnCantonsRes.Text:=intToSTR(nCantonsRes); EditAntiTO.Text:=intToSTR(AntiTimeoutEthLenz); EditTempoTC.Text:=intToSTR(TempoTC); + EditMaxParcours.Text:=intToSTR(MaxParcours); + EditMaxRoutes.Text:=intToSTR(MaxRoutes); EditRep.Text:=RepConfig; {$IF CompilerVersion >= 28.0} @@ -15105,6 +15314,7 @@ begin cbAffSig.Checked:=AffSig; cbRes.Checked:=affRes; cbAck.Checked:=avecAck; + cbDebugRoulage.checked:=DebugRoulage; CheckBoxOptionDemiTour.checked:=option_demitour; CheckBoxSombre.Checked:=sombre; @@ -15853,6 +16063,83 @@ begin end; end; + + +procedure TFormConfig.EditAigTripleKeyPress(Sender: TObject; + var Key: Char); + var s : string; + i,erreur,index,ancien,adr1,adr2 : integer; + model: TEquipement; + nouveau : boolean; +begin + if clicliste or (ligneclicAig<0) or (ord(Key)<>VK_RETURN) then exit; + if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAig then + with Formconfig do + begin + s:=EditAigTriple.Text; + Val(s,Adr2,erreur); + index:=ligneclicAig+1; + if index=0 then exit; + + model:=aiguillage[index].modele; + if (model=triple) then + begin + if (erreur<>0) then begin LabelInfo.caption:='Erreur adresse aiguillage ';exit;end; + // vérifier si l'adresse de l'aiguillage existe déja + if (aiguillage[Index_Aig(i)].modele<>rien) then + begin + LabelInfo.caption:='aiguillage '+IntToSTR(i)+' existe déja - ne sera pas écrasé' ; + exit; + end ; + LabelInfo.caption:=''; + + Ancien:=aiguillage[index].AdrTriple; + adr1:=aiguillage[index].adresse; + aiguillage[index].AdrTriple:=adr2; + aiguillage[index].modifie:=true; + s:=encode_aig(index); + formconfig.ListBoxAig.items[ligneclicAig]:=s; + formconfig.ListBoxAig.selected[ligneclicAig]:=true; + + // créer aiguillage homologue + if ancien<>Adr2 then + begin + i:=Index_aig(ancien); + nouveau:=i=0; + if nouveau then + begin + inc(MaxAiguillage); + i:=MaxAiguillage; + end; + + if i>=NbreMaxiAiguillages then + begin + Affiche('Nombre maximal d''aiguillages atteint',clRed); + exit; + end; + + // créer homologue triple + aiguillage[i].Adresse:=adr2; + aiguillage[i].modele:=aig; + aiguillage[i].Apointe:=aiguillage[index].Adroit; + aiguillage[i].ApointeB:='D'; + aiguillage[i].ADevie:=aiguillage[index].Adevie2; + aiguillage[i].ADevieB:=aiguillage[index].Adevie2B; + aiguillage[i].ADroit:=aiguillage[index].Adroit; + aiguillage[i].ADroitB:=aiguillage[index].AdroitB; + aiguillage[i].visible:=false; + tablo_index_aiguillage[adr2]:=i; + s:=encode_Aig(i); + if nouveau then + begin + formconfig.ListBoxAig.items.add(s); + end + else formconfig.ListBoxAig.items[i-1]:=s; + end; + end; + end; +end; + end. diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index bb06699..e883085 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -1355,6 +1355,7 @@ var idc,x,y: integer; h : boolean; begin Idc:=index_canton(indexTCOcourant,xclicC,yclicC); + if Idc<1 then exit; x:=canton[Idc].x; y:=canton[Idc].y; H:=IsCantonH(IndexTCOCourant,x,y); diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index f42c1f4..3483d60 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -113,7 +113,7 @@ object FormConfigTCO: TFormConfigTCO end object Label10: TLabel Left = 56 - Top = 256 + Top = 224 Width = 258 Height = 13 Caption = 'Cliquez sur l'#39'ic'#244'ne pour changer la couleur de l'#39#233'l'#233'ment' @@ -170,11 +170,11 @@ object FormConfigTCO: TFormConfigTCO OnClick = ImagePiedFeuClick end object CheckCouleur: TCheckBox - Left = 64 - Top = 224 + Left = 48 + Top = 248 Width = 281 Height = 17 - Caption = 'Couleur du canton activ'#233' par la couleur du train' + Caption = 'Couleur du canton activ'#233'e par la couleur du train' TabOrder = 0 OnClick = CheckCouleurClick end @@ -241,7 +241,7 @@ object FormConfigTCO: TFormConfigTCO TabOrder = 4 end object RadioButtonCourbes: TRadioButton - Left = 392 + Left = 320 Top = 328 Width = 113 Height = 17 @@ -445,7 +445,7 @@ object FormConfigTCO: TFormConfigTCO end end object RadioButtonLignes: TRadioButton - Left = 392 + Left = 320 Top = 312 Width = 113 Height = 17 @@ -459,6 +459,18 @@ object FormConfigTCO: TFormConfigTCO TabOrder = 8 OnClick = RadioButtonLignesClick end + object CheckNB: TCheckBox + Left = 488 + Top = 312 + Width = 137 + Height = 17 + Hint = 'Affichage du TCO en noir et blanc pour impression' + Caption = 'Mode noir et blanc' + ParentShowHint = False + ShowHint = True + TabOrder = 9 + OnClick = CheckNBClick + end object ColorDialog1: TColorDialog OnShow = ColorDialog1Show Left = 272 diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index 3144319..03a9071 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -59,6 +59,7 @@ type Label17: TLabel; Label18: TLabel; RadioButtonLignes: TRadioButton; + CheckNB: TCheckBox; procedure ButtonDessineClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ImageAigClick(Sender: TObject); @@ -81,6 +82,7 @@ type procedure FormCreate(Sender: TObject); procedure TrackBarEpaisseurChange(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure CheckNBClick(Sender: TObject); private { Déclarations privées } public @@ -614,5 +616,10 @@ begin else action:=tCloseAction(caNone); // si la config est nok, on ferme pas la fenetre end; +procedure TFormConfigTCO.CheckNBClick(Sender: TObject); +begin + NB:=CheckNB.checked; +end; + begin end. diff --git a/UnitHorloge.pas b/UnitHorloge.pas index fe2a17b..59698f2 100644 --- a/UnitHorloge.pas +++ b/UnitHorloge.pas @@ -300,12 +300,13 @@ begin if (erreur<>0) or (i<0) or (i>23) then begin LabelErreur.Caption:='Erreur heure'; + SpinEditHInit.value:=0; exit; end; + SpinEditHInit.Value:=i; LabelErreur.Caption:=''; HeureInit:=i; config_modifie:=true; - end; procedure TFormHorloge.ButtonLanceClick(Sender: TObject); diff --git a/UnitIntro.dfm b/UnitIntro.dfm new file mode 100644 index 0000000..1488230 --- /dev/null +++ b/UnitIntro.dfm @@ -0,0 +1,36 @@ +object FormIntro: TFormIntro + Left = 300 + Top = 150 + BorderStyle = bsDialog + Caption = 'Introduction de donn'#233'es' + ClientHeight = 95 + ClientWidth = 186 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object LabeledEditDetAig: TLabeledEdit + Left = 40 + Top = 24 + Width = 121 + Height = 21 + EditLabel.Width = 47 + EditLabel.Height = 13 + EditLabel.Caption = 'D'#233'tecteur' + TabOrder = 0 + end + object ButtonTrouver: TButton + Left = 56 + Top = 56 + Width = 75 + Height = 25 + Caption = 'Trouver' + TabOrder = 1 + OnClick = ButtonTrouverClick + end +end diff --git a/UnitIntro.pas b/UnitIntro.pas new file mode 100644 index 0000000..4628326 --- /dev/null +++ b/UnitIntro.pas @@ -0,0 +1,36 @@ +unit UnitIntro; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls; + +type + TFormIntro = class(TForm) + LabeledEditDetAig: TLabeledEdit; + ButtonTrouver: TButton; + procedure ButtonTrouverClick(Sender: TObject); + private + { Déclarations privées } + public + { Déclarations publiques } + end; + +var + FormIntro: TFormIntro; + Achercher : integer; + +implementation + +{$R *.dfm} + +procedure TFormIntro.ButtonTrouverClick(Sender: TObject); +var i,erreur : integer; +begin + val(LabeledEditDetAig.text,i,erreur); + Achercher:=i; + close; +end; + +end. diff --git a/UnitModifAction.dfm b/UnitModifAction.dfm index 3c3d293..8b43b63 100644 --- a/UnitModifAction.dfm +++ b/UnitModifAction.dfm @@ -61,7 +61,7 @@ object FormModifAction: TFormModifAction Top = 64 Width = 729 Height = 337 - ActivePage = TabSheetOp + ActivePage = TabSheet1 MultiLine = True TabOrder = 2 object TabSheetDecl: TTabSheet diff --git a/UnitModifAction.pas b/UnitModifAction.pas index 8efabb2..83ddb8b 100644 --- a/UnitModifAction.pas +++ b/UnitModifAction.pas @@ -1172,7 +1172,12 @@ begin if (decl<>declAccessoire) and (decl<>DeclDetAct) and (decl<>DeclZoneDet) then exit; val(SpinEditEtat.Text,i,erreur); - if (i<0) or (i>2) or (erreur<>0) then exit; + if (i<0) or (i>2) or (erreur<>0) then + begin + SpinEditEtat.value:=0; + exit; + end; + SpinEditEtat.value:=i; Tablo_Action[index].etat:=i; maj_combocactions(ligneclicAct); @@ -1573,10 +1578,16 @@ begin end; procedure TFormModifAction.SpinEditHeure1Change(Sender: TObject); -var cond,i : integer; +var cond,i,erreur : integer; begin if (ligneclicAct<0) or clicliste then exit; - i:=SpinEditHeure1.Value; + val(SpinEditHeure1.Text,i,erreur); + if erreur<>0 then + begin + SpinEditHeure1.Value:=0; + exit; + end; + SpinEditHeure1.Value:=i; cond:=Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].numcondition; case cond of CondHorl : Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].HeureMin:=i; @@ -1584,12 +1595,17 @@ begin maj_combocactions(ligneclicAct); end; - procedure TFormModifAction.SpinEditMn1Change(Sender: TObject); -var cond,i : integer; +var cond,i,erreur : integer; begin if (ligneclicAct<0) or clicliste then exit; - i:=SpinEditMn1.Value; + val(SpinEditMn1.Text,i,erreur); + if erreur<>0 then + begin + SpinEditMn1.Value:=0; + exit; + end; + SpinEditMn1.Value:=i; cond:=Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].numcondition; case cond of CondHorl : Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].MinuteMin:=i; @@ -1598,10 +1614,16 @@ begin end; procedure TFormModifAction.SpinEditHeure2Change(Sender: TObject); -var cond,i : integer; +var cond,i,erreur : integer; begin if (ligneclicAct<0) or clicliste then exit; - i:=SpinEditHeure2.Value; + val(SpinEditHeure2.Text,i,erreur); + if erreur<>0 then + begin + SpinEditHeure2.Value:=0; + exit; + end; + SpinEditHeure2.Value:=i; cond:=Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].numcondition; case cond of CondHorl : Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].HeureMax:=i; @@ -1610,10 +1632,16 @@ begin end; procedure TFormModifAction.SpinEditMn2Change(Sender: TObject); -var cond,i : integer; +var cond,i,erreur : integer; begin if (ligneclicAct<0) or clicliste then exit; - i:=SpinEditMn2.Value; + val(SpinEditMn2.Text,i,erreur); + if erreur<>0 then + begin + SpinEditMn2.Value:=0; + exit; + end; + SpinEditMn2.Value:=i; cond:=Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].numcondition; case cond of CondHorl : Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].MinuteMax:=i; @@ -1635,10 +1663,16 @@ begin end; procedure TFormModifAction.SpinEditEtat2Change(Sender: TObject); -var cond,i : integer; +var cond,i,erreur : integer; begin if (ligneclicAct<0) or clicliste then exit; - i:=SpinEditEtat2.Value; + val(SpinEditEtat2.Text,i,erreur); + if erreur<>0 then + begin + SpinEditEtat2.Value:=0; + exit; + end; + SpinEditEtat2.Value:=i; cond:=Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].numcondition; case cond of CondPosAcc : Tablo_Action[ligneclicact+1].tabloCond[cliccond+1].etat:=i; @@ -1659,10 +1693,16 @@ begin end; procedure TFormModifAction.SpinEditEtatopChange(Sender: TObject); -var i,op : integer; +var i,o,erreur,op : integer; begin if (ligneclicAct<0) or clicliste then exit; - i:=SpinEditEtatop.Value; + val(SpinEditEtatop.text,i,erreur); + if erreur<>0 then + begin + SpinEditEtatOp.Value:=0; + exit; + end; + SpinEditEtatop.Value:=i; op:=Tablo_Action[ligneclicact+1].tabloOp[clicaction+1].numoperation; case op of ActionAccessoire : Tablo_Action[ligneclicact+1].tabloOp[clicaction+1].etat:=i; @@ -1724,4 +1764,6 @@ begin Aff_champs(ligneclicAct+1,1,1); end; + + end. diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 966e599..94bc4f3 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,8 +1,8 @@ object FormPrinc: TFormPrinc - Left = 75 - Top = 270 + Left = 132 + Top = 172 Width = 1148 - Height = 624 + Height = 625 Anchors = [akLeft, akTop, akRight] Caption = 'SIgnaux complexes' Color = clBtnFace @@ -20,8 +20,8 @@ object FormPrinc: TFormPrinc OnCreate = FormCreate OnResize = FormResize DesignSize = ( - 1140 - 573) + 1132 + 566) PixelsPerInch = 96 TextHeight = 13 object LabelTitre: TLabel @@ -1445,8 +1445,8 @@ object FormPrinc: TFormPrinc end object StatusBar1: TStatusBar Left = 0 - Top = 551 - Width = 1140 + Top = 544 + Width = 1132 Height = 22 Panels = < item @@ -2043,6 +2043,7 @@ object FormPrinc: TFormPrinc Height = 25 Caption = 'Route' TabOrder = 2 + OnClick = Button3Click end object Timer1: TTimer Interval = 100 @@ -2417,7 +2418,7 @@ object FormPrinc: TFormPrinc object Roulage1: TMenuItem Caption = 'Roulage' object Routes1: TMenuItem - Caption = 'Fen'#234'tre des routes' + Caption = 'Fen'#234'tre des routes par trains' OnClick = Routes1Click end object Afficheroutespartrain1: TMenuItem diff --git a/UnitPrinc.pas b/UnitPrinc.pas index fe77378..8716170 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,5 +1,5 @@ unit Unitprinc; -// 21/08/2024 18h30 +// 24/09/2024 18h30 (******************************************** Programme signaux complexes Graphique Lenz [Delphi 7 ou RadStudio (Delphi 12)] + activeX Tmscomm + clientSocket @@ -22,7 +22,7 @@ unit Unitprinc; ******************************************** - Pour TMSCOM : il est nécessaire d'avoir le fichier mscomm32.ocx dans le repertoire system de windows +in Pour TMSCOM : il est nécessaire d'avoir le fichier mscomm32.ocx dans le repertoire system de windows (Pour un Os64, %systemroot%\sysWOW64 pour unOs32 : %systemroot%\system32) et que ce composant soit enregistré (avec regsvr32) @@ -73,7 +73,7 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MMSystem , - Buttons, NB30, comObj, activeX ,DateUtils + Buttons, NB30, comObj, activeX ,DateUtils, PsAPI {$IF CompilerVersion >= 28.0} // si delphi>=12 ,Vcl.Themes // pour les thèmes d'affichage (auric etc) ,AdPort, OoMisc // AsyncPro pour COM/USB @@ -82,7 +82,6 @@ uses {$IFEND} ; - type TFormPrinc = class(TForm) Timer1: TTimer; @@ -409,6 +408,7 @@ type procedure Codificationdestrains1Click(Sender: TObject); procedure Afficheroutespartrain1Click(Sender: TObject); procedure Sauvegarderlaconfiguration1Click(Sender: TObject); + procedure Button3Click(Sender: TObject); private { Déclarations privées } procedure DoHint(Sender : Tobject); @@ -458,12 +458,13 @@ const_inconnu=9; // position inconnue const_pointe=10; // aiguillage pris en pointe const_talon=11; // aiguillage pris en talon IdClients=10; // Index maxi de clients -MaxParcours=200; -MaxRoutes=3000; +MaxParcoursTablo=200; // taille maxi du tableau des routes +MaxRoutesCte=25000; // Nombre maximal de routes NbCouleurTrain=8; MaxCdeDccpp=20; couleurTexte=$A0FFFF; clRose=$AAAAFF; + clCyan=$FFA0A0; clviolet=$FF00FF; GrisF=$191919; @@ -606,62 +607,63 @@ Taiguillage = record // si modifié en mode config modifie : boolean ; + visible : boolean ; //invisible si 2eme adresse triple AdrCDM : integer; // adresse de l'aiguillage dans CDM, si c'est une BJD (bretelle jonction double) end; -TtabloDet = array[0..MaxParcours] of integer; +TtabloDet = array[0..MaxParcoursTablo] of integer; TSignal = record - adresse, aspect : integer; // adresse du signal, aspect (2 feux..9 feux 12=direction 2 feux .. 16=direction 6 feux) (11=signal belge 1) - Img : TImage; // Pointeur sur structure TImage du feu - Lbl : TLabel; // pointeur sur structure Tlabel du feu - checkFB : TCheckBox; // pointeur sur structure Checkbox "demande feu blanc" - checkFR : boolean; // demande feu rouge cli - checkFV : boolean; // demande feu vert cli - FeuVertCli : boolean ; // avec checkbox ou pas - FeuRougeCli : boolean ; // avec checkbox ou pas - contrevoie : boolean; // signal de contrevoie (SNCB) - Verscontrevoie : boolean; // signal vers contrevoie (SNCB) - FeuBlanc : boolean ; // avec checkbox ou pas - decodeur : integer; // type du décodeur // 'rien','DigitalBahn','CDF','LS-DEC-SNCF','LEB','Digikeijs','Unisemaf','SR','Arcomora',LS_DEC_NMBS,Bmodels, puis les perso - Adr_det1 : integer; // adresse du détecteur1 sur lequel il est implanté - Adr_det2 : integer; // adresse du détecteur2 sur lequel il est implanté (si un signal est pour plusieurs voies) - Adr_det3 : integer; // adresse du détecteur3 sur lequel il est implanté (si un signal est pour plusieurs voies) - Adr_det4 : integer; // adresse du détecteur4 sur lequel il est implanté (si un signal est pour plusieurs voies) - Adr_el_suiv1 : integer; // adresse de l'élément1 suivant voie 1 - Adr_el_suiv2 : integer; // adresse de l'élément2 suivant voie 2 (si un signal est pour plusieurs voies) - Adr_el_suiv3 : integer; // adresse de l'élément3 suivant voie 3 (si un signal est pour plusieurs voies) - Adr_el_suiv4 : integer; // adresse de l'élément4 suivant voie 4 (si un signal est pour plusieurs voies) - Btype_suiv1 : TEquipement ; // type de l'élément suivant voie 1 - Ne prend que les valeurs rien, det ou aig - Btype_suiv2 : TEquipement ; // type de l'élément suivant voie 2 - Ne prend que les valeurs rien, det ou aig - Btype_suiv3 : TEquipement ; // type de l'élément suivant voie 3 - Ne prend que les valeurs rien, det ou aig - Btype_suiv4 : TEquipement ; // type de l'élément suivant voie 4 - Ne prend que les valeurs rien, det ou aig - VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal - // EtatVerrouCarre : boolean ; // si vrai, le feu est verrouillé au carré - modifie : boolean; // feu modifié - EtatSignal : word ; // état du signal - AncienEtat : word ; // ancien état du signal - AncienAff : word ; // état ancien affichage - UniSemaf : integer ; // définition supplémentaire de la cible pour les décodeurs UNISEMAF - BinLin : integer; // Binaire=0 ou Linéaire décodeur LEB - AigDirection : array[1..7] of array of record // pour les signaux directionnels : contient la liste des aiguillages associés + adresse, aspect : integer; // adresse du signal, aspect (2 feux..9 feux 12=direction 2 feux .. 16=direction 6 feux) (11=signal belge 1) + Img : TImage; // Pointeur sur structure TImage du feu + Lbl : TLabel; // pointeur sur structure Tlabel du feu + checkFB : TCheckBox; // pointeur sur structure Checkbox "demande feu blanc" + checkFR : boolean; // demande feu rouge cli + checkFV : boolean; // demande feu vert cli + FeuVertCli : boolean ; // avec checkbox ou pas + FeuRougeCli : boolean ; // avec checkbox ou pas + contrevoie : boolean; // signal de contrevoie (SNCB) + Verscontrevoie : boolean; // signal vers contrevoie (SNCB) + FeuBlanc : boolean ; // avec checkbox ou pas + decodeur : integer; // type du décodeur // 'rien','DigitalBahn','CDF','LS-DEC-SNCF','LEB','Digikeijs','Unisemaf','SR','Arcomora',LS_DEC_NMBS,Bmodels, puis les perso + Adr_det1 : integer; // adresse du détecteur1 sur lequel il est implanté + Adr_det2 : integer; // adresse du détecteur2 sur lequel il est implanté (si un signal est pour plusieurs voies) + Adr_det3 : integer; // adresse du détecteur3 sur lequel il est implanté (si un signal est pour plusieurs voies) + Adr_det4 : integer; // adresse du détecteur4 sur lequel il est implanté (si un signal est pour plusieurs voies) + Adr_el_suiv1 : integer; // adresse de l'élément1 suivant voie 1 + Adr_el_suiv2 : integer; // adresse de l'élément2 suivant voie 2 (si un signal est pour plusieurs voies) + Adr_el_suiv3 : integer; // adresse de l'élément3 suivant voie 3 (si un signal est pour plusieurs voies) + Adr_el_suiv4 : integer; // adresse de l'élément4 suivant voie 4 (si un signal est pour plusieurs voies) + Btype_suiv1 : TEquipement ; // type de l'élément suivant voie 1 - Ne prend que les valeurs rien, det ou aig + Btype_suiv2 : TEquipement ; // type de l'élément suivant voie 2 - Ne prend que les valeurs rien, det ou aig + Btype_suiv3 : TEquipement ; // type de l'élément suivant voie 3 - Ne prend que les valeurs rien, det ou aig + Btype_suiv4 : TEquipement ; // type de l'élément suivant voie 4 - Ne prend que les valeurs rien, det ou aig + VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal + // EtatVerrouCarre : boolean ; // si vrai, le feu est verrouillé au carré + modifie : boolean; // feu modifié + EtatSignal : word ; // état du signal + AncienEtat : word ; // ancien état du signal + AncienAff : word ; // état ancien affichage + UniSemaf : integer ; // définition supplémentaire de la cible pour les décodeurs UNISEMAF + BinLin : integer; // Binaire=0 ou Linéaire décodeur LEB + AigDirection : array[1..7] of array of record // pour les signaux directionnels : contient la liste des aiguillages associés Adresse : integer; // 6 feux max associés à un tableau dynamique décrivant les aiguillages +1 position 0 posAig : char; end; - CondCarre : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le carré + CondCarre : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le carré // attention les données sont stockées en adresse 1 du tableau dynamique Adresse : integer; // aiguillage posAig : char; end; - CondFeuBlanc : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le blanc + CondFeuBlanc : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le blanc // attention les données sont stockées en adresse 1 du tableau dynamique Adresse : integer; // aiguillage posAig : char; end; - SR : array[1..19] of record // configuration des sorties du décodeur Stéphane Ravaut ou digikeijs ou cdf pour chacun des 19 états + SR : array[1..19] of record // configuration des sorties du décodeur Stéphane Ravaut ou digikeijs ou cdf pour chacun des 19 états sortie1,sortie0 : integer; // ex SR[1]=[carre] (voir tableau Etats) end; - Na : integer; // nombre d'adresses du signal occupées par le décodeur CDF/SR/digikeijs/Belge - DetAmont : TtabloDet; // tableau des détecteurs amonts, calculés à la lecture du fichier de config - end; + Na : integer; // nombre d'adresses du signal occupées par le décodeur CDF/SR/digikeijs/Belge + DetAmont : TtabloDet; // tableau des détecteurs amonts, calculés à la lecture du fichier de config + end; TPeripherique = record nom : string; // nom du périphérique @@ -728,18 +730,16 @@ Tactionneur = record end; TelementRoute=record // l'index 0 contient le nombre d'éléments - adresse : integer; // adresse de l'élément - typ : tequipement; // type de l'élément - pos : integer; // position pour la route si l'élément est un aiguillage - talon : boolean; // vrai si l'élément est un aiguillage pris en talon pour la route - traite : boolean; // traité ou non par la procédure aig_canton - end; + adresse : integer; // adresse de l'élément + typ : tequipement; // type de l'élément + pos : integer; // position pour la route si l'élément est un aiguillage + talon : boolean; // vrai si l'élément est un aiguillage pris en talon pour la route + traite : boolean; // traité ou non par la procédure aig_canton + end; -TUneRoute=array[0..MaxParcours] of TelementRoute; +TUneRoute=array[0..MaxParcoursTablo] of TelementRoute; // Une route -TElroute=array[1..MaxRoutes] of TUneroute; - -Tparcours=array[1..MaxParcours] of integer; +TElroute=array[1..MaxRoutesCte] of TUneroute; // tableau de routes TchaineBIN=array[0..Long_tampon_interface] of byte; @@ -763,25 +763,25 @@ var LargeurF,HauteurF,OffsetXF,OffsetYF,PosSplitter,NbPeriph,NbPeriph_COMUSB,NbPeriph_Socket, AigMal,AncMinute,axFP,ayFP,NbreOperations,NbreDeclencheurs,index_seqAct,NbreConditions, SensAig,NbreRoutes,nbreIti,DetAtrouve,DetDepart,iteration,IdActTr,Long_recue, - prec1,prec2,Eprec,Esuiv,param1,param2,param3 : integer; + prec1,prec2,Eprec,Esuiv,param1,param2,param3,MaxParcours,MaxRoutes : integer; ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc, Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO, Srvc_Pos,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif,Srvc_tdcc, - Hors_tension,TraceZone,parSocketLenz,ackCdm,PremierFD,doubleclic, + Hors_tension,TraceZone,parSocketLenz,ackCdm,PremierFD,doubleclic,debugRoulage, NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,AffTiers,AvecDemandeAiguillages, TraceListe,clignotant,nack,Maj_signaux_cours,configNulle,LanceCDM,AvecInitAiguillages, AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro, retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain, - fichier_module_cdm,Diffusion,cdmDevant,serveurIPCDM_Touche,avecAckCDM, + fichier_module_cdm,Diffusion,cdmDevant,serveurIPCDM_Touche,avecAckCDM,Stop_Maj_Sig, sombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour : boolean; tick,Premier_tick : longint; {$IF CompilerVersion >= 28.0} - MSCommUSBInterface, MsCommCde1,MsCommCde2 : tApdComPort; // objets AsyncPro + MSCommUSBInterface, MsCommCde1,MsCommCde2 : tApdComPort; // objets AsyncPro {$ELSE} - MSCommUSBInterface, MsCommCde1,MsCommCde2 : TMSComm; + MSCommUSBInterface, MsCommCde1,MsCommCde2 : TMSComm; {$IFEND} CDMhd : THandle; @@ -899,12 +899,10 @@ var train : string; end; - seq_actionneurs : array[1..30] of + seq_actions : array[1..30] of record indiceAction,IndiceOp, // indice à partir duquel reprendre l'exécution - op,tick // opération - : integer; - + op,tick : integer; // opération end; Declencheurs : array[0..10] of @@ -957,13 +955,15 @@ var sens : integer; // sens de déplacement, stockage provisoire pour restocker dans le tableau canton[] compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s // pilotage des trains------------------- - TempoArret : integer; // tempo d'arret pour le timer + //TempoArret : integer; // tempo d'arret pour le timer TempoArretCour : integer; // valeur dynamique TempoDemarre : integer; // tempo de démarrage, valeur dynamique TempsDemarreSig : integer; // temps de redémarrage du signal, valeur d'initialisation (fichier de config) TempoArretTemp : integer; // temps d'arrêt temporisé sur un détecteur index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train - // + arret_det : boolean; // arrêt du train sur le détecteur + phase_arret : integer; // numéro de phase arret + //--------- canton : integer ; // numéro du canton (pas index) sur lequel le train se trouve icone : Timage ; NomIcone : string; @@ -975,7 +975,8 @@ var roulage : integer; // =1 train en roulage mais arrêté pour réservation par tiers =2 en roulage effectif dernierDet : integer; // dernier détecteur traité cantonOrg,CantonDest : integer; // cantons origine et destination si route - route : TuneRoute; // tableau de la route du train + route : TuneRoute; // tableau de la route en cours du train + routePref : TUneroute; // tableau de la route sauvegardée du train PointRout : integer; // cantons sur lesquels le train doit d'arrêter DetecteurArret : array[1..NbDetArret] of record @@ -1130,10 +1131,15 @@ procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor); procedure Event_vitesse(adr: integer ;train : string;vitesse : integer); function detecteur_suivant(prec : integer;TypeElPrec : TEquipement;actuel : integer;TypeElActuel : TEquipement;algo : integer) : integer ; procedure prepare_route(IndexTCO,cantonOrg,arrivee,sens : integer); -function route_to_string(tablo : tUneRoute) : string; +function route_totale_to_string(tablo : tUneRoute) : string; +function route_restreinte_to_string(tablo : tUneRoute) : string; procedure supprime_route_train(idtrain : integer); -procedure trouve_element_V1(el: integer; TypeEl : TEquipement; Offset,branche_pref : integer; erreur : boolean); +procedure trouve_element(el: integer; TypeEl : TEquipement); overload; +procedure trouve_element_V1(el: integer; TypeEl : TEquipement; Offset,branche_pref,OffsetDsBranche : integer;erreur : boolean;it : integer); procedure procetape(s : string); +procedure Affiche_routes_brut; +procedure TJD4(adr1,pos1,adr2,pos2 : integer;var c1,c2 : char); +procedure affecte_trains_config; implementation @@ -1364,8 +1370,6 @@ begin end; end; - - // procédures liaisons série com usb ------------------------------------------------ // envoie une chaine s à un périphérique COM/USB en fonction du composant comp // contrôle si le pointeur comp est valide par traitement de l'exception @@ -1434,18 +1438,17 @@ end; // envoi la chaîne trameIF à la centrale par USBLenz ou socket, n'attend pas l'ack // pour le protole XpressNet (1), on ajoute l'entete et le suffixe dans la trame. // ici on envoie pas à CDM -// la fonction PutBlock nécessite un tableau commençant à 1 et pas à 0 +// la fonction PutBlock nécessite un tableau z[] commençant à 1 et pas à 0 // avec asyncpro procedure envoi_ss_ack(s : string); var i,timeout,valto,l : integer; z : array[1..100] of byte; begin if simuInterface then exit; - // XpressNet + s:=entete+s; l:=length(s); - for i:=1 to l do z[i]:=byte(ord(s[i])); - if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClLime); + for i:=1 to l do z[i]:=byte(ord(s[i])); // transforme la chaine en tableau d'octets if traceTrames then begin @@ -1625,8 +1628,11 @@ function test_protocole : boolean; var s: string; temp : integer; begin - //result:=true; - //exit; // #### + if simuInterface then + begin + result:=true; + exit; // #### + end; begin if protocole=1 then // Xpressnet begin @@ -3675,10 +3681,20 @@ begin repeat inc(i); Application.ProcessMessages; - until (temps<=0) or (i>1000000); - if i>1000000 then Affiche('Erreur temporisation',clred); + until (temps<=0) or (i>5000000); + if i>5000000 then Affiche('Erreur temporisation',clred); end; +// tempo en ValTemps x100ms +procedure tempo2(ValTemps : integer); +var Tc,seuil: Cardinal; +begin + Tc:=GetTickCount; + Seuil:=ValTemps*100; + repeat + Application.ProcessMessages; + until Cardinal(GetTickCount-Tc)>Seuil; +end; // envoi d'une chaîne à l'interface par USB ou socket, puis attend l'ack ou le nack function envoi(s : string) : boolean; @@ -4070,7 +4086,7 @@ var s : string; begin if not(hors_tension) and ((portCommOuvert or parSocketLenz)) then begin - if not(Diffusion) then Affiche('Vitesse train @'+inttostr(adr_loco)+'='+inttostr(vitesse),clLime); + if debugRoulage then Affiche('Vitesse train @'+inttostr(adr_loco)+'='+inttostr(vitesse),clLime); // mettre à jour la trackBar si le train sélectionné=editAdrTrain val(Formprinc.EditAdrTrain.Text,v,erreur); @@ -4090,13 +4106,13 @@ begin if (trains[index].inverse) xor (vitesse>=0) then v:=v or 128; s:=#$e4+#$13+#$0+char(adr_loco)+char(v); s:=checksum(s); - envoi(s); + if avecAck then envoi(s) else envoi_ss_ack(s); end; if protocole=2 then begin s:='=0) then s:=s+'1>' else s:=s+'0>'; - envoi(s); + if avecAck then envoi(s) else envoi_ss_ack(s); end; end; @@ -6338,7 +6354,8 @@ begin begin trains[index_train].tempoDemarre:=td*10; // armer la tempo, en dixièmes de s // annuler la demande d'arret éventuelle - trains[index_train].TempoArret:=0; + //trains[index_train].TempoArret:=0; + s:='Le train @'+intToSTR(AdrTrain)+' va démarrer dans '+intToSTR(td)+'s du signal '+intToSTR(adr); Affiche(s,clyellow); // arreter le train @@ -6449,17 +6466,18 @@ end; // si pas trouvé, renvoie 0 sinon renvoie l'index du détecteur dans la branche function index_detecteur(detecteur,Num_branche : integer) : integer; var i,adr : integer; - trouve : boolean; + trouve,fin : boolean; // trouve si detecteur est dans la branche num_branche à partir de l'index i procedure recherche; begin repeat adr:=BrancheN[Num_Branche,i].adresse; trouve:=(detecteur=adr) and ((BrancheN[Num_Branche,i].Btype=det) or (BrancheN[Num_branche,i].BType=buttoir)); // cherche un détecteur + fin:=(adr=0) and (BrancheN[Num_branche,i].BType<>buttoir); //Affiche('cherche='+intToSTR(det)+'/explore='+intToSTR(adr)+' Branche='+intToStr(Num_branche)+' index='+intToStr(i),ClWhite); if not(trouve) then inc(i); //if trouve then Affiche('Trouvé en branche'+IntToSTR(Num_branche)+' index='+IntToSTR(i),clGreen); - until trouve or (adr=0) ; + until trouve or fin ; end; begin if debug=3 then formprinc.Caption:='index_detecteur '+IntToSTR(detecteur); @@ -6640,8 +6658,8 @@ end; // si une branche preférée est choisie, elle est non nulle. // erreur=true affiche le message d'erreur // si pas trouvé, Branche_trouve=0 IndexBranche_trouve=0 -procedure trouve_element_V1(el: integer; TypeEl : TEquipement; Offset,branche_pref : integer;erreur : boolean); -var i,adr,Branche : integer ; +procedure trouve_element_V1(el: integer; TypeEl : TEquipement; Offset,branche_pref,OffsetDsBranche : integer;erreur : boolean;it : integer); +var i,adr,Branche,ia : integer ; s : string; BT : TEquipement; sort : boolean; @@ -6651,6 +6669,7 @@ begin if (typeEL=triple) or (typeEL=tjd) or (typeEL=tjs) or (typeEL=crois) then TypeEL:=aig; i:=1; + if OffsetDsBranche<>0 then i:=OffsetDsBranche; branche_trouve:=0; IndexBranche_trouve:=0; if branche_pref<>0 then branche:=Branche_Pref else Branche:=offset; @@ -6671,22 +6690,34 @@ begin branche_trouve:=Branche; IndexBranche_trouve:=i-1; end - else begin - branche_trouve:=0; IndexBranche_trouve:=0; - if erreur then - begin - s:='Erreur 175 : élément '+intToSTR(el)+' '; - s:=s+BTypeToChaine(TypeEl); - s:=s+' non trouvé';Affiche(s,clred); - AfficheDebug(s,clred); - end; - end; + else + begin + // si pas trouvé, si TJD 4 états, chercher son homologue + if (TypeEl=Aig) and (it=0) then // it c'est pour ne faire qu'une itération + begin + ia:=index_aig(el); + if (aiguillage[ia].modele=TJD) and (aiguillage[ia].EtatTJD=4) then + begin + el:=aiguillage[ia].dDroit; // homologue + trouve_element_v1(el,TypeEl,Offset,branche_pref,OffsetDsBranche,erreur,1); + if branche_trouve<>0 then exit; + end; + end; + branche_trouve:=0; IndexBranche_trouve:=0; + if erreur then + begin + s:='Erreur 175 : élément '+intToSTR(el)+' '; + s:=s+BTypeToChaine(TypeEl); + s:=s+' non trouvé';Affiche(s,clred); + AfficheDebug(s,clred); + end; + end; if debug=3 then formprinc.Caption:=''; end; // trouve un élément dans les branches depuis les index. // Plus rapide que la procédure précédente. Renvoie branche_trouve IndexBranche_trouve -// el : adresse de l'élément TypeEL=(1=détécteur 2=aig 3=aig Bis 4=aig triple - Buttoir) +// el : adresse de l'élément TypeEL=det aig triple tjd buttoir) // avec cet algorithme, un détecteur ne peut se trouver qu'à un seul endroit dans les branches // si branche_Pref<>0 : recherche un aig sur la branche_Pref procedure trouve_element(el: integer; TypeEl : TEquipement;Branche_pref : integer;erreur : boolean); overload; @@ -6732,7 +6763,7 @@ begin if (TypeEl=triple) or (typeEL=aig) or (typeEL=crois) or (typeEL=tjd) or (typeEL=tjs) then begin - Trouve_element_V1(el,TypeEl,1,branche_pref,erreur); + Trouve_element_V1(el,TypeEl,1,branche_pref,0,erreur,0); end; if typeEL=buttoir then @@ -7280,12 +7311,12 @@ begin end else begin - // si TJD (modele=2) sur le précédent, alors substituer avec la 2eme adresse de la TJD + { // si TJD (modele=2) sur le précédent, alors substituer avec la 2eme adresse de la TJD if TypeElPrec<>det then begin md:=aiguillage[index_aig(prec)].modele; if (md=tjd) or (md=tjs) then prec:=aiguillage[index_aig(prec)].Ddevie; - end; + end; } if (prec<>aiguillage[index].Adevie) or (aiguillage[index].position=const_inconnu) then begin if NivDebug=3 then AfficheDebug('135.3 Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); @@ -7464,7 +7495,7 @@ begin AfficheDebug(s,clred); suivant_alg3:=9996; exit; - end; + end; end else @@ -7537,6 +7568,16 @@ begin //--------------- 4 états ou TJS if (NetatTJD=4) or tjsC then begin + // vérifier que l'entrée de la TJD correspond à l'élément actuel + if (aiguillage[index].Adroit<>prec) and (aiguillage[index].Adevie<>prec) then + begin + if (aiguillage[index2].Adroit=prec) or (aiguillage[index2].Adevie=prec) then + begin + // en fait, l'élément prec est sur l'homologue... + echange(index,index2); + end; + end; + // determiner la position de la première section de la TJD (4 cas) // cas 1 : droit droit if (( aiguillage[index].position=const_droit) and @@ -7913,7 +7954,7 @@ begin typeGen:=TypeGenS; exit; end; - if (aiguillage[index].position<>const_droit) and (aiguillage[index_aig(Adr2)].position=const_droit) then + if (aiguillage[index].position=const_devie) and (aiguillage[index_aig(Adr2)].position=const_droit) then begin if NivDebug=3 then AfficheDebug('Aiguillage triple dévié1 (à gauche)',clYellow); A:=aiguillage[index].AdevieB; @@ -7928,7 +7969,7 @@ begin typeGen:=TypeGenS; exit; end; - if (aiguillage[index].position=const_droit) and (aiguillage[index_aig(Adr2)].position<>const_droit) then + if (aiguillage[index].position=const_droit) and (aiguillage[index_aig(Adr2)].position=const_devie) then begin if NivDebug=3 then AfficheDebug('Aiguillage triple dévié2 (à droite)',clYellow); A:=aiguillage[index].Adevie2B; @@ -9254,7 +9295,7 @@ begin exit; end; - // trouver détecteur 2 + // trouver élément 2 trouve_element(el2,Typedet2); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin @@ -9308,7 +9349,7 @@ begin end; end; - // trouver détecteur 1 + // trouver élément 1 if el1<>0 then begin trouve_element(el1,Typedet1); // branche_trouve IndexBranche_trouve @@ -11789,15 +11830,17 @@ Procedure Maj_Signaux(detect : boolean); var i : integer; begin if (nivDebug=1) or ProcPrinc then AfficheDebug('Proc Maj_signaux',clorange); - if not(Maj_signaux_cours) then + if not(Maj_signaux_cours) and not(Stop_Maj_sig) then begin Maj_signaux_cours:=TRUE; - for i:=1 to NbreSignaux do - begin + i:=1; + repeat Maj_Signal_P(Signaux[i].Adresse,detect); - end; + inc(i); + until (i>NbreSignaux) or Stop_Maj_Sig; Maj_signaux_cours:=FALSE; end; + Stop_Maj_Sig:=false; end; @@ -12089,37 +12132,34 @@ end; // libère le canton avant detecteur2, qui doit être associé à un signal depuis la direction de detecteur1 // detecteur1->detecteur2 -Procedure libere_canton(detecteur1,detecteur2 : integer); -var sd2,i,j: integer; +Procedure libere_cantonX(detecteur1,detecteur2 : integer); +var i,j,index,adrSig1: integer; typ : tEquipement; begin if not(roulage) then exit; proc:=Tlibere_canton; param1:=detecteur1; param2:=detecteur2; - if traceliste or ProcPrinc or affres then + //if traceliste or ProcPrinc or affres then affiche('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); if ProcPrinc or traceListe then AfficheDebug('Libère_Canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); // est-on en limite de canton du detecteur 2 pour le libérer? - sd2:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2 - if sd2=0 then + adrSig1:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2 + if adrSig1=0 then begin if traceliste then affiche('le détecteur '+intToSTR(detecteur2)+' n''est pas pas associé à un signal - pas de libération du canton',clorange); exit; // pas de signal associé end; // ce signal sd2 est il dans le bon sens i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal dans le bon sens associé au détecteur - if i<>sd2 then + if i<>adrSig1 then begin - if traceliste then affiche('Le signal '+intToSTR(sd2)+' n''est pas dans le bon sens',clOrange); + if traceliste then affiche('Le signal '+intToSTR(adrsig1)+' n''est pas dans le bon sens',clOrange); exit; end; if i=0 then exit; - // trouver le signal précédent - i:=Signal_precedent(i); // trouve les éléments entre les deux signaux - if traceListe then AfficheDebug('Libération canton det '+IntToSTR(detecteur1)+' '+intToSTR(detecteur2)+' : ',clLime); for i:=1 to idEl-1 do begin @@ -12127,9 +12167,18 @@ begin typ:=elements[i].typ; if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then begin + index:=index_aig(j); if traceListe then Affichedebug_Suivi('A'+intToSTR(j)+' ',clLime); - Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'aiguillage + if debugRoulage then Affiche('Libération aiguillage A'+intToSTR(j),clWhite); + Aiguillage[index].AdrTrain:=0; // libère l'aiguillage Texte_aig_fond(j); + typ:=aiguillage[index].modele; + if (typ=Tjd) and (aiguillage[index].EtatTJD=4) then + begin + j:=aiguillage[index].Ddroit;// homologue + if debugRoulage then Affiche('Libération aiguillage A'+intToSTR(j),clWhite); + Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'homologue + end; end; if (typ=det) then begin @@ -12141,6 +12190,99 @@ begin Maj_Signaux(false); end; +// libère le canton avant detecteur2, qui doit être associé à un signal depuis la direction de detecteur1 +// detecteur1->detecteur2 +Procedure libere_canton(detecteur1,detecteur2,AdrTrain : integer); +var i,j,index,adrSig1,adrSig2,detsig1,detSig2,it,n,id1,id2 : integer; + typ : tEquipement; + trouve1,trouve2 : boolean; +begin + if not(roulage) then exit; + it:=index_train_adresse(AdrTrain); + if it=0 then exit; + proc:=Tlibere_canton; + param1:=detecteur1; + param2:=detecteur2; + //if traceliste or ProcPrinc or affres then + affiche('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); + if ProcPrinc or traceListe then AfficheDebug('Libère_Canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); + + // est-on en limite de canton du detecteur 2 pour le libérer? + adrSig2:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2 + if adrSig2=0 then + begin + if traceliste then affiche('le détecteur '+intToSTR(detecteur2)+' n''est pas pas associé à un signal - pas de libération du canton',clorange); + exit; // pas de signal associé + end; + // ce signal sd2 est il dans le bon sens + i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal dans le bon sens associé au détecteur + if i<>adrSig2 then + begin + if traceliste then affiche('Le signal '+intToSTR(adrsig2)+' n''est pas dans le bon sens',clOrange); + exit; + end; + if i=0 then exit; + + index:=index_signal(adrSig2); + detSig2:=signaux[index].Adr_det1; + // trouver le signal précédent + AdrSig1:=Signal_precedent(AdrSig2); // trouve les éléments entre les deux signaux + if AdrSig1<>0 then + begin + index:=index_signal(adrSig1); + detSig1:=signaux[index].Adr_det1; + end + else DetSig1:=trains[it].route[1].adresse; + + // trouve les index des détecteurs des deux signaux dans la route + i:=1;id1:=1;id2:=1; + n:=trains[it].route[0].adresse; + trouve1:=false;trouve2:=false; + repeat + if (trains[it].route[i].adresse=detSig1) and (trains[it].route[i].typ=det) then + begin + trouve1:=true; + id1:=i; + end; + if trouve1 and (trains[it].route[i].adresse=detSig2) and (trains[it].route[i].typ=det) then + begin + trouve2:=true; + id2:=i; + end; + inc(i); + until (trouve1 and trouve2) or (i>n); + + for i:=id1 to id2 do + begin + typ:=trains[it].route[i].typ; + j:=trains[it].route[i].adresse; + if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then + begin + index:=index_aig(j); + if traceListe then Affichedebug_Suivi('A'+intToSTR(j)+' ',clLime); + if debugRoulage then Affiche('Libération aiguillage A'+intToSTR(j),clWhite); + Aiguillage[index].AdrTrain:=0; // libère l'aiguillage + Texte_aig_fond(j); + typ:=aiguillage[index].modele; + if (typ=Tjd) and (aiguillage[index].EtatTJD=4) then + begin + j:=aiguillage[index].Ddroit;// homologue + if debugRoulage then Affiche('Libération aiguillage A'+intToSTR(j),clWhite); + Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'homologue + end; + end; + if (typ=det) then + begin + if traceListe then Affichedebug_Suivi(intToSTR(j)+' ',clLime); + detecteur[j].AdrTrainRes:=0; // libère le détecteur + Texte_aig_fond(j); + end; + end; + + Maj_Signaux(false); +end; + + // mode=0 = libère 1=réserve reserve_dereserve_det(detecteur1,detecteur2,adrTrain,i,1); // du détecteur1 au détecteur2 NON INCLUS @@ -12360,36 +12502,42 @@ end; procedure pilote_train(det1,det2,AdrTrain,it : integer); var entree_signal,jauneC,rappel30C,rappel60C,rouge : boolean; index_train,adresse,adresse1,adresse2,Etat,voie1,voie2,indexSig,indexSig1,indexSig2, - n,vitesse,i2 : integer; + n,vitesse,i2,PointRoute : integer; couleur : TColor; s,nomTrain : string; begin if not(roulage) or (adrtrain=0) then exit; - if not(diffusion) then Affiche('Pilote train '+intToSTR(det1)+' '+intToSTR(det2),clYellow); + if debugRoulage then Affiche('Pilote train '+intToSTR(det1)+' '+intToSTR(det2),clYellow); if ProcPrinc then AfficheDebug('Pilote_train '+intToSTR(det1)+' '+intToSTR(det2)+' '+intToSTR(AdrTrain),clWhite); index_train:=index_train_adresse(adrTrain); // index du tableau trains + if (index_train<1) or (index_train>Max_Trains) then + begin + Affiche('Erreur 650 : index train='+intToSTR(index_train),clred); + exit; + end; nomTrain:=trains[Index_train].nom_train; i2:=((it-1) mod NbCouleurTrain) +1; couleur:=CouleurTrain[i2]; n:=trains[index_train].route[0].adresse; // si le détecteur est le dernier détecteur de la route - if (det2=trains[index_train].route[n].adresse) and (trains[index_train].route[n].typ=det) then + //if (det2=trains[index_train].route[n].adresse) and (trains[index_train].route[n].typ=det) then + pointroute:=trains[index_train].PointRout; + if (pointroute>=n) and (trains[index_train].route[n].typ=det) then begin - s:='Fin de route '+nomTrain+' - Arrêt train '; + s:='Fin de route '+nomTrain+' - Arrêt train - Pointeur='; + if debugRoulage then s:=s+intToSTR(PointRoute)+'/'+intToSTR(n); if traceListe then AfficheDebug(s,couleur); Affiche(s,couleur); trains[index_train].roulage:=0; // évite le démarrage du train s'il s'arrête sur un detecteur avec demade d'arret temporisé. //event_det_train[it].signal_rouge:=adresse; //Affiche('*************Arret train',clred); - if (index_train<>0) and (index_train0) and (index_train0 then + if trains[idTrain].TempoArretTemp<>0 then begin trains[idTrain].TempoDemarre:=trains[idTrain].TempoArretTemp; trains[idTrain].TempoArretTemp:=0; - end; + end; if not(roulage) then exit; //Affiche('Maj Route det '+intToSTR(detect),clWhite); @@ -12636,13 +12792,10 @@ begin //Affiche('Route du train '+nom_train,clWhite); Affiche('Route du train '+nom_train+' terminée.',clOrange); - {trains[idTrain].TempoArretCour:=0; - trains[idTrain].TempoArret:=50; - } // repartir à l'envers if false then begin - if not(diffusion) then Affiche('Route inverse',clWhite); + if debugRoulage then Affiche('Route inverse',clWhite); // inverser élement suivant et précédent du détecteur echange(detecteur[detect].suivant,detecteur[detect].precedent); t:=detecteur[detect].TypSuivant; @@ -12669,10 +12822,10 @@ end; procedure maj_route(detect : integer); var i : integer; begin - //Affiche('Maj_route '+intToSTR(detect),clYellow); + if DebugRoulage then Affiche('Maj_route '+intToSTR(detect),clYellow); if roulage then begin - // explorer les autres trains pour libérer leurs routes + // explorer les autres trains pour libérer leurs routes et positionner les aiguillages for i:=1 to ntrains do begin if trains[i].roulage<>0 then @@ -12706,6 +12859,7 @@ var m,AdrSignal,AdrDetSignal,AdrTrainLoc,Nbre,i,i2,j,k,l,n,det1,det2,det3,det4,A TypePrec,TypeSuiv : tEquipement; s,train_ch : string; begin + //Affiche('calcul zones',clYellow); det3:=adresse; // c'est le nouveau détecteur if det3=0 then exit; // pas de nouveau détecteur traite:=false; @@ -12824,9 +12978,7 @@ begin AdrTrain:=AdrTrainLoc end; end; - libere_canton(det1,det3); // on quitte det3 - Maj_Signaux(false); - Maj_Signaux(false); + libere_canton(det1,det3,AdrTrainLoc); // on quitte det3 event_act(det1,det3,1,''); // évènement détecteur de zone - 1 // affichages Affiche_Evt('1-0 route ok de '+intToSTR(det1)+' à '+IntToSTR(det3),clWhite); @@ -12855,6 +13007,8 @@ begin else zone_TCO(ntco,det3,adrSuiv,i,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train end; end; + Maj_Signaux(false); + Maj_Signaux(false); exit; // sortir absolument end else @@ -12907,6 +13061,7 @@ begin // vérifier si l'élément du tableau et le nouveau sont contigus Det_Adj(det1); // renvoie les adresses des détecteurs adjacents au détecteur "det1" résultat dans adj1 et adj2 + suivok1:=((Adj1=det3) and (adj1<9999)) or ((Adj2=det3) and (adj2<9990)); if suivok1 then begin @@ -12934,8 +13089,11 @@ begin // mettre à jour éléments prec et suivant du nouveau détecteur det_adj(det3); - if adj1=det1 then begin prec:=prec1;typePrec:=t1;end; // les variables sont renvoyée par detAdj - if adj2=det1 then begin prec:=prec2;typePrec:=t2;end; + // on autorise l'adjacent sur un aiguillage mal positionné en talon + if (adj1=det1) or (adj1=9998) then begin prec:=prec1;typePrec:=t1;end // les variables sont renvoyées par detAdj + else + if (adj2=det1) or (adj2=9998) then begin prec:=prec2;typePrec:=t2;end + else exit; // affectation précédent au nouveau détecteur detecteur[det3].precedent:=prec; @@ -12989,11 +13147,11 @@ begin pilote_train(det1,det3,adrtrainLoc,i); // pilote le train sur det3 event_act(det1,det3,1,''); // activation zone - 2 - maj_signaux(false); // actualiser le signal du det3 j:=signal_detecteur(det3); if j<>0 then Maj_Signal_P(j,false); maj_route(det3); + maj_signaux(false); exit; end; @@ -13107,7 +13265,7 @@ begin if detecteur[det2].train=train_ch then detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur si le nom du train est égal if detecteur[det2].AdrTrain=AdrTrainLoc then detecteur[det2].AdrTrain:=0; // désaffectation du nom de train de l'ancien détecteur - libere_canton(det2,det3); + libere_canton(det2,det3,AdrTrainLoc); det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1); if det4>9990 then begin @@ -13121,7 +13279,6 @@ begin else trains[i].detecteurSuiv:=det4; end; - //Maj_Signaux(false); sans_maj // stockage dans historique de zones if i0 then @@ -13213,7 +13370,6 @@ begin etatSig:=Signaux[k].etatsignal; end; Maj_Signaux(false); // mise à jour générale - maj_route(det3); exit; // sortir absolument end; end @@ -13240,8 +13396,10 @@ begin det_Adj(det2); // adj1, adj2 a1:=adj1;a2:=adj2; det_Adj(det3); - SuivOk2:=((a1=adj1) and detecteur[a1].Etat) or ((a1=adj2) and detecteur[a1].Etat) or - ((a2=adj1) and detecteur[a2].Etat) or ((a2=adj2) and detecteur[a2].Etat); + if (a10 then Maj_Signal_P(i2,false); // avec détecteur - } + for i:=1 to N_trains do // N_trains est le nombre de trains détectés en circulation begin i2:=event_det_train[i].Suivant; @@ -13411,6 +13567,7 @@ begin // test si on peut réserver le canton suivant det_suiv:=det_suiv_cont(i2,det3,1); maj_route(det3); + Maj_Signaux(true); exit; end; end; @@ -13485,14 +13642,14 @@ begin sens:=canton[j].SensLoco; if sens=0 then begin - Affiche('Anomalie 626 : Pas de sens train '+trains[canton[j].indexTrain].nom_train+' canton '+intToSTR(canton[j].numero),clred); + Affiche('Anomalie 626 : Pas de sens de circulation déclaré pour le train '+trains[canton[j].indexTrain].nom_train+' canton '+intToSTR(canton[j].numero),clred); end; // convertir en sens canton case sens of - sensGauche : sensTCO:=5; - sensDroit : sensTCO:=6; - sensBas : sensTCO:=8; - sensHaut : sensTCO:=7; + sensGauche : sensTCO:=SensTCO_O; + sensDroit : sensTCO:=SensTCO_E; + sensBas : sensTCO:=SensTCO_S; + sensHaut : sensTCO:=SensTCO_N; end; suivant:=trouve_det_suiv_canton(j,det3,sensTCO); if suivant>9990 then exit; @@ -13519,6 +13676,9 @@ begin end; pilote_train(0,det3,adrtrainLoc,n_trains); // pilote le train sur det3 + // libérer le canton précédent + libere_canton(det1,det2,AdrTrainLoc); + end; begin // si démarré sans positionnement dans canton @@ -13661,7 +13821,7 @@ procedure demande_etat_det; var i,j,adr,t : integer; s : string; begin - //exit; // #### + if simuInterface then exit; // #### if portCommOuvert or parSocketLenz or (etat_init_interface>=11) then begin Affiche('Demande état des détecteurs',ClYellow); @@ -13681,8 +13841,8 @@ begin sleep(10); until (retEtatDet) or (t>100); if t>100 then s:='=?' else - if Detecteur[adr].etat then s:='=1' else s:='=0'; - Affiche_suivi(s,clLime); + //if Detecteur[adr].etat then s:='=1' else s:='=0'; + //Affiche_suivi(s,clLime); end; modeStkRetro:=false; // avec evt end; @@ -14047,9 +14207,9 @@ begin if (ida0) and not(CDM_connecte) and (i_simule=0) then @@ -14468,7 +14627,7 @@ begin //if (train='') and (s<>'') then train:=s; if Etat then Etat01:=1 else Etat01:=0; - if traceliste then Affiche('Event Det '+inTToSTR(adresse)+' '+IntToSTR(etat01),ClCyan); + if traceliste or debugRoulage then Affiche('Event Det '+inTToSTR(adresse)+' '+IntToSTR(etat01),ClCyan); // vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état // on reçoit un doublon dans deux index consécutifs. (* @@ -14486,7 +14645,6 @@ begin begin //s:='Evt Det '+intToSTR(adresse)+'='+intToSTR(etat01); s:='Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01)+' Train='+train; - Affiche(s,clYellow); AfficheDebug(s,clyellow); end; if AFfDetSIg then AfficheDebug('Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01),clOrange); @@ -14803,7 +14961,7 @@ begin begin adr:=aiguillage[id].Ddevie; // homologue Maj_TCO(i,adr); - end; + end; end; Maj_TCO(i,Adresse); end; @@ -14885,7 +15043,7 @@ begin if indexAig<>0 then begin AdrTrainLoc:=aiguillage[indexAig].AdrTrain; - if (AdrTrainLoc<>0) and (AdrTrain<>0) and (AdrTrainLoc<>AdrTrain) and (diffusion) then + if (AdrTrainLoc<>0) and (AdrTrain<>0) and (AdrTrainLoc<>AdrTrain) then begin Affiche('Pilotage impossible, l''aiguillage '+intToSTR(adresse)+' est réservé par le train @'+intToSTR(AdrTrainLoc),clred); Result:=false; @@ -14917,7 +15075,7 @@ begin if Acc=AigP then begin temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; // mini pour pilotage en signaux LEB - if portCommOuvert or parSocketLenz then tempo(temp); + if portCommOuvert or parSocketLenz then tempo2(temp); end; // remise à 0 @@ -14958,7 +15116,7 @@ begin if Acc=AigP then begin temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; - if portCommOuvert or parSocketLenz then tempo(temp); + if portCommOuvert or parSocketLenz then tempo2(temp); end; // pilotage à 0 pour éteindre le pilotage de la bobine du relais @@ -15874,12 +16032,12 @@ var chaineInt: TchaineBIN; c : char; begin chaineINT:=chaine; - if protocole=1 then + if protocole=1 then // xpressNet begin chaineINT:=decode_chaine_retro_Xpress(chaineINT); end; - if protocole=2 then + if protocole=2 then // Dccpp begin // transformer chaine en s ascii s:=''; @@ -15962,6 +16120,10 @@ var const IsWow64: Boolean=False; begin + {$IFDEF WIN64} // si déjà compilé en 64 bits + result:=true; + exit; + {$ENDIF} IsWow64:=false; Dll:=LoadLibrary('kernel32.dll'); if (Dll<>0) then @@ -15994,9 +16156,6 @@ begin end; end; - - - // détermine si le périphérique i est un comusb ou un socket // =0 erreur // =1 comusb @@ -16200,7 +16359,9 @@ end; function ProcessRunning(sExeName: String) : Boolean; var hSnapShot : THandle; ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 + t : ModuleEntry32; processID : DWord; + //s : array[0..MAX_PATH - 1] of char; //PAnsiChar; begin Result:=false; hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); @@ -16217,12 +16378,20 @@ begin begin processID:=ProcessEntry32.th32ProcessID; CDMhd:=GetWindowFromID(processID); - //Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); + Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); Result:=true; + // marche pas - devrait récuperer le chemin d'install + //n:=GetModuleFileNameExA(ProcessID,0, pchar(s), MAX_PATH); + //Affiche(s+' '+intToSTR(n),clred); Break; end; until (Process32Next(hSnapShot,ProcessEntry32)=false); CloseHandle(hSnapShot); + //Module32First(CDMHd,t); + //s:=t.szExePath; + //Affiche(s,clred); + // := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessID); + end; // préparation du tampon pour SendInput @@ -16551,12 +16720,15 @@ begin begin trains[i].canton:=0; trains[i].detecteurSuiv:=0; - trains[i].TempoArret:=0; + //trains[i].TempoArret:=0; trains[i].TempoArretCour:=0; trains[i].TempoArretTemp:=0; trains[i].TempoDemarre:=0; trains[i].TempsDemarreSig:=0; trains[i].roulage:=0; + trains[i].arret_det:=false; + trains[i].phase_arret:=0; + trains[i].route[0].adresse:=0; // dévalide la route end; for index:=1 to NbreTCO do @@ -17223,6 +17395,53 @@ begin end; end; +// affecte les trains aux cantons d'après la config +procedure affecte_trains_config; +var i,n,t : integer; +begin +// affecter les trains au cantons d'après le placement du fichier de config + procetape('Mise à jour des trains cantons'); + for i:=1 to Ntrains do + begin + ProcEtape('Début extraction train '+intToSTR(i)+' sur canton'); + n:=trains[i].canton; // numéro de canton (pas index) provient du placement du fichier de config + ProcEtape('Fin extraction train '+intToSTR(i)+' sur canton '+intToSTR(n)); + if n>0 then + begin + t:=index_canton_numero(n); + if t=0 then + begin + Affiche('Le train '+trains[i].nom_train+' est affecté à un canton '+intToSTR(n)+' qui est inexistant,',clOrange); + Affiche('Ceci a été corrigé en désaffectant le train.',clOrange); + trains[i].canton:=0; + end + else + begin + ProcEtape('Train '+intToSTR(i)+' canton numéro '+intToSTR(n)); + affecte_Train_canton(trains[i].adresse,t,trains[i].sens); + end; + end; + end; + + { + procetape('Affecter les sens des trains aux cantons'); + // affecter les sens des trains dans les cantons + for i:=1 to nCantons do + begin + t:=canton[i].indexTrain; + if t>nTrains then + begin + Affiche('Anomalie train index='+intToSTR(t)+'au canton '+intToSTR(i)+' - forçage à 0',clred); + t:=0; + canton[i].SensLoco:=0; + end + else + begin + if t>0 then canton[i].SensLoco:=trains[t].sens; + end; + end; } +end; + // démarrage principal du programme signaux_complexes procedure TFormPrinc.FormCreate(Sender: TObject); var n,t,i,index,OrgMilieu : integer; @@ -17231,7 +17450,7 @@ var n,t,i,index,OrgMilieu : integer; Sr : TSearchRec; tmP,tmA : tMenuItem; begin - af:='Client TCP-IP ou USB CDM Rail - Système XpressNet DCC++ Version '+VersionSC+sousVersion+' Rho'; + af:='Client TCP-IP ou USB CDM Rail - Système XpressNet DCC++ Version '+VersionSC+sousVersion; {$IF CompilerVersion >= 28.0} af:=af+' D12'; {$IFEND} @@ -17327,9 +17546,13 @@ begin serveurIPCDM_Touche:=false; debugPN:=false; option_demitour:=false; + debugroulage:=false; sombre:=false; - AvecInit:=true; // avec initialisation des aiguillages ou pas + AvecInit:=true; // avec initialisation des aiguillages ou pas simuInterface:=false; + Stop_Maj_Sig:=false; + MaxParcours:=100; // Nombre maxi d'éléments d'une route + MaxRoutes:=1000; // nombre maxi de routes Diffusion:=true; // &&&& mode diffusion publique + debug mise au point etc AffAigDet:=not(diffusion); @@ -17352,12 +17575,22 @@ begin begin trains[i].canton:=0; trains[i].detecteurSuiv:=0; - trains[i].TempoArret:=0; + //trains[i].TempoArret:=0; trains[i].TempoArretCour:=0; trains[i].TempoDemarre:=0; + trains[i].arret_det:=false; + trains[i].phase_arret:=0; trains[i].TempoArretTemp:=0; trains[i].TempsDemarreSig:=0; + With Trains[i].routePref[0] do + begin + adresse:=0; + pos:=0; + typ:=rien; + end; + Trains[i].icone:=Timage.create(self); + with Trains[i].icone do begin autosize:=true; @@ -17527,7 +17760,7 @@ begin Application.HintHidePause:=30000; Application.HintColor:=$70FFFF; - Application.HintPause:=400; + Application.HintPause:=400; // 400ms //visible:=true; // rend la form visible plus tot for i:=1 to MaxCdeDccpp do CdeDccpp[i]:=''; // lecture fichiers de configuration @@ -17606,46 +17839,6 @@ begin cree_image(i); // et initialisation tableaux signaux end; - procetape('Mise à jour des trains cantons'); - - // affecter les trains au cantons d'après le placement du fichier de config - for i:=1 to Ntrains do - begin - ProcEtape('Début extraction train '+intToSTR(i)+' sur canton'); - n:=trains[i].canton; // numéro de canton (pas index) provient du placement du fichier de config - ProcEtape('Fin extraction train '+intToSTR(i)+' sur canton '+intToSTR(n)); - if n>0 then - begin - t:=index_canton_numero(n); - if t=0 then - begin - Affiche('Le train '+trains[i].nom_train+' est affecté à un canton '+intToSTR(n)+' qui est inexistant,',clOrange); - Affiche('Ceci a été corrigé en désaffectant le train.',clOrange); - trains[i].canton:=0; - end - else - begin - ProcEtape('Train '+intToSTR(i)+' canton numéro '+intToSTR(n)); - affecte_Train_canton(trains[i].adresse,t); - end; - end; - end; - - procetape('Affecter les sens des trains aux cantons'); - // affecter les sens des trains dans les cantons - for i:=1 to nCantons do - begin - t:=canton[i].indexTrain; - if t>nTrains then - begin - Affiche('Anomalie train index='+intToSTR(t)+'au canton '+intToSTR(i)+' - forçage à 0',clred); - t:=0; - canton[i].SensLoco:=0; - end - else - canton[i].SensLoco:=trains[t].sens; - end; - Tempo_init:=5; // démarre les initialisations des signaux et des aiguillages dans 0,5 s OrgMilieu:=formprinc.width div 2; @@ -18029,10 +18222,10 @@ begin // séquencement des actions après tempo if index_seqAct>0 then begin - if seq_actionneurs[index_seqAct].tick=tick then + if seq_actions[index_seqAct].tick=tick then begin - i:=seq_actionneurs[index_seqAct].indiceAction; - j:=seq_actionneurs[index_seqAct].IndiceOp; + i:=seq_actions[index_seqAct].indiceAction; + j:=seq_actions[index_seqAct].IndiceOp; n:=Tablo_Action[i].NbOperations; dec(index_seqAct); a:=j; @@ -18278,85 +18471,52 @@ begin //if (tick mod 10)=0 then Affiche(intToSTR(trains[4].TempoArretCour),clWhite); for i:=1 to ntrains do begin - a:=trains[i].TempoArret; // la tempo d'arret est écrite par pilote_train() ou autre - if a<>0 then + if trains[i].arret_det then begin - if trains[i].TempoArretCour=0 then - begin - trains[i].TempoArretCour:=a; - if not(diffusion) then Affiche('Timer Vitesse train /2',clYellow); - vitesse:=trains[i].VitRalenti div 2; - trains[i].vitesse:=vitesse; - if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,true); - end; - - dec(trains[i].TempoArretCour); - a:=trains[i].TempoArretCour; adresse:=trains[i].dernierDet; - - // si le train est sur un détecteur - if (adresse<>0) then + if adresse<>0 then begin - longueur:=detecteur[adresse].longueur; // longueur du détecteur - - if detecteur[Adresse].Etat then - begin - inc(detecteur[adresse].temps); - - vitesse:=trains[i].vitesse; - if not(diffusion) then Affiche('Timer Vitesse='+intToSTR(vitesse),clred); - if vitesse<>0 then - d:=abs(round(detecteur[adresse].temps*90/vitesse)) - else d:=9999; // si la vitesse du train est nulle, mettre une condition qui arrete le train en fin de parcours sur le détecteur - - //Affiche('TempoarretCour='+intToSTR(a)+' train '+intToSTR(i)+' detecteur='+intToSTR(adresse)+' TpsDet='+intToSTR(detecteur[adresse].temps),clOrange); - // si la longueur déclarée du canton <>0 on s'arrete sur la longueur sinon on s'arrete sur la tempo d'arret. - if (a<>0) and (longueur<>0) then - begin - // arrêt - if not(diffusion) then Affiche('Timer Dist='+intToSTR(d),clYellow); - if d>longueur-5 then - begin - a:=0; - trains[i].TempoArret:=0; - trains[i].TempoArretCour:=0; - if not(diffusion) then Affiche('Timer '+trains[i].nom_train+' Arrêté',ClWhite); - vitesse:=0; + case trains[i].phase_arret of + 0 : begin + vitesse:=trains[i].VitRalenti div 2; trains[i].vitesse:=vitesse; if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,false); // arrêt du train - train_sarrete(i); + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,true); + trains[i].phase_arret:=1; + detecteur[adresse].temps:=0; end; - end; + 1 : begin + inc(detecteur[adresse].temps); + vitesse:=trains[i].vitesse; + if vitesse<>0 then + d:=abs(round(detecteur[adresse].temps*90/vitesse)) // distance parcourue depuis l'arrivée sur le détecteur + else d:=9999; // si la vitesse du train est nulle, mettre une condition qui arrete le train en fin de parcours sur le détecteur - if a<>0 then - begin - if (longueur=0) then - begin - if not(diffusion) then Affiche('Timer Cas longueur non déclarée',clWhite); - dec(a); - trains[i].TempoArretCour:=a; // il faut utiliser la tempo d'arret<>0 pour savoir que le train doit s'arrêter - if a=0 then + //Affiche('TempoarretCour='+intToSTR(a)+' train '+intToSTR(i)+' detecteur='+intToSTR(adresse)+' TpsDet='+intToSTR(detecteur[adresse].temps),clOrange); + // si la longueur déclarée du canton <>0 on s'arrete sur la longueur sinon on s'arrete sur la tempo d'arret. + // arrêt + if debugRoulage then Affiche('Timer Dist='+intToSTR(d),clYellow); + longueur:=detecteur[adresse].longueur; + if ((d>longueur-5) and (longueur>0)) or + ((d>10) and (longueur=0)) then begin - //Affiche(trains[i].nom_train+' Arrêté',ClWhite); - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,false); - train_sarrete(i); - end; - if (a mod 10)=0 then - begin - vitesse:=trains[i].VitRalenti div 2; + //trains[i].TempoArret:=0; + trains[i].TempoArretCour:=0; + trains[i].arret_det:=false; + trains[i].phase_arret:=0; + if debugRoulage then Affiche('Timer '+trains[i].nom_train+' Arrêté',ClWhite); + vitesse:=0; + trains[i].vitesse:=vitesse; if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,true); + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,false); // arrêt du train + train_sarrete(i); // vérifie si fin de route, et copie tempo_demarre si détecteur arrêt optionnel+ tempo de redémarrage end; end; - end; end; - end; - if a=0 then + end + else begin - trains[i].TempoArret:=0; - trains[i].TempoArretCour:=0; + if DebugRoulage then Affiche('Erreur 681 : adresse detecteur nul train '+Trains[i].nom_train,clred); end; end; @@ -18364,19 +18524,19 @@ begin a:=trains[i].TempoDemarre; if a<>0 then begin - if not(diffusion) then Affiche('timer tempo démarre '+intToSTR(a)+' '+intToSTR(trains[i].TempsDemarreSig-5),clWhite); + if debugRoulage then Affiche('Timer tempo démarre '+intToSTR(a)+' '+intToSTR(trains[i].TempsDemarreSig-5),clWhite); if a=(trains[i].TempsDemarreSig*10)-5 then // renvoi consigne d'arret 5x1/10 de secondes apres begin - s:=trains[i].nom_train; - //s:=chaine_CDM_vitesseST(1,s); +{ s:=trains[i].nom_train; s:=chaine_CDM_StopTrainST(s); - envoi_cdm(s); + envoi_cdm(s); ???!! } + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,false); end; dec(a); - if a mod 10=0 then Affiche_temps_arret(i,a); + if a mod 10=0 then Affiche_temps_arret(i,a); // affiche le temps d'arrêt sur le canton trains[i].TempoDemarre:=a; - if a=0 then + if a=0 then // fin de la tempo d'arrêt: on redémarre! begin vitesse:=trains[i].VitNominale; if (trains[i].inverse) then vitesse:=-vitesse; @@ -18421,7 +18581,7 @@ begin s:='Simu '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' det='+intToSTR(Tablo_simule[i_simule].adresse)+'='+IntToSTR(Tablo_simule[i_simule].etat); Event_Detecteur(Tablo_simule[i_simule].adresse, Tablo_simule[i_simule].etat=1, Tablo_simule[i_simule].train); // créer évt détecteur StatusBar1.Panels[1].text:=s; - //Affiche(s,clyellow); + Affiche(s,clyellow); end; // evt actionneur ? @@ -18439,7 +18599,7 @@ begin s:='Simu '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' aig='+intToSTR(Tablo_simule[i_simule].adresse)+'='+IntToSTR(Tablo_simule[i_simule].etat); Event_Aig(Tablo_simule[i_simule].Adresse,Tablo_simule[i_simule].etat); // créer évt aiguillage StatusBar1.Panels[1].text:=s; - //Affiche(s,clyellow); + Affiche(s,clyellow); end; inc(i_simule); @@ -18860,8 +19020,8 @@ begin if model=triple then // aig triple begin j:=aiguillage[i].AdrTriple; - s:=s+' Aig '+IntToSTR(j)+': '+intToSTR(aiguillage[index_aig(j)].position); - if aiguillage[index_aig(j)].position=const_devie then s:=s+' (dévié)' else s:=s+' (droit)'; + s:=s+' Aig '+IntToSTR(j)+': '+intToSTR(aiguillage[j].position)+' '; + if aiguillage[j].position=const_devie then s:=s+' (dévié)' else s:=s+' (droit)'; end; if (model=Crois) then s:='Croisement '+IntToSTR(aiguillage[i].Adresse); @@ -18991,9 +19151,6 @@ begin end; - - - // décodage d'une trame CDM au protocole IPC // la trame_CDM peut contenir 2000 caractères à l'initialisation du RUN. procedure Interprete_trameCDM(trame_CDM:string); @@ -19936,7 +20093,7 @@ begin s:=#$23+#$16+Char(cv)+Char(valeur); //CV de 1 à 256 s:=checksum(s); envoi(s); // envoi de la trame et attente Ack, la premiere trame fait passer la centrale en mode programmation (service) - tempo(5); + tempo2(5); end; end; end; @@ -19992,11 +20149,11 @@ begin s:=checksum(s); //envoi(s); envoi_ss_ack(s); - Tempo(1); + Tempo2(1); // attente de la réponse de la centrale i:=0; repeat - Tempo(2); // attend 200 ms + Tempo2(2); // attend 200 ms inc(i); until recu_cv or (i>4); if (i>4) then @@ -20015,11 +20172,11 @@ begin begin s:=''; envoi_ss_ack(s); - Tempo(1); + Tempo2(1); // attente de la réponse de la centrale i:=0; repeat - Tempo(2); // attend 200 ms + Tempo2(2); // attend 200 ms inc(i); until recu_cv or (i>4); if (i>4) then @@ -20326,7 +20483,8 @@ end; function InfoSignal(adresse : integer) : string; var s,ss : string; - nation,etat,i,j,aspect,n,combine,aig,trainReserve,AdrSignalsuivant,voie,AdrTrainRes,adraig : integer; + nation,etat,i,j,aspect,n,combine,aig,trainReserve,AdrSignalsuivant,voie, + indexTrain,AdrTrainRes,adraig : integer; reserveTrainTiers : boolean; code : word; begin @@ -20353,6 +20511,7 @@ begin begin //Affiche(s,clyellow); adraig:=carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes); + IndexTrain:=Index_train_adresse(AdrTrainRes); if adraig<>0 then s:=s+'les aiguillages en aval du signal sont mal positionnés (A'+IntToSTR(AdrAig)+') ou leur positions inconnues'+#13; if reserveTrainTiers then begin @@ -20365,8 +20524,9 @@ begin inc(j); end; end; - if j=1 then s:=s+'Un aiguillage ou un croisement en aval du signal ('+ss+') est réservé par le train (@'+intToSTR(AdrTrainRes)+')'+#13 - else s:=s+'Des aiguillages ou des croisements en aval du signal ('+ss+') sont réservés par le train (@'+intToSTR(AdrTrainRes)+')'+#13 + if j=1 then s:=s+'Un aiguillage ou un croisement en aval du signal '+#13+'('+ss+') est réservé par le train (@'+intToSTR(AdrTrainRes)+')' + else s:=s+'Des aiguillages ou des croisements en aval du signal '+#13+'('+ss+') sont réservés par le train (@'+intToSTR(AdrTrainRes)+')'; + s:=s+' '+trains[Indextrain].nom_train+#13; end; if Cond_Carre(Adresse) then s:=s+'les aiguillages déclarés dans la définition du signal sont mal positionnés'+#13; if Signaux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,false,TrainReserve,voie)) then s:=s+'le signal est verrouillable au carré et aucun train n''est présent avant le signal'+#13; @@ -20832,8 +20992,9 @@ begin begin Affiche('Arrêt train @'+intToSTR(adr)+' '+Trains[i].nom_train,clyellow); vitesse_loco('',i,adr,0,true); - trains[i].TempoArretCour:=0; - trains[i].TempoArret:=0; + //trains[i].TempoArretCour:=0; + //trains[i].arret_det:=true; + //trains[i].TempoArret:=0; end; end; end; @@ -22161,6 +22322,15 @@ begin end; end; +// renvoie les poinnts ouverts d'une TJD 4 états en fonction de son état passé en paramètres +procedure TJD4(adr1,pos1,adr2,pos2 : integer;var c1,c2 : char); +begin + if (pos1=const_droit) and (pos2=const_droit) then begin c1:='D';c2:='D';end; + if (pos1=const_devie) and (pos2=const_droit) then begin c1:='D';c2:='S';end; + if (pos1=const_droit) and (pos2=const_devie) then begin c1:='S';c2:='D';end; + if (pos1=const_devie) and (pos2=const_devie) then begin c1:='S';c2:='S';end; +end; + // copie le parcours source vers le fin de la route dest function copie_route(source,dest : integer) : boolean; var i,n,d : integer; @@ -22186,7 +22356,7 @@ end; // trouve toutes les routes de "depart" à "fin" , // "prec" est le départ // "actuel" est l'élément suivant à pres , pour le sens de rechercher au départ -// remplit le tableau tabloroute[route,i] (route=index de la route trouvée) +// remplit le tableau tabloroute[route,id] (route=index de la route trouvée) // on teste les aiguillages et les tjd sur toutes leurs positions // procédure récursive // tabloroute[n,0].adresse contient le nombre d'éléments de la route n @@ -22200,14 +22370,26 @@ end; // 4 si max récursivité // sorties normales: ----- // 5 si rebouclage sur départ -// 6 si rebouclage sur élément déja traité +// 6 si rebouclage sur élément déja traité (plus envisagé car c'est possible sur une route qui repasse) // 7 fin exploration aiguillage // 8 fin exploration TJD // -------------- // 9 demande sortie (trop de traitements); -// 10 si trouvé le détecteur "fin" +// 10 trouvé le détecteur "fin" // 11 nouvelle route, vient après 10 // 12 mauvais sens +// 13 trouvé détecteur à 1 +// 14 trouvé détecteur interdit +// 15 détecteur obligatoire non trouvé +// 16 tjd non résolue +// 98 erreur de type +// 99 erreur alg3 +// Nota: +// sur un moyen réseau (Djeff pour trouver toutes les routes, les paramètres sont: +// MaxRoutes:=10000 +// MaxParcours=300 +// Ctot=1 000 000 +// ce qui est excessif, donc on limite une route à 150 éléments (MaxParcours) function explore_el(prec : integer;typPrec : Tequipement;actuel : integer;TypActuel : Tequipement;var nroute : integer;id : integer;ir,depart,fin : integer;var ctot : integer) : integer; // copie la route dans la suivante @@ -22245,21 +22427,27 @@ function explore_el(prec : integer;typPrec : Tequipement;actuel : integer;TypAct const itmax=90; var -suivant,indexAig,IndexAigSuiv,it,r,c1,c2,sensEL1,sensEL2,el1,el2,sensCirc1,SensCirc2, -NumCanton1,NumCanton2,origine,position,idx,indexAig2,AdrEntreTJD,nEtats : integer; -typSuiv,tel1,tel2 : tEquipement; -ok,AffRouteR,taig,Horz1,Horz2 : boolean; +suivant,indexAig,IndexAigSuiv,it,r,c1,c2,sensEL1c1,sensEL2c1,el1c1,el2c1,sensCirc1,SensCirc2, +NumCanton1,NumCanton2,origine,position,idx,indexAig2,TJDEntre,nEtats,i,k,sensEL1c2,sensEL2c2, +el1c2,el2c2,posPrec,TjdS,adresse2 : integer; +typSuiv,tel1c1,tel2c1,tel1c2,tel2c2 : tEquipement; +ok,AffRouteR,taig,Horzc1,Horzc2,DebugRoute : boolean; +s : string; c : char; begin proc:=Texplore_el; param1:=prec; param2:=actuel; inc(ctot); - AffRouteR:=false; // pour debug - if ctot>200000 then + AffRouteR:=false; + DebugRoute:=formRoute.CheckBoxDebugRoutes.Checked; // pour debug + + + if ctot>1500000 then // 500000 nombre d'itérations begin result:=9; - if affRouteR then Affiche('Sortie totale',clred); + if affRouteR then + Affiche('Sortie totale',clred); Affichedebug('Sortie totale Explore_el:'+intToSTR(prec)+' '+intToSTR(actuel),clred); exit; end; @@ -22272,14 +22460,20 @@ begin inc(ir); if ir>itMax then begin - if affRouteR then + if affRouteR or DebugRoute then Affiche('MaxRecursivité recherche route',clred); result:=4; exit; end; repeat - if affRouteR then Affiche(intToSTR(actuel),clyellow); + if affRouteR then Affiche(intToSTR(id)+' : '+intToSTR(actuel),clyellow); + if id>MaxParcours then + begin + if affRouteR or DebugRoute then Affiche('MaxParcours',clred); + result:=1; + exit; + end; tabloroute[nRoute,id].adresse:=actuel; tabloroute[nRoute,id].typ:=typActuel; tabloRoute[nRoute,0].adresse:=id; @@ -22289,85 +22483,130 @@ begin // exit si pas le bon sens du canton avec le code 12 if (TypActuel=det) then // un détecteur peut être jointif de 2 cantons begin - NumCanton1:=detecteur[actuel].canton1; // numéro de canton 1 + NumCanton1:=0; + if actuel0 then // il y a un canton begin c1:=Index_canton_numero(NumCanton1); SensCirc1:=canton[c1].SensCirc; - el1:=canton[c1].el1; - tel1:=canton[c1].typ1; - el2:=canton[c1].el2; - tel2:=canton[c1].typ2; - sensEL1:=canton[c1].SensEl1; //( SensGauche SensDroit SensHaut SensBas) - sensEL2:=canton[c1].SensEl2; //( SensGauche SensDroit SensHaut SensBas) - Horz1:=canton[c1].horizontal; + el1c1:=canton[c1].el1; + tel1c1:=canton[c1].typ1; + el2c1:=canton[c1].el2; + tel2c1:=canton[c1].typ2; + sensEL1c1:=canton[c1].SensEl1; //( SensGauche SensDroit SensHaut SensBas) + sensEL2c1:=canton[c1].SensEl2; //( SensGauche SensDroit SensHaut SensBas) + Horzc1:=canton[c1].horizontal; end; - NumCanton2:=detecteur[actuel].canton2; // numéro de canton 2 + numcanton2:=0; + if actuel0 then begin c2:=Index_canton_numero(NumCanton2); SensCirc2:=canton[c2].SensCirc; - el1:=canton[c2].el1; - tel1:=canton[c2].typ1; - el2:=canton[c2].el2; - tel2:=canton[c2].typ2; - sensEL1:=canton[c2].SensEl1; //( SensGauche SensDroit SensHaut SensBas) - sensEL2:=canton[c2].SensEl2; //( SensGauche SensDroit SensHaut SensBas) - Horz2:=canton[c2].horizontal; + el1c2:=canton[c2].el1; + tel1c2:=canton[c2].typ1; + el2c2:=canton[c2].el2; + tel2c2:=canton[c2].typ2; + sensEL1c2:=canton[c2].SensEl1; //( SensGauche SensDroit SensHaut SensBas) + sensEL2c2:=canton[c2].SensEl2; //( SensGauche SensDroit SensHaut SensBas) + Horzc2:=canton[c2].horizontal; end; suivant:=suivant_alg3(prec,TypPrec,actuel,TypActuel,1); - - // le suivant doit être l'un des 2 éléments du canton - if (numcanton1<>0) and (sensCirc1<>0) and ((suivant=el1) or (suivant=el2)) then + if suivant>9000 then begin - if horz1 then // si le canton 1 est horizontal + Affiche('Erreur 96 : '+intToSTR(prec)+' '+intToSTR(actuel),clred); + result:=suivant; + exit; + end; + //vérif si détecteur interdit (vient des cantons interdits) + i:=1; + + while (list_det_int[i].adresse<>0) and (i<20) do + begin + if (actuel=list_det_int[i].adresse) and (typActuel=det) then begin - ok:=(actuel=el2) and (sensEl2=sensDroit) and (SensCirc1=SensGauche) ; - ok:=((actuel=el2) and (sensEl2=sensGauche) and (SensCirc1=SensDroit)) or ok; - ok:=((actuel=el1) and (sensEl1=sensDroit) and (SensCirc1=SensGauche)) or ok ; - ok:=((actuel=el1) and (sensEl1=sensGauche) and (SensCirc1=SensDroit)) or ok ; + if affRouteR or DebugRoute then + Affiche('Détecteur interdit: '+intToSTR(actuel)+' route='+intToSTR(nroute),clLime); + result:=14; + exit; // le fait de faire un exit sans incrémenter le numéro de route annule cette route, reprise de l'aiguillage précédent. + end; + inc(i); + end; + + // détecteur à 1 + if (TypActuel=det) and (actuel<>depart) and (detecteur[actuel].Etat) then + begin + ok:=false; + // si l'un des deux détecteurs est le final, ne pas considérer le detecteur à 1 de l'autre détecteur du canton + if numcanton1<>0 then + begin + if ((el1c1=actuel) or (el2c1=actuel)) and ((el1c1=fin) or (el2c1=fin)) then ok:=true; + end; + if numcanton2<>0 then + begin + if ((el1c2=actuel) or (el2c2=actuel)) and ((el1c2=fin) or (el2c2=fin)) then ok:=true; + end; + + if not ok then + begin + if affRouteR or DebugRoute then + Affiche('Route '+intToSTR(nroute)+' Détecteur '+intToSTR(actuel)+' à 1',clyellow); + result:=13; + exit; + end; + end; + + // le suivant doit être l'un des 2 éléments du canton + if (numcanton1<>0) and (sensCirc1<>0) and ((suivant=el1c1) or (suivant=el2c1)) then + begin + if horzc1 then // si le canton 1 est horizontal + begin + ok:=(actuel=el2c1) and (sensEl2c1=sensDroit) and (SensCirc1=SensGauche) ; + ok:=((actuel=el2c1) and (sensEl2c1=sensGauche) and (SensCirc1=SensDroit)) or ok; + ok:=((actuel=el1c1) and (sensEl1c1=sensDroit) and (SensCirc1=SensGauche)) or ok ; + ok:=((actuel=el1c1) and (sensEl1c1=sensGauche) and (SensCirc1=SensDroit)) or ok ; if not(ok) then begin - if affRouteR then + if affRouteR or DebugRoute then Affiche('1 Canton '+intToSTR(NumCanton1)+' sens nok',clLime); result:=12;exit;end; end else begin // le canton 1 est vertical - ok:=(actuel=el2) and (sensEl2=sensBas) and (SensCirc1=SensHaut) ; - ok:=((actuel=el2) and (sensEl2=sensHaut) and (SensCirc1=SensBas)) or ok; - ok:=((actuel=el1) and (sensEl1=sensBas) and (SensCirc1=SensHaut)) or ok; - ok:=((actuel=el1) and (sensEl1=sensHaut) and (SensCirc1=SensBas)) or ok; + ok:=(actuel=el2c1) and (sensEl2c1=sensBas) and (SensCirc1=SensHaut) ; + ok:=((actuel=el2c1) and (sensEl2c1=sensHaut) and (SensCirc1=SensBas)) or ok; + ok:=((actuel=el1c1) and (sensEl1c1=sensBas) and (SensCirc1=SensHaut)) or ok; + ok:=((actuel=el1c1) and (sensEl1c1=sensHaut) and (SensCirc1=SensBas)) or ok; if not(ok) then begin - if affRouteR then + if affRouteR or DebugRoute then Affiche('2 Canton '+intToSTR(NumCanton1)+' sens nok',clLime); result:=12;exit;end; end; end; - if (numcanton2<>0) and (sensCirc2<>0) and ((suivant=el1) or (suivant=el2)) then + if (numcanton2<>0) and (sensCirc2<>0) and ((suivant=el1c2) or (suivant=el2c2)) then begin - if horz2 then + if horzc2 then begin - ok:=(actuel=el2) and (sensEl2=sensDroit) and (SensCirc2=SensGauche) ; - ok:=((actuel=el2) and (sensEl2=sensGauche) and (SensCirc2=SensDroit)) or ok; - ok:=((actuel=el1) and (sensEl1=sensDroit) and (SensCirc2=SensGauche)) or ok ; - ok:=((actuel=el1) and (sensEl1=sensGauche) and (SensCirc2=SensDroit)) or ok ; + ok:=(actuel=el2c2) and (sensEl2c2=sensDroit) and (SensCirc2=SensGauche) ; + ok:=((actuel=el2c2) and (sensEl2c2=sensGauche) and (SensCirc2=SensDroit)) or ok; + ok:=((actuel=el1c2) and (sensEl1c2=sensDroit) and (SensCirc2=SensGauche)) or ok ; + ok:=((actuel=el1c2) and (sensEl1c2=sensGauche) and (SensCirc2=SensDroit)) or ok ; if not(ok) then begin - if affRouteR then - Affiche('3 Canton '+intToSTR(NumCanton1)+' sens nok',clLime); + if affRouteR or DebugRoute then + Affiche('3 Canton '+intToSTR(NumCanton2)+' sens nok',clLime); result:=12;exit;end; end else begin - ok:=(actuel=el2) and (sensEl2=sensBas) and (SensCirc2=SensHaut) ; - ok:=((actuel=el2) and (sensEl2=sensHaut) and (SensCirc2=SensBas)) or ok; - ok:=((actuel=el1) and (sensEl1=sensBas) and (SensCirc2=SensHaut)) or ok; - ok:=((actuel=el1) and (sensEl1=sensHaut) and (SensCirc2=SensBas)) or ok; + ok:=(actuel=el2c2) and (sensEl2c2=sensBas) and (SensCirc2=SensHaut) ; + ok:=((actuel=el2c2) and (sensEl2c2=sensHaut) and (SensCirc2=SensBas)) or ok; + ok:=((actuel=el1c2) and (sensEl1c2=sensBas) and (SensCirc2=SensHaut)) or ok; + ok:=((actuel=el1c2) and (sensEl1c2=sensHaut) and (SensCirc2=SensBas)) or ok; if not(ok) then begin - if affRouteR then - Affiche('4 Canton '+intToSTR(NumCanton1)+' sens nok',clLime); + if affRouteR or DebugRoute then + Affiche('4 Canton '+intToSTR(NumCanton2)+' sens nok',clLime); result:=12;exit;end; end; end; @@ -22375,39 +22614,74 @@ begin if actuel=0 then begin - if affRouteR then + if affRouteR or DebugRoute then Affiche('Trouvé 0',clred); result:=0; exit; end; if id>=MaxParcours then begin - if affRouteR then + if affRouteR or DebugRoute then Affiche('MaxParcours',clred); result:=1; exit; end; - if nroute>=(MaxRoutes) then + if nroute>=MaxRoutes then begin - if affRouteR then Affiche('MaxRoutes atteint',clred); + if affRouteR or DebugRoute then Affiche('MaxRoutes atteint',clred); Affichedebug('Max routes atteint: '+intToSTR(prec)+' '+intToSTR(actuel),clred); result:=2; exit; end; - if (actuel=depart) and (ir>1) then - begin - if affRouteR then affiche('Rebouclage',clred); - result:=5; - exit; - end; - if (actuel=fin) then + if (actuel=fin) and (id>2) then // fin de route? begin tabloroute[nRoute,id].typ:=det; - if affRouteR then Affiche('Trouvé détecteur final **********',clWhite); - result:=10; + // voir si tous les détecteurs obligatoires sont dans la route + + for i:=1 to 20 do List_det_obl[i].n:=0; + i:=1; + while (list_det_obl[i].adresse<>0) and (i<20) do + begin + for k:=1 to tabloroute[nRoute,0].adresse do + begin + if (tabloRoute[nRoute,k].adresse=list_det_obl[i].adresse) and (tabloroute[nroute,k].typ=det) then + begin + inc(list_det_obl[i].n); // incrémenter le nombre de détecteurs obligatoires + end; + end; + inc(i); + end; + + i:=1; + while (list_det_obl[i].adresse<>0) and (i<20) do + begin + if list_det_obl[i].n=0 then + begin + if AffrouteR or DebugRoute then Affiche('Détecteur obligatoire '+intToSTR(list_det_obl[i].adresse)+' absent',clorange); + result:=15; + exit; + end; + inc(i); + end; + + if affRouteR or DebugRoute then Affiche('Trouvé détecteur final **********',clWhite); + + {if nroute=1 then + for i:=1 to tabloroute[1,0].adresse do + begin + s:=intToSTR(i)+' : '+intToSTR(tabloroute[1,i].adresse)+' '+BTypeToChaine(tabloroute[1,i].typ)+' '; + Affiche(s,clyellow); + end; } copie; - inc(nRoute); + inc(nRoute); // l'index ID ne change pas, on passe à la route suivante à l'index ID if nroute>NbreRoutes then NbreRoutes:=nroute; + result:=10; + exit; + end; + if (actuel=depart) and (ir>1) then + begin + if affRouteR or DebugRoute then affiche('Rebouclage',clred); + result:=5; exit; end; @@ -22423,7 +22697,7 @@ begin if (typactuel=aig) or (typactuel=triple) then begin - if aiguillage[indexAig].APointe=prec then + if aiguillage[indexAig].APointe=prec then // on le franchit en pointe begin inc(id); // faire droit @@ -22441,6 +22715,15 @@ begin end; if suivant=0 then TypSuiv:=buttoir; + if TypActuel=Triple then // pour faire droit droit + begin + inc(id); + tabloroute[nroute,id-1].adresse:=aiguillage[indexAig].Adevie2; + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].talon:=false; + end; + + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); if affrouteR then affiche('1.Retour explore_el de l''aig '+intToSTR(actuel)+' pos droit :'+intToSTR(r),clCyan); if r=9 then @@ -22451,6 +22734,7 @@ begin if r=10 then begin result:=11; + exit; end; // dévié if affRouteR then Affiche('Faire dévié aig'+intToSTR(actuel),clorange); @@ -22488,7 +22772,7 @@ begin else begin // dévié 2 du triple - if affRouteR then Affiche('Faire dévié2 aig'+intToSTR(actuel),clorange); + if affRouteR then Affiche('Faire dévié2 aig triple '+intToSTR(actuel),clorange); suivant:=aiguillage[indexAig].ADevie2; c:=aiguillage[indexAig].Adevie2B; if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; @@ -22527,12 +22811,12 @@ begin if aiguillage[indexaig].Adroit=prec then tabloroute[nroute,id].pos:=const_droit; tabloroute[nroute,id].talon:=true; - if test_reboucle then + {if test_reboucle then begin result:=6; if AffRouteR then Affiche('Reboucle sur '+intToSTR(actuel)+' élément déja traité ',clred); exit; - end; + end;} suivant:=aiguillage[indexAig].APointe; c:=aiguillage[indexAig].APointeB; @@ -22554,124 +22838,884 @@ begin if (typactuel=tjd) or (typactuel=tjs) then begin inc(id); - // faire droit TJD origine:=tabloroute[nroute,id-2].adresse; // d'où on vient - position:=tabloroute[nroute,id-2].pos; // position de l'élément d'ou on vient + prec:=origine; + if (typPrec=aig) or (typPrec=tjd) or (typPrec=triple) then posPrec:=TabloRoute[nroute,id-2].pos; //position de l'aig précédent indexAig:=index_aig(actuel); // 28: entrée TJD - AdrEntreTJD:=actuel; // mémoriser l'adresse d'entrée de la TJD 4 états - - // TJD d'entrée - tabloroute[nroute,id-1].pos:=const_droit; // faire droit - tabloroute[nroute,id-1].typ:=tjd; - tabloroute[nroute,id-1].adresse:=actuel; // 28 + TjdEntre:=actuel; nEtats:=aiguillage[indexAig].EtatTJD; - + if nEtats=2 then + begin + if affRouteR then Affiche('Faire traversée directe tjd 2 états '+intToSTR(actuel),clorange); + + if ((aiguillage[indexAig].dDroit=prec) and // on vient de ddroit + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].DdroitB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].DdroitB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + // traversée de la tjd + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + + Suivant:=aiguillage[indexAig].Adroit; + c:=aiguillage[IndexAig].AdroitB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + if ((aiguillage[indexAig].DDevie=prec) and // on vient de ddevié + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].DdevieB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].DdevieB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + Suivant:=aiguillage[indexAig].Adevie; + c:=aiguillage[IndexAig].AdevieB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + if ((aiguillage[indexAig].Adroit=prec) and // on vient de Adroit + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].AdroitB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].AdroitB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + + Suivant:=aiguillage[indexAig].Ddroit; + c:=aiguillage[IndexAig].DdroitB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + + else + if ((aiguillage[indexAig].ADevie=prec) and // on vient de adevié + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].AdevieB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].AdevieB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + + Suivant:=aiguillage[indexAig].Ddevie; + c:=aiguillage[IndexAig].dDevieB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + begin + Affiche('Anomalie 580 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD 2 états '+intToSTR(actuel),clred); + if c=#0 then c:=' '; + Affiche('Origine = '+intToSTR(Origine)+c,clred); + Affiche('Inégalité de '+intToSTR(aiguillage[indexAig].ADroit)+' ou '+intToSTR(aiguillage[indexAig].ADevie)+' avec : '+intToSTR(prec),clred); + {for i:=1 to tabloroute[nroute,0].adresse do + begin + s:=intToSTR(i)+' : '+intToSTR(tabloroute[nroute,i].adresse)+' '+BTypeToChaine(tabloroute[nroute,i].typ)+' '; + Affiche(s,clyellow); + end;} + result:=16; + exit; + end; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + // faire dévié TJD 2 états + if affRouteR then + begin + Affiche('Retour de la traversée directe tjd 2 états '+intToSTR(actuel),clorange); + end; + + if r=9 then + begin + result:=r; + exit; + end; + if r=10 then + begin + result:=11; + end; + + // faire TJD en mode "courbe" + // reprendre les éléments de la tjd entrante + actuel:=TjdEntre; + indexaig:=index_aig(actuel); + if ((aiguillage[indexAig].dDroit=prec) and // on vient de ddroit + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].DdroitB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].DdroitB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + // traversée de la tjd + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + + Suivant:=aiguillage[indexAig].Adevie; + c:=aiguillage[IndexAig].AdevieB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + if ((aiguillage[indexAig].DDevie=prec) and // on vient de ddevié + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].DdevieB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].DdevieB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + Suivant:=aiguillage[indexAig].Adroit; + c:=aiguillage[IndexAig].AdroitB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + if ((aiguillage[indexAig].Adroit=prec) and // on vient de Adroit + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].AdroitB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].AdroitB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + + Suivant:=aiguillage[indexAig].Ddevie; + c:=aiguillage[IndexAig].DdevieB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + + else + if ((aiguillage[indexAig].ADevie=prec) and // on vient de adevié + ( + ( + typPrec=det) or (typPrec=buttoir) + ) + or + ( + ((aiguillage[indexAig].AdevieB='S') and (posprec=const_devie)) or ((aiguillage[indexAig].AdevieB='D') and (posprec=const_droit)) + and ((typPrec=aig) or (typPrec=tjd) or (typPrec=Triple)) + ) + ) + then + begin + // faire droit depuis extrémité Droit + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + + Suivant:=aiguillage[indexAig].Ddroit; + c:=aiguillage[IndexAig].DdroitB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + begin + Affiche('Anomalie 580 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD 2 états '+intToSTR(actuel),clred); + if c=#0 then c:=' '; + Affiche('Origine = '+intToSTR(Origine)+c,clred); + Affiche('Inégalité de '+intToSTR(aiguillage[indexAig].ADroit)+' ou '+intToSTR(aiguillage[indexAig].ADevie)+' avec : '+intToSTR(prec),clred); + {for i:=1 to tabloroute[nroute,0].adresse do + begin + s:=intToSTR(i)+' : '+intToSTR(tabloroute[nroute,i].adresse)+' '+BTypeToChaine(tabloroute[nroute,i].typ)+' '; + Affiche(s,clyellow); + end;} + result:=16; + exit; + end; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + // faire dévié TJD 2 états + if affRouteR then Affiche('Retour de la traversée courbe tjd 2 états '+intToSTR(actuel),clorange); + if r=9 then + begin + result:=r; + exit; + end; + if r=10 then + begin + result:=11; + end; + result:=8; + exit; + end; + if nEtats=4 then begin - actuel:=aiguillage[indexAig].Ddroit; // homologue :26 - indexAig2:=index_aig(actuel); + //************************VERSION 3 + if affRouteR then + Affiche('Faire traversée directe tjd 4 états '+intToSTR(actuel),clorange); - if tabloroute[nroute,id-2].typ=aig then + // TJD d'entrée + origine:=prec; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + TjdS:=aiguillage[indexAig].Ddroit; // TJD de sortie + indexAig2:=index_Aig(TjdS); + TjdEntre:=actuel; + if typSuiv=det then c:='Z'; + + if (typPrec=Tjd) or (TypPrec=det) then //le précédent est une TJD ou un détecteur (traité de la même façon, on ne vérifie pas l'élément B begin - idx:=index_Aig(origine); - if position=0 then c:='P'; - if aiguillage[idx].InversionCDM=1 then + // chercher d'ou on vient de la TJD + if aiguillage[indexAig].Adroit=prec then begin - if position=const_droit then c:='S'; - if position=const_devie then c:='D'; + tabloroute[nroute,id-1].pos:=const_droit; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + // tjd homologue + tabloroute[nroute,id].pos:=const_droit; // faire droit + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].ADroit; // 26 sortie TJD, direction droit + c:=aiguillage[indexAig2].AdroitB; + end; + if aiguillage[indexAig].ADevie=prec then + begin + // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_devie; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_devie; // faire dévié + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].ADevie; // 26 sortie TJD + c:=aiguillage[indexAig2].AdevieB; + end; + end; + if (typPrec=aig) or (typPrec=triple) then // le précédent est un aiguillage + begin + // si l'aig préc est dévié et n'a pas été pris en talon + c:='P'; + if not tabloroute[nroute,id-2].talon then + begin + if typprec=triple then + begin + adresse2:=aiguillage[indexAig].Adrtriple; + // à finir !!!Adevie2 + end + else if tabloroute[nroute,id-2].pos=const_devie then c:='S' else c:='D'; + end; + + // test d'ou l'on vient sur la tjd + if (aiguillage[indexAig].ADroit=prec) and (aiguillage[indexAig].ADroitB=c) then // on vient de Adroit + begin + // on vient de la position droite de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_droit; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_droit; // faire droit + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].ADroit; // 26 sortie TJD, direction droit + c:=aiguillage[indexAig2].AdroitB; + end + else + if (aiguillage[indexAig].ADevie=prec) and (aiguillage[indexAig].ADevieB=c) then // on vient de Adevie + begin + // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_devie; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_devie; // faire dévié + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].ADevie; // 26 sortie TJD + c:=aiguillage[indexAig2].AdevieB; end else begin - if position=const_droit then c:='D'; - if position=const_devie then c:='S'; + Affiche('Anomalie 584 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD '+intToSTR(actuel),clred); + if c=#0 then c:=' '; + Affiche('Origine = '+intToSTR(Origine)+c,clred); + Affiche('Inégalité de '+intToSTR(aiguillage[indexAig].ADroit)+' ou '+intToSTR(aiguillage[indexAig].ADevie)+' avec : '+intToSTR(prec),clred); + result:=16; + exit; end; end; - inc(id); + if typPrec=triple then + begin - if (aiguillage[indexAig].ADroit=origine) and (aiguillage[indexAig].ADroitB=c) then - begin - // on vient de la position droite de l'entrée de la TJD, ce qui détermine l'aiguille de sortie - tabloroute[nroute,id-1].pos:=const_droit; - end; - if (aiguillage[indexAig].ADevie=origine) and (aiguillage[indexAig].ADevieB=c) then - begin - // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie - tabloroute[nroute,id-1].pos:=const_devie; end; - // sortie de TJD 4 états - actuel:=aiguillage[indexAig2].Adresse; + if (c='Z') or (c=#0) then TypSuiv:=det; + if suivant=0 then TypSuiv:=buttoir; + if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; + if typSuiv=aig then + begin + indexAigSuiv:=index_aig(suivant); + TypSuiv:=aiguillage[indexAigSuiv].modele; + end; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + if affrouteR then affiche('3.Retour explore_el de la tjd '+intToSTR(actuel)+' pos droit :'+intToSTR(r),clCyan); + if r=9 then // demande de sortie + begin + result:=r; + exit; + end; + if r=10 then // trouvé le détecteur de fin + begin + result:=11; + end; + + actuel:=TjdEntre; + if affRouteR then + // faire courbe TJD - il faut positionner la première adresse à dévié et la 2ème à droit + Affiche('Faire traversée courbe tjd 4 états'+intToSTR(actuel),clorange); + if typSuiv=det then c:='Z'; + TypActuel:=Tjd; + c:=aiguillage[indexAig2].AdevieB; + dec(id); + origine:=tabloroute[nroute,id-2].adresse; tabloroute[nroute,id-1].typ:=tjd; - tabloroute[nroute,id-1].adresse:=actuel; - end; - if nEtats=2 then - begin - indexAig2:=IndexAig; - end; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + TjdS:=aiguillage[indexAig].Ddroit; // TJD de sortie + indexAig2:=index_Aig(TjdS); - //--------------faire droit TJD - tabloroute[nroute,id-1].talon:=false; - if affRouteR then Affiche('Faire droit tjd '+intToSTR(actuel),clorange); - suivant:=aiguillage[indexAig2].ADroit; // 26 sortie TJD, direction droit - c:=aiguillage[indexAig2].AdroitB; - if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; - if typSuiv=aig then - begin - indexAigSuiv:=index_aig(suivant); - TypSuiv:=aiguillage[indexAigSuiv].modele; - end; - if suivant=0 then TypSuiv:=buttoir; - r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); - if affrouteR then affiche('3.Retour explore_el de la tjd '+intToSTR(actuel)+' pos droit :'+intToSTR(r),clCyan); - if r=9 then // demande de sortie - begin - result:=r; + if (typPrec=Tjd) or (TypPrec=det) then //le précédent est une TJD ou un détecteur + begin + // chercher d'ou on vient de la TJD + if aiguillage[indexAig].Adroit=prec then + begin + tabloroute[nroute,id-1].pos:=const_devie; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_droit; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].Adevie; // 26 sortie TJD, direction droit + c:=aiguillage[indexAig2].AdevieB; + end; + if aiguillage[indexAig].ADevie=prec then + begin + // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_droit; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_devie; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].Adroit; // 26 sortie TJD + c:=aiguillage[indexAig2].AdroitB; // ok cas validé + end; + end; + if typPrec=aig then // le précédent est un aiguillage + begin + // si l'aig préc est dévié et n'a pas été pris en talon + c:='P'; + if not tabloroute[nroute,id-2].talon then + if (tabloroute[nroute,id-2].pos=const_devie) then c:='S' else c:='D'; + + // test d'ou l'on vient sur la tjd + if (aiguillage[indexAig].ADroit=prec) and (aiguillage[indexAig].ADroitB=c) then // on vient de Adroit + begin + // on vient de la position droite de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_devie; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_droit; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].Adevie; // 26 sortie TJD, direction droit + c:=aiguillage[indexAig2].AdevieB; + end + else + if (aiguillage[indexAig].ADevie=prec) and (aiguillage[indexAig].ADevieB=c) then // on vient de Adevie + begin + // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_droit; + // sortie de TJD 4 états + actuel:=TjdS; + TypActuel:=tjd; + + tabloroute[nroute,id].pos:=const_devie; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=TjdS; + inc(id); + + suivant:=aiguillage[indexAig2].ADroit; // 26 sortie TJD + c:=aiguillage[indexAig2].AdroitB; + end + else + begin + Affiche('Anomalie 585 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD '+intToSTR(actuel),clred); + if c=#0 then c:=' '; + Affiche('Origine = '+intToSTR(Origine)+c,clred); + Affiche('Inégalité de '+intToSTR(aiguillage[indexAig].ADroit)+' ou '+intToSTR(aiguillage[indexAig].ADevie)+' avec : '+intToSTR(prec),clred); + result:=16; + exit; + end; + end; + + if typPrec=triple then + begin + + end; + + + if (c='Z') or (c=#0) then TypSuiv:=det; + if suivant=0 then TypSuiv:=buttoir; + if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; + if typSuiv=aig then + begin + indexAigSuiv:=index_aig(suivant); + TypSuiv:=aiguillage[indexAigSuiv].modele; + end; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + if affrouteR then affiche('3.Retour explore_el de la tjd '+intToSTR(actuel)+' pos droit :'+intToSTR(r),clCyan); + if r=9 then // demande de sortie + begin + result:=r; + exit; + end; + if r=10 then // trouvé le détecteur de fin + begin + result:=11; + end; + result:=8; exit; end; - if r=10 then // trouvé le détecteur de fin + { + //************************VERSION 2 begin - result:=11; - end; + if affRouteR then Affiche('Faire traversée directe tjd 4 états '+intToSTR(actuel),clorange); + // faire TJD traversante : on va tout droit + if aiguillage[indexAig].ADroit=prec then // on vient de Adroit + begin + // faire droit droit + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 - // faire dévié dévié TJD - if affRouteR then - Affiche('Faire dévié tjd '+intToSTR(actuel),clorange); - //suivant:=aiguillage[indexAig].ADevie; // 28 entrée TJD - suivant:=aiguillage[indexAig2].ADevie; // 26 sortie TJD - c:=aiguillage[indexAig2].AdevieB; - if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; - if typSuiv=aig then - begin - indexAigSuiv:=index_aig(suivant); - TypSuiv:=aiguillage[indexAigSuiv].modele; + Suivant:=aiguillage[indexAig].Ddroit; // homologue 26 + actuel:=suivant; + TypActuel:=tjd; + tabloroute[nroute,id].pos:=const_droit; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=Suivant; // 26 + inc(id); + indexAig:=Index_aig(suivant); + suivant:=aiguillage[IndexAig].aDroit; + c:=aiguillage[IndexAig].adroitB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + if aiguillage[indexAig].ADevie=prec then // on vient de Adévié + begin + // faire devie dévié + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + + Suivant:=aiguillage[indexAig].Ddroit; // homologue 26 + actuel:=suivant; + TypActuel:=tjd; + tabloroute[nroute,id].pos:=const_devie; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=Suivant; // 26 + inc(id); + indexAig:=Index_aig(suivant); + suivant:=aiguillage[IndexAig].aDevie; + c:=aiguillage[IndexAig].aDevieB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + begin + Affiche('Anomalie 584 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD '+intToSTR(actuel),clred); + if c=#0 then c:=' '; + Affiche('Origine = '+intToSTR(Origine)+c,clred); + Affiche('Inégalité de '+intToSTR(aiguillage[indexAig].ADroit)+' ou '+intToSTR(aiguillage[indexAig].ADevie)+' avec : '+intToSTR(prec),clred); + result:=16; + exit; + end; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + + if affRouteR then + begin + Affiche('Retour de la traversée directe tjd 4 états '+intToSTR(actuel),clorange); + Affiche('Faire traversée courbe tjd 4 états '+intToSTR(actuel),clorange); + end; + + if r=9 then + begin + result:=r; + exit; + end; + if r=10 then + begin + result:=11; + end; + + // faire TJD en mode "courbe" + // reprendre les éléments le la tjd entrante + actuel:=TjdEntre; + + indexaig:=index_aig(actuel); + + dec(id); + if aiguillage[indexAig].ADroit=prec then // on vient de A droit + begin + // faire droit dévié + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + Suivant:=aiguillage[indexAig].Ddroit; // homologue + actuel:=suivant; + TypActuel:=tjd; + Actuel:=suivant; + typActuel:=tjd; + tabloroute[nroute,id].pos:=const_devie; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=Suivant; // 26 + inc(id); + indexAig:=Index_aig(suivant); + suivant:=aiguillage[IndexAig].aDevie; + c:=aiguillage[IndexAig].adevieB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + if aiguillage[indexAig].ADevie=prec then // on vient de dévié + begin + // faire devie droit + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + Suivant:=aiguillage[indexAig].Ddroit; // homologue 26 + Actuel:=suivant; + typActuel:=Tjd; + tabloroute[nroute,id].pos:=const_droit; + tabloroute[nroute,id].typ:=tjd; + tabloroute[nroute,id].adresse:=Suivant; // 26 + inc(id); + indexAig:=Index_aig(suivant); + suivant:=aiguillage[IndexAig].aDroit; + c:=aiguillage[IndexAig].aDroitB; + if ((c='Z') or (c=#0)) and (suivant<>0) then TypSuiv:=det; + if ((c='Z') or (c=#0)) and (suivant=0) then TypSuiv:=buttoir; + if (c='P') or (c='S') or (c='D') then + begin + IndexAig:=index_aig(suivant); + TypSuiv:=aiguillage[indexAig].modele; + end; + end + else + begin + Affiche('Anomalie 585 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD '+intToSTR(actuel),clred); + if c=#0 then c:=' '; + Affiche('Origine = '+intToSTR(Origine)+c,clred); + Affiche('Inégalité de '+intToSTR(aiguillage[indexAig].ADroit)+' ou '+intToSTR(aiguillage[indexAig].ADevie)+' avec : '+intToSTR(prec),clred); + result:=16; + exit; + end; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + if affRouteR then Affiche('retour de la traversée courbe tjd 4 états '+intToSTR(actuel),clorange); + if r=9 then + begin + result:=r; + exit; + end; + if r=10 then + begin + result:=11; + end; + result:=8; + exit; end; - if suivant=0 then TypSuiv:=buttoir; - if nEtats=4 then + } + + //************************VERSION 1 + // faire droit TJD + { begin - tabloroute[nroute,id-2].pos:=const_devie; // 28 entrée de la TJD - tabloroute[nroute,id-2].talon:=false; - end; - if nEtats=2 then - begin - tabloroute[nroute,id-1].pos:=const_devie; + origine:=tabloroute[nroute,id-2].adresse; // d'où on vient + position:=tabloroute[nroute,id-2].pos; // position de l'élément d'ou on vient + indexAig:=index_aig(actuel); // 28: entrée TJD + tjdEntre:=actuel; // mémoriser l'adresse d'entrée de la TJD 4 états + + // TJD d'entrée + tabloroute[nroute,id-1].pos:=const_droit; // faire droit + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + nEtats:=aiguillage[indexAig].EtatTJD; + + if nEtats=4 then + begin + actuel:=aiguillage[indexAig].Ddroit; // homologue :26 + indexAig2:=index_aig(actuel); + c:='Z'; + if tabloroute[nroute,id-2].typ=aig then + begin + idx:=index_Aig(origine); + if position=0 then c:='P'; + if aiguillage[idx].InversionCDM=1 then + begin + if position=const_droit then c:='S'; + if position=const_devie then c:='D'; + end + else + begin + if position=const_droit then c:='D'; + if position=const_devie then c:='S'; + end; + end; + // condition point d'arrêt : (origine=90) and (actuel=92) + // si le précédent est une TJD, il faudrait distinguer le cas 2 états et 4 états. + if tabloroute[nroute,id-2].typ=tjd then + begin + idx:=index_Aig(origine); + if aiguillage[idx].EtatTJD=4 then + begin + + end; + if position=0 then c:='P'; + if aiguillage[idx].InversionCDM=1 then + begin + if position=const_droit then c:='S'; + if position=const_devie then c:='D'; + end + else + begin + if position=const_droit then c:='D'; + if position=const_devie then c:='S'; + end; + end; + inc(id); + + if (aiguillage[indexAig].ADroit=origine) then //and ((aiguillage[indexAig].ADroitB=c) or (aiguillage[indexAig].ADroitB='P')) then + begin + // on vient de la position droite de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_droit; + end + else + if (aiguillage[indexAig].ADevie=origine) then// and ((aiguillage[indexAig].ADevieB=c) or (aiguillage[indexAig].ADevieB='P')) then + begin + // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie + tabloroute[nroute,id-1].pos:=const_devie; + end + else + begin + Affiche('Anomalie 584 : Route '+intToSTR(nroute)+' Id='+intToSTR(id)+' : pas de résolution de la TJD '+intToSTR(actuel),clred); + Affiche('Origine = '+intToSTR(Origine)+c,clred); + end; + // sortie de TJD 4 états + actuel:=aiguillage[indexAig2].Adresse; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; + end; + if nEtats=2 then + begin + indexAig2:=IndexAig; + end; + + //--------------faire droit TJD tabloroute[nroute,id-1].talon:=false; - end; + if affRouteR then Affiche('Faire droit tjd '+intToSTR(actuel),clorange); + suivant:=aiguillage[indexAig2].ADroit; // 26 sortie TJD, direction droit + c:=aiguillage[indexAig2].AdroitB; + if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; + if typSuiv=aig then + begin + indexAigSuiv:=index_aig(suivant); + TypSuiv:=aiguillage[indexAigSuiv].modele; + end; + if suivant=0 then TypSuiv:=buttoir; + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + if affrouteR then affiche('3.Retour explore_el de la tjd '+intToSTR(actuel)+' pos droit :'+intToSTR(r),clCyan); + if r=9 then // demande de sortie + begin + result:=r; + exit; + end; + if r=10 then // trouvé le détecteur de fin + begin + result:=11; + end; - r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); - if affrouteR then affiche('4.Retour explore_el de la tjd '+intToSTR(actuel)+' pos dévié :'+intToSTR(r),clCyan); - if r=9 then // demande sortie - begin - result:=r; + // faire dévié dévié TJD + if affRouteR then + Affiche('Faire dévié tjd '+intToSTR(actuel),clorange); + //suivant:=aiguillage[indexAig].ADevie; // 28 entrée TJD + suivant:=aiguillage[indexAig2].ADevie; // 26 sortie TJD + c:=aiguillage[indexAig2].AdevieB; + if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; + if typSuiv=aig then + begin + indexAigSuiv:=index_aig(suivant); + TypSuiv:=aiguillage[indexAigSuiv].modele; + end; + if suivant=0 then TypSuiv:=buttoir; + if nEtats=4 then + begin + tabloroute[nroute,id-2].pos:=const_devie; // 28 entrée de la TJD + tabloroute[nroute,id-2].talon:=false; + end; + if nEtats=2 then + begin + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].talon:=false; + end; + + r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); + if affrouteR then affiche('4.Retour explore_el de la tjd '+intToSTR(actuel)+' pos dévié :'+intToSTR(r),clCyan); + if r=9 then // demande sortie + begin + result:=r; + exit; + end; + if r=10 then // trouvé détecteur de fin + begin + result:=11; + end; + + result:=8; exit; - end; - if r=10 then // trouvé détecteur de fin - begin - result:=11; - end; - result:=8; - exit; + end; } end else @@ -22722,11 +23766,15 @@ begin end; // trouve les routes du canton selon le sens à arrivée +// IndexTCO : indexTCO dans lequel on a choisi la route +// CantonOrg : canton de départ (numéro) +// arrivee : détecteur à trouver +// sens de démarrage du canton de départ procedure prepare_route(IndexTCO,CantonOrg,arrivee,sens : integer); var r,i,j,n,p,nroute,id,Suiv,ctot,IndexCanton,prec,detDepart : integer; s : string; TypeS,TypeP : tequipement; - tg,bouclage : boolean; + tg : boolean; temp : Tuneroute; begin TraceListe:=false; @@ -22755,6 +23803,7 @@ begin end; raz_route_fenetre; + NbreRoutes:=0; indexCanton:=index_canton_numero(CantonOrg); // trouver l'élément précédent/suivant @@ -22796,40 +23845,53 @@ begin // stocker le départ nroute:=1; detAtrouve:=arrivee; - id:=1; + id:=2; ctot:=0; + tabloroute[nroute,1].adresse:=prec; + tabloroute[nroute,1].typ:=det; + tabloroute[nroute,0].adresse:=1; + + // trouve toutes les routes de DetDeprt à Suivant + { + prec:=100;TypeP:=crois; + Suiv:=523;TypeS:=det; + DetDepart:=523;DetAtrouve:=523; + } + Screen.Cursor:=crSQLWait; r:=explore_el(prec,TypeP,suiv,TypeS,nroute,id,0,DetDepart,detAtrouve,ctot); - - {for j:=1 to NbreRoutes do + { + for j:=1 to NbreRoutes do begin n:=tabloroute[j,0].adresse; Affiche('Route '+intToSTR(j)+' n='+intToSTR(n),clwhite); - end; } - + end; + } + TraceListe:=false; if NbreRoutes>1 then Dec(NbreRoutes); // la dernière route est forcément mauvaise - if TraceListe then Affiche('Trouvé '+intToSTR(NbreRoutes)+' routes',clYellow); - // supprimer les routes inutiles : trop grandes ou qui se rebouclent + if TraceListe then + Affiche('Trouvé '+intToSTR(NbreRoutes)+' routes',clYellow); + // supprimer les routes inutiles : trop grandes ou qui se rebouclent ou qui ont un détecteur de fin qui n'est pas celui attendu j:=1; repeat n:=tabloroute[j,0].adresse; //if traceListe then Affiche('Route '+inttostr(j)+' Nbre='+inttostr(n),clWhite); tg:=n>MaxParcours; - bouclage:=tabloroute[j,n].adresse<>DetAtrouve; - if tg or bouclage then - //if false then + + if tg or (tabloroute[j,n].adresse<>detAtrouve) then begin - {s:=' Supprime route '+intToSTR(j)+' '; + s:=' Supprime route '+intToSTR(j)+' '; if tg then s:=s+' trop grande ;'; - if bouclage then s:=s+' pas trouvé ;'; - if traceListe then Affiche_suivi(s,clOrange); - } + if traceListe then + Affiche_suivi(s,clOrange); + supprime_route(j); end else inc(j); until j>NbreRoutes; + traceliste:=false; // trier les routes de l plus petite à la plus grande tg:=true; while tg do @@ -22837,7 +23899,6 @@ begin tg:=false; for i:=1 to NbreRoutes-1 do begin - //for j:=i+1 to NbreRoutes do n:=tabloroute[i,0].adresse; if n>tabloroute[i+1,0].adresse then begin @@ -22848,6 +23909,8 @@ begin end; end; end; + TraceListe:=False; + Screen.Cursor:=crDefault; if traceListe then for j:=1 to NbreRoutes do @@ -22871,7 +23934,7 @@ begin if traceListe then Affiche('il y a '+intToSTR(NbreRoutes)+' routes',clYellow); end; -function route_to_string(tablo : tUneRoute) : string; +function route_restreinte_to_string(tablo : tUneRoute) : string; var i,p,n : integer; typ : tequipement; s : string; @@ -22901,38 +23964,76 @@ begin result:=s; end; +function route_totale_to_string(tablo : tUneRoute) : string; +var i,p,n : integer; + typ : tequipement; + s : string; +begin + s:=''; + n:=tablo[0].adresse; + if n<>0 then + begin + s:=intToSTR(tablo[1].adresse)+'->'; // premier détecteur + for i:=1 to n do + begin + p:=tablo[i].pos; + typ:=tablo[i].typ; + if typ<>det then + begin + s:=s+intToSTR(tablo[i].adresse)+' '; + case p of + const_droit : s:=s+'droit'; + const_devie : s:=s+'dev'; + else s:=s+intToSTR(p); + end; + s:=s+'->'; + end; + end; + s:=s+intToSTR(tablo[n].adresse); // dernier détecteur + end; + result:=s; +end; + + + procedure Affiche_routes_brut; -var i,j,n,p : integer; +var i,j,n,p,nr : integer; s : string; typ : tequipement; begin // Affiche_routes; + nr:=0; for i:=1 to Ntrains do begin with trains[i] do begin n:=route[0].adresse; - Affiche('Route du train '+Nom_Train+' ---------------n='+intToSTR(n),clwhite); - for j:=1 to n do + if n<>0 then begin - s:=inttoSTR(j)+': '+intToSTR(route[j].adresse)+' '+BTypeToChaine(route[j].typ)+' '; - p:=Route[j].pos; - typ:=Route[j].typ; - if (typ=aig) or (typ=tjd) or (typ=tjs) or (typ=triple) then + inc(nr); + Affiche('Route du train '+Nom_Train+' ---------------n='+intToSTR(n),clwhite); + for j:=1 to n do begin - case p of - const_droit : s:=s+'droit'; - const_devie : s:=s+'dev'; - 0 : s:=s+'talon'; - else s:=s+intToSTR(p); + s:=inttoSTR(j)+': '+intToSTR(route[j].adresse)+' '+BTypeToChaine(route[j].typ)+' '; + p:=Route[j].pos; + typ:=Route[j].typ; + if (typ=aig) or (typ=tjd) or (typ=tjs) or (typ=triple) then + begin + case p of + const_droit : s:=s+'droit'; + const_devie : s:=s+'dev'; + 0 : s:=s+'talon'; + else s:=s+intToSTR(p); + end; + if route[j].talon then s:=s+' (en talon)'; end; - if route[j].talon then s:=s+' (en talon)'; + if route[j].traite then s:=s+' Traité' else s:=s+' Non traité'; + Affiche(s,clyellow); end; - if route[j].traite then s:=s+' Traité' else s:=s+' Non traité'; - Affiche(s,clyellow); - end; + end ; end; end; + if nr=0 then Affiche('Aucune route sur aucun train',ClWhite); end; procedure TFormPrinc.Routes1Click(Sender: TObject); @@ -22964,6 +24065,16 @@ begin Sauve_config; end; +procedure TFormPrinc.Button3Click(Sender: TObject); +var prec,suiv,nroute,id,detDepart,detAtrouve,ctot : integer; + TypeP,TypeS : tequipement; +begin + //debugTCO:=true; + //zone_tco(1,30,SensTCO_O,0,0,11,false); + //debugtco:=false; + affiche(intToSTR(Trains[4].sens),clred); +end; + end. diff --git a/UnitRoute.dfm b/UnitRoute.dfm index 2db6e73..c5ae9f3 100644 --- a/UnitRoute.dfm +++ b/UnitRoute.dfm @@ -3,7 +3,7 @@ object FormRoute: TFormRoute Top = 182 BorderStyle = bsDialog Caption = 'Route' - ClientHeight = 257 + ClientHeight = 298 ClientWidth = 634 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -15,11 +15,14 @@ object FormRoute: TFormRoute OnActivate = FormActivate OnClose = FormClose OnCreate = FormCreate + DesignSize = ( + 634 + 298) PixelsPerInch = 96 TextHeight = 13 object LabelInfo: TLabel - Left = 16 - Top = 16 + Left = 8 + Top = 8 Width = 324 Height = 13 Caption = @@ -28,9 +31,10 @@ object FormRoute: TFormRoute end object LabelNombre: TLabel Left = 19 - Top = 192 + Top = 234 Width = 29 Height = 13 + Anchors = [akLeft, akBottom] Caption = 'Route' end object ImageTrainR: TImage @@ -43,10 +47,11 @@ object FormRoute: TFormRoute end object ListBoxRoutes: TListBox Left = 16 - Top = 80 + Top = 116 Width = 609 - Height = 105 + Height = 114 Hint = 'S'#233'lectionne une route pour l'#39'affecter au train courant' + Anchors = [akLeft, akBottom] Color = clBlack Font.Charset = DEFAULT_CHARSET Font.Color = clYellow @@ -58,15 +63,17 @@ object FormRoute: TFormRoute ParentShowHint = False ShowHint = True TabOrder = 0 + OnDrawItem = ListBoxRoutesDrawItem OnKeyDown = ListBoxRoutesKeyDown OnMouseDown = ListBoxRoutesMouseDown end object ButtonEfface: TButton Left = 424 - Top = 216 + Top = 258 Width = 97 Height = 33 Hint = 'Efface la route du tco' + Anchors = [akLeft, akBottom] Caption = 'Efface route du TCO' ParentShowHint = False ShowHint = True @@ -76,19 +83,21 @@ object FormRoute: TFormRoute end object ButtonQuitte: TButton Left = 16 - Top = 216 + Top = 259 Width = 89 - Height = 33 + Height = 32 + Anchors = [akLeft, akBottom] Caption = 'Quitter' TabOrder = 2 OnClick = ButtonQuitteClick end object ButtonDetail: TButton Left = 320 - Top = 216 + Top = 258 Width = 97 Height = 33 Hint = 'D'#233'tail route' + Anchors = [akLeft, akBottom] Caption = 'D'#233'tail route' ParentShowHint = False ShowHint = True @@ -97,37 +106,132 @@ object FormRoute: TFormRoute end object ButtonRAZ: TButton Left = 528 - Top = 216 + Top = 258 Width = 97 Height = 33 Hint = 'Annule toutes les routes pour ce train' + Anchors = [akLeft, akBottom] Caption = 'D'#233'valider routes' ParentShowHint = False ShowHint = True TabOrder = 4 OnClick = ButtonRAZClick end - object ComboBoxTrains: TComboBox - Left = 16 - Top = 48 - Width = 601 - Height = 21 - Style = csDropDownList - ItemHeight = 13 - TabOrder = 5 - Visible = False - end object ButtonFenPil: TButton Left = 232 - Top = 216 + Top = 258 Width = 83 Height = 33 Hint = 'Ouvre la fen'#234'tre de pilotage des trains' + Anchors = [akLeft, akBottom] Caption = 'Fen'#234'tre de pilotage' ParentShowHint = False ShowHint = True + TabOrder = 5 + WordWrap = True + OnClick = ButtonFenPilClick + end + object Button1: TButton + Left = 128 + Top = 258 + Width = 75 + Height = 33 + Hint = + 'Affiche la route sous forme d'#39'une progression du train sur cette' + + ' route' + Anchors = [akLeft, akBottom] + Caption = 'Parcours route' + ParentShowHint = False + ShowHint = True TabOrder = 6 WordWrap = True - OnClick = ButtonFenPilClick + OnClick = ButtonParcours + end + object ButtonRaf: TButton + Left = 384 + Top = 78 + Width = 89 + Height = 25 + Hint = + 'R'#233'affiche la liste des routes en fonction des filtres, d'#39'apr'#232's l' + + 'a liste des routes trouv'#233'es' + Caption = 'Rafra'#238'chir la liste' + ParentShowHint = False + ShowHint = True + TabOrder = 7 + OnClick = ButtonRafClick + end + object GroupBox1: TGroupBox + Left = 16 + Top = 32 + Width = 321 + Height = 65 + Caption = 'Filtrage des routes' + TabOrder = 8 + object Label1: TLabel + Left = 8 + Top = 24 + Width = 189 + Height = 13 + Caption = 'Obligation de passer par le(s) canton(s) :' + end + object Label2: TLabel + Left = 8 + Top = 40 + Width = 194 + Height = 13 + Caption = 'Interdiction de passer par le(s) canton(s) :' + end + object EditObligeCanton: TEdit + Left = 216 + Top = 20 + Width = 81 + Height = 21 + Hint = 'Num'#233'ro de cantons s'#233'par'#233's par des virgules (10 maxi)' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnChange = EditObligeCantonChange + end + object EditInterditCanton: TEdit + Left = 216 + Top = 38 + Width = 81 + Height = 21 + Hint = 'Num'#233'ro de cantons s'#233'par'#233's par des virgules (10 maxi)' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnChange = EditInterditCantonChange + end + end + object ButtonTrouver: TButton + Left = 496 + Top = 78 + Width = 97 + Height = 25 + Hint = 'Recalcule les routes en fonction des filtres' + Caption = 'Trouver les routes' + ParentShowHint = False + ShowHint = True + TabOrder = 9 + OnClick = ButtonTrouverClick + end + object CheckBoxRoutesLongues: TCheckBox + Left = 384 + Top = 54 + Width = 209 + Height = 17 + Caption = 'Afficher les routes longues (en orange)' + TabOrder = 10 + OnClick = CheckBoxRoutesLonguesClick + end + object CheckBoxDebugRoutes: TCheckBox + Left = 552 + Top = 232 + Width = 65 + Height = 17 + Caption = 'Debug' + TabOrder = 11 end end diff --git a/UnitRoute.pas b/UnitRoute.pas index a8d1cf5..6b52d0f 100644 --- a/UnitRoute.pas +++ b/UnitRoute.pas @@ -18,8 +18,17 @@ type ButtonDetail: TButton; ButtonRAZ: TButton; ImageTrainR: TImage; - ComboBoxTrains: TComboBox; ButtonFenPil: TButton; + Button1: TButton; + ButtonRaf: TButton; + GroupBox1: TGroupBox; + EditObligeCanton: TEdit; + EditInterditCanton: TEdit; + Label1: TLabel; + Label2: TLabel; + ButtonTrouver: TButton; + CheckBoxRoutesLongues: TCheckBox; + CheckBoxDebugRoutes: TCheckBox; procedure FormActivate(Sender: TObject); procedure ListBoxRoutesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -32,6 +41,14 @@ type procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ButtonFenPilClick(Sender: TObject); + procedure ButtonParcours(Sender: TObject); + procedure ButtonRafClick(Sender: TObject); + procedure EditObligeCantonChange(Sender: TObject); + procedure EditInterditCantonChange(Sender: TObject); + procedure ButtonTrouverClick(Sender: TObject); + procedure ListBoxRoutesDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure CheckBoxRoutesLonguesClick(Sender: TObject); private { Déclarations privées } public @@ -41,7 +58,12 @@ type var FormRoute: TFormRoute; parcoursDet : TUneroute; - AncLigneRoute,LigneRoute,IdTrainCourant : integer; + CoulText : Tcolor; + AncLigneRoute,NumRoute,AncRoute,IndexLigneRoute,IdTrainCourant,Nprop,NpropTot : integer; + list_det_obl,list_det_int : array[1..20] of record + adresse : integer; + n :integer; + end; procedure raz_route_fenetre; procedure raz_toutes_routes; @@ -57,7 +79,7 @@ uses UnitDebug,unitTCO,UnitConfig, UnitRouteTrains; // efface la route parcoursDet[] procedure efface_route_tco; -var n,det1,det2,i,indexAig : integer; +var n,det1,nti,x,y,det2,i,indexAig : integer; t : tequipement; begin n:=parcoursdet[0].adresse; @@ -88,6 +110,21 @@ begin aiguillage[indexAig].Position:=aiguillage[indexAig].AncPos; // restitue position end; end; + + // rafraichir la position des aiguillages dans les TCO + for nti:=1 to NbreTCO do + begin + for y:=1 to NbreCellY[nti] do + for x:=1 to NbreCellX[nti] do + begin + if isAigTCO(tco[nti,x,y].BImage) then + begin + affiche_cellule(nti,x,y); + // entoure_cell_grille(indexTCO,x,y); + end; + end; + FormTCO[nti].Repaint; + end; end; // efface la fenetre et la route du tco @@ -96,11 +133,12 @@ begin efface_route_tco; formRoute.ListBoxRoutes.Clear; - ligneroute:=-1; + Indexligneroute:=-1; + NumRoute:=-1; end; // Affiche sans effacer l'ancienne, la route du TCO du tableau ParcoursDet[] -// détruit l'index du train dans le canton !!!! +// détruit l'index du train dans le canton !!!! function Affiche_route_TCO : boolean ; var i,n,det1,det2,indexAig : integer; t :tequipement; @@ -117,12 +155,13 @@ begin begin indexaig:=index_aig(ParcoursDet[i].adresse); aiguillage[indexAig].AncPos:=aiguillage[IndexAig].position; // sauvegarder position + //Affiche('Aig='+intToSTR(ParcoursDet[i].adresse)+' pos='+intToSTR(aiguillage[IndexAig].position),clYellow); aiguillage[indexAig].position:=ParcoursDet[i].pos; // forcer la position de l'aiguillage sue le parcours end; // car on utilise TRUE dans la fonction zone_tco if t=det then begin det2:=ParcoursDet[i].adresse; - ok:=zone_tco(1,det1,det2,1,0,1,true) and ok; + ok:=zone_tco(1,det1,det2,1,0,1,true) and ok; //çà efface laloco du canton det1:=det2; end; end; @@ -146,44 +185,45 @@ var n,id : integer; ok : boolean; s : string; begin - AncLigneRoute:=LigneRoute; + AncLigneRoute:=IndexLigneRoute; - if LigneRoute<0 then exit; - id:=LigneRoute+1; - formRoute.ButtonDetail.caption:='Détail route '+intToSTR(id); - formRoute.ButtonEfface.caption:='Efface route '+intToSTR(id)+' du TCO'; + if IndexLigneRoute<0 then exit; + id:=IndexLigneRoute; + formRoute.ButtonDetail.caption:='Détail route '+intToSTR(id+1); + formRoute.ButtonEfface.caption:='Efface route '+intToSTR(id+1)+' du TCO'; efface_route_tco; // fabriquer le tableau parcoursDet[] depuis tabloRoute[] - parcoursDet:=tabloRoute[id]; + parcoursDet:=tabloRoute[NumRoute]; n:=ParcoursDet[0].adresse; // Affiche les routes ok:=Affiche_route_tco; - s:='Route '+intToSTR(id)+'/'+intToSTR(NbreRoutes)+' : '+intToSTR(n)+' éléments'; + s:=intToSTR(Nprop)+' propositions - Route '+intToSTR(NumRoute)+'/'+intToSTR(NbreRoutes)+' : '+intToSTR(n)+' éléments'; //if not(ok) then s:=s+' - Route pas affichable car des éléments ne sont pas au TCO'; formRoute.LabelNombre.Caption:=s; end; +// r: numéro de route procedure clic_route(r : integer); var idTrain : integer; begin - LigneRoute:=r; +// IndexLigneRoute:=r; // copier la route au train - if (idcantonroute<1) or (ligneroute<0) then exit; + if (idcantonroute<1) or (Indexligneroute<0) then exit; idTrain:=Index_Train_adresse(canton[idCantonRoute].AdrTrainRoute); //IdTrain:=canton[idcantonRoute].indexTrain; - if idtrain<1 then + if (idtrain<0) or (idTrain>Max_Trains) then begin // le train a été déplacé affiche('Anomalie 50',clred); exit; end; - - trains[idTrain].route:=tabloroute[LigneRoute+1]; + if r<1 then exit; + trains[idTrain].route:=tabloroute[r]; formRoute.ButtonFenPil.enabled:=trains[IdTrain].route[0].adresse<>0; @@ -191,13 +231,96 @@ begin end; +// transforme la liste de chaine des cantons obligatoires en détecteurs +procedure detObl_to_liste; +var i,n,j,erreur :integer; + s : string; +begin + // transformer la liste des cantons obligatoires en détecteurs + for i:=1 to 20 do begin list_det_obl[i].adresse:=0;list_det_obl[i].n:=0;end; + + i:=1; + s:=formRoute.EditObligeCanton.text; + while (length(s)>0) and (i<20) do + begin + val(s,n,erreur); // n= numéro de canton + delete(s,1,erreur); + while not(s='') and not(s[1] in ['0'..'9']) do + begin + delete(s,1,1); + end; + + if erreur=0 then s:=''; + j:=index_canton_numero(n); + if j<>0 then + begin + if canton[j].typ1=det then + begin + list_det_obl[i].adresse:=canton[j].el1; + inc(i); + end; + if canton[j].typ2=det then + begin + list_det_obl[i].adresse:=canton[j].el2; + inc(i); + end; + end; + end; +end; + +// transforme la liste de chaine des cantons interdits en détecteurs +procedure detInt_to_liste; +var i,n,j,erreur :integer; + s : string; +begin + for i:=1 to 20 do begin list_det_int[i].adresse:=0;list_det_int[i].n:=0;end; + + // transformer la liste des cantons interdits en détecteurs + i:=1; + s:=formRoute.EditInterditCanton.text; + while (length(s)>0) and (i<20) do + begin + val(s,n,erreur); // n= numéro de canton + delete(s,1,erreur); + while not(s='') and not(s[1] in ['0'..'9']) do + begin + delete(s,1,1); + end; + + if erreur=0 then s:=''; + j:=index_canton_numero(n); + if j<>0 then + begin + if canton[j].typ1=det then + begin + list_det_int[i].adresse:=canton[j].el1; + //Affiche('détecteur interdit '+intToSTR(canton[j].el1),clOrange); + inc(i); + end; + if canton[j].typ2=det then + begin + list_det_int[i].adresse:=canton[j].el2; + //Affiche('détecteur interdit '+intToSTR(canton[j].el2),clOrange); + inc(i); + end; + end; + end; +end; // affiche les routes du train courant procedure maj_fenetre; -var l,pluslongue,n,j,pixelLength : integer; +var iI,iO,c,l,pluslongue,n,i,j,k,pixelLength,erreur,np : integer; s,chaineLongue : string; + trouveObl,trouveint,aflongue : boolean; + list_cantons_obl : array[1..10] of integer; + begin - if (cantonorg=0) or (cantonDest=0) then FormRoute.caption:='Pas de canton depart/arrivée' else + if (idcantonroute<1) or (cantonorg=0) or (cantonDest=0) then + begin + FormRoute.caption:='Pas de canton depart/arrivée'; + exit; + end; + Nprop:=0; NpropTot:=0; formRoute.caption:='Liste des routes trouvées du train '+canton[idcantonRoute].NomTrain+' pour aller de '+intToSTR(DetDepart)+' (canton '+intToSTR(cantonOrg)+ ') à '+intToSTR(DetaTrouve)+' (canton '+intToSTR(cantonDest)+')'; plusLongue:=0; @@ -208,41 +331,92 @@ begin if idcantonRoute<>0 then formRoute.ListBoxRoutes.Hint:='Sélectionne une route pour l''affecter au train '+canton[idcantonRoute].NomTrain; formRoute.listBoxRoutes.Clear; - // trouver le canton dest d'après le canton origine cliqué - if IdCantonClic=0 then exit; - idCantonRoute:=index_canton_numero(canton[idCantonClic].NumcantonOrg); - - if idcantonroute<>0 then + IdCantonClic:=Idcantonroute; + IdTrainCourant:=canton[idcantonRoute].indexTrain; + if idTrainCourant>9000 then begin - IdTrainCourant:=canton[idcantonRoute].indexTrain; - if idTrainCourant>9000 then - begin - Affiche('Anomalie 626 ',clred); - messageBeep(Mb_iconError); - exit; - end; - end - else idtraincourant:=0; + Affiche('Anomalie 626 ',clred); + messageBeep(Mb_iconError); + exit; + end; if NbreRoutes>0 then FormRoute.labelInfo.Caption:='Cliquer sur une route pour la visualiser sur le TCO et l''affecter au train'; + Screen.Cursor:=crSQLWait; + + // regarder chaque route pour les détecteurs obligatoires / interdits et l'afficher + aflongue:=FormRoute.checkBoxRoutesLongues.checked; + np:=tabloroute[1,0].adresse; for j:=1 to NbreRoutes do begin + // compter le nombre de détecteur obligatoires et interdits + iO:=1; + for k:=1 to 20 do begin list_det_obl[k].n:=0;list_det_int[k].n:=0;end; n:=tabloroute[j,0].adresse; - s:=intToSTR(j)+'. '; - s:=s+route_to_string(tabloroute[j]); - l:=Length(s); - if l>pluslongue then + // obligatoires + while (iO<=20) and (list_det_obl[iO].adresse<>0) do begin - chainelongue:=s; - pluslongue:=l; + for k:=1 to n do + begin + if (tabloroute[j,k].typ=det) and (list_det_obl[iO].adresse=tabloroute[j,k].adresse) then inc(list_Det_obl[iO].n); + end; + inc(iO); + end; + // interdits + iI:=1; + while (iI<=20) and (list_det_int[iI].adresse<>0) do + begin + for k:=1 to n do + begin + if (tabloroute[j,k].typ=det) and (list_det_int[iI].adresse=tabloroute[j,k].adresse) then inc(list_Det_int[iI].n); + end; + inc(iI); end; - FormRoute.listBoxRoutes.Items.Add(s); + trouveObl:=true; + trouveInt:=false; + // trouver si cette route j contient tous détecteurs obligatoires + // ou des détecteurs interdits + for k:=1 to iI-1 do + begin + trouveInt:=TrouveInt or (list_det_int[k].n>0); + end; + // obligatoires + for k:=1 to iO-1 do + begin + trouveObl:=TrouveObl and (list_det_obl[k].n>0); + end; + if trouveObl and not trouveint then + begin + s:=intToSTR(j)+'. '; + s:=s+route_restreinte_to_string(tabloroute[j]); + l:=Length(s); + if l>pluslongue then + begin + chainelongue:=s; + pluslongue:=l; + end; + inc(NpropTot); + if round(n/np)>2 then + begin + if afLongue then + begin + coulText:=clOrange; + FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // permet d'afficher un texte en couleurs avec l'evt onDrawItem + end + end + else + begin + inc(Nprop); + coulText:=clYellow; + FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // permet d'afficher un texte en couleurs avec l'evt onDrawItem + end; + end; end; + Screen.Cursor:=crDefault; PixelLength:=FormRoute.ListboxRoutes.Canvas.TextWidth(chaineLongue)+30; - // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength + // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength SendMessage(FormRoute.ListBoxRoutes.Handle,LB_SETHORIZONTALEXTENT,PixelLength,0); // icone train @@ -251,18 +425,28 @@ begin formRoute.ButtonFenPil.enabled:=trains[IdTrainCourant].route[0].adresse<>0; if NbreRoutes=1 then clic_route(0); + + s:=intToSTR(Nprop)+' propositions - Route '+intToSTR(NumRoute)+'/'+intToSTR(NbreRoutes)+' : '+intToSTR(n)+' éléments'; + FormRoute.LabelNombre.caption:=s; + end; procedure TFormRoute.FormActivate(Sender: TObject); begin maj_fenetre; + coulText:=clYellow; end; procedure TFormRoute.ListBoxRoutesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var s : string; + erreur : integer; begin - LigneRoute:=listBoxRoutes.Itemindex; - clic_route(ligneRoute); + IndexLigneRoute:=listBoxRoutes.Itemindex; + if IndexLigneRoute<0 then exit; + s:=ListBoxRoutes.items[IndexLigneRoute]; + val(s,NumRoute,erreur); + clic_route(NumRoute); end; procedure TFormRoute.ButtonEffaceClick(Sender: TObject); @@ -281,7 +465,8 @@ var i,j,n,p : integer; s : string; typ : tequipement; begin - if ligneroute<0 then exit; + if (Indexligneroute<0) or (NumRoute<1) then exit; + with formprinc do begin windowState:=wsNormal; //Maximized; @@ -289,12 +474,12 @@ begin BringToFront; end; - j:=ligneroute+1; + j:=Indexligneroute+1; n:=tabloroute[j,0].adresse; Affiche('Route '+intToSTR(j)+' ---------------n='+intToSTR(n),clwhite); for i:=1 to n do begin - s:=intToSTR(tabloroute[j,i].adresse)+' '+BTypeToChaine(tabloroute[j,i].typ)+' '; + s:=intToSTR(i)+' : '+intToSTR(tabloroute[j,i].adresse)+' '+BTypeToChaine(tabloroute[j,i].typ)+' '; p:=tabloRoute[j,i].pos; typ:=tabloRoute[j,i].typ; if (typ=aig) or (typ=tjd) or (typ=tjs) or (typ=triple) then @@ -367,17 +552,23 @@ end; procedure TFormRoute.ListBoxRoutesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +var s : string; + erreur : integer; begin - if (ord(Key)=VK_UP) and (ligneroute>0) then + if indexLigneRoute<0 then exit; + if (ord(Key)=VK_UP) and (Indexligneroute>0) then begin - dec(ligneRoute); - efface_affiche_route; + dec(IndexligneRoute); end; - if (ord(Key)=VK_DOWN) and (ligneroute+1n) or (toucheTCO=#27); + titre_fenetre(1); + Show; + //Affiche('Fini',clred); +end; + +procedure TFormRoute.ButtonRafClick(Sender: TObject); +begin + maj_fenetre; +end; + +procedure TFormRoute.EditObligeCantonChange(Sender: TObject); +begin + detObl_to_liste; +end; + +procedure TFormRoute.EditInterditCantonChange(Sender: TObject); +begin + detInt_to_liste; +end; + +procedure TFormRoute.ButtonTrouverClick(Sender: TObject); +var sens,sensCanton,indexTCO,IdCantonOrg : integer; +begin + if cantonOrg=0 then exit; + + IdCantonOrg:=index_canton_numero(cantonOrg); + //IdCantonDest:=index_canton_numero(cantonDest); + sensCanton:=canton[IdCantonOrg].sensLoco; + case sensCanton of // sens de la loco dans le canton + sensGauche : begin sens:=SensTCO_O;end; + sensDroit : begin sens:=SensTCO_E;end; + SensHaut : begin sens:=SensTCO_N;end; + SensBas : begin sens:=SensTCO_S;end; + end; + IndexTCO:=canton[IdcantonOrg].Ntco; + prepare_route(IndexTCO,CantonOrg,DetaTrouve,sens); + maj_fenetre; + +end; + +procedure TFormRoute.ListBoxRoutesDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); + var + myColor: TColor; + myBrush: TBrush; + myPen : Tpen; +begin + myBrush := TBrush.Create; + with (Control as TListBox).Canvas do // draw on control canvas, not on the form + begin +{ if Index = 3 then + myColor := clRed + else + myColor := clBlack; +} + //myBrush.Style := bsSolid; + //myBrush.Color := myColor; + + //Windows.FillRect(handle, Rect, myBrush.Handle); + //Pen.color:=clWhite;//CoulText; + //myBrush.color:=clBlue; + //Brush.Style := bsClear; + // display the text + // TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]); + //MyBrush.Free; + FillRect(Rect); + Font.Color := TColor(ListBoxRoutes.Items.Objects[Index]); + TextOut(Rect.Left + 2, Rect.Top, ListBoxRoutes.Items[Index]); + end; +end; + +procedure TFormRoute.CheckBoxRoutesLonguesClick(Sender: TObject); +begin + Maj_fenetre; +end; + end. diff --git a/UnitRouteTrains.dfm b/UnitRouteTrains.dfm index b5e1e18..bdf8b99 100644 --- a/UnitRouteTrains.dfm +++ b/UnitRouteTrains.dfm @@ -43,8 +43,8 @@ object FormRouteTrain: TFormRouteTrain end object ButtonQuitte: TButton Left = 8 - Top = 118 - Width = 89 + Top = 120 + Width = 81 Height = 33 Caption = 'Quitter' TabOrder = 1 @@ -93,9 +93,9 @@ object FormRouteTrain: TFormRouteTrain OnClick = ButtonSupprimeClick end object ButtonRouler1Tr: TButton - Left = 256 + Left = 280 Top = 120 - Width = 107 + Width = 83 Height = 33 Hint = 'Roule le train s'#233'lectionn'#233' s'#39'il dispose d'#39'une route' Caption = 'Rouler le train' @@ -106,7 +106,7 @@ object FormRouteTrain: TFormRouteTrain OnClick = ButtonRouler1TrClick end object ButtonRoulerTsTrains: TButton - Left = 168 + Left = 192 Top = 120 Width = 75 Height = 33 @@ -118,4 +118,16 @@ object FormRouteTrain: TFormRouteTrain WordWrap = True OnClick = ButtonRoulerTsTrainsClick end + object ButtonSauveRoute: TButton + Left = 104 + Top = 120 + Width = 81 + Height = 33 + Hint = 'Sauve la route et l'#39'affecte '#224' ce train' + Caption = 'Sauve route' + ParentShowHint = False + ShowHint = True + TabOrder = 7 + OnClick = ButtonSauveRouteClick + end end diff --git a/UnitRouteTrains.pas b/UnitRouteTrains.pas index 22d94aa..d63299f 100644 --- a/UnitRouteTrains.pas +++ b/UnitRouteTrains.pas @@ -20,6 +20,7 @@ type ButtonSupprime: TButton; ButtonRouler1Tr: TButton; ButtonRoulerTsTrains: TButton; + ButtonSauveRoute: TButton; procedure FormActivate(Sender: TObject); procedure ButtonQuitteClick(Sender: TObject); procedure ComboBoxTrainsChange(Sender: TObject); @@ -30,6 +31,7 @@ type procedure ButtonSupprimeClick(Sender: TObject); procedure ButtonRouler1TrClick(Sender: TObject); procedure ButtonRoulerTsTrainsClick(Sender: TObject); + procedure ButtonSauveRouteClick(Sender: TObject); private { Déclarations privées } public @@ -78,7 +80,10 @@ begin if trouve then begin trains[indexTrain].dernierdet:=detect; - if not(diffusion) then Affiche('Le détecteur du train '+train+' est le '+intToSTR(detect),clWhite); + if debugRoulage then + begin + Affiche('Le détecteur du train '+train+' est le '+intToSTR(detect),clWhite); + end; index_signal_det(detect,voie1,indexSig1,voie2,indexSig2); AdrSig1:=0;AdrSig2:=0; @@ -163,6 +168,8 @@ begin if not(roulage) then exit; + + s:='Lancement du train '+train; if detect<>0 then s:=s+' depuis détecteur '+intToSTR(Detect); Affiche(s,clYellow); @@ -195,7 +202,7 @@ begin with formRouteTrain do begin RicheditRoute.Clear; - RichEditRoute.Lines.Add(route_to_string(trains[idTrain].route)); + RichEditRoute.Lines.Add(route_restreinte_to_string(trains[idTrain].route)); if trains[idtrain].route[0].adresse<>0 then begin labelroute.caption:='Route affectée au train '+trains[idtrain].nom_train; @@ -264,6 +271,7 @@ begin supprime_route_train(indexTrainFR); maj_infos(indexTrainFR); + close; end; // Réserve les éléments s'ils ne sont pas déja réservés et positionne les aiguillages @@ -271,12 +279,12 @@ end; // en entrée : index du train ; detect=détecteur à partir duquel faire la réservation et le positionnement des aiguillages // en sortie : si erreur : -1 ou adresse du train qui a réservé le canton // phase 0 : si le détecteur detect est en fin de route, alors on active l'arret du train -// phase 1 : tester si éléments réservés par train tiers jusqu'au signal suivant. Si oui, sortir. +// phase 1 : tester si éléments réservés par train tiers jusqu'aux cantons suivants. Si oui, sortir. // phase 2 : positionner les aiguillages // phase 3 : réserver les aiguillages function aig_canton(idTrain,detect : integer) : integer; -var AdrSig,n,i,ic,j,ideb,iFin,AdrTrain,etat,pointeur,voie1,voie2,indexSig1,indexSig2, - Trainexistant,adr,pos,index,Ncanton,icanton,NumCanton,pr,det_arret,it,PointRoute,ElPrec, +var AdrSig,n,i,ic,j,ideb,iFin,AdrTrain,etat,pointeur,voie1,voie2,indexSig1,indexSig2,AncPr, + Trainexistant,adr,pos,index,Ncanton,icanton,NumCanton,det_arret,it,PointRoute,ElPrec, adr2 : integer; typ,tprec: tequipement; trainTiers,SigBonSens,trouve : boolean; @@ -284,7 +292,7 @@ var AdrSig,n,i,ic,j,ideb,iFin,AdrTrain,etat,pointeur,voie1,voie2,indexSig1,index begin //traceliste:=true; if ProcPrinc then AfficheDebug('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); - if not(diffusion) then Affiche('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); + if debugRoulage then Affiche('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); result:=0; If traceliste then @@ -303,7 +311,7 @@ begin i:=pointeur-1; if i=0 then i:=1; // on commence à 1 - if traceListe then + if DebugRoulage then begin Affiche('AC train @'+intToSTR(AdrTrain)+'Detecteur='+intToSTR(detect)+' Pointeur'+intToSTR(pointeur)+' ->'+intToSTR(trains[idTrain].route[i].adresse),clOrange); if i>=n then @@ -314,17 +322,18 @@ begin end; j:=1; - pr:=trains[idTrain].PointRout; + AncPr:=trains[idTrain].PointRout; repeat - if (trains[idTrain].route[j].adresse=detect) and (trains[idTrain].route[j].typ=det) and (j>pr) then + + trouve:=(trains[idTrain].route[j].adresse=detect) and (trains[idTrain].route[j].typ=det) and (j>=AncPr); + if trouve then begin trains[idTrain].PointRout:=j; PointRoute:=j; - //Affiche('Le pointeur de route est '+intToSTR(j)+' au détecteur '+intToSTR(detect),clred); + if DebugRoulage then Affiche('Le pointeur de route est '+intToSTR(j)+'/'+intToSTR(n)+' au détecteur '+intToSTR(detect),clWhite); end; inc(j); - until j>n; - + until trouve or (j>n); // arrêt sur détecteur demandé trouve:=false; @@ -344,36 +353,42 @@ begin adr2:=aiguillage[j].DDroit; // homologue end; end; - if not(diffusion) and (Det_arret<>0) then Affiche('Détecteur demande arrêt rencontré ('+intToSTR(det_arret)+')',clYellow); + if debugRoulage and (Det_arret<>0) then Affiche('Détecteur demande arrêt rencontré ('+intToSTR(det_arret)+')',clYellow); // detecteur courant=arret - if (det_arret=detect) and (detecteur[detect].etat) and (trains[idTrain].route[PointRoute-1].adresse=ElPrec) and (trains[idTrain].route[PointRoute-1].typ=tPrec) then + if (det_arret=detect) and (detecteur[detect].etat) and + (trains[idTrain].route[PointRoute-1].adresse=ElPrec) and (trains[idTrain].route[PointRoute-1].typ=tPrec) and + (pointrouteAdrTrain) and (TrainExistant<>0) then + //if (trainexistant<>AdrTrain) and (TrainExistant<>0) then + if (TrainExistant<>0) then + begin + result:=TrainExistant; + trains[idtrain].roulage:=1; + trainTiers:=true; + if traceListe then Affiche('AC-Aiguillage '+intToSTR(adr)+' réservé par autre train : @='+intToSTR(result),clyellow); + end; + end; + if (typ=det) then + begin + TrainExistant:=detecteur[adr].AdrTrainRes; + if (TrainExistant<>AdrTrain) and (trainExistant<>0) then + begin + result:=TrainExistant; + trains[idtrain].roulage:=1; // le roulage est arrêté + traintiers:=true; + if traceListe then Affiche('AC-Détecteur '+intToSTR(adr)+' réservé par autre train : @='+intToSTR(result),clyellow); + //exit; + end; + // si détecteur comporte signal + index_signal_det(adr,voie1,indexSig1,voie2,indexSig2); + if indexSig1<>0 then + begin + AdrSig:=0; + // si le signal est dans le bon sens + if (i+1<=n) then // si on arrive pas en bout de route + begin + if (signaux[indexSig1].Adr_el_suiv1=route[i+1].adresse) then + begin + AdrSig:=signaux[indexSig1].adresse; + if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(AdrSig)+' dans bon sens',clYellow); + inc(nCanton); + icanton:=i; + SigBonSens:=true; + end + else + begin + if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(signaux[indexSig1].adresse)+' dans mauvais sens',clYellow); + end; + + if indexSig2<>0 then + begin + if (signaux[indexSig2].Adr_el_suiv1=route[i+1].adresse) then + begin + AdrSig:=signaux[indexSig2].adresse; + if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(AdrSig)+' dans bon sens',clYellow); + inc(nCanton); + icanton:=i; + SigBonSens:=true; + end + else + begin + if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(signaux[indexSig2].adresse)+' dans mauvais sens',clYellow); + end; + end; + end; + end; + end; + inc(i); + until (i>n) or (SigBonSens and (nCanton=nCantonsRes+1)) or (trainTiers); + + if traceliste then affiche('Phase 2-3',clWhite); + // phases 2 et 3 + trains[idtrain].roulage:=2; // roulage effectif + result:=AdrTrain; + if not(traintiers) then iFin:=i-1 else iFin:=icanton; + AdrTrain:=trains[idTrain].adresse; + + // balayage du (des) cantons libres ------------------------------------------------------------- + if traceListe or debugRoulage then Affiche('Balayage de '+intToSTR(ideb)+' à '+intToSTR(ifin)+' pour positionner et réserver aiguillages',clYellow); + for i:=iDeb to iFin do + begin + route[i].traite:=true; + typ:=route[i].typ; + adr:=route[i].adresse; + if (typ=aig) or (typ=triple) or (typ=tjs) or (typ=tjd) or (typ=crois) then + begin + pos:=route[i].pos; + index:=index_aig(adr); + + if ((typ=aig) or (typ=triple) or (typ=tjs) or (typ=tjd)) then + begin + if aiguillage[index].AdrTrain=0 then + begin + pilote_acc(adr,pos,AdrTrain); // pilote l'aig si il est reservé par le train ou non réservé + s:='AC-Pilote aiguillage '+intToSTR(adr)+'='+intToSTR(pos); + case pos of + const_devie : s:=s+' (dévié)'; + const_droit : s:=s+' (droit)'; + else + s:=s+' non positionné'; + end; + if debugRoulage then Affiche(s,clWhite); + if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig); + // réservation + Affiche('Réservation Aig '+intToSTR(adr),clCyan); + aiguillage[index].adrTrain:=AdrTrain; + end; + end; + end; + if typ=det then + begin + detecteur[adr].AdrTrainRes:=adrTrain; + end; + Texte_aig_fond(adr); + end; + end; + maj_signaux(false); + //TraceListe:=false; +end; + +// Réserve les éléments s'ils ne sont pas déja réservés et positionne les aiguillages +// jusqu'au signal suivant (soit 1 canton) +// en entrée : index du train ; detect=détecteur à partir duquel faire la réservation et le positionnement des aiguillages +// en sortie : si erreur : -1 ou adresse du train qui a réservé le canton +// phase 0 : si le détecteur detect est en fin de route, alors on active l'arret du train +// phase 1 : tester si éléments réservés par train tiers jusqu'aux cantons suivants. Si oui, sortir. +// phase 2 : positionner les aiguillages +// phase 3 : réserver les aiguillages +function aig_cantonX(idTrain,detect : integer) : integer; +var AdrSig,n,i,ic,j,ideb,iFin,AdrTrain,etat,pointeur,voie1,voie2,indexSig1,indexSig2,AncPr, + Trainexistant,adr,pos,index,Ncanton,icanton,NumCanton,det_arret,it,PointRoute,ElPrec, + adr2 : integer; + typ,tprec: tequipement; + trainTiers,SigBonSens,trouve : boolean; + s : string; +begin + //traceliste:=true; + if ProcPrinc then AfficheDebug('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); + if debugRoulage then Affiche('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); + result:=0; + + If traceliste then + begin + if detecteur[detect].Etat then etat:=1 else etat:=0; + affiche('Aig_canton Train id='+intToSTR(idtrain)+' '+intToSTR(detect)+' à '+intToSTR(etat)+'---------------Phase 1',clWhite); + end; + AdrTrain:=trains[idTrain].adresse; + + pointeur:=0; + n:=trains[idTrain].route[0].adresse; + repeat + inc(pointeur); + until (trains[idTrain].route[pointeur].traite=false) or (pointeur+1>=n); + + i:=pointeur-1; + if i=0 then i:=1; // on commence à 1 + + if DebugRoulage then + begin + Affiche('AC train @'+intToSTR(AdrTrain)+'Detecteur='+intToSTR(detect)+' Pointeur'+intToSTR(pointeur)+' ->'+intToSTR(trains[idTrain].route[i].adresse),clOrange); + if i>=n then + begin + affiche('La route a été complètement traitée (réservation)',clOrange); + result:=0; + end; + end; + + // mettre le pointeur de route j sur le détecteur "detect", après le pointeur 'AncPr' + j:=1; + AncPr:=trains[idTrain].PointRout; + repeat + trouve:=(trains[idTrain].route[j].adresse=detect) and (trains[idTrain].route[j].typ=det) and (j>=AncPr); + if trouve then + begin + trains[idTrain].PointRout:=j; //<<<<<<<<< le pointeur est stocké + PointRoute:=j; + if DebugRoulage then Affiche('Le pointeur de route est '+intToSTR(j)+'/'+intToSTR(n)+' au détecteur '+intToSTR(detect),clWhite); + end; + inc(j); + until trouve or (j>n); + + // arrêt temporisé sur détecteur demandé + trouve:=false; + it:=1; // boucle de détecteurs dans les trains + if roulage and (trains[idTrain].roulage>0) and (pointRoute>1) then + repeat + det_arret:=trains[idTrain].DetecteurArret[it].detecteur; + elPrec:=trains[idTrain].DetecteurArret[it].prec; + Tprec:=trains[idTrain].DetecteurArret[it].tprec; + adr2:=0; + // si le précédent est une TJD 4 états il faut tester les 2 adresses + if Tprec=aig then + begin + j:=index_aig(elprec); + if (aiguillage[j].modele=tjd) and (aiguillage[j].EtatTJD=4) then + begin + adr2:=aiguillage[j].DDroit; // homologue + end; + end; + if debugRoulage and (Det_arret<>0) then Affiche('Détecteur demande arrêt rencontré ('+intToSTR(det_arret)+')',clYellow); + // detecteur courant=arret + if (det_arret=detect) and (detecteur[detect].etat) and + (trains[idTrain].route[PointRoute-1].adresse=ElPrec) and (trains[idTrain].route[PointRoute-1].typ=tPrec) and + (pointrouteNbDetArret) or trouve; + + if pointRoute>=n then + begin + // route traitée , arrêter le train + if debugRoulage then Affiche('AC - Route terminée *****',clred); + trains[idTrain].arret_det:=true; + Trains[idTrain].phase_arret:=0; + end; + + traintiers:=false; + icanton:=0; + ncanton:=0; + TrainExistant:=0; + ideb:=trains[idTrain].PointRout; // i; //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + AdrSig:=0; + SigBonSens:=false; + //TraceListe:=true; + if traceliste then Affiche('Aiguillages',clOrange); + with trains[idtrain] do + begin + // boucle de vérification de réservation des aiguillages par un train même lui même, jusqu'à rencontrer n cantons + repeat + typ:=route[i].typ; + adr:=route[i].adresse; + typ:=route[i].typ; + if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then + begin + if TraceListe then Affiche(intToSTR(adr)+' ',clOrange); + // vérifier si l'aiguillage est libre + TrainExistant:=Aiguillage[index_aig(adr)].AdrTrain; + //if (trainexistant<>AdrTrain) and (TrainExistant<>0) then + if (TrainExistant<>0) then begin result:=TrainExistant; trains[idtrain].roulage:=1; @@ -448,7 +700,7 @@ begin // phases 2 et 3 trains[idtrain].roulage:=2; // roulage effectif result:=AdrTrain; - if not(traintiers) then iFin:=i-1 else iFin:=icanton; + if not(traintiers) then iFin:=i-1 else iFin:=icanton; //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< AdrTrain:=trains[idTrain].adresse; // balayage du (des) cantons libres @@ -463,31 +715,38 @@ begin pos:=route[i].pos; index:=index_aig(adr); - if (typ=aig) or (typ=triple) or (typ=tjs) or (typ=tjd) then + if ((typ=aig) or (typ=triple) or (typ=tjs) or (typ=tjd)) then begin - pilote_acc(adr,pos,AdrTrain); // pilote l'aig si il est reservé par le train ou non réservé - - s:='AC-Pilote aiguillage '+intToSTR(adr)+'='+intToSTR(pos); - case pos of - const_devie : s:=s+' (dévié)'; - const_droit : s:=s+' (droit)'; - else - s:=s+' non positionné'; + if aiguillage[index].AdrTrain=0 then + begin + pilote_acc(adr,pos,AdrTrain); // pilote l'aig si il est reservé par le train ou non réservé + s:='AC-Pilote aiguillage '+intToSTR(adr)+'='+intToSTR(pos); + case pos of + const_devie : s:=s+' (dévié)'; + const_droit : s:=s+' (droit)'; + else + s:=s+' non positionné'; + end; + if debugRoulage then Affiche(s,clWhite); + if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig); + // réservation + Affiche('Réservation Aig '+intToSTR(adr),clCyan); + aiguillage[index].adrTrain:=AdrTrain; end; - if not(diffusion) then - Affiche(s,clWhite); - if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig); end; - // réservation - aiguillage[index].adrTrain:=AdrTrain; end; - if typ=det then detecteur[adr].AdrTrainRes:=adrTrain; + if typ=det then + begin + detecteur[adr].AdrTrainRes:=adrTrain; + end; Texte_aig_fond(adr); end; end; maj_signaux(false); + //TraceListe:=false; end; + // bouton rouler 1 train procedure TFormRouteTrain.ButtonRouler1TrClick(Sender: TObject); var demarre : boolean; @@ -501,10 +760,11 @@ begin // si le train est doté d'une route if trains[indexTrainFR].route[0].adresse>0 then begin - aig_canton(indexTrainFR,trains[indexTrainFR].route[1].adresse); // positionne aiguillage et fait les réservations demarre:=demarre_index_train(indexTrainFR); // met la mémoire de roulage du train à 1 + aig_canton(indexTrainFR,trains[indexTrainFR].route[1].adresse); // positionne aiguillage et fait les réservations + if debugRoulage then Affiche_routes_brut; end; - close; + close; // efface la route du TCO end; // bouton rouler tous les trains @@ -519,23 +779,31 @@ begin maj_signaux(true); // positionner les aiguillages de la 1ère route - idtrain:=1; - repeat - //si le train est doté d'une route - if trains[idTrain].route[0].adresse>0 then - begin - aig_canton(idTrain,trains[idTrain].route[1].adresse); - end; - inc(idtrain); - until (idtrain>ntrains); - for idtrain:=1 to ntrains do begin //si le train est doté d'une route - if trains[idTrain].route[0].adresse>0 then demarre:=demarre_index_train(idtrain); // met la mémoire de roulage du train à 1 + if trains[idTrain].route[0].adresse>0 then + begin + if debugRoulage then Affiche_routes_brut; + demarre:=demarre_index_train(idtrain); // met la mémoire de roulage du train à 1 + aig_canton(idTrain,trains[idTrain].route[1].adresse); + end; end; close; end; +procedure TFormRouteTrain.ButtonSauveRouteClick(Sender: TObject); +var n : integer; +begin + if (indexTrainFR<1) then exit; + n:=trains[indexTrainFr].route[0].adresse; + if n=0 then exit; + + Trains[indexTrainFr].routePref:=Trains[IndexTrainFr].route; + Sauve_config; +end; + + + end. diff --git a/UnitSimule.pas b/UnitSimule.pas index ba9bfdc..274888f 100644 --- a/UnitSimule.pas +++ b/UnitSimule.pas @@ -38,7 +38,7 @@ procedure ouvre_simulation(nomfichier : string); var s: string; fte : text; i,k,erreur : integer; - sortie : boolean; + AvecTick,sortie : boolean; begin assignFile(fte,nomfichier); {$I+} @@ -48,96 +48,111 @@ begin Affiche('Fichier '+nomFichier+' incorrect',clred); exit; end; + avecTick:=false; index_simule:=1; sortie:=false; + k:=0; while not(eof(fte)) and not(sortie) do begin readln(fte,s); - s:=Uppercase(s); - i:=pos('TICK=',s); - if i<>0 then + if length(s)>0 then + if s[1]<>'/' then begin - Delete(s,1,i+4); - val(s,k,erreur); - //if intervalle<>0 then k:=Index_Simule*Intervalle+tick+30 else // démarre dans 3s - // k:=Index_Simule+tick+30 ; - Tablo_simule[index_simule].tick:=k; - - // détecteur? Det=528=1 Train=BB16024 - i:=pos('DET',s); - if i<>0 then + s:=Uppercase(s); + i:=pos('TICK=',s); + if ((i<>0) and avecTick) or (not avecTick) then begin - Delete(s,1,i+2); - if s[1]='=' then delete(s,1,1); - if s[1]=' ' then delete(s,1,1); - val(s,k,erreur); - Tablo_simule[index_simule].adresse:=k; - Tablo_simule[index_simule].modele:=det; - i:=pos('=',s); + if avecTick then + begin + Delete(s,1,i+4); + val(s,k,erreur); + //if intervalle<>0 then k:=Index_Simule*Intervalle+tick+30 else // démarre dans 3s + //k:=Index_Simule+tick+30 ; + end + else inc(k); + Tablo_simule[index_simule].tick:=k; + + // détecteur? Det=528=1 Train=BB16024 + i:=pos('DET',s); if i<>0 then begin - Delete(s,1,i); + Delete(s,1,i+2); + if s[1]='=' then delete(s,1,1); + if s[1]=' ' then delete(s,1,1); val(s,k,erreur); - Tablo_simule[index_simule].etat:=k; + if k<>0 then + begin + Tablo_simule[index_simule].adresse:=k; + Tablo_simule[index_simule].modele:=det; + delete(s,1,erreur); + val(s,k,erreur); + Tablo_simule[index_simule].etat:=k; + + i:=pos('=',s); + if i<>0 then + begin + delete(s,1,i); + Tablo_simule[index_simule].train:=s; + end; + inc(index_simule); + end; end; - i:=pos('=',s); - if i<>0 then delete(s,1,i); - Tablo_simule[index_simule].train:=s; - - inc(index_simule); - end; - - // actionneur? Act=803/0=1 Train=CC406526 - i:=pos('ACT',s); - if i<>0 then - begin - Delete(s,1,i+2); - if s[1]='=' then delete(s,1,1); - if s[1]=' ' then delete(s,1,1); - val(s,k,erreur); - Tablo_simule[index_simule].adresse:=k; - - i:=pos('/',s); - if i<>0 then delete(s,1,i); - val(s,k,erreur); - - i:=pos('=',s); - if i<>0 then delete(s,1,i); - val(s,k,erreur); - - Tablo_simule[index_simule].modele:=act; - Tablo_simule[index_simule].etat:=k; - - i:=pos('=',s); - if i<>0 then delete(s,1,i); - Tablo_simule[index_simule].train:=s; - inc(index_simule); - end; - - // aiguillage? - i:=pos('AIG',s); - if i<>0 then - begin - Delete(s,1,i+2); - if s[1]='=' then delete(s,1,1); - if s[1]=' ' then delete(s,1,1); - val(s,k,erreur); - Tablo_simule[index_simule].adresse:=k; - Tablo_simule[index_simule].modele:=aig; - i:=pos('=',s); + // actionneur? Act=803/0=1 Train=CC406526 + i:=pos('ACT',s); if i<>0 then begin - Delete(s,1,i); + Delete(s,1,i+2); + if s[1]='=' then delete(s,1,1); + if s[1]=' ' then delete(s,1,1); val(s,k,erreur); - if (k=1) or (k=2) then Tablo_simule[index_simule].etat:=k - else Affiche('Erreur 622 : Position aiguillage '+intToSTR(Tablo_simule[index_simule].adresse)+' inconnue dans le fichier de simulation',clred); + Tablo_simule[index_simule].adresse:=k; + + i:=pos('/',s); + if i<>0 then delete(s,1,i); + val(s,k,erreur); + + i:=pos('=',s); + if i<>0 then delete(s,1,i); + val(s,k,erreur); + + Tablo_simule[index_simule].modele:=act; + Tablo_simule[index_simule].etat:=k; + + i:=pos('=',s); + if i<>0 then delete(s,1,i); + Tablo_simule[index_simule].train:=s; inc(index_simule); end; + + // aiguillage? + i:=pos('AIG',s); + if i<>0 then + begin + delete(s,1,i+2); + i:=pos(' ',s); + if i=0 then i:=pos('=',s); + delete(s,1,i); + val(s,k,erreur); + if k<>0 then + begin + Tablo_simule[index_simule].adresse:=k; + Tablo_simule[index_simule].modele:=aig; + i:=pos('=',s); + if i<>0 then + begin + Delete(s,1,i); + val(s,k,erreur); + if (k=1) or (k=2) then Tablo_simule[index_simule].etat:=k + else Affiche('Erreur 622 : Position aiguillage '+intToSTR(Tablo_simule[index_simule].adresse)+' inconnue dans le fichier de simulation',clred); + inc(index_simule); + end; + end; + end; end; + Application.ProcessMessages; + sortie:=eof(fte) or (index_simule>Max_Simule) or (pos('STOP',s)<>0); end; - Application.ProcessMessages; - sortie:=eof(fte) or (index_simule>Max_Simule) or (pos('STOP',s)<>0); - end ; + end; if index_simule>Max_Simule then Affiche('Tableau maximal atteint',clred); Affiche('Intervalle='+intToSTR(intervalle),clyellow); diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 6e2eb60..ffeaeeb 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,6 +1,6 @@ object FormTCO: TFormTCO - Left = 229 - Top = 65 + Left = 332 + Top = 73 Width = 1013 Height = 607 VertScrollBar.Visible = False @@ -24,8 +24,8 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 997 - 549) + 1005 + 556) PixelsPerInch = 96 TextHeight = 13 object LabelZoom: TLabel @@ -1537,6 +1537,10 @@ object FormTCO: TFormTCO object N8: TMenuItem Caption = '-' end + object rouverunlment1: TMenuItem + Caption = 'Trouver un '#233'l'#233'ment' + OnClick = rouverunlment1Click + end object DessinerleTCO1: TMenuItem Caption = 'Dessiner le TCO' Hint = 'Dessine le TCO '#224' la souris' @@ -1575,8 +1579,12 @@ object FormTCO: TFormTCO end object Routes: TMenuItem Caption = 'Routes' + object Optiondesroutes1: TMenuItem + Caption = 'Option des routes' + OnClick = Optiondesroutes1Click + end object AffRoutes: TMenuItem - Caption = 'Fen'#234'tre des routes' + Caption = 'Fen'#234'tre des routes par trains' OnClick = AffRoutesClick end end diff --git a/UnitTCO.pas b/UnitTCO.pas index aa6c786..d27671e 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -162,6 +162,8 @@ type ImageDrapVert: TImage; ImageDrapRouge: TImage; Button1: TButton; + Optiondesroutes1: TMenuItem; + rouverunlment1: TMenuItem; //TimerTCO: TTimer; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -378,7 +380,9 @@ type procedure ButtonAffSCClick(Sender: TObject); procedure RadioGroupSelClick(Sender: TObject); procedure SauvegarderleTCO1Click(Sender: TObject); procedure DessinerleTCO1Click(Sender: TObject); procedure ConfigurationduTCO1Click(Sender: TObject); procedure Redessine1Click(Sender: TObject); procedure BandeauClick(Sender: TObject); procedure Mosaquehorizontale1Click(Sender: TObject); procedure Mosaqueverticale1Click(Sender: TObject); procedure AfficherSignauxComplexes1Click(Sender: TObject); procedure Signalvertical180Click(Sender: TObject); procedure RechargerleTCOdepuislefichier1Click(Sender: TObject); procedure Supprimercanton1Click(Sender: TObject); procedure Affecterlocomotiveaucanton1Click(Sender: TObject); procedure ImagePalette52MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette52DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette53EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImageTCOEndDrag(Sender, Target: TObject; X, Y: Integer); procedure AffRoutesClick(Sender: TObject); procedure Button1Click(Sender: TObject); private + procedure ImageTCOEndDrag(Sender, Target: TObject; X, Y: Integer); procedure AffRoutesClick(Sender: TObject); procedure Button1Click(Sender: TObject); + procedure Optiondesroutes1Click(Sender: TObject); + procedure rouverunlment1Click(Sender: TObject); private { Déclarations privées } function index_TCOMainMenu : integer; public @@ -395,9 +399,9 @@ const SensTCO_O=5; // gauche SensTCO_NO=9; // NO SensTCO_E=6; // droite - SensTCO_N=7; // haut + SensTCO_N=7; // N SensTCO_NE=10; // NE - SensTCO_S=8; // bas + SensTCO_S=8; // S SensTCO_SE=11; // SE SensTCO_SO=12; // SO @@ -533,9 +537,11 @@ var ancienTraceX,ancienTraceY,rangUndo,NbreTCO,IndexTCOCreate,deltaXrect,deltaYrect, CellX,CellY,AncienXclic,AncienYclic,xCadre1,yCadre1,xCadre2,yCadre2,colonne_supprime, couleurAction,couleurCanton,Ncantons,Xcanton,Ycanton,IdCantonSelect,IdCantonClic,AxSC,AySC,Drag, - Ldrag,Hdrag,IdCantonDragOrg,sens,idcantonRoute,cantonOrg,cantonDest,AncienIdCantonSelect, + Ldrag,Hdrag,IdCantonDragOrg,idcantonRoute,cantonOrg,cantonDest,AncienIdCantonSelect, indexTrainFR : integer; + ToucheTCO : char; + Tel1,tel2 : Tequipement; titre_Fonte,s90,s91,s93,s94,s100,s101 : string; @@ -649,11 +655,12 @@ procedure renseigne_canton(i : integer); overload; function index_canton_numero(n : integer) : integer; procedure renseigne_TJDs; procedure Affiche_temps_arret(IdTrain,tps : integer); +procedure titre_fenetre(indexTCO : integer); implementation uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO, UnitClock, selection_train , - UnitRoute, UnitRouteTrains, UnitInfo; + UnitRoute, UnitRouteTrains, UnitInfo, UnitIntro; {$R *.dfm} @@ -1143,7 +1150,13 @@ var n,Bim,larg,haut,xt,yt,adr,Xorg,Yorg,yr,xr,xm,ym : integer; r : Trect; ok,rien,versE,versO,versN,versS : boolean; begin - if canton[indexCanton].Ntco<>IndexTCO then begin result:=false; exit; end; // si le canton n'est pas sur le bon TCO + //Affiche('AC',clWhite); + if canton[indexCanton].Ntco<>IndexTCO then + begin + //Affiche('Canton différent',clred); + result:=false; + exit; + end; // si le canton n'est pas sur le bon TCO rien:=not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_haut) ; larg:=largeurCell[IndexTCO]; @@ -1188,7 +1201,6 @@ begin //if versO then begin Affiche('-',clYellow); end; AxSC:=x;AySC:=y; - ok:=(Adr=0) and ( (Bim=1) or (Bim=20) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9))); if not(ok) then // sortir car non ok begin @@ -1197,17 +1209,17 @@ begin exit; end; - // gauche + // poignée gauche r:=canton[indexCanton].rO; // si x est dans le rectangle if (((x>=r.left-5) and (x<=r.Right+5) and (y>=r.top-5) and (y<=r.bottom+5)) or prise_gauche) then //and (x>0) then begin - ok:=( (Bim=1) or (Bim=20) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9))); + ok:=( (Bim=1) or (Bim=0) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9))); ok:=ok and (x>canton[indexCanton].mini); // empeche d'aller à gauche - if not(ok) then begin result:=false;exit;end; + if not(ok) then begin result:=true;exit;end; - n:=abs(canton[indexCanton].gd.right-x) div larg; - if (n>9) or (n<3) then exit; // nombre de cellules tirées : maxi 9 + n:=1+(abs(canton[indexCanton].gd.right-x) div larg); + if (n>10) or (n<4) then begin result:=false;exit;end; // nombre de cellules tirées : maxi 9 screen.cursor:=crSizeWE; if (rien and clicsouris) or prise_gauche then begin @@ -1232,17 +1244,25 @@ begin // poignée droite r:=canton[indexCanton].rE; + if (((x>=r.left-5) and (x<=r.Right+5) and (y>=r.top-5) and (y<=r.bottom+5)) or prise_droit) then //and (x=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9))); - ok:=ok and (x9) or (n<3) then exit; // nombre de cellules tirées : maxi 9 + ok:=( (Bim=1) or (Bim=0) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9))); + ok:=ok and (x=r.left-5) and (x<=r.Right+5) and (y>=r.top-5) and (y<=r.bottom+5)) or prise_haut) and (y>0) then begin - ok:=(Bim=1) or (Bim=20) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9)); + ok:=(Bim=0) or (Bim=20) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9)); ok:=ok and (y>canton[indexCanton].mini); // empeche d'aller en haut if not(ok) then begin result:=true;exit;end; - n:=abs(canton[indexCanton].gd.bottom-y) div larg; // nombre de cellules tirées - if (n>9) or (n<3) then exit; // nombre de cellules tirées : maxi 9 + n:=1+(abs(canton[indexCanton].gd.bottom-y) div larg); // nombre de cellules tirées + if (n>10) or (n<4) then begin result:=false;exit;end;; // nombre de cellules tirées : maxi 9 screen.cursor:=crSizeNS; if (rien and clicsouris) or prise_haut then begin @@ -1300,12 +1320,12 @@ begin r:=canton[indexCanton].rS; if (((x>=r.left-5) and (x<=r.Right+5) and (y>=r.top-5) and (y<=r.bottom+5)) or prise_bas) then //and (y=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9)); + ok:=(Bim=0) or (Bim=20) or ((Bim>=Id_cantonH) and (bim<=Id_cantonH+9)) or ((Bim>=Id_cantonV) and (bim<=Id_cantonV+9)); ok:=ok and (y9) or (n<3) then exit; // nombre de cellules tirées : maxi 9 + n:=1+(abs(canton[indexCanton].gd.top-y) div larg); + if (n>10) or (n<4) then begin result:=false;exit;end;; // nombre de cellules tirées : maxi 9 screen.cursor:=crSizeNS; if (rien and clicsouris) or prise_bas then begin @@ -1373,8 +1393,9 @@ end; // i : indexCanton // remplit les champs horizontal, el1,el2,typ1,typ2,sens1,sens2 de canton[] // et les champs canton1 et canton2 du tableau detecteurs[] +// remplit les case du TCO avec les Images du canton procedure renseigne_canton(i : integer;Horz :boolean) ; overload; -var t,x,y,indexTCO : integer; +var t,x,y,n,j,indexTCO : integer; begin if i<1 then exit; indexTCO:=canton[i].Ntco; @@ -1393,13 +1414,13 @@ begin if horz then begin - zone_tco(t,i,5,0,0,11,false); // demande éléments contigus à gauche (5) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_O,0,0,11,false); // demande éléments contigus à gauche (5) du canton, résultats dans var globales xCanton et tel1 canton[i].el1:=xCanton; canton[i].typ1:=tel1; canton[i].SensEl1:=SensGauche; if tel1=det then detecteur[xCanton].canton1:=canton[i].numero; - zone_tco(t,i,6,0,0,11,false); // demande éléments contigus à droite (6) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_E,0,0,11,false); // demande éléments contigus à droite (6) du canton, résultats dans var globales xCanton et tel1 canton[i].el2:=xCanton; canton[i].typ2:=tel1; canton[i].SensEl2:=SensDroit; @@ -1407,19 +1428,28 @@ begin end else begin - zone_tco(t,i,7,0,0,11,false); // demande éléments contigus en haut (7) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_N,0,0,11,false); // demande éléments contigus en haut (7) du canton, résultats dans var globales xCanton et tel1 canton[i].el1:=xCanton; canton[i].typ1:=tel1; canton[i].SensEl1:=SensHaut; if tel1=det then detecteur[xCanton].canton1:=canton[i].numero; - zone_tco(t,i,8,0,0,11,false); // demande éléments contigus en bas (8) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_S,0,0,11,false); // demande éléments contigus en bas (8) du canton, résultats dans var globales xCanton et tel1 canton[i].el2:=xCanton; canton[i].typ2:=tel1; canton[i].SensEl2:=SensBas; if tel1=det then detecteur[xCanton].canton2:=canton[i].numero; end; + n:=canton[i].Nelements; + if horz then for j:=0 to n-1 do tco[t,x+j,y].BImage:=Id_cantonH+j + else for j:=0 to n-1 do tco[t,x,y+j].BImage:=Id_cantonV+j; + + if (canton[i].el1=canton[i].el2) and (canton[i].typ1=det) and (canton[i].typ2=det) then + begin + Affiche('Erreur 210 : Le canton '+intToSTR(canton[i].numero)+' dans le tco '+intToSTR(t)+' dispose de deux détecteurs contigus d''adresses identiques: '+intToSTR(canton[i].el1),clred); + end; + //Affiche(intToSTR(xCanton)+' '+intToStr(yCanton),clyellow); end; @@ -2267,7 +2297,9 @@ begin inc(y);x:=1; end; closefile(fichier); + renseigne_tous_cantons; trier_cantons; + affecte_trains_config; e:=sizeof(Tco) div 1024; @@ -2685,16 +2717,25 @@ begin b:=tco[indextco,x,y].BImage; - if (b=id_Quai) then PCanvasTCO[indextco].Brush.Color:=clQuai[indexTCO] - else if ((b=id_cantonH) or (b=id_CantonV)) then - begin - if TCO[IndexTCO,x,y].train=0 then - PCanvasTCO[indextco].Brush.Color:=clFondCantonV - else PCanvasTCO[indextco].Brush.Color:=clFondCantonR; - end - else PCanvasTCO[indextco].Brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then + begin + if (b=id_Quai) then PCanvasTCO[indextco].Brush.Color:=clQuai[indexTCO] + else if ((b=id_cantonH) or (b=id_CantonV)) then + begin + if TCO[IndexTCO,x,y].train=0 then + PCanvasTCO[indextco].Brush.Color:=clFondCantonV + else PCanvasTCO[indextco].Brush.Color:=clFondCantonR; + end + else PCanvasTCO[indextco].Brush.Color:=tco[indextco,x,y].CouleurFond; + + c.Font.Color:=tco[indextco,x,y].CoulFonte; + end + else + begin + PCanvasTCO[indextco].Brush.color:=clWhite; + c.Font.color:=clBlack; + end; - c.Font.Color:=tco[indextco,x,y].CoulFonte; nf:=tco[indextco,x,y].fonte; if nf='' then ss:='Arial'; c.Font.Name:=nf; @@ -5897,6 +5938,7 @@ var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont,adr1,adr2, index1,index2,etatTJD,position1,position2,sHG,sBD : integer; a1,b1,a2,b2 : double; md,tHG,tBD : tequipement; + fond : tcolor; procedure horizontale; begin with canvas do @@ -5919,7 +5961,7 @@ var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont,adr1,adr2, end; end; - procedure TjdHaut; + procedure TjdHaut(dessin : integer); begin x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+(LargeurCell[indexTCO] div 3)+3;y2:=yc; @@ -5928,12 +5970,23 @@ var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont,adr1,adr2, with canvas do begin - if testbit(ep,2) or testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,2) or testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; - procedure TjdBas; + // si dessin=1 dessine en épaisseur de voie + // si dessin=2 dessine en épaisseur de trajet + procedure TjdBas(dessin : integer); begin x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; @@ -5943,7 +5996,11 @@ var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont,adr1,adr2, with canvas do begin - if testbit(ep,6) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,6) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else pen.width:=epaisseur div 2; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; @@ -5956,6 +6013,7 @@ begin xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; + fond:=tco[indextco,x,y].CouleurFond; pont:=tco[indextco,x,y].pont; md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; @@ -5967,11 +6025,11 @@ begin horizontale; diagonale; - + if (md=tjd) or (md=tjs) then begin - tjdbas; - tjdhaut; + tjdbas(1); + tjdhaut(1); end; // horizontale @@ -6055,7 +6113,7 @@ begin moveto(x0,yf);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yc);} - tjdbas; + tjdbas(1); end; if trajet=4 then // -/ O C NE begin @@ -6063,7 +6121,7 @@ begin moveto(x0,yc);LineTo(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,y0);} - tjdhaut; + tjdhaut(1); end; end; end; @@ -6104,23 +6162,27 @@ begin begin if tco[indexTCO,x,y].tjdE=adr1 then with canvas do begin - moveTo(x0,yc);LineTo(xc,yc);Lineto(xf,y0); + //moveTo(x0,yc);LineTo(xc,yc);Lineto(xf,y0); + tjdhaut(2); end; - if tco[indexTCO,x,y].tjdE=adr2 then + if tco[indexTCO,x,y].tjdE=adr2 then with canvas do begin - moveTo(x0,yf);LineTo(xc,yc);Lineto(xf,yc); + //moveTo(x0,yf);LineTo(xc,yc);Lineto(xf,yc); + tjdbas(2); end; end; - + if (position1=const_devie) and (position2=const_droit) then begin - if tco[indexTCO,x,y].tjdE=adr1 then + if tco[indexTCO,x,y].tjdE=adr1 then with canvas do begin - moveTo(x0,yf);LineTo(xc,yc);Lineto(xf,yc); + //moveTo(x0,yf);LineTo(xc,yc);Lineto(xf,yc); + tjdbas(2); end; - if tco[indexTCO,x,y].tjdE=adr2 then + if tco[indexTCO,x,y].tjdE=adr2 then with canvas do begin - moveTo(x0,yc);LineTo(xc,yc);Lineto(xf,y0); + //moveTo(x0,yc);LineTo(xc,yc);Lineto(xf,y0); + tjdhaut(2); end; end; end; @@ -6132,14 +6194,14 @@ begin begin moveTo(x0,yf);LineTo(xf,y0); moveTo(x0,yc);LineTo(xf,yc); - end; + end; if position1=const_devie then with canvas do begin // donne l'équation de droite y=ax+b passant par les points (x1,y1) (x2,y2) droite(xc,yc,xf,y0,a1,b1); //haut - moveTo(x0,yc); LineTo(xc-epaisseur,yc); + moveTo(x0,yc); LineTo(xc-epaisseur,yc); LineTo(xc+epaisseur,round((xc+epaisseur)*a1+b1) ); LineTo(xf,y0); //bas moveTo(x0,yf); @@ -6149,8 +6211,6 @@ begin end; end; end; - - end; // Element 22 @@ -6182,7 +6242,7 @@ var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,position1,positi end; end; - procedure TJDbas; // morceau courbe bas + procedure TJDbas(dessin :integer); // morceau courbe bas begin x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc; x2:=xf+(LargeurCell[indexTCO] div 3);y2:=yf+2*hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 2); @@ -6191,12 +6251,21 @@ var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,position1,positi ep:=tco[indextco,x,y].epaisseurs; with canvas do begin - if testbit(ep,7) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,7) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; - procedure TJDHaut; // morceau courbe haut + procedure TJDHaut(dessin :integer); // morceau courbe haut begin x1:=x0-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+LargeurCell[indexTCO]+(LargeurCell[indexTCO] div 3);y2:=yc; @@ -6204,7 +6273,16 @@ var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,position1,positi x4:=xf;y4:=yc; with canvas do begin - if testbit(ep,0) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,0) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; @@ -6237,8 +6315,8 @@ begin if (md=tjd) or (md=tjs) then begin - TJDbas; - TJDHaut; + TJDbas(1); + TJDHaut(1); end; // horizontale @@ -6300,7 +6378,6 @@ begin y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); end; - // regarder d'ou on vient de la route du tco if mode>0 then @@ -6317,11 +6394,11 @@ begin if trajet=2 then diagonale; if trajet=3 then // NO centre E \- begin - tjdhaut; + tjdhaut(1); end; if trajet=4 then // O C SE -\ begin - tjdbas; + tjdbas(1); end; end; end; @@ -6360,38 +6437,44 @@ begin if (position1=const_droit) and (position2=const_devie) then begin if tco[indexTCO,x,y].tjdE=adr1 then - with canvas do begin + {with canvas do + begin moveTo(x0,y0);LineTo(xc,yc);Lineto(xf,yc); - end; + end;} + tjdhaut(2); if tco[indexTCO,x,y].tjdE=adr2 then - with canvas do begin + tjdbas(2); + {with canvas do + begin moveTo(x0,yc);LineTo(xc,yc);Lineto(xf,yf); - end; + end;} end; if (position1=const_devie) and (position2=const_droit) then begin - if tco[indexTCO,x,y].tjdE=adr1 then - with canvas do begin + if tco[indexTCO,x,y].tjdE=adr1 then + {with canvas do begin moveTo(x0,yc);LineTo(xc,yc);Lineto(xf,yf); - end; - if tco[indexTCO,x,y].tjdE=adr2 then - with canvas do begin + end;} + tjdbas(2); + if tco[indexTCO,x,y].tjdE=adr2 then + {with canvas do begin moveTo(x0,y0);LineTo(xc,yc);Lineto(xf,yc); - end; + end;} + tjdhaut(2); end; end; - + if etatTJD=2 then begin - if position1=const_droit then - with canvas do + if position1=const_droit then + with canvas do begin moveTo(x0,y0);LineTo(xf,yf); moveTo(x0,yc);LineTo(xf,yc); - end; - if position1=const_devie then - with canvas do + end; + if position1=const_devie then + with canvas do begin // donne l'équation de droite y=ax+b passant par les points (x1,y1) (x2,y2) droite(x0,y0,xc,yc,a1,b1); @@ -6640,7 +6723,7 @@ end; // mode=0 canton normal mode=1 : affiche le canton en mode rectangle de sélection avec les poignées // =3 drapeau vert =4 drapeau rouge procedure dessin_cantonH(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); -var i,xi,yi,x0,y0,yf,yc,xt,yt,dx,dy,larg,haut,xr,xm,LargDest,Hautdest,indexTrain,NumC, +var i,xi,yi,x0,y0,yf,yc,xt,yt,dx,dy,larg,haut,xr,xm,LargDest,Hautdest,indexTrain,NumC,sens, offsetY,xf,AdrTrain,Xcentre,yCentre,n,al,r,l,h,HautDestF,LargDestF,LargSrc,HautSrc,OffsetX, bouton : integer; frX,frY,rd : real; @@ -6766,14 +6849,16 @@ begin sens:=canton[i].SensLoco; case sens of - 0,sensGauche : xi:=x0+OffsetX; - sensDroit : xi:=xf-largdest-larg; + 0,sensGauche : begin + xi:=x0+OffsetX; + xt:=xi+largDest+round(10*frx);yt:=y0+round(20*fry);dx:=xf-larg;dy:=yf; // espace restant + end; + sensDroit : begin + xi:=xf-largdest-larg; + xt:=x0+round(5*frx);yt:=y0+round(20*fry);dx:=xi+largdest-larg;dy:=y0+offsety+hautdest; + end; end; - // coordonnées du texte de la loco - if sens=sensGauche then begin xt:=xi+largDest+round(10*frx);yt:=y0+round(20*fry);dx:=xf-larg;dy:=yf;end; // espace restant - if sens=sensdroit then begin xt:=x0+round(5*frx);yt:=y0+round(20*fry);dx:=xi+largdest-larg;dy:=y0+offsety+hautdest;end; - // Nom du train s:=canton[i].NomTrain; l:=TextWidth(s); @@ -6787,7 +6872,7 @@ begin Canton[i].Licone:=LargDest; Canton[i].Hicone:=HautDest; - if canton[i].SensLoco=SensGauche then + if sens=SensGauche then begin // efface l'image temporaire with FormTCO[indexTCO].ImageTemp2.Canvas do @@ -6825,7 +6910,7 @@ end; procedure dessin_cantonV(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); var AdrTrain,i,xi,yi,xt,yt,x0,xc,yc,y0,xf,yf,dx,dy,larg,haut,hautDest,LargDest,LargSrc,HautSrc,yr,ym,l, - xCentre,yCentre,r,indexTrain,n,al,bouton : integer; + xCentre,yCentre,r,indexTrain,n,al,bouton,sens : integer; frX,frY,rd : real; coul : tcolor; s : string; @@ -6958,8 +7043,15 @@ begin sens:=canton[i].SensLoco; case sens of - 0,sensHaut : yi:=y0+10; - sensBas : yi:=yf-Hautdest-haut; + 0,sensHaut : begin + yi:=y0+10; + // coordonnées du texte de la loco + xt:=x0+round(40*frx);yt:=yi+hautdest+round(10*fry);dx:=xf;dy:=yf-haut; + end; + sensBas : begin + yi:=yf-Hautdest-haut; + xt:=x0+round(40*frx);yt:=y0+round(10*fry);dx:=x0+Largdest;dy:=yi-haut + end; end; Canton[i].Xicone:=x0+round(8*frx); @@ -6967,10 +7059,6 @@ begin Canton[i].Licone:=LargDest; Canton[i].Hicone:=HautDest; - // coordonnées du texte de la loco - if sens=sensHaut then begin xt:=x0+round(40*frx);yt:=yi+hautdest+round(10*fry);dx:=xf;dy:=yf-haut;end; // espace restant - if sens=sensBas then begin xt:=x0+round(40*frx);yt:=y0+round(10*fry);dx:=x0+Largdest;dy:=yi-haut;end; - //PCanvasTCO[indexTCO].font.Size:=PCanvasTCO[indexTCO].font.Size+1; s:=canton[i].NomTrain; l:=TextWidth(s); @@ -7367,7 +7455,8 @@ procedure dessin_23(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont, adr1,adr2,index1,index2,position1,position2,EtatTJD,sHG,sBD : integer; a1,b1,a2,b2 : double; - md,tHG,tBD: tEquipement; + md,tHG,tBD : tEquipement; + fond : tcolor; procedure verticale; begin with canvas do @@ -7390,7 +7479,7 @@ var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont, end; end; - procedure tjd_d; + procedure tjd_d(dessin : integer); begin x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); @@ -7400,12 +7489,21 @@ var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont, with canvas do begin - if testbit(ep,2) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,2) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; - procedure tjd_G; + procedure tjd_G(dessin : integer); begin x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 2.5); @@ -7415,7 +7513,16 @@ var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont, with canvas do begin - if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; @@ -7429,6 +7536,7 @@ begin yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; pont:=tco[indextco,x,y].pont; + fond:=tco[indextco,x,y].CouleurFond; with canvas do begin @@ -7446,8 +7554,8 @@ begin md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; if (md=tjd) or (md=tjs) then begin - tjd_G; - tjd_D; + tjd_G(1); + tjd_D(1); end; // verticale @@ -7531,7 +7639,7 @@ begin moveto(xf,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xc,yf);} - tjd_d; + tjd_d(1); end; if trajet=4 then // N C SO begin @@ -7539,7 +7647,7 @@ begin moveto(xc,y0);LineTo(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(x0,yf);} - tjd_g; + tjd_g(1); end; end; end; @@ -7561,7 +7669,7 @@ begin adr2:=aiguillage[index1].DDevie; // homologue Index2:=Index_aig(adr2); position2:=aiguillage[index2].position; - + if (position1=const_devie) and (position2=const_devie) then begin with canvas do begin @@ -7578,44 +7686,48 @@ begin if (position1=const_droit) and (position2=const_devie) then begin - if tco[indexTCO,x,y].tjdS=adr1 then - with canvas do begin + if tco[indexTCO,x,y].tjdS=adr1 then + {with canvas do begin moveTo(xf,y0);LineTo(xc,yc);Lineto(xc,yf); - end; - if tco[indexTCO,x,y].tjdS=adr2 then - with canvas do begin + end;} + tjd_d(2); + if tco[indexTCO,x,y].tjdS=adr2 then + {with canvas do begin moveTo(xc,y0);LineTo(xc,yc);Lineto(x0,yf); - end; + end;} + tjd_g(2); end; - + if (position1=const_devie) and (position2=const_droit) then begin if tco[indexTCO,x,y].tjdS=adr1 then - with canvas do begin + {with canvas do begin moveTo(xc,y0);LineTo(xc,yc);Lineto(x0,yf); - end; - if tco[indexTCO,x,y].tjdS=adr2 then - with canvas do begin + end; } + tjd_g(2); + if tco[indexTCO,x,y].tjdS=adr2 then + {with canvas do begin moveTo(xf,y0);LineTo(xc,yc);Lineto(xc,yf); - end; + end;} + tjd_d(2); end; end; - + if etatTJD=2 then begin - if position1=const_droit then - with canvas do + if position1=const_droit then + with canvas do begin moveTo(xc,y0);LineTo(xc,yf); moveTo(xf,y0);LineTo(x0,yf); - end; - if position1=const_devie then - with canvas do - begin + end; + if position1=const_devie then + with canvas do + begin // donne l'équation de droite y=ax+b passant par les points (x1,y1) (x2,y2) droite(xc,yc,x0,yf,a1,b1); //gauche - moveTo(xc,y0); LineTo(xc,yc-epaisseur); + moveTo(xc,y0); LineTo(xc,yc-epaisseur); LineTo(xc-epaisseur,round((xc-epaisseur)*a1+b1) ); LineTo(x0,yf); //droite moveTo(xc,yf); @@ -7639,6 +7751,7 @@ var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2, adr1,adr2,index1,index2,position1,position2,EtatTJD,sHG,sBD : integer; a1,b1,a2,b2 : double; md,tHG,tBD : tEquipement; + fond : tcolor; procedure verticale; begin with canvas do @@ -7661,7 +7774,7 @@ var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2, end; end; - procedure tjd_g; + procedure tjd_g(dessin : integer); begin x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); @@ -7671,12 +7784,21 @@ var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2, with canvas do begin - if testbit(ep,0) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,0) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; - procedure tjd_d; + procedure tjd_d(dessin : integer); begin x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 3); @@ -7686,7 +7808,16 @@ var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2, with canvas do begin - if testbit(ep,1) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + if dessin=1 then + begin + if testbit(ep,1) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + end + else + begin + pen.color:=fond; + Brush.Color:=fond; + pen.width:=epaisseur div 2; + end; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; @@ -7700,6 +7831,7 @@ begin yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; pont:=tco[indextco,x,y].pont; + fond:=tco[indexTco,x,y].CouleurFond; with canvas do begin @@ -7717,9 +7849,9 @@ begin md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; if (md=tjd) or (md=tjs) then begin - tjd_g; - tjd_d; - end; + tjd_g(1); + tjd_d(1); + end; // verticale if testbit(pont,1) or testbit(pont,5) then @@ -7802,7 +7934,7 @@ begin moveto(x0,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xc,yf);} - tjd_g; + tjd_g(1); end; if trajet=4 then begin @@ -7810,7 +7942,7 @@ begin moveto(xc,y0);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yf);} - tjd_d; + tjd_d(1); end; end; end; @@ -7850,28 +7982,32 @@ begin if (position1=const_droit) and (position2=const_devie) then begin if tco[indexTCO,x,y].tjdS=adr1 then - with canvas do begin + {with canvas do begin moveTo(xc,y0);LineTo(xc,yc);Lineto(xf,yf); - end; - if tco[indexTCO,x,y].tjdS=adr2 then - with canvas do begin + end;} + tjd_d(2); + if tco[indexTCO,x,y].tjdS=adr2 then + {with canvas do begin moveTo(x0,y0);LineTo(xc,yc);Lineto(xc,yf); - end; + end; } + tjd_g(2); end; - + if (position1=const_devie) and (position2=const_droit) then begin - if tco[indexTCO,x,y].tjdS=adr1 then - with canvas do begin + if tco[indexTCO,x,y].tjdS=adr1 then + {with canvas do begin moveTo(x0,y0);LineTo(xc,yc);Lineto(xc,yf); - end; - if tco[indexTCO,x,y].tjdS=adr2 then - with canvas do begin + end; } + tjd_g(2); + if tco[indexTCO,x,y].tjdS=adr2 then + {with canvas do begin moveTo(xc,y0);LineTo(xc,yc);Lineto(xf,yf); - end; + end; } + tjd_d(2); end; end; - + if etatTJD=2 then begin if position1=const_droit then @@ -10864,7 +11000,7 @@ begin Epaisseur:=LargeurCell[indexTCO]*epaisseur_voies div 30; HautCell:=hauteurCell[indexTCO]; largCell:=LargeurCell[indexTCO]; - clFond:=tco[indextco,x,y].CouleurFond; + if not NB then clFond:=tco[indextco,x,y].CouleurFond else clFond:=clWhite; Xorg:=(x-1)*LargeurCell[indexTCO]; Yorg:=(y-1)*HautCell; @@ -10903,7 +11039,7 @@ begin if AdrTr=0 then begin - Brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; //SetBkMode(PCanvasTCO[indexTCO].Handle,TRANSPARENT); if roulage then s:=s+' '; // efface l'adresse de réservation end @@ -10950,7 +11086,7 @@ begin if repr<>0 then with PCanvasTCO[indexTCO] do begin - Brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.Color:=clwhite; if NB then font.color:=clblack else Font.Color:=tco[indextco,x,y].coulFonte; Font.Name:='Arial'; @@ -11046,7 +11182,7 @@ begin if AdrTr<>0 then begin Brush.style:=bsSolid; - Brush.Color:=clBlue; + if not NB then Brush.Color:=clBlue else Brush.color:=clwhite; s:=s+' '+intToSTR(AdrTr); end else @@ -11075,7 +11211,7 @@ begin if (AdrTr<>0) then begin Brush.style:=bsSolid; - clfond:=clBlue; + if not NB then clfond:=clBlue else clfond:=clwhite; s:=s+' '+intToSTR(AdrTr); end; @@ -11090,7 +11226,7 @@ begin begin // Adresse de l'élément with PCanvasTCO[indexTCO] do begin - Brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); if NB then font.color:=clblack else @@ -11104,7 +11240,7 @@ begin begin // Adresse de l'élément with PCanvasTCO[indexTCO] do begin - Brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; if NB then font.color:=clblack else Font.Color:=tco[indextco,x,y].coulFonte; Font.Style:=style(tco[indextco,x,y].FontStyle); @@ -11194,7 +11330,7 @@ begin with PCanvasTCO[indexTCO] do begin - Brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; if NB then font.color:=clblack else Font.Color:=tco[indextco,x,y].coulFonte; Font.Style:=style(tco[indextco,x,y].FontStyle); @@ -11279,7 +11415,7 @@ begin end; end; -// affiche le tco suivant le tableau TCO +// affiche le tco "index" procedure Affiche_TCO(indexTCO : integer) ; var Bim,x,y,x1,y1,DimX,DimY : integer; s : string; @@ -11333,7 +11469,7 @@ begin begin x1:=(x-1)*LargeurCell[indexTCO]; y1:=(y-1)*hauteurCell[indexTCO]; - brush.Color:=tco[indextco,x,y].CouleurFond; + if not NB then brush.Color:=tco[indextco,x,y].CouleurFond else brush.color:=clWhite; r:=rect(x1,y1,x1+LargeurCell[indexTCO],y1+hauteurCell[indexTCO]); FillRect(r); @@ -11410,7 +11546,7 @@ end; procedure TFormTCO.FormCreate(Sender: TObject); var s : string; begin - NB:=false; + NB:=false; // mode noir et blanc pour l'affichage if affevt or (debug=1) then Affiche('FormTCO'+intToSTR(indexTCOCreate)+' create',clLime); procetape('Création fenêtre TCO'); @@ -11605,11 +11741,10 @@ end; // sinon mode = couleur du train // affecte le train au canton procedure affiche_trajet(indexTCO,train,AdrTrain,ir,mode : integer); -var i,sx,sy,x,y,ax,ay,Bimage,adresse,IdCanton,IdTrain,AncTrain : integer; +var i,sx,sy,x,y,ax,ay,Bimage,adresse,IdCanton,IdTrain,AncTrain,d1,d2: integer; cant : boolean; begin // et affichage de la route - if debugTCO then begin if ir<>0 then @@ -11643,19 +11778,20 @@ begin //Affiche('Affiche_trajet: Affecte '+intToSTR(IdTrain)+' au TCO '+intToSTR(indexTCO)+' '+intToSTR(x)+' '+intToSTR(y),clWhite); - // si pas canton, affectation du train--------------------------- + // si pas canton, affectation du train à la cellule--------------------------- if not(cant) then TCO[IndexTCO,x,y].train:=IdTrain else begin // si canton IdCanton:=index_canton_numero(TCO[indexTCO,x,y].NumCanton); // index canton + { if (idTrain<>0) and (idcanton<>0) then begin if canton[IdCanton].indexTrain<>0 then //si train dans canton begin if AdrTrain<>0 then canton[idCanton].indexTrain:=Index_Train_Adresse(AdrTrain); IdTrain:=canton[IdCanton].indexTrain; - //Affiche('Affecte train '+intToSTR(adrTrain)+' au canton n°'+intToSTR(index_canton_numero(TCO[indexTCO,x,y].PiedFeu)),clred); + Affiche('1.Affecte train '+intToSTR(adrTrain)+' au canton n°'+intToSTR(index_canton_numero(TCO[indexTCO,x,y].PiedFeu)),clred); affecte_train_canton(AdrTrain,IdCanton); end; if idTrain<=Ntrains then // dans le cas de la libération d'un canton par un train qui avance, @@ -11665,9 +11801,23 @@ begin if (idTrain=0) and (AncTrain=9999) and (adrtrain=0) then adrTrain:=0; //if (ancTrain=0) or (IdTrain=0) then // si le canton est déja affecté à un train et que le nouveau train<>0, on ne réaffecte pas le train qui arrive //if idTrain=0 then AdrTrain:=0; - //Affiche('Affecte train '+intToSTR(adrTrain)+' au canton n°'+intToSTR(index_canton_numero(TCO[indexTCO,x,y].NumCanton)),clorange); + Affiche('2. Affecte train '+intToSTR(adrTrain)+' au canton n°'+intToSTR(index_canton_numero(TCO[indexTCO,x,y].NumCanton)),clorange); affecte_Train_canton(AdrTrain,IdCanton); end; + end; } + AncTrain:=0; + if idcanton<>0 then + begin + if canton[idCanton].typ1=det then + begin + d1:=canton[idCanton].el1; + AncTrain:=detecteur[d1].AdrTrain; if AncTrain<>0 then affecte_Train_canton(AncTrain,IdCanton,canton[idcanton].SensLoco); + end; + if (canton[idCanton].typ2=det) and (ancTrain=0) then // si déja affecté train + begin + d2:=canton[idCanton].el2; + AncTrain:=detecteur[d2].AdrTrain; if AncTrain<>0 then affecte_Train_canton(AncTrain,IdCanton,canton[idcanton].SensLoco); + end; end; end; @@ -11683,7 +11833,7 @@ begin if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de gauche à droite if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de droite à gauche if (ax-x=-1) and (ay-y=1) and (sx-x=1) and (sy-y=-1) then tco[indextco,x,y].trajet:=2; // de bas gauche vers haut droit - if (ax-x=1) and (ay-y=-1) and (sx-x=-1) and (sy-y=1) then tco[indextco,x,y].trajet:=2; // de haut droit vers bas gauche + if (ax-x=1) and (ay-y=-1) and (sx-x=-1) and (sy-y=1) then tco[indextco,x,y].trajet:=2; // de NE vers SO if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=-1) then tco[indextco,x,y].trajet:=4; // de gauche vers haut droite if (ax-x=1) and (ay-y=-1) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=4; // de haut droite vers gauche if (ax-x=-1) and (ay-y=1) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=3; // de bas gauche vers droite @@ -11751,6 +11901,7 @@ begin if tco[indextco,x,y].trajet=0 then affiche('Erreur 73 TCO - Cellule '+intToSTR(x)+','+intToSTR(y),clred); end; Affiche_cellule(indexTCO,x,y); + //Affiche('AC='+intToSTR(x)+' '+intToSTR(y),clyellow); end; end; @@ -11765,7 +11916,7 @@ end; // =11 : det1=indexcanton det2=direction - renvoie les éléments adjacent du canton dans la direction indiquée dans xCanton et tel1 // =12 : det1 = détecteur de départ - renvoie l'élément sursuivant (peut être un aiguillage)dans la direction demandée dans xCanton et tel1 // direction=det2 = TCO_N TCO_NE etc -// =13 : det1=adresse de l'élément TypEL : type de l'élément, s'arrête au suivant suivant direction +// =13 : det1=adresse de l'élément TypEL : type de l'élément, s'arrête au suivant, suivant la direction // Ne nécessite pas que les aiguillages en talon soient bien positionnés entre det1 et det2 // PosAig = False:teste toutes les routes en récursif les aiguillages en pointe // True: les aiguillages en pointe doivent être positionnés @@ -11812,13 +11963,15 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter // récursivité suivante leur valeur, mais elles reprennent leur valeurs initiales à la remontée vers la résursivité appellante. Procedure El_tco(AncienX,ancienY,x,y,train : integer; ir : integer); var mdl : Tequipement; - i,j,index,position : integer; + i,j,index,position,TjdHom,Index_TjdHom,position2 : integer; + c1,c2 : char; SortirBoucle,NePasfaire : boolean; begin // répète la route depuis un aiguillage inc(iteration); - if DebugTCO then AfficheDebug('El_TCO',clorange); - + //Affiche('123iteration '+intToSTR(iteration),clWhite); + if DebugTCO then AfficheDebug('El_TCO'+intToSTR(X)+' '+intToSTR(Y),clYellow); + //Affiche('El_TCO'+intToSTR(X)+' '+intToSTR(Y),clYellow); i:=0; repeat sortirBoucle:=false; @@ -11845,32 +11998,31 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter end; // vers case suivante: trouver le trajet pour rejoindre det1 à det2 - // si canton, prendre les coordonnées du canton if (Bimage>=id_cantonH) and (Bimage<=id_cantonH+9) then begin //if mode=10 then trouveCanton:=true; if (Bimage=id_cantonH) and (mode=10) then begin - Xcanton:=x-(Bimage-Id_cantonH); + Xcanton:=x-(Bimage-Id_cantonH); // revenir à la coordonnée X du début du canton Ycanton:=y; // variable globale end; - Bimage:=1; + Bimage:=1; // substituer au canton un élément de voie H end; if (Bimage>=id_cantonV) and (Bimage<=id_cantonV+9) then begin if (Bimage=Id_cantonV) and (mode=10) then begin Xcanton:=x; - Ycanton:=y-(Bimage-Id_cantonH); + Ycanton:=y-(Bimage-Id_cantonH); // revenir à la coordonnée Y du début du canton end; - Bimage:=20; + Bimage:=20; // substituer au canton un élément de voie V end; // spécial mode 11 et 12 nepasfaire:=(mode=12) and (adresse<>0) and (adresse<>det1); - nepasfaire:=(mode=11) and (adresse<>0) or nepasfaire; - nepasfaire:=(mode=13) and (adresse<>0) and (adresse<>det1) or nepasfaire; + nepasfaire:=((mode=11) and (adresse<>0)) or nepasfaire; + nepasfaire:=((mode=13) and (adresse<>0) and (adresse<>det1)) or nepasfaire; if not(nepasFaire) then case Bimage of @@ -11917,7 +12069,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin ancienX:=x;AncienY:=y; inc(x); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); dec(x); end; // essayer dévié @@ -11941,7 +12093,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin AncienX:=x;AncienY:=y; inc(x); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); dec(x); end; // essayer dévié @@ -12016,7 +12168,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin ancienX:=x;ancienY:=y; dec(x);inc(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); inc(x);dec(y); end; // essayer dévié @@ -12060,7 +12212,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin ancienX:=x;ancienY:=y; inc(x);dec(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); dec(x);inc(y); end; if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then @@ -12101,61 +12253,174 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin ancienX:=x;ancienY:=y; x:=x+1; - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; if (ancienX>x) and (ancienYy) then // on va au NE en mode 13 begin ancienX:=x;ancienY:=y; inc(x);dec(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; if (ancienX>x) and (ancienY=y) then // on va au O en mode 13 begin ancienX:=x;ancienY:=y; dec(x); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; end - - else + else // pas mode 13 begin - if ancienXx) and not(Memtrouve) then // on va à gauche + // on esten mode récursif + // essayer vers E + ancienX:=x;ancienY:=y; + x:=x+1; + el_tco(ancienx,ancienY,x,y,train,ir); + if not(memtrouve) then + begin + // essai vers NE + AncienY:=y; + AncienX:=x-1; + y:=y-1;x:=x; + el_tco(ancienx,ancienY,x,y,train,ir); + end; + end; + if (ancienX>x) and not(Memtrouve) then // on va à gauche + begin + // essayer vers O + ancienX:=x;ancienY:=y; + x:=x-1; + el_tco(ancienx,ancienY,x,y,train,ir); + if not(memtrouve) then + begin + // essai vers SO + AncienY:=y; + AncienX:=x+1; + y:=y+1;x:=x; + el_tco(ancienx,ancienY,x,y,train,ir); + end; + end + end + else // mode posaig=true : on tient compte de la position des aiguillages pur suivre le parcours begin - // essayer vers O - ancienX:=x;ancienY:=y; - x:=x-1; - el_tco(ancienx,ancienY,x,y,train,ir); - if not(memtrouve) then + if aiguillage[index].EtatTJD=4 then // TJD 4 états begin - // essai vers SO - AncienY:=y; - AncienX:=x+1; - y:=y+1;x:=x; - el_tco(ancienx,ancienY,x,y,train,ir); + TjdHom:=aiguillage[index].Ddevie; // adresse de la TJD homologue + Index_TjdHom:=index_aig(TjdHom); // Index de la TJD homologue + position2:=aiguillage[Index_TjdHom].position; // position de la TJD homologue + + tjd4(adresse,position,TjdHom,position2,c1,c2); // retourne c1 et C2 + if (ancienYx) then // on vient du NE + begin + if c1=c2 then // si on traverse la TJD + begin + dec(x);inc(y); // on va au SO + end + else // si on passe la TJD en courbe + begin + dec(x); // on va à l'Ouest + end; + end + else + if (ancienY=y) and (ancienX>x) then // on vient de E + begin + if c1=c2 then // si on traverse la TJD + begin + dec(x); //on va à l'O + end + else + begin + dec(x);inc(y) // on va au SO + end; + end + else + if (ancienY=y) and (ancienXy) and (ancienXx) then // on vient du NE + begin + if position=const_droit then // si on traverse la TJD + begin + dec(x);inc(y); // on va au SO + end + else // si on passe la TJD en courbe + begin + dec(x); // on va à l'Ouest + end; + end + else + if (ancienY=y) and (ancienX>x) then // on vient de E + begin + if position=const_droit then // si on traverse la TJD + begin + dec(x); //on va à l'O + end + else + begin + dec(x);inc(y) // on va au SO + end; + end + else + if (ancienY=y) and (ancienXy) and (ancienXx) and (ancienY>y) then // on va au NO en mode 13 begin ancienX:=x;ancienY:=y; dec(x);dec(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; if (ancienX>x) and (ancienY=y) then // on va au O en mode 13 @@ -12218,40 +12483,151 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter el_tco(ancienx,ancienY,x,y,train,ir); end; end - - else + else // pas mode 13 begin - if (ancienXx) and not(Memtrouve)) then // on va à gauche + begin + // essayer vers O + ancienX:=x;ancienY:=y; + x:=x-1; + el_tco(ancienx,ancienY,x,y,train,ir); + if not(memtrouve) then + begin + // essai vers NO + AncienY:=y; + AncienX:=x+1; + y:=y-1;x:=x; + el_tco(ancienx,ancienY,x,y,train,ir); + end; + end; + end + else // mode posAig + begin + if aiguillage[index].EtatTJD=4 then + begin + TjdHom:=aiguillage[index].Ddevie; + Index_TjdHom:=index_aig(TjdHom); + position2:=aiguillage[Index_TjdHom].position; + tjd4(adresse,position,TjdHom,position2,c1,c2); // retourne c1 et C2 + if (ancienYx) then // on vient de E + begin + if c1=c2 then // si on traverse la TJD + begin + dec(x); //on va à l'O + end + else + begin + dec(x);dec(y) // on va au NO + end; + end + else + if (ancienY=y) and (ancienXy) and (ancienX>x) then // on vient du SE + begin + if c1=c2 then // si on traverse la TJD + begin + dec(x);dec(y) //on va au NO + end + else + begin + dec(x); // on va O + end; + end; + el_tco(ancienx,ancienY,x,y,train,ir); + end + else + begin // TJD 2 états + if (ancienYx) then // on vient de E + begin + if position=const_droit then // si on traverse la TJD + begin + dec(x); //on va à l'O + end + else + begin + dec(x);dec(y) // on va au NO + end; + end + else + if (ancienY=y) and (ancienXy) and (ancienX>x) then // on vient du SE + begin + if position=const_droit then // si on traverse la TJD + begin + dec(x);dec(y) //on va au NO + end + else + begin + dec(x); // on va O + end; + end; el_tco(ancienx,ancienY,x,y,train,ir); end; end; - if ((ancienX>x) and not(Memtrouve)) then // on va à gauche - begin - // essayer vers O - ancienX:=x;ancienY:=y; - x:=x-1; - el_tco(ancienx,ancienY,x,y,train,ir); - if not(memtrouve) then - begin - // essai vers NO - AncienY:=y; - AncienX:=x+1; - y:=y-1;x:=x; - el_tco(ancienx,ancienY,x,y,train,ir); - end; - end; - end; + end; end; end; @@ -12289,60 +12665,172 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin ancienX:=x;ancienY:=y; dec(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; if (ancienX>x) and (ancienYy) then // on va au NE en mode 13 begin ancienX:=x;ancienY:=y; inc(x);dec(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; - + if (ancienX=x) and (ancienYy) and not(Memtrouve) then // on monte - begin - // essayer vers N - ancienX:=x;ancienY:=y; - y:=y-1; - el_tco(ancienx,ancienY,x,y,train,ir); - if not(memtrouve) then + if (ancienY>y) and not(Memtrouve) then // on monte begin - // essai vers NE - AncienY:=y+1; - AncienX:=x; - x:=x+1; - el_tco(ancienx,ancienY,x,y,train,ir); + // essayer vers N + ancienX:=x;ancienY:=y; + y:=y-1; + el_tco(ancienx,ancienY,x,y,train,ir); + if not(memtrouve) then + begin + // essai vers NE + AncienY:=y+1; + AncienX:=x; + x:=x+1; + el_tco(ancienx,ancienY,x,y,train,ir); + end; + end; + end + else // mode posAig + begin + if aiguillage[index].EtatTJD=4 then + begin + TjdHom:=aiguillage[index].Ddevie; + Index_TjdHom:=index_aig(TjdHom); + position2:=aiguillage[Index_TjdHom].position; + tjd4(adresse,position,TjdHom,position2,c1,c2); // retourne c1 et C2 + if (ancienYx) then // on vient du NE + begin + if c1=c2 then // si on traverse la TJD + begin + dec(x);inc(y); // on va au SO + end + else + begin + inc(y); // on va au S + end; + end + else + if (ancienYy) and (ancienX=x) then // on vient du S + begin + if c1=c2 then // si on traverse la TJD + begin + dec(y) //on va au N + end + else + begin + inc(x);dec(y); // on va NE + end; + end; + el_tco(ancienx,ancienY,x,y,train,ir); + end + else + begin // TJD 2 états + if (ancienYx) then // on vient du NE + begin + if position=const_droit then // si on traverse la TJD + begin + dec(x);inc(y); // on va au SO + end + else + begin + inc(y); // on va au S + end; + end + else + if (ancienYy) and (ancienX=x) then // on vient du S + begin + if position=const_droit then // si on traverse la TJD + begin + dec(y) //on va au N + end + else + begin + inc(x);dec(y); // on va NE + end; + end; + el_tco(ancienx,ancienY,x,y,train,ir); end; end; end; @@ -12405,7 +12893,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter begin ancienX:=x;ancienY:=y; inc(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; if (ancienXy) then // on va au N en mode 13 begin ancienX:=x;ancienY:=y; dec(y); - el_tco(ancienx,ancienY,x,y,train,ir); + el_tco(ancienx,ancienY,x,y,train,ir); end; end - else - + else // pas mode 13 begin - if ancienYy) and not(Memtrouve) then // on monte - begin - // essayer vers N - ancienX:=x;ancienY:=y; - y:=y-1; - el_tco(ancienx,ancienY,x,y,train,ir); - if not(memtrouve) then + if (ancienY>y) and not(Memtrouve) then // on monte begin - // essai vers NO - AncienY:=y+1; - AncienX:=x; - x:=x-1; - el_tco(ancienx,ancienY,x,y,train,ir); + // essayer vers N + ancienX:=x;ancienY:=y; + y:=y-1; + el_tco(ancienx,ancienY,x,y,train,ir); + if not(memtrouve) then + begin + // essai vers NO + AncienY:=y+1; + AncienX:=x; + x:=x-1; + el_tco(ancienx,ancienY,x,y,train,ir); + end; + end; + end + else + begin // mode posaig + if aiguillage[index].EtatTJD=4 then + begin + TjdHom:=aiguillage[index].Ddevie; + Index_TjdHom:=index_aig(TjdHom); + position2:=aiguillage[Index_TjdHom].position; + tjd4(adresse,position,TjdHom,position2,c1,c2); // retourne c1 et C2 + if (ancienYy) and (ancienX>x) then // on vient du SE + begin + if c1=c2 then // si on traverse la TJD + begin + dec(x);dec(y); //on va au NO + end + else + begin + dec(y) // on va au N + end; + end + else + if (ancienY>y) and (ancienX=x) then // on vient du S + begin + if c1=c2 then // si on traverse la TJD + begin + dec(y) //on va au N + end + else + begin + dec(x);dec(y); // on va NO + end; + end; + el_tco(ancienx,ancienY,x,y,train,ir); + end + else // tjs 2 états + begin + if (ancienYy) and (ancienX>x) then // on vient du SE + begin + if position=const_droit then // si on traverse la TJD + begin + dec(x);dec(y); //on va au NO + end + else + begin + dec(y) // on va au N + end; + end + else + if (ancienY>y) and (ancienX=x) then // on vient du S + begin + if position=const_droit then // si on traverse la TJD + begin + dec(y) //on va au N + end + else + begin + dec(x);dec(y); // on va NO + end; + end; + el_tco(ancienx,ancienY,x,y,train,ir); end; end; end; end; end; - if (adresse=0) or (mdl=crois) then - // croisement - begin - if DebugTCO then AfficheDebug('Croisement',clyellow); - if (ancienXx) and (ancienY>Y) then begin xn:=x-1;yn:=yn-1;end; - if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; - end; - if (mdl=aig) then + if (adresse=0) or (mdl=crois) then + // croisement + begin + if DebugTCO then AfficheDebug('Croisement',clyellow); + if (ancienXx) and (ancienY>Y) then begin xn:=x-1;yn:=yn-1;end; + if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; + end; + if (mdl=aig) then begin Affiche('Erreur 51 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); Affiche('mais la cellule représente un croisement ou une TJD/S',clred); @@ -12662,6 +13261,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter inc(i); // éléments adj if (mode=11) and ( (adresse<>0) or (tco[indexTCO,x,y].buttoir<>0)) then sortir:=true; + //if (mode=11) and ((adresse=0) or (tco[indexTCO,x,y].buttoir<>0)) then sortir:=true; if (mode=12) and ( ((adresse<>0) and (adresse<>det1)) or (tco[indexTCO,x,y].buttoir<>0)) then sortir:=true; if (mode=13) and ( ((adresse<>0) and (adresse<>det1)) or (tco[indexTCO,x,y].buttoir<>0)) then begin @@ -12840,7 +13440,8 @@ begin el_tco(ancienx,ancienY,x,y,train,ir); // *********** trouve l'élément suivant, et explore les ports de l'aiguillage en récursif si posAig=true - if (mode=11) and ((adresse<>0) or (but<>0) or sortir) then +// if (mode=11) and ((adresse<>0) or (but<>0) or sortir) then + if (mode=11) then begin MemTrouve:=true; Xcanton:=adresse; @@ -13430,6 +14031,7 @@ begin tco[indextco,x,y].FeuOriente:=0; end; +// insère une colonne dans le Tco indexTCO à la colonne "colonne" procedure insere_colonne(indexTCO,colonne : integer); var x,y,i,Bim : integer; begin @@ -13443,17 +14045,17 @@ begin inc(canton[i].x); end; - // copie pour décaler + // copie pour décaler la nouvelle colonne for x:=NbreCellX[indexTCO] downto colonne do begin for y:=1 to NbreCellY[indexTCO] do begin Bim:=tco[indexTco,x,y].Bimage; - if not(isCantonH(Bim)) then tco[indextco,x+1,y]:=tco[indextco,x,y]; + tco[indextco,x+1,y]:=tco[indextco,x,y]; end; end; - // efface la nouvelle ligne + // efface la nouvelle colonne for y:=1 to NbreCellY[indexTCO] do begin Bim:=tco[indexTco,colonne,y].Bimage; @@ -13482,7 +14084,7 @@ begin for x:=1 to NbreCellX[indexTCO] do begin Bim:=tco[indexTco,x,y].Bimage; - if not(isCantonV(Bim)) then tco[indextco,x,y+1]:=tco[indextco,x,y]; + tco[indextco,x,y+1]:=tco[indextco,x,y]; end; // efface la nouvelle ligne @@ -13643,7 +14245,8 @@ begin end; procedure couper(indexTCO: integer); -var x,y,xMax,Ymax,XCell1,YCell1,xCell2,yCell2,haut,larg,Bim : integer; +var x,y,xMax,Ymax,XCell1,YCell1,xCell2,yCell2,haut,larg,Bim,index : integer; + s : string; raz_canton: boolean; begin larg:=largeurCell[indexTCO]; @@ -13698,8 +14301,15 @@ begin begin // si c'est un canton, le supprimer en remplaçant par les voies Bim:=tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].BImage; + if isCanton(Bim) then begin + index:=index_canton(indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]); + s:='Voulez vous supprimer le canton '; + if index<>0 then s:=s+intToSTR(canton[index].numero)+' '+canton[index].nom; + s:=s+' ?'; + if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; + bim:=index_canton(indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]); supprime_remplace_canton(bim); raz_canton:=true; @@ -15136,10 +15746,10 @@ end; procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); var position : Tpoint; Numcanton,xt,yt,bt,indexTCO,i,n,adresse,Bimage,xf,yf,xclic,yclic,el1,el2,senscanton,larg,haut, - indexTrain,idcantonOrg,AdrTrain : integer; + indexTrain,idcantonOrg,idcantonDest,AdrTrain,sens : integer; tel1,tel2 : tequipement; s : string; - presTrain : boolean; + presTrain,Horz,Pc,trouve : boolean; begin indexTCO:=index_tco(sender); if indexTCO<1 then exit; @@ -15165,8 +15775,23 @@ begin clicsouris:=true; Bimage:=tco[indextco,xclic,yclic].BImage; + pc:=false; + if IdCantonSelect<>0 then // si on clique sur un canton, augmenter les tolérances + begin + //Affiche('idcantonSelect'+IntToSTR(IdCantonSelect),clYellow); + Horz:=Canton[IdCantonSelect].horizontal; + if horz then + begin + pc:=(position.x>canton[IdCantonSelect].Gd.Left-5) and (position.xcanton[IdCantonSelect].Gd.Top-5) and (position.y0 then @@ -15183,7 +15808,10 @@ begin end else - IdCantonSelect:=0; // pas cliqué sur un canton + begin + IdCantonSelect:=0; // pas cliqué sur un canton + //Affiche('RAZ1 x='+intToSTR(xclic),clred); + end; // ------------------ si clic sur bouton canton @@ -15243,6 +15871,48 @@ begin FormTCO[IndexTCO].Caption:='Attention, aucun train n''est physiquement présent dans le canton pour définir une route - Aucun des deux détecteurs encadrant le canton n''est à 1'; exit; end; + + // + n:=trains[indexTrain].routePref[0].adresse; + if n<>0 then + begin + Affiche('trouvé route affectée au train',clYellow); + el1:=trains[indexTrain].routePref[1].adresse; + // vérifier si le détecteur est l'un des deux du canton cliqué + if ((canton[IdCantonClic].el1=el1) and (canton[IdCantonClic].typ1=det)) or + ((canton[IdCantonClic].el2=el2) and (canton[IdCantonClic].typ2=det)) then + begin + // trouver le canton destination + if trains[indexTrain].routePref[n].typ<>det then exit; + el2:=trains[indexTrain].routePref[n].adresse; + i:=1; + repeat + trouve:=((canton[i].el1=el2) and (canton[i].typ1=det)) or + ((canton[i].el2=el2) and (canton[i].typ2=det)) ; + inc(i); + until trouve or (i>ncantons); + if not trouve then exit; + dec(i); + Idcantondest:=i; + + canton[IdCantonClic].bouton:=3; + canton[IdCantonClic].NumcantonOrg:=canton[IdcantonClic].numero; + canton[IdCantonClic].NumcantonDest:=canton[IdcantonDest].numero; + dessin_canton(IdCantonClic,0); + + canton[IdCantonDest].bouton:=4; + canton[IdCantonDest].NumcantonOrg:=canton[IdcantonClic].numero; + canton[IdCantonDest].NumcantonDest:=canton[IdcantonDest].numero; + dessin_canton(IdCantonDest,0); + + indexTrainFR:=indexTrain; + trains[indexTrain].route:=trains[indexTrain].routePref; + FormRouteTrain.Show; + + exit; + end; + end; + if tel1=det then detDepart:=el1; if tel2=det then detDepart:=el2; cantonOrg:=canton[IdCantonClic].numero; @@ -15269,10 +15939,11 @@ begin end else begin - // detdépart validé : valider le det de destination - if (detatrouve=0) and (bt<3) and not(ConfCellTCO) then // bt=3 drapeau vert bt=4 drapeau rouge + // detdépart validé : valider le det de destination sauf si route en roulage + if (detatrouve=0) and (bt<=3) and not(ConfCellTCO) and (NbreRoutes=0) + then // bt=3 drapeau vert bt=4 drapeau rouge begin - if canton[IdCantonClic].adresseTrain<>0 then + if (canton[IdCantonClic].adresseTrain<>0) and (bt<3) then begin ImageTCO.Hint:='Canton occupé par train '+canton[IdCantonClic].nomtrain; exit; @@ -15283,6 +15954,7 @@ begin canton[IdCantonClic].NumCantonOrg:=cantonOrg; canton[IdCantonClic].NumCantonDest:=cantonDest; // c'est lui meme idcantonOrg:=index_canton_numero(cantonOrg); + if idcantonOrg=0 then exit; canton[idcantonOrg].NumcantonOrg:=cantonOrg; canton[idcantonOrg].NumcantonDest:=cantonDest; @@ -15291,10 +15963,10 @@ begin // trouve les routes - sens du canton d'origine sensCanton:=canton[IdCantonOrg].sensLoco; case sensCanton of // sens de la loco dans le canton - sensGauche : begin sens:=5;end; - sensDroit : begin sens:=6;end; - SensHaut : begin sens:=7;end; - SensBas : begin sens:=8;end; + sensGauche : begin sens:=SensTCO_O;end; + sensDroit : begin sens:=SensTCO_E;end; + SensHaut : begin sens:=SensTCO_N;end; + SensBas : begin sens:=SensTCO_S;end; end; // affiche la fenetre des routes ou de la route affectée au train, @@ -15302,12 +15974,11 @@ begin if indexTrain>9000 then begin Affiche('Anomalie 627',clred); - messageBeep(Mb_iconError); + messageBeep(Mb_iconError); exit; end; Trains[IndexTrain].cantonOrg:=cantonOrg; Trains[IndexTrain].cantonDest:=cantonDest; - formTCO[indexTCO].Caption:='TCO'+intToSTR(indexTCO)+' : '+NomFichierTCO[indexTCO]; Screen.cursor:=crDefault; @@ -15316,23 +15987,25 @@ begin canton[idCantonClic].AdrTrainRoute:=Trains[indexTrain].adresse; dessin_canton(IdCantonClic,0); FormTCO[IndexTCO].Caption:='Calcul des routes en cours.....................'; + application.processMessages; prepare_route(indexTCO,cantonOrg,detAtrouve,sens); // à gauche(5) du détecteur / droite (6) / en bas (8) / haut (7) if trains[indexTrain].route[0].adresse<>0 then formRouteTrain.show else formRoute.show; titre_Fenetre(indexTCO); - detatrouve:=0; - detDepart:=0; - + //detatrouve:=0; + //detDepart:=0; exit; end; - // on clique sur le drapeau vert ou rouge - if (bt>=3) then // canton de départ ou destination + // on clique sur le drapeau rouge + if (bt>=3) then // canton de destination begin // est-ce un canton de destination? + if idcantonClic<1 then exit; Numcanton:=canton[IdCantonClic].numero; if canton[IdCantonClic].NumCantonDest=NumCanton then begin Numcanton:=canton[IdCantonClic].NumcantonOrg; // revenir au canton origine de la route + if numcanton=0 then exit; IdCantonClic:=index_canton_numero(NumCanton); end; @@ -15362,7 +16035,11 @@ begin titre_fenetre(indexTCO); if (IdCantonSelect<>0) and not(ConfCellTCO) then begin - if accroche_canton(indexTCO,IdCantonSelect,x,y) then exit; // on a pas cliqué sur les poignées + if accroche_canton(indexTCO,IdCantonSelect,x,y) then + begin + // Affiche('on a pas cliqué sur les poignées dans MouseDown',clred); + exit; // on a pas cliqué sur les poignées + end; begin // sinon, désélect le canton IndexTCO:=canton[IdCantonSelect].Ntco; // reprendre l'index du TCO depuis le canton car on a peut etre cliqué sur un autre TCO @@ -15374,6 +16051,7 @@ begin Dessin_canton(IdCantonClic,0); AncienIdCantonSelect:=IdCantonSelect; IdCantonSelect:=0; + //Affiche('RAZ2',clred); exit; end; end; @@ -15386,7 +16064,7 @@ begin formRoute.Close; selec_canton(indexTCO); actualise(indexTCO); // actualise la fenetre de paramétrage - ImageTCO.Hint:='canton '+intToSTR(canton[IdCantonSelect].numero); + if IdcantonSelect>0 then ImageTCO.Hint:='canton '+intToSTR(canton[IdCantonSelect].numero); exit; end; end; @@ -15737,6 +16415,7 @@ begin cellY:=y div hauteurCell[indexTCO]+1; //Affiche(intToSTR(x)+','+intToSTR(y),clYellow); + //Affiche('IdCantonSelect='+intToSTR(IdCantonSelect),clWhite); // exécuté uniquement si changement position souris if (aSourisx<>x) or (aSourisy<>y) then begin @@ -15753,7 +16432,11 @@ begin if IdCantonSelect<>0 then begin //Affiche('Acc',clOrange); - if Accroche_canton(IndexTCO,IdCantonSelect,x,y) then exit; + if Accroche_canton(IndexTCO,IdCantonSelect,x,y) then + begin + //Affiche('On a pas cliqué sur les poignées dans mouseMove',clred); + exit; + end; idTrain:=canton[IdCantonSelect].indexTrain; if clicSouris and (idTrain<>0) then if (trains[IdTrain].icone<>nil) and (trains[IdTrain].icone.width<>0) then @@ -15762,7 +16445,8 @@ begin exit; end; exit; - end; + end ; + // vérifier si on passe au dessus d'un bouton canton IdCanton:=passe_bouton_canton(indexTCO,x,y); if idCanton<>0 then @@ -16100,7 +16784,7 @@ begin for y:=1 to NbreCellY[ntco] do for x:=1 to NbreCellX[ntco] do begin - Bim:=TCO[ntco,x,y].BImage; + Bim:=TCO[ntco,x,y].Bimage; //if IsAigTCO(Bim) then begin if TCO[ntco,x,y].Adresse=adresse then @@ -17407,6 +18091,8 @@ end; procedure TFormTCO.FormKeyPress(Sender: TObject; var Key: Char); begin if affevt then Affiche('TCO.FormKeyPress',clOrange); + //MessageBeep(MB_ICONEXCLAMATION); + toucheTCO:=key; end; procedure TFormTCO.ImagePalette1MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -17992,16 +18678,13 @@ begin exit; end; - canton[IdCantonDest].SensLoco:=sens; - // raz train canton d'origine IdTrain:=canton[IdCantonDragOrg].indexTrain; supprime_route_train(canton[idcantonDragOrg].indexTrain); Raz_trains_idcanton(IdCantonDragOrg); // raz du train du canton - // affectation train canton destination - affecte_Train_canton(trains[idTrain].adresse,IdCantonDest); + affecte_Train_canton(trains[idTrain].adresse,IdCantonDest,sens); application.processMessages; Affiche_TCO(indexTCO); @@ -18035,13 +18718,44 @@ begin formRouteTrain.Show; end; - procedure TFormTCO.Button1Click(Sender: TObject); begin zone_tco(1,523,518,1,0,1,false); end; +procedure TFormTCO.Optiondesroutes1Click(Sender: TObject); +begin + formRoute.Show; +end; +procedure TFormTCO.rouverunlment1Click(Sender: TObject); +var x,y : integer; + trouve : boolean; +begin + IndexTCOCourant:=index_TCOMainMenu; + FormIntro.showmodal; + y:=1; + repeat + x:=1; + repeat + trouve:=tco[IndexTCOCourant,x,y].Adresse=Achercher; + inc(x); + until (x>NbreCellX[IndexTCOCourant]) or trouve; + inc(y); + until (y>NbreCellY[IndexTCOCourant]) or trouve; + if trouve then + begin + dec(x);dec(y); + x:=(x-1)*LargeurCell[indexTCOCourant]; + y:=(y-1)*HauteurCell[indexTCOCourant]; + with PcanvasTCO[indexTcoCourant] do + begin + Pen.Color:=clLime; + Pen.Width:=3; + moveto(0,0);LineTo(x,y); + end; + end; +end; end. diff --git a/Unit_Pilote_aig.pas b/Unit_Pilote_aig.pas index 1323a36..7a0c6ff 100644 --- a/Unit_Pilote_aig.pas +++ b/Unit_Pilote_aig.pas @@ -31,7 +31,7 @@ type var FormAig: TFormAig; aiguille,aiguille2 : integer; - tjdC,aigC : boolean; + tjdC,aigC,aigT : boolean; implementation {$R *.dfm} @@ -72,11 +72,19 @@ var i : integer; s : string; begin i:=Index_aig(Aiguille); + + aigC:=(aiguillage[i].modele=aig); + tjdC:=(aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs); + AigT:=aiguillage[i].modele=triple; + + if tjdC then s:='Pilotage de la TJD/S '+intToSTR(aiguille); + if aigC then s:='Pilotage de l''aiguillage '+intToSTR(aiguille); + if aigT then s:='Pilotage de l''aiguillage triple '+intToSTR(aiguille); + + Label1.Caption:=s; + if aiguillage[i].AdrTrain<>0 then begin - tjdC:=(aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs); - if tjdC then s:='Pilotage de la TJD/S '+intToSTR(aiguille) else s:='Pilotage de l''aiguillage '+intToSTR(aiguille); - Label1.Caption:=s; if tjdC then s:='La TJD/S '+intToSTR(aiguille)+' est réservée ' else s:='L''aiguillage '+intToSTR(aiguille)+' est réservé '; labelAdr1.caption:=s+'par le train '+intToSTR(aiguillage[i].AdrTrain); labelAdr1.Visible:=true; @@ -85,44 +93,55 @@ begin buttonDev2.Visible:=false; buttonDroit2.Visible:=false; LabelAdr2.Visible:=false; - if diffusion then exit; + if diffusion then exit; end; - aigC:=(aiguillage[i].modele=aig); - tjdC:=(aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs); if aigC then begin - s:='Pilotage de l''aiguillage '+intToSTR(aiguille); commande_simple; end; - if tjdC then + + if (tjdC and (aiguillage[i].EtatTJD=4)) then begin - s:='Pilotage de la TJD '+intToSTR(aiguille); + LabelAdr1.Caption:='Adresse1: '+intToSTR(aiguille); + aiguille2:=aiguillage[i].DDevie; + LabelAdr2.Caption:='Adresse2: '+intToSTR(aiguille2); + s:=s+'/'+intToSTR(aiguille2); + LabelAdr2.Visible:=true; + LabelAdr1.Visible:=true; + ButtonDev2.Visible:=true; + ButtonOk.Visible:=true; + ButtonDroit2.Visible:=true; + ButtonDev.Left:=8; + ButtonDroit.Left:=88; - if aiguillage[i].EtatTJD=4 then - begin - LabelAdr1.Caption:='Adresse1: '+intToSTR(aiguille); - aiguille2:=aiguillage[i].DDevie; - LabelAdr2.Caption:='Adresse2: '+intToSTR(aiguille2); - s:=s+'/'+intToSTR(aiguille2); - LabelAdr2.Visible:=true; - LabelAdr1.Visible:=true; - ButtonDev2.Visible:=true; - ButtonOk.Visible:=true; - ButtonDroit2.Visible:=true; - ButtonDev.Left:=8; - ButtonDroit.Left:=88; - - buttonDroit.Visible:=true; - buttonDev.Visible:=true; - - end; + buttonDroit.Visible:=true; + buttonDev.Visible:=true; end; - if aiguillage[i].EtatTJD=2 then + + if TjdC and (aiguillage[i].EtatTJD=2) then begin commande_simple; end; + if AigT then + begin + LabelAdr1.Caption:='Adresse1: '+intToSTR(aiguille); + aiguille2:=aiguillage[i].Adrtriple; + LabelAdr2.Caption:='Adresse2: '+intToSTR(aiguille2); + s:=s+'/'+intToSTR(aiguille2); + LabelAdr2.Visible:=true; + LabelAdr1.Visible:=true; + ButtonDev2.Visible:=true; + ButtonOk.Visible:=true; + ButtonDroit2.Visible:=true; + ButtonDev.Left:=8; + ButtonDroit.Left:=88; + + buttonDroit.Visible:=true; + buttonDev.Visible:=true; + end; + Label1.Caption:=s; end; diff --git a/selection_train.dfm b/selection_train.dfm index a31e9ee..6635bc1 100644 --- a/selection_train.dfm +++ b/selection_train.dfm @@ -1,11 +1,9 @@ object FormSelTrain: TFormSelTrain - Left = 198 - Top = 117 - BorderIcons = [biSystemMenu] - BorderStyle = bsDialog + Left = 358 + Top = 131 + Width = 860 + Height = 370 Caption = 'S'#233'lection train' - ClientHeight = 311 - ClientWidth = 800 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -16,15 +14,16 @@ object FormSelTrain: TFormSelTrain OnActivate = FormActivate OnCreate = FormCreate DesignSize = ( - 800 - 311) + 844 + 331) PixelsPerInch = 96 TextHeight = 13 object LabelInfo: TLabel - Left = 104 - Top = 288 + Left = 125 + Top = 306 Width = 44 Height = 13 + Anchors = [akBottom] Caption = 'LabelInfo' end object Label1: TLabel @@ -329,11 +328,11 @@ object FormSelTrain: TFormSelTrain Height = 13 end object ButtonOK: TButton - Left = 41 - Top = 280 + Left = 29 + Top = 300 Width = 75 Height = 24 - Anchors = [akTop, akRight] + Anchors = [akBottom] Caption = 'Ok' TabOrder = 0 OnClick = ButtonOKClick @@ -347,29 +346,52 @@ object FormSelTrain: TFormSelTrain TabOrder = 1 OnChange = ComboBoxCantonChange end - object StringGridTrains: TStringGrid - Left = 8 - Top = 64 - Width = 785 - Height = 209 - ColCount = 6 - Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor] - ScrollBars = ssVertical - TabOrder = 2 - OnDrawCell = StringGridTrainsDrawCell - OnKeyDown = StringGridTrainsKeyDown - OnSelectCell = StringGridTrainsSelectCell - end object ButtonSauve: TButton - Left = 624 - Top = 280 - Width = 129 + Left = 695 + Top = 300 + Width = 82 Height = 25 Hint = 'Sauvegarde le placement des trains dans les cantons' + Anchors = [akBottom] Caption = 'Sauvegarder' ParentShowHint = False ShowHint = True - TabOrder = 3 + TabOrder = 2 OnClick = ButtonSauveClick end + object ScrollBoxST: TScrollBox + Left = 11 + Top = 49 + Width = 821 + Height = 240 + HorzScrollBar.Smooth = True + HorzScrollBar.Tracking = True + VertScrollBar.Increment = 21 + VertScrollBar.Tracking = True + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 3 + object StringGridTrains: TStringGrid + Left = 0 + Top = 0 + Width = 793 + Height = 233 + ColCount = 8 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goAlwaysShowEditor] + ScrollBars = ssNone + TabOrder = 0 + OnDrawCell = StringGridTrainsDrawCell + OnKeyDown = StringGridTrainsKeyDown + OnSelectCell = StringGridTrainsSelectCell + ColWidths = ( + 43 + 214 + 172 + 57 + 105 + 108 + 32 + 29) + end + end end diff --git a/selection_train.pas b/selection_train.pas index 0a0660b..a3400da 100644 --- a/selection_train.pas +++ b/selection_train.pas @@ -17,8 +17,9 @@ type Imagegauche: TImage; ImageDroite: TImage; LabelCanton: TLabel; - StringGridTrains: TStringGrid; ButtonSauve: TButton; + ScrollBoxST: TScrollBox; + StringGridTrains: TStringGrid; procedure ButtonOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure StringGridTrainsDrawCell(Sender: TObject; ACol, @@ -32,17 +33,20 @@ type procedure ButtonSauveClick(Sender: TObject); private { Déclarations privées } - public + public { Déclarations publiques } end; +const +HauteurLigneSGT=30; + var FormSelTrain: TFormSelTrain; - x,y,El,largC,hautC,indexTrainClic : Integer; + x,y,El,largC,hautC,indexTrainClic,LargeurSGT : Integer; routeSav : TuneRoute; procedure actualise_seltrains; -procedure affecte_Train_canton(AdrTrain,idcanton : integer); +procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer); procedure raz_trains_Idcanton(idc : integer); procedure raz_cantons_train(AdrTrain : integer); procedure trouve_det_canton(idcanton : integer;var el1,el2 : integer); @@ -89,7 +93,7 @@ begin end; // le détecteur considéré est le e2c - if (e2c=adresse) and (t1=det) then + if (e2c=adresse) and (t2=det) then begin case sens of sensGauche,sensHaut : @@ -233,7 +237,7 @@ end; // si adrTrain=9999 , train inconnu // si adrTrain=0 ; efface // et les pointeurs de trains de l'idTrain sont razés -procedure affecte_Train_canton(AdrTrain,idcanton : integer); +procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer); var idTrain,t,el1,el2 : integer; t1,t2 : tequipement; begin @@ -247,6 +251,8 @@ begin raz_cantons_train(AdrTrain); // efface tous les cantons contenant le train Adrtrain trains[idTrain].canton:=canton[idcanton].numero; + trains[idTrain].sens:=sens; + canton[IdCanton].SensLoco:=sens; canton[Idcanton].indexTrain:=idTrain; canton[Idcanton].NomTrain:=trains[idTrain].nom_train; canton[IdCanton].adresseTrain:=AdrTrain; @@ -404,17 +410,29 @@ end; procedure TFormSelTrain.FormCreate(Sender: TObject); var i : integer; begin - with ImageHaut do begin Width:=60;Height:=60;visible:=false; end; with ImageBas do begin Width:=60;Height:=60;visible:=false; end; with ImageDroite do begin Width:=60;Height:=60;visible:=false; end; with ImageGauche do begin Width:=60;Height:=60;visible:=false; end; + with ScrollBoxST do + begin + Anchors:=[akTop,AkLeft,akRight,AkBottom]; + VertScrollBar.Smooth:=false; // ne pas mettre true sinon çà plante quand on clique sur la ScrollBar + VertScrollBar.tracking:=true; + end; + hautC:=25; largC:=130; LabelInfo.caption:=''; with StringGridTrains do begin + Anchors:=[]; + Anchors:=[AkTop,AkLeft,akright]; + + Height:=nTrains*HauteurLigneSGT; + Top:=0; + Left:=0; //Options:=StringGridTrains.Options+[goEditing]; Hint:='Sélection d''un train'; ShowHint:=true; @@ -429,8 +447,11 @@ begin ColWidths[5]:=120; ColWidths[6]:=30; ColWidths[7]:=35; + LargeurSGT:=0; + for i:=0 to 7 do LargeurSGT:=LargeurSGT+ColWidths[i]; + width:=LargeurSGT+30; - Cells[0,0]:='N° / @'; + Cells[0,0]:='Train'+#13+'N° / @'; Cells[1,0]:='Icône'; Cells[2,0]:='Nom du train'; Cells[3,0]:='Affectation'+#13+'au canton'; @@ -439,7 +460,8 @@ begin Cells[6,0]:='Sens'; Cells[7,0]:='Route'; - RowHeights[0]:=30; + for i:=0 to RowCount-1 do + RowHeights[i]:=HauteurLigneSGT; end; for i:=1 to ntrains do @@ -463,7 +485,7 @@ var indextrain,l,h,hautdest,largdest : integer; coul: Tcolor; s : string; begin - // Affiche('DrawCell '+intToSTR(Acol)+'x'+intToSTR(Arow),clred); + //Affiche('DrawCell '+intToSTR(Acol)+'x'+intToSTR(Arow),clred); // titres sur 2 lignes if Arow=0 then @@ -471,12 +493,12 @@ begin begin if Pos(#13,Cells[ACol,ARow])>0 then begin - Coul:=canvas.Pixels[5,5]; // trouver la couleur de la première ligne de la stringgrid, car elle change en fonction des styles + Coul:=canvas.Pixels[3,1]; // trouver la couleur de la première ligne de la stringgrid, car elle change en fonction des styles Canvas.Brush.Color:=coul; Canvas.FillRect(Rect); // Efface la cellule qu'on va réécrire en mode WORDBREAK - - Inc(Rect.Left, 2); - Inc(Rect.Top, 2); + // rectangle du texte + Inc(Rect.Left,2); + Inc(Rect.Top,2); DrawText(Canvas.Handle,PChar(Cells[ACol, ARow]),-1,Rect,DT_NOPREFIX or DT_WORDBREAK); end; end; @@ -564,7 +586,7 @@ begin end; -// cliqué sur cellule pour changer la sélection du train ou voir la route ou la flèche +// cliqué ou roulé la molette souris sur cellule pour changer la sélection du train ou voir la route ou la flèche procedure TFormSelTrain.StringGridTrainsSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); var f,AutreTrain,AutreCanton,idAutrecanton,i,ancienSens,AdrTrain,IdTrain,sensloco : integer; @@ -641,8 +663,8 @@ begin if (canton[IdCantonSelect].sensCirc<>0) then sensLoco:=canton[IdCantonSelect].sensCirc ; - canton[IdCantonSelect].SensLoco:=sensLoco; - affecte_Train_canton(trains[indexTrainClic].adresse,IdCantonSelect); // le train affecté contient la route du train razé + //canton[IdCantonSelect].SensLoco:=sensLoco; + affecte_Train_canton(trains[indexTrainClic].adresse,IdCantonSelect,sensLoco); // le train affecté contient la route du train razé maj_signaux(true); end; @@ -691,8 +713,7 @@ begin end; renseigne_canton(IdAutreCanton); - canton[IdAutreCanton].SensLoco:=f; - affecte_Train_canton(AdrTrain,idAutreCanton); + affecte_Train_canton(AdrTrain,idAutreCanton,f); //Affiche('Et 3',clYellow); maj_signaux(true); end; @@ -785,6 +806,7 @@ begin // trouver si le train est dans la grille with StringGridTrains do begin + Height:=nTrains*HauteurLigneSGT+HauteurLigneSGT; // actualiser la taille de la stringGrig en fonction du nombre de trains i:=1;n:=RowCount; repeat trouve:=cells[2,i]=nomTrain; @@ -816,5 +838,7 @@ begin Sauve_config; end; + + end. diff --git a/verif_version.pas b/verif_version.pas index 4ac8b18..259a582 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -25,15 +25,16 @@ var chemin_Dest,chemin_src,date_creation,nombre_tel : string; f : text; -Const VersionSC ='9.1'; // sert à la comparaison de la version publiée - SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace - // pour unzip - SHCONTCH_NOPROGRESSBOX = 4; - SHCONTCH_AUTORENAME = 8; - SHCONTCH_RESPONDYESTOALL = 16; - SHCONTF_INCLUDEHIDDEN = 128; - SHCONTF_FOLDERS = 32; - SHCONTF_NONFOLDERS = 64; +Const +VersionSC ='9.3'; // sert à la comparaison de la version publiée +SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace +// pour unzip +SHCONTCH_NOPROGRESSBOX=4; +SHCONTCH_AUTORENAME=8; +SHCONTCH_RESPONDYESTOALL=16; +SHCONTF_INCLUDEHIDDEN=128; +SHCONTF_FOLDERS=32; +SHCONTF_NONFOLDERS=64; function GetCurrentProcessEnvVar(const VariableName: string): string; function verifie_version : real; @@ -92,10 +93,10 @@ begin i:=getLastError; if i<>0 then case i of - 12007 : Affiche('Erreur de résolution DNS',clred); - 12037 : Affiche('Erreur validité de certificat - Mettre windows à jour ou version windows obsolète',clred); - 12157 : Affiche('Erreur canal sécurisé SSL 2.0 - Mettre windows à jour ou version windows obsolète',clred); - else affiche('Erreur '+intToSTR(i),clred); + 12007 : Affiche('Réseau: Erreur de résolution DNS',clred); + 12037 : Affiche('Réseau: Erreur validité de certificat - Mettre windows à jour ou version windows obsolète',clred); + 12157 : Affiche('Réseau: Erreur canal sécurisé SSL 2.0 - Mettre windows à jour ou version windows obsolète',clred); + else affiche('Erreur réseau '+intToSTR(i),clred); end; if Assigned(hService) then try diff --git a/versions.txt b/versions.txt index 3202aaa..8bfd678 100644 --- a/versions.txt +++ b/versions.txt @@ -267,5 +267,10 @@ version 9.2 : Utilisation de l'unit Arrets temporisés sur les détecteurs en mode autonome/roulage pour les routes de canton à canton. Correction connexion à la GENLI. Version x64 D12 disponible. +version 9.3 : Amélioration de la proposition des routes en mode autonome. + Renforcement de la vérification des TJD. + Amélioration des aiguillages triples, et de leur représentation dans le TCO. + Gestion des erreurs de vérification d'étendue. +