easylinux/SignauxComplexes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

V9.3

Browse Source
This commit is contained in:
f1iwq2
2024-09-25 14:13:46 +02:00
parent 7d2c4bd591
commit 20b1990c2e
29 changed files with 4529 additions and 1448 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice d'utilisation des signaux_complexes_GL_V9.2.pdf → Notice d'utilisation des signaux_complexes_GL_V9.3.pdf
BIN
View File
Binary file not shown.
Signaux_complexes_GL.cfg
+2 -2
View File
@@ -14,8 +14,8 @@
-$N+
-$O-
-$P-
-$Q+
-$R+
-$Q-
-$R-
-$S-
-$T-
-$U-
Signaux_complexes_GL.dof
+2 -2
View File
@@ -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
Signaux_complexes_GL.dpr
+3 -1
View File
@@ -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.
Signaux_complexes_GL.map
+72 -67
View File
@@ -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
UnitConfig.dfm
+64 -22
View File
@@ -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
UnitConfig.pas
+434 -147
View File
@@ -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
@@ -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';
@@ -6059,7 +6158,6 @@ begin
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 AdrMax<Signaux[i].adresse then AdrMax:=Signaux[i].adresse;
if AdrMax<Signaux[i].adresse then
begin
AdrMax:=Signaux[i].adresse;
end;
end;
if AdrMax<>0 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);
@@ -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,7 +10469,10 @@ begin
else
begin
AdrAig:=aiguillage[IndexAig].Adresse;
//Affiche(intToSTR(adrAig),clred);
delta:=0;
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
@@ -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';
@@ -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
@@ -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
// 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;
@@ -12312,43 +12552,6 @@ begin
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;
@@ -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.
UnitConfigCellTCO.pas
+1
View File
@@ -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);
UnitConfigTCO.dfm
+18 -6
View File
@@ -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
UnitConfigTCO.pas
+7
View File
@@ -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.
UnitHorloge.pas
+2 -1
View File
@@ -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);
UnitIntro.dfm
+36
View File
@@ -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
UnitIntro.pas
+36
View File
@@ -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.
UnitModifAction.dfm
+1 -1
View File
@@ -61,7 +61,7 @@ object FormModifAction: TFormModifAction
Top = 64
Width = 729
Height = 337
ActivePage = TabSheetOp
ActivePage = TabSheet1
MultiLine = True
TabOrder = 2
object TabSheetDecl: TTabSheet
UnitModifAction.pas
+56 -14
View File
@@ -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.
UnitPrinc.dfm
+9 -8
View File
@@ -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
UnitPrinc.pas
+1455 -344
View File
File diff suppressed because it is too large Load Diff
UnitRoute.dfm
+127 -23
View File
@@ -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
UnitRoute.pas
+347 -41
View File
@@ -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,7 +133,8 @@ 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[]
@@ -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,12 +331,7 @@ 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
begin
IdCantonClic:=Idcantonroute;
IdTrainCourant:=canton[idcantonRoute].indexTrain;
if idTrainCourant>9000 then
begin
@@ -221,25 +339,81 @@ begin
messageBeep(Mb_iconError);
exit;
end;
end
else idtraincourant:=0;
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;
// obligatoires
while (iO<=20) and (list_det_obl[iO].adresse<>0) do
begin
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;
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_to_string(tabloroute[j]);
s:=s+route_restreinte_to_string(tabloroute[j]);
l:=Length(s);
if l>pluslongue then
begin
chainelongue:=s;
pluslongue:=l;
end;
FormRoute.listBoxRoutes.Items.Add(s);
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
@@ -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+1<NbreRoutes) then
if (ord(Key)=VK_DOWN) and (Indexligneroute+1<ListBoxRoutes.Count) then
begin
inc(ligneRoute);
efface_affiche_route;
inc(IndexligneRoute);
end;
//Affiche('9985 '+intToSTR(indexLigneROute)+'/'+intToSTR(Nprop),clWhite);
s:=ListBoxRoutes.items[IndexLigneRoute];
val(s,NumRoute,erreur);
efface_affiche_route;
end;
@@ -385,7 +576,12 @@ procedure TFormRoute.FormCreate(Sender: TObject);
begin
ButtonFenPil.hint:='Ouvre la fenêtre de pilotage des trains'+#13+'ce qui permet de lancer leur roulage';
ButtonDetail.hint:='Affiche le détail de la route en fenêtre principale';
EditObligeCanton.Text:='aucun';
EditInterditCanton.Text:='aucun';
EditObligeCanton.Hint:='Numéro de cantons séparés par des virgules (10 maxi)'+#13+'Laisser vide pour aucune obligation';
EditInterditCanton.Hint:='Numéro de cantons séparés par des virgules (10 maxi)'+#13+'Laisser vide pour aucune interdiction';
ListBoxRoutes.Style:=lbOwnerDrawFixed; // pour déclencher l'evt on drawitem
// fenêtre toujours devant
SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
end;
@@ -413,9 +609,119 @@ end;
procedure TFormRoute.ButtonFenPilClick(Sender: TObject);
begin
if idcantonRoute<1 then exit;
indexTrainFR:=canton[idcantonRoute].indexTrain;
FormRouteTrain.show;
close;
end;
procedure TFormRoute.ButtonParcours(Sender: TObject);
var i,j,n,p,det1,det2 : integer;
s : string;
typ : tequipement;
begin
if (Indexligneroute<0) or (NumRoute<1) then exit;
efface_route_tco;
hide;
j:=NumRoute;
n:=tabloroute[j,0].adresse;
i:=1;
det2:=0;
toucheTCO:=#0;
repeat
s:=intToSTR(tabloroute[j,i].adresse)+' '+BTypeToChaine(tabloroute[j,i].typ)+' ';
p:=tabloRoute[j,i].pos;
typ:=tabloRoute[j,i].typ;
if typ=det then
begin // attention on ne gère que le TCO1
Zone_TCO(1,det1,det2,1,0,0,false); // faire true et positionner les aiguillages
det1:=det2;
det2:=tabloroute[j,i].adresse;
Zone_TCO(1,det1,det2,1,0,1,false);
FormTCO[1].Caption:=intToSTR(i)+'/'+intToSTR(n)+' '+intToSTR(det1)+' '+intToSTR(det2)+ ' Arrêt par touche Echap';
//Affiche(intToSTR(det1)+' '+intToSTR(det2),clyellow);
end;
Application.ProcessMessages;
Sleep(500);
inc(i);
until (i>n) 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.
UnitRouteTrains.dfm
+17 -5
View File
@@ -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
UnitRouteTrains.pas
+309 -41
View File
@@ -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
(pointroute<n) then
begin
Affiche('Demande arrêt train '+trains[idTrain].nom_train+' '+intToSTR(trains[idTrain].DetecteurArret[it].temps)+'s sur détecteur '+inttoStr(detect)+' prec='+intToSTR(trains[idTrain].route[PointRoute-1].adresse),ClOrange);
trains[idTrain].TempoArret:=50;
//trains[idTrain].TempoArret:=2;
trains[idTrain].TempoArretTemp:=trains[idTrain].DetecteurArret[it].temps*10;
trains[idTrain].arret_det:=true;
trains[idTrain].phase_arret:=0;
trouve:=true;
end;
inc(it);
until (it>NbDetArret) or trouve;
if (detect=trains[idTrain].route[n].adresse) and (trains[idTrain].route[n].typ=det) then
if pointRoute>=n then
begin
// route traitée , arrêter le train
trains[idTrain].TempoArretCour:=0;
trains[idTrain].TempoArret:=50;
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:=i;
ideb:=trains[idTrain].PointRout;
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 tiers, jusqu'à rencontrer n cantons
// 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;
@@ -383,7 +398,244 @@ 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<>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
(pointroute<n) then
begin
Affiche('Demande arrêt train '+trains[idTrain].nom_train+' '+intToSTR(trains[idTrain].DetecteurArret[it].temps)+'s sur détecteur '+inttoStr(detect)+' prec='+intToSTR(trains[idTrain].route[PointRoute-1].adresse),ClOrange);
//trains[idTrain].TempoArret:=2;
trains[idTrain].TempoArretTemp:=trains[idTrain].DetecteurArret[it].temps*10; // récupérer le temps d'arrêt sur le détecteur
trains[idTrain].arret_det:=true;
trains[idTrain].phase_arret:=0;
trouve:=true;
end;
inc(it);
until (it>NbDetArret) 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,10 +715,11 @@ 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
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é)';
@@ -474,20 +727,26 @@ begin
else
s:=s+' non positionné';
end;
if not(diffusion) then
Affiche(s,clWhite);
if debugRoulage then Affiche(s,clWhite);
if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig);
end;
// réservation
Affiche('Réservation Aig '+intToSTR(adr),clCyan);
aiguillage[index].adrTrain:=AdrTrain;
end;
if typ=det then detecteur[adr].AdrTrainRes:=adrTrain;
end;
end;
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.
UnitSimule.pas
+30 -15
View File
@@ -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,19 +48,28 @@ 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);
if length(s)>0 then
if s[1]<>'/' then
begin
s:=Uppercase(s);
i:=pos('TICK=',s);
if i<>0 then
if ((i<>0) and avecTick) or (not avecTick) then
begin
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 ;
//k:=Index_Simule+tick+30 ;
end
else inc(k);
Tablo_simule[index_simule].tick:=k;
// détecteur? Det=528=1 Train=BB16024
@@ -71,22 +80,23 @@ begin
if s[1]='=' then delete(s,1,1);
if s[1]=' ' then delete(s,1,1);
val(s,k,erreur);
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);
val(s,k,erreur);
Tablo_simule[index_simule].etat:=k;
end;
i:=pos('=',s);
if i<>0 then delete(s,1,i);
delete(s,1,i);
Tablo_simule[index_simule].train:=s;
end;
inc(index_simule);
end;
end;
// actionneur? Act=803/0=1 Train=CC406526
i:=pos('ACT',s);
if i<>0 then
@@ -118,10 +128,13 @@ begin
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);
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);
@@ -135,9 +148,11 @@ begin
end;
end;
end;
end;
Application.ProcessMessages;
sortie:=eof(fte) or (index_simule>Max_Simule) or (pos('STOP',s)<>0);
end ;
end;
end;
if index_simule>Max_Simule then Affiche('Tableau maximal atteint',clred);
Affiche('Intervalle='+intToSTR(intervalle),clyellow);
UnitTCO.dfm
+13 -5
View File
@@ -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
UnitTCO.pas
+880 -166
View File
File diff suppressed because it is too large Load Diff
Unit_Pilote_aig.pas
+33 -14
View File
@@ -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;
@@ -88,18 +96,12 @@ begin
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
begin
s:='Pilotage de la TJD '+intToSTR(aiguille);
if aiguillage[i].EtatTJD=4 then
if (tjdC and (aiguillage[i].EtatTJD=4)) then
begin
LabelAdr1.Caption:='Adresse1: '+intToSTR(aiguille);
aiguille2:=aiguillage[i].DDevie;
@@ -115,14 +117,31 @@ begin
buttonDroit.Visible:=true;
buttonDev.Visible:=true;
end;
end;
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;
selection_train.dfm
+52 -30
View File
@@ -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
selection_train.pas
+42 -18
View File
@@ -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,
@@ -36,13 +37,16 @@ type
{ 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.
verif_version.pas
+14 -13
View File
@@ -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
versions.txt
+5
View File
@@ -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.