diff --git a/Notice d'utilisation des signaux_complexes_GL_V8.27.pdf b/Notice d'utilisation des signaux_complexes_GL_V8.3.pdf similarity index 76% rename from Notice d'utilisation des signaux_complexes_GL_V8.27.pdf rename to Notice d'utilisation des signaux_complexes_GL_V8.3.pdf index 0cff53d..de18056 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V8.27.pdf and b/Notice d'utilisation des signaux_complexes_GL_V8.3.pdf differ diff --git a/Signaux_complexes_GL.cfg b/Signaux_complexes_GL.cfg index 8d97c47..bcc5ab2 100644 --- a/Signaux_complexes_GL.cfg +++ b/Signaux_complexes_GL.cfg @@ -14,8 +14,8 @@ -$N+ -$O- -$P+ --$Q- --$R- +-$Q+ +-$R+ -$S- -$T- -$U- diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index 5ccec48..454559d 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -17,8 +17,8 @@ M=0 N=1 O=0 P=1 -Q=0 -R=0 +Q=1 +R=1 S=0 T=0 U=0 diff --git a/Signaux_complexes_GL.map b/Signaux_complexes_GL.map index 5ba485e..0bf5c6f 100644 --- a/Signaux_complexes_GL.map +++ b/Signaux_complexes_GL.map @@ -1,104 +1,104 @@ Start Length Name Class - 0001:00000000 001688D8H .text CODE - 0002:00000000 00002BE8H .data DATA - 0002:00002BE8 041CEA31H .bss BSS + 0001:00000000 0019E6D8H .text CODE + 0002:00000000 00002C20H .data DATA + 0002:00002C20 045A150DH .bss BSS Detailed map of segments - 0001:00000000 00005DF3 C=CODE S=.text G=(none) M=System ACBP=A9 - 0001:00005DF4 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 - 0001:00005F34 00000108 C=CODE S=.text G=(none) M=Types ACBP=A9 - 0001:0000603C 00000ED8 C=CODE S=.text G=(none) M=Windows ACBP=A9 - 0001:00006F14 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 - 0001:00006F4C 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 - 0001:00007284 00006E28 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 - 0001:0000E0AC 0000081B C=CODE S=.text G=(none) M=VarUtils ACBP=A9 - 0001:0000E8C8 0000809A C=CODE S=.text G=(none) M=Variants ACBP=A9 - 0001:00016964 00000188 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 - 0001:00016AEC 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 - 0001:00017328 00000358 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 - 0001:00017680 0000A236 C=CODE S=.text G=(none) M=Classes ACBP=A9 - 0001:000218B8 00000370 C=CODE S=.text G=(none) M=Consts ACBP=A9 - 0001:00021C28 00009BFB C=CODE S=.text G=(none) M=Graphics ACBP=A9 - 0001:0002B824 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 - 0001:0002B948 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 - 0001:0002BC00 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 - 0001:0002BD98 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 - 0001:0002C520 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 - 0001:0002C558 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 - 0001:0002D550 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 - 0001:0002D5A8 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 - 0001:0002E670 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 - 0001:0002E990 000001A4 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 - 0001:0002EB34 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 - 0001:0002F4F0 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 - 0001:0002F528 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 - 0001:0002F560 00000040 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 - 0001:0002F5A0 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 - 0001:0002F5D8 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 - 0001:0002F630 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 - 0001:0002F668 0000006C C=CODE S=.text G=(none) M=ShlObj ACBP=A9 - 0001:0002F6D4 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 - 0001:0002F734 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 - 0001:0002F76C 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 - 0001:00032E40 00004ADA C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 - 0001:0003791C 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 - 0001:000379AC 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 - 0001:0003814C 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 - 0001:00038274 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 - 0001:0003BA98 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 - 0001:0003BAD0 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 - 0001:0003BB38 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 - 0001:0003BBA0 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 - 0001:0003BC0C 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 - 0001:0003BC64 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 - 0001:0003BC9C 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 - 0001:000455E4 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 - 0001:00046484 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 - 0001:00052B1C 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 - 0001:00052C84 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 - 0001:000539A4 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 - 0001:00064DA8 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 - 0001:0006603C 00001B9C C=CODE S=.text G=(none) M=ImgList ACBP=A9 - 0001:00067BD8 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 - 0001:0006E2BC 0000CEFC C=CODE S=.text G=(none) M=Forms ACBP=A9 - 0001:0007B1B8 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 - 0001:0007B218 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 - 0001:0007C474 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 - 0001:0007C4AC 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 - 0001:0007DC40 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 - 0001:0007DCA0 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 - 0001:000811BC 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 - 0001:0008120C 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 - 0001:000945F8 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 - 0001:0009490C 000000D8 C=CODE S=.text G=(none) M=WinSock ACBP=A9 - 0001:000949E4 00001F40 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 - 0001:00096924 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 - 0001:00097210 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 - 0001:000977A8 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 - 0001:000977E8 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 - 0001:00097820 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 - 0001:00098238 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 - 0001:0009A340 0000924C C=CODE S=.text G=(none) M=Grids ACBP=A9 - 0001:000A358C 000015B4 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 - 0001:000A4B40 000004D0 C=CODE S=.text G=(none) M=Importation ACBP=A9 - 0001:000A5010 00010280 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 - 0001:000B5290 00002698 C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 - 0001:000B7928 000009C0 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 - 0001:000B82E8 00003988 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 - 0001:000BBC70 0002ED60 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 - 0001:000EA9D0 00002C18 C=CODE S=.text G=(none) M=UnitSR ACBP=A9 - 0001:000ED5E8 00002404 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 - 0001:000EF9EC 000015D3 C=CODE S=.text G=(none) M=verif_version ACBP=A9 - 0001:000F0FC0 0000114C C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 - 0001:000F210C 0003732C C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 - 0001:00129438 0000290C C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 - 0001:0012BD44 00000C00 C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 - 0001:0012C944 00002390 C=CODE S=.text G=(none) M=Unitplace ACBP=A9 - 0001:0012ECD4 00039774 C=CODE S=.text G=(none) M=UnitPrinc ACBP=A9 - 0001:00168448 0000048D C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 + 0001:00000000 00005EC7 C=CODE S=.text G=(none) M=System ACBP=A9 + 0001:00005EC8 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 + 0001:00006008 00000108 C=CODE S=.text G=(none) M=Types ACBP=A9 + 0001:00006110 00000F08 C=CODE S=.text G=(none) M=Windows ACBP=A9 + 0001:00007018 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 + 0001:00007050 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 + 0001:00007388 00006E28 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 + 0001:0000E1B0 0000081B C=CODE S=.text G=(none) M=VarUtils ACBP=A9 + 0001:0000E9CC 0000809A C=CODE S=.text G=(none) M=Variants ACBP=A9 + 0001:00016A68 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 + 0001:00016C08 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 + 0001:00017444 00000358 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 + 0001:0001779C 0000A7EA C=CODE S=.text G=(none) M=Classes ACBP=A9 + 0001:00021F88 00000370 C=CODE S=.text G=(none) M=Consts ACBP=A9 + 0001:000222F8 00009BFB C=CODE S=.text G=(none) M=Graphics ACBP=A9 + 0001:0002BEF4 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 + 0001:0002C018 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 + 0001:0002C2D0 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 + 0001:0002C468 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 + 0001:0002CBF0 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 + 0001:0002CC28 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 + 0001:0002DC20 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 + 0001:0002DC78 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 + 0001:0002ED40 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 + 0001:0002F060 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 + 0001:0002F450 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 + 0001:0002FE0C 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 + 0001:0002FE44 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 + 0001:0002FE7C 00000040 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 + 0001:0002FEBC 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 + 0001:0002FEF4 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 + 0001:0002FF4C 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 + 0001:0002FF84 0000006C C=CODE S=.text G=(none) M=ShlObj ACBP=A9 + 0001:0002FFF0 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 + 0001:00030050 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 + 0001:00030088 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 + 0001:0003375C 00004ADA C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 + 0001:00038238 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 + 0001:000382C8 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 + 0001:00038A68 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 + 0001:00038B90 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 + 0001:0003C3B4 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 + 0001:0003C3EC 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 + 0001:0003C454 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 + 0001:0003C4BC 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 + 0001:0003C528 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 + 0001:0003C580 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 + 0001:0003C5B8 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 + 0001:00045F00 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 + 0001:00046DA0 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 + 0001:00053438 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 + 0001:000535A0 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 + 0001:000542C0 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 + 0001:000656C4 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 + 0001:00066958 00001B9C C=CODE S=.text G=(none) M=ImgList ACBP=A9 + 0001:000684F4 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 + 0001:0006EBD8 0000CEFC C=CODE S=.text G=(none) M=Forms ACBP=A9 + 0001:0007BAD4 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 + 0001:0007BB34 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 + 0001:0007CD90 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 + 0001:0007CDC8 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 + 0001:0007E55C 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 + 0001:0007E5BC 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 + 0001:00081AD8 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 + 0001:00081B28 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 + 0001:00094F14 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 + 0001:00095228 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 + 0001:00095350 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 + 0001:00098DC8 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 + 0001:000996B4 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 + 0001:00099C4C 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 + 0001:00099C8C 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 + 0001:00099CC4 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 + 0001:0009A6DC 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 + 0001:0009C7E4 0000924C C=CODE S=.text G=(none) M=Grids ACBP=A9 + 0001:000A5A30 00001900 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 + 0001:000A7330 000004D0 C=CODE S=.text G=(none) M=Importation ACBP=A9 + 0001:000A7800 00013B20 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 + 0001:000BB320 00002C44 C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 + 0001:000BDF64 00000D10 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 + 0001:000BEC74 00004D74 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 + 0001:000C39E8 000452B4 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 + 0001:00108C9C 000030E4 C=CODE S=.text G=(none) M=UnitSR ACBP=A9 + 0001:0010BD80 000027D4 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 + 0001:0010E554 00040BD0 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 + 0001:0014F124 000017E7 C=CODE S=.text G=(none) M=verif_version ACBP=A9 + 0001:0015090C 000011D8 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 + 0001:00151AE4 00002B44 C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 + 0001:00154628 00000D2C C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 + 0001:00155354 00002580 C=CODE S=.text G=(none) M=Unitplace ACBP=A9 + 0001:001578D4 00046974 C=CODE S=.text G=(none) M=UnitPrinc ACBP=A9 + 0001:0019E248 0000048D 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 @@ -106,31 +106,31 @@ Detailed map of segments 0002:00000348 000001B2 C=DATA S=.data G=DGROUP M=Variants ACBP=A9 0002:000004FC 0000000C C=DATA S=.data G=DGROUP M=TypInfo ACBP=A9 0002:00000508 00000010 C=DATA S=.data G=DGROUP M=ActiveX ACBP=A9 - 0002:00000518 00000064 C=DATA S=.data G=DGROUP M=Classes ACBP=A9 - 0002:0000057C 0000030C C=DATA S=.data G=DGROUP M=Graphics ACBP=A9 - 0002:00000888 00000004 C=DATA S=.data G=DGROUP M=Printers ACBP=A9 - 0002:0000088C 00000180 C=DATA S=.data G=DGROUP M=Dialogs ACBP=A9 - 0002:00000A0C 0000018C C=DATA S=.data G=DGROUP M=ExtCtrls ACBP=A9 - 0002:00000B98 0000009E C=DATA S=.data G=DGROUP M=Buttons ACBP=A9 - 0002:00000C38 00000008 C=DATA S=.data G=DGROUP M=IniFiles ACBP=A9 - 0002:00000C40 00000008 C=DATA S=.data G=DGROUP M=Registry ACBP=A9 - 0002:00000C48 00000008 C=DATA S=.data G=DGROUP M=Mapi ACBP=A9 - 0002:00000C50 000000B9 C=DATA S=.data G=DGROUP M=ComCtrls ACBP=A9 - 0002:00000D0C 00000068 C=DATA S=.data G=DGROUP M=Themes ACBP=A9 - 0002:00000D74 00000154 C=DATA S=.data G=DGROUP M=StdCtrls ACBP=A9 - 0002:00000EC8 0000013C C=DATA S=.data G=DGROUP M=Controls ACBP=A9 - 0002:00001004 00000020 C=DATA S=.data G=DGROUP M=ImgList ACBP=A9 - 0002:00001024 000000EC C=DATA S=.data G=DGROUP M=Menus ACBP=A9 - 0002:00001110 00000124 C=DATA S=.data G=DGROUP M=Forms ACBP=A9 - 0002:00001234 00000030 C=DATA S=.data G=DGROUP M=ComObj ACBP=A9 - 0002:00001264 0000002C C=DATA S=.data G=DGROUP M=OleCtrls ACBP=A9 - 0002:00001290 00000908 C=DATA S=.data G=DGROUP M=jpeg ACBP=A9 - 0002:00001B98 00000058 C=DATA S=.data G=DGROUP M=MSCommLib_TLB ACBP=A9 - 0002:00001BF0 00000009 C=DATA S=.data G=DGROUP M=MaskUtils ACBP=A9 - 0002:00001BFC 00000004 C=DATA S=.data G=DGROUP M=Mask ACBP=A9 - 0002:00001C00 00000006 C=DATA S=.data G=DGROUP M=Grids ACBP=A9 - 0002:00001C08 000000D4 C=DATA S=.data G=DGROUP M=UnitTCO ACBP=A9 - 0002:00001CDC 0000060D C=DATA S=.data G=DGROUP M=UnitPrinc ACBP=A9 + 0002:00000518 00000080 C=DATA S=.data G=DGROUP M=Classes ACBP=A9 + 0002:00000598 0000030C C=DATA S=.data G=DGROUP M=Graphics ACBP=A9 + 0002:000008A4 00000004 C=DATA S=.data G=DGROUP M=Printers ACBP=A9 + 0002:000008A8 00000180 C=DATA S=.data G=DGROUP M=Dialogs ACBP=A9 + 0002:00000A28 0000018C C=DATA S=.data G=DGROUP M=ExtCtrls ACBP=A9 + 0002:00000BB4 0000009E C=DATA S=.data G=DGROUP M=Buttons ACBP=A9 + 0002:00000C54 00000008 C=DATA S=.data G=DGROUP M=IniFiles ACBP=A9 + 0002:00000C5C 00000008 C=DATA S=.data G=DGROUP M=Registry ACBP=A9 + 0002:00000C64 00000008 C=DATA S=.data G=DGROUP M=Mapi ACBP=A9 + 0002:00000C6C 000000B9 C=DATA S=.data G=DGROUP M=ComCtrls ACBP=A9 + 0002:00000D28 00000068 C=DATA S=.data G=DGROUP M=Themes ACBP=A9 + 0002:00000D90 00000154 C=DATA S=.data G=DGROUP M=StdCtrls ACBP=A9 + 0002:00000EE4 0000013C C=DATA S=.data G=DGROUP M=Controls ACBP=A9 + 0002:00001020 00000020 C=DATA S=.data G=DGROUP M=ImgList ACBP=A9 + 0002:00001040 000000EC C=DATA S=.data G=DGROUP M=Menus ACBP=A9 + 0002:0000112C 00000124 C=DATA S=.data G=DGROUP M=Forms ACBP=A9 + 0002:00001250 00000030 C=DATA S=.data G=DGROUP M=ComObj ACBP=A9 + 0002:00001280 0000002C C=DATA S=.data G=DGROUP M=OleCtrls ACBP=A9 + 0002:000012AC 00000908 C=DATA S=.data G=DGROUP M=jpeg ACBP=A9 + 0002:00001BB4 00000058 C=DATA S=.data G=DGROUP M=MSCommLib_TLB ACBP=A9 + 0002:00001C0C 00000009 C=DATA S=.data G=DGROUP M=MaskUtils ACBP=A9 + 0002:00001C18 00000004 C=DATA S=.data G=DGROUP M=Mask ACBP=A9 + 0002:00001C1C 00000006 C=DATA S=.data G=DGROUP M=Grids ACBP=A9 + 0002:00001C24 000000D4 C=DATA S=.data G=DGROUP M=UnitTCO ACBP=A9 + 0002:00001CF8 0000060D C=DATA S=.data G=DGROUP M=UnitPrinc ACBP=A9 0002:00003000 00000664 C=BSS S=.bss G=DGROUP M=System ACBP=A9 0002:00003664 00000010 C=BSS S=.bss G=DGROUP M=SysInit ACBP=A9 0002:00003674 00000004 C=BSS S=.bss G=DGROUP M=Types ACBP=A9 @@ -143,85 +143,85 @@ Detailed map of segments 0002:00003840 00000004 C=BSS S=.bss G=DGROUP M=RTLConsts ACBP=A9 0002:00003844 00000004 C=BSS S=.bss G=DGROUP M=TypInfo ACBP=A9 0002:00003848 00000004 C=BSS S=.bss G=DGROUP M=ActiveX ACBP=A9 - 0002:0000384C 00000040 C=BSS S=.bss G=DGROUP M=Classes ACBP=A9 - 0002:0000388C 00000004 C=BSS S=.bss G=DGROUP M=Consts ACBP=A9 - 0002:00003890 00000060 C=BSS S=.bss G=DGROUP M=Graphics ACBP=A9 - 0002:000038F0 00000004 C=BSS S=.bss G=DGROUP M=Math ACBP=A9 - 0002:000038F4 00000004 C=BSS S=.bss G=DGROUP M=Contnrs ACBP=A9 - 0002:000038F8 0000000C C=BSS S=.bss G=DGROUP M=CommCtrl ACBP=A9 - 0002:00003904 00000031 C=BSS S=.bss G=DGROUP M=MultiMon ACBP=A9 - 0002:00003938 00000004 C=BSS S=.bss G=DGROUP M=Imm ACBP=A9 - 0002:0000393C 00000008 C=BSS S=.bss G=DGROUP M=HelpIntfs ACBP=A9 - 0002:00003944 00000004 C=BSS S=.bss G=DGROUP M=WinSpool ACBP=A9 - 0002:00003948 00000004 C=BSS S=.bss G=DGROUP M=Printers ACBP=A9 - 0002:0000394C 00000034 C=BSS S=.bss G=DGROUP M=FlatSB ACBP=A9 - 0002:00003980 00000004 C=BSS S=.bss G=DGROUP M=SyncObjs ACBP=A9 - 0002:00003984 000000CC C=BSS S=.bss G=DGROUP M=UxTheme ACBP=A9 - 0002:00003A50 00000004 C=BSS S=.bss G=DGROUP M=RichEdit ACBP=A9 - 0002:00003A54 00000004 C=BSS S=.bss G=DGROUP M=ToolWin ACBP=A9 - 0002:00003A58 00000004 C=BSS S=.bss G=DGROUP M=ShellAPI ACBP=A9 - 0002:00003A5C 00000004 C=BSS S=.bss G=DGROUP M=RegStr ACBP=A9 - 0002:00003A60 00000004 C=BSS S=.bss G=DGROUP M=WinInet ACBP=A9 - 0002:00003A64 00000004 C=BSS S=.bss G=DGROUP M=UrlMon ACBP=A9 - 0002:00003A68 00000004 C=BSS S=.bss G=DGROUP M=ShlObj ACBP=A9 - 0002:00003A6C 00000004 C=BSS S=.bss G=DGROUP M=CommDlg ACBP=A9 - 0002:00003A70 00000004 C=BSS S=.bss G=DGROUP M=Dlgs ACBP=A9 - 0002:00003A74 0000003C C=BSS S=.bss G=DGROUP M=Dialogs ACBP=A9 - 0002:00003AB0 00000004 C=BSS S=.bss G=DGROUP M=ExtCtrls ACBP=A9 - 0002:00003AB4 00000004 C=BSS S=.bss G=DGROUP M=ComStrs ACBP=A9 - 0002:00003AB8 0000000C C=BSS S=.bss G=DGROUP M=Clipbrd ACBP=A9 - 0002:00003AC4 00000004 C=BSS S=.bss G=DGROUP M=StrUtils ACBP=A9 - 0002:00003AC8 00000030 C=BSS S=.bss G=DGROUP M=Buttons ACBP=A9 - 0002:00003AF8 00000004 C=BSS S=.bss G=DGROUP M=ExtDlgs ACBP=A9 - 0002:00003AFC 00000004 C=BSS S=.bss G=DGROUP M=IniFiles ACBP=A9 - 0002:00003B00 00000004 C=BSS S=.bss G=DGROUP M=Registry ACBP=A9 - 0002:00003B04 00000004 C=BSS S=.bss G=DGROUP M=Mapi ACBP=A9 - 0002:00003B08 00000009 C=BSS S=.bss G=DGROUP M=ExtActns ACBP=A9 - 0002:00003B14 00000004 C=BSS S=.bss G=DGROUP M=ListActns ACBP=A9 - 0002:00003B18 00000010 C=BSS S=.bss G=DGROUP M=ComCtrls ACBP=A9 - 0002:00003B28 00000008 C=BSS S=.bss G=DGROUP M=Themes ACBP=A9 - 0002:00003B30 00000004 C=BSS S=.bss G=DGROUP M=StdCtrls ACBP=A9 - 0002:00003B34 00000004 C=BSS S=.bss G=DGROUP M=StdActns ACBP=A9 - 0002:00003B38 00000014 C=BSS S=.bss G=DGROUP M=WinHelpViewer ACBP=A9 - 0002:00003B4C 00000080 C=BSS S=.bss G=DGROUP M=Controls ACBP=A9 - 0002:00003BCC 00000004 C=BSS S=.bss G=DGROUP M=ActnList ACBP=A9 - 0002:00003BD0 0000000C C=BSS S=.bss G=DGROUP M=ImgList ACBP=A9 - 0002:00003BDC 00000010 C=BSS S=.bss G=DGROUP M=Menus ACBP=A9 - 0002:00003BEC 00000020 C=BSS S=.bss G=DGROUP M=Forms ACBP=A9 - 0002:00003C0C 00000004 C=BSS S=.bss G=DGROUP M=ComConst ACBP=A9 - 0002:00003C10 00000011 C=BSS S=.bss G=DGROUP M=ComObj ACBP=A9 - 0002:00003C24 00000004 C=BSS S=.bss G=DGROUP M=StdVCL ACBP=A9 - 0002:00003C28 0000001C C=BSS S=.bss G=DGROUP M=AxCtrls ACBP=A9 - 0002:00003C44 00000004 C=BSS S=.bss G=DGROUP M=OleConst ACBP=A9 - 0002:00003C48 00000014 C=BSS S=.bss G=DGROUP M=OleCtrls ACBP=A9 - 0002:00003C5C 00000004 C=BSS S=.bss G=DGROUP M=JConsts ACBP=A9 - 0002:00003C60 00000004 C=BSS S=.bss G=DGROUP M=jpeg ACBP=A9 - 0002:00003C64 00000048 C=BSS S=.bss G=DGROUP M=TlHelp32 ACBP=A9 - 0002:00003CAC 00000004 C=BSS S=.bss G=DGROUP M=WinSock ACBP=A9 - 0002:00003CB0 00000194 C=BSS S=.bss G=DGROUP M=ScktComp ACBP=A9 - 0002:00003E44 00000004 C=BSS S=.bss G=DGROUP M=OleServer ACBP=A9 - 0002:00003E48 00000004 C=BSS S=.bss G=DGROUP M=MSCommLib_TLB ACBP=A9 - 0002:00003E4C 00000004 C=BSS S=.bss G=DGROUP M=MMSystem ACBP=A9 - 0002:00003E50 00000004 C=BSS S=.bss G=DGROUP M=Nb30 ACBP=A9 - 0002:00003E54 00000004 C=BSS S=.bss G=DGROUP M=MaskUtils ACBP=A9 - 0002:00003E58 00000004 C=BSS S=.bss G=DGROUP M=Mask ACBP=A9 - 0002:00003E5C 00000004 C=BSS S=.bss G=DGROUP M=Grids ACBP=A9 - 0002:00003E60 00000010 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 - 0002:00003E70 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 - 0002:00003E80 00003DC0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 - 0002:00007C40 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 - 0002:00007C54 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 - 0002:00007C68 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 - 0002:00007C7C 00047DC8 C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 - 0002:0004FA44 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 - 0002:0004FA54 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 - 0002:0004FA68 00000018 C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 - 0002:0004FA80 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 - 0002:0004FA84 000004F8 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 - 0002:0004FF7C 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 - 0002:0004FFA8 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 - 0002:0004FFB4 00000008 C=BSS S=.bss G=DGROUP M=Unitplace ACBP=A9 - 0002:0004FFBC 04181A74 C=BSS S=.bss G=DGROUP M=UnitPrinc ACBP=A9 + 0002:0000384C 00000044 C=BSS S=.bss G=DGROUP M=Classes ACBP=A9 + 0002:00003890 00000004 C=BSS S=.bss G=DGROUP M=Consts ACBP=A9 + 0002:00003894 00000060 C=BSS S=.bss G=DGROUP M=Graphics ACBP=A9 + 0002:000038F4 00000004 C=BSS S=.bss G=DGROUP M=Math ACBP=A9 + 0002:000038F8 00000004 C=BSS S=.bss G=DGROUP M=Contnrs ACBP=A9 + 0002:000038FC 0000000C C=BSS S=.bss G=DGROUP M=CommCtrl ACBP=A9 + 0002:00003908 00000031 C=BSS S=.bss G=DGROUP M=MultiMon ACBP=A9 + 0002:0000393C 00000004 C=BSS S=.bss G=DGROUP M=Imm ACBP=A9 + 0002:00003940 00000008 C=BSS S=.bss G=DGROUP M=HelpIntfs ACBP=A9 + 0002:00003948 00000004 C=BSS S=.bss G=DGROUP M=WinSpool ACBP=A9 + 0002:0000394C 00000004 C=BSS S=.bss G=DGROUP M=Printers ACBP=A9 + 0002:00003950 00000034 C=BSS S=.bss G=DGROUP M=FlatSB ACBP=A9 + 0002:00003984 00000004 C=BSS S=.bss G=DGROUP M=SyncObjs ACBP=A9 + 0002:00003988 000000CC C=BSS S=.bss G=DGROUP M=UxTheme ACBP=A9 + 0002:00003A54 00000004 C=BSS S=.bss G=DGROUP M=RichEdit ACBP=A9 + 0002:00003A58 00000004 C=BSS S=.bss G=DGROUP M=ToolWin ACBP=A9 + 0002:00003A5C 00000004 C=BSS S=.bss G=DGROUP M=ShellAPI ACBP=A9 + 0002:00003A60 00000004 C=BSS S=.bss G=DGROUP M=RegStr ACBP=A9 + 0002:00003A64 00000004 C=BSS S=.bss G=DGROUP M=WinInet ACBP=A9 + 0002:00003A68 00000004 C=BSS S=.bss G=DGROUP M=UrlMon ACBP=A9 + 0002:00003A6C 00000004 C=BSS S=.bss G=DGROUP M=ShlObj ACBP=A9 + 0002:00003A70 00000004 C=BSS S=.bss G=DGROUP M=CommDlg ACBP=A9 + 0002:00003A74 00000004 C=BSS S=.bss G=DGROUP M=Dlgs ACBP=A9 + 0002:00003A78 0000003C C=BSS S=.bss G=DGROUP M=Dialogs ACBP=A9 + 0002:00003AB4 00000004 C=BSS S=.bss G=DGROUP M=ExtCtrls ACBP=A9 + 0002:00003AB8 00000004 C=BSS S=.bss G=DGROUP M=ComStrs ACBP=A9 + 0002:00003ABC 0000000C C=BSS S=.bss G=DGROUP M=Clipbrd ACBP=A9 + 0002:00003AC8 00000004 C=BSS S=.bss G=DGROUP M=StrUtils ACBP=A9 + 0002:00003ACC 00000030 C=BSS S=.bss G=DGROUP M=Buttons ACBP=A9 + 0002:00003AFC 00000004 C=BSS S=.bss G=DGROUP M=ExtDlgs ACBP=A9 + 0002:00003B00 00000004 C=BSS S=.bss G=DGROUP M=IniFiles ACBP=A9 + 0002:00003B04 00000004 C=BSS S=.bss G=DGROUP M=Registry ACBP=A9 + 0002:00003B08 00000004 C=BSS S=.bss G=DGROUP M=Mapi ACBP=A9 + 0002:00003B0C 00000009 C=BSS S=.bss G=DGROUP M=ExtActns ACBP=A9 + 0002:00003B18 00000004 C=BSS S=.bss G=DGROUP M=ListActns ACBP=A9 + 0002:00003B1C 00000010 C=BSS S=.bss G=DGROUP M=ComCtrls ACBP=A9 + 0002:00003B2C 00000008 C=BSS S=.bss G=DGROUP M=Themes ACBP=A9 + 0002:00003B34 00000004 C=BSS S=.bss G=DGROUP M=StdCtrls ACBP=A9 + 0002:00003B38 00000004 C=BSS S=.bss G=DGROUP M=StdActns ACBP=A9 + 0002:00003B3C 00000014 C=BSS S=.bss G=DGROUP M=WinHelpViewer ACBP=A9 + 0002:00003B50 00000080 C=BSS S=.bss G=DGROUP M=Controls ACBP=A9 + 0002:00003BD0 00000004 C=BSS S=.bss G=DGROUP M=ActnList ACBP=A9 + 0002:00003BD4 0000000C C=BSS S=.bss G=DGROUP M=ImgList ACBP=A9 + 0002:00003BE0 00000010 C=BSS S=.bss G=DGROUP M=Menus ACBP=A9 + 0002:00003BF0 00000020 C=BSS S=.bss G=DGROUP M=Forms ACBP=A9 + 0002:00003C10 00000004 C=BSS S=.bss G=DGROUP M=ComConst ACBP=A9 + 0002:00003C14 00000011 C=BSS S=.bss G=DGROUP M=ComObj ACBP=A9 + 0002:00003C28 00000004 C=BSS S=.bss G=DGROUP M=StdVCL ACBP=A9 + 0002:00003C2C 0000001C C=BSS S=.bss G=DGROUP M=AxCtrls ACBP=A9 + 0002:00003C48 00000004 C=BSS S=.bss G=DGROUP M=OleConst ACBP=A9 + 0002:00003C4C 00000014 C=BSS S=.bss G=DGROUP M=OleCtrls ACBP=A9 + 0002:00003C60 00000004 C=BSS S=.bss G=DGROUP M=JConsts ACBP=A9 + 0002:00003C64 00000004 C=BSS S=.bss G=DGROUP M=jpeg ACBP=A9 + 0002:00003C68 00000048 C=BSS S=.bss G=DGROUP M=TlHelp32 ACBP=A9 + 0002:00003CB0 00000004 C=BSS S=.bss G=DGROUP M=WinSock ACBP=A9 + 0002:00003CB4 00000194 C=BSS S=.bss G=DGROUP M=ScktComp ACBP=A9 + 0002:00003E48 00000004 C=BSS S=.bss G=DGROUP M=OleServer ACBP=A9 + 0002:00003E4C 00000004 C=BSS S=.bss G=DGROUP M=MSCommLib_TLB ACBP=A9 + 0002:00003E50 00000004 C=BSS S=.bss G=DGROUP M=MMSystem ACBP=A9 + 0002:00003E54 00000004 C=BSS S=.bss G=DGROUP M=Nb30 ACBP=A9 + 0002:00003E58 00000004 C=BSS S=.bss G=DGROUP M=MaskUtils ACBP=A9 + 0002:00003E5C 00000004 C=BSS S=.bss G=DGROUP M=Mask ACBP=A9 + 0002:00003E60 00000004 C=BSS S=.bss G=DGROUP M=Grids ACBP=A9 + 0002:00003E64 00000010 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 + 0002:00003E74 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 + 0002:00003E84 00003DC0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 + 0002:00007C44 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 + 0002:00007C58 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 + 0002:00007C6C 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 + 0002:00007C80 004186C8 C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 + 0002:00420348 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 + 0002:00420358 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 + 0002:0042036C 000004FC C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 + 0002:00420868 00000018 C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 + 0002:00420880 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 + 0002:00420884 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 + 0002:004208B0 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 + 0002:004208BC 00000008 C=BSS S=.bss G=DGROUP M=Unitplace ACBP=A9 + 0002:004208C4 04183C48 C=BSS S=.bss G=DGROUP M=UnitPrinc ACBP=A9 Bound resource files @@ -237,8 +237,8 @@ UnitConfigCellTCO.dfm UnitTCO.dfm UnitSR.dfm UnitCDF.dfm -verif_version.dfm UnitConfig.dfm +verif_version.dfm UnitDebug.dfm UnitSimule.dfm Unitplace.dfm @@ -247,4 +247,4 @@ Signaux_complexes_GL.res Signaux_complexes_GL.drf -Program entry point at 0001:00168758 +Program entry point at 0001:0019E558 diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 93fcbc4..8e22bf0 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -502,7 +502,6 @@ begin exit; end; - // modif pour signaux complexes if (segType='turnout') or (segType='turnout_3way') or (segType='dbl_slip_switch') then begin inc(nligne); @@ -1229,10 +1228,10 @@ begin end; // rotation matricielle autour de Centre -function XForm_Rotation(AAngle : Single;Centre : TPoint) : TXForm; +function XForm_Rotation(Angle : Single;Centre : TPoint) : TXForm; var SinA,CosA: Extended; begin - SinCos(AAngle,SinA,CosA); + SinCos(Angle,SinA,CosA); Result.eM11:=CosA; Result.eM12:=SinA; Result.eM21:=-SinA; diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 8b46803..a8b4a60 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,6 +1,6 @@ object FormConfig: TFormConfig - Left = 278 - Top = 142 + Left = 247 + Top = 117 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' @@ -668,7 +668,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 497 - ActivePage = TabSheetAutonome + ActivePage = TabSheetCDM Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -693,7 +693,7 @@ object FormConfig: TFormConfig Left = 16 Top = 8 Width = 273 - Height = 113 + Height = 81 Caption = 'Socket de comm. CDM Rail <--> Signaux complexes' TabOrder = 0 object Label1: TLabel @@ -717,35 +717,19 @@ object FormConfig: TFormConfig Height = 21 TabStop = False TabOrder = 0 - Text = 'EditAdrIPCDM' end object EditPortCDM: TEdit - Left = 176 + Left = 200 Top = 48 - Width = 81 + Width = 57 Height = 21 TabStop = False TabOrder = 1 - Text = 'EditPortCDM' - end - object ButtonPFCDM: TButton - Left = 16 - Top = 72 - Width = 241 - Height = 25 - Hint = - 'Ajoute une r'#232'gle d'#39'autorisation de communication du socket vers ' + - 'CDM rail dans le pare-feu' - Caption = 'Ajouter une autorisation au pare-feu windows' - ParentShowHint = False - ShowHint = True - TabOrder = 2 - OnClick = ButtonPFCDMClick end end object GroupBox5: TGroupBox Left = 16 - Top = 128 + Top = 96 Width = 273 Height = 209 Caption = 'Au d'#233'marrage de Signaux_Complexes ' @@ -980,7 +964,7 @@ object FormConfig: TFormConfig end object GroupBox8: TGroupBox Left = 16 - Top = 344 + Top = 312 Width = 273 Height = 97 Caption = 'Services CommIP CDM Rail' @@ -1042,7 +1026,7 @@ object FormConfig: TFormConfig Left = 312 Top = 256 Width = 297 - Height = 145 + Height = 161 Caption = 'Divers' TabOrder = 5 object Label31: TLabel @@ -1073,6 +1057,13 @@ object FormConfig: TFormConfig Height = 13 Caption = 'Debug' end + object Label28: TLabel + Left = 8 + Top = 136 + Width = 182 + Height = 13 + Caption = 'Port du serveur de Signaux Complexes' + end object EditNbDetDist: TEdit Left = 240 Top = 20 @@ -1119,7 +1110,7 @@ object FormConfig: TFormConfig end object CheckBoxVerifXpressNet: TCheckBox Left = 8 - Top = 116 + Top = 108 Width = 233 Height = 17 Hint = @@ -1132,6 +1123,32 @@ object FormConfig: TFormConfig TabOrder = 4 OnClick = CheckBoxVerifXpressNetClick end + object EditPortServeur: TEdit + Left = 224 + Top = 130 + Width = 49 + Height = 21 + Hint = 'Port de 1 '#224' 65535' + ParentShowHint = False + ShowHint = True + TabOrder = 5 + OnChange = EditPortServeurChange + OnExit = EditPortServeurExit + end + end + object ButtonPFCDM: TButton + Left = 40 + Top = 416 + Width = 241 + Height = 25 + Hint = + 'Ajoute une r'#232'gle d'#39'autorisation de communication du socket vers ' + + 'CDM rail dans le pare-feu' + Caption = 'Ajouter les autorisations au pare-feu windows' + ParentShowHint = False + ShowHint = True + TabOrder = 6 + OnClick = ButtonPFCDMClick end end object TabSheetAutonome: TTabSheet @@ -1279,9 +1296,8 @@ object FormConfig: TFormConfig BorderStyle = bsNone Lines.Strings = ( '1. Port COM de l'#39'adresse USB de l'#39'interface XpressNet. ' - 'COM de 1 '#224' 99 - Si COMX : Signaux complexes d'#233'tecte le ' - 'port automatiquement (mais le d'#233'marrage est plus long)' - ' ') + 'COM de 1 '#224' 255 - Si COMX : Signaux complexes d'#233'tecte le ' + 'port automatiquement (mais le d'#233'marrage est plus long)') ReadOnly = True TabOrder = 3 end @@ -1415,6 +1431,20 @@ object FormConfig: TFormConfig ShowHint = True TabOrder = 5 end + object CheckBoxResa: TCheckBox + Left = 16 + Top = 136 + Width = 265 + Height = 17 + Hint = + 'Permet de r'#233'server les aiguillages, les TJD/S et les croisements' + + ' sur le parcours d'#39'un train' + Caption = 'Mode r'#233'servation des aiguillages par les trains' + ParentShowHint = False + ShowHint = True + TabOrder = 6 + OnClick = CheckBoxResaClick + end end object GroupBox22: TGroupBox Left = 312 @@ -1478,11 +1508,17 @@ object FormConfig: TFormConfig object Label12: TLabel Left = 0 Top = 8 - Width = 468 + Width = 575 Height = 13 Caption = 'Liste de mod'#233'lisation des aiguillages - cliquez sur une ligne po' + 'ur afficher la description de l'#39'aiguillage' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False end object GroupBox11: TGroupBox Left = 328 @@ -1987,11 +2023,17 @@ object FormConfig: TFormConfig object Label14: TLabel Left = 0 Top = 8 - Width = 508 + Width = 622 Height = 13 Caption = 'Liste de mod'#233'lisation des branches - Cliquer sur une ligne pour ' + 'la modifier - Valider la ligne apr'#232's modification' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False end object Label34: TLabel Left = 472 @@ -2127,11 +2169,17 @@ object FormConfig: TFormConfig object Label15: TLabel Left = 0 Top = 8 - Width = 434 + Width = 531 Height = 13 Caption = 'Liste de mod'#233'lisation des signaux - cliquez sur une ligne pour a' + 'fficher la description du signal' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False end object Label35: TLabel Left = 72 @@ -2318,7 +2366,7 @@ object FormConfig: TFormConfig Width = 137 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 1 OnChange = ComboBoxDecChange end @@ -2400,8 +2448,8 @@ object FormConfig: TFormConfig Width = 145 Height = 17 Hint = - 'Passe le feu au carr'#233' ci aucun train n'#39'est pr'#233'sent 3 cantons ava' + - 'nt le signal' + 'Passe le signal au carr'#233' ci aucun train n'#39'est pr'#233'sent 3 cantons ' + + 'avant le signal' Caption = 'Verrouillable au carr'#233 ParentShowHint = False ShowHint = True @@ -2425,7 +2473,7 @@ object FormConfig: TFormConfig Width = 137 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxAspChange end @@ -2605,14 +2653,14 @@ object FormConfig: TFormConfig object Label61: TLabel Left = 13 Top = 12 - Width = 173 + Width = 208 Height = 13 Caption = 'D'#233'codeurs personnalis'#233's de signaux' Font.Charset = ANSI_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' - Font.Style = [] + Font.Style = [fsBold] ParentFont = False end object Label62: TLabel @@ -2719,7 +2767,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 AutoComplete = False - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxDecodeurPersoChange end @@ -2738,7 +2786,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxNationChange end @@ -2784,7 +2832,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 6 OnChange = ComboBoxDecCdeChange end @@ -2796,11 +2844,17 @@ object FormConfig: TFormConfig object Label16: TLabel Left = 0 Top = 8 - Width = 459 + Width = 562 Height = 13 Caption = 'Liste de mod'#233'lisation des actionneurs - cliquez sur une ligne po' + 'ur afficher la description de l'#39'action' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False end object GroupBox13: TGroupBox Left = 352 @@ -2811,7 +2865,7 @@ object FormConfig: TFormConfig TabOrder = 0 object GroupBoxRadio: TGroupBox Left = 8 - Top = 24 + Top = 120 Width = 249 Height = 89 Caption = 'Type d'#39'action' @@ -2855,14 +2909,14 @@ object FormConfig: TFormConfig end object GroupBoxAct: TGroupBox Left = 8 - Top = 120 + Top = 24 Width = 249 Height = 321 Caption = 'Action fonction de locomotive ' TabOrder = 1 object GroupBox18: TGroupBox Left = 8 - Top = 16 + Top = 24 Width = 233 Height = 161 Caption = 'D'#233'clencheur ' @@ -2969,8 +3023,8 @@ object FormConfig: TFormConfig end end object GroupBox19: TGroupBox - Left = 8 - Top = 136 + Left = 56 + Top = 32 Width = 233 Height = 137 Caption = 'Destinataire de l'#39'action ' @@ -3163,7 +3217,7 @@ object FormConfig: TFormConfig Height = 21 Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 6 @@ -3184,24 +3238,24 @@ object FormConfig: TFormConfig end end object GroupBoxPNA: TGroupBox - Left = 56 - Top = 64 + Left = 104 + Top = 160 Width = 169 Height = 121 Caption = 'Actionneurs PN simples' TabOrder = 2 end object GroupBoxPNZ: TGroupBox - Left = 120 - Top = 64 + Left = 64 + Top = 48 Width = 169 Height = 65 Caption = 'Zones de d'#233'tection' TabOrder = 3 end object GroupBoxPN: TGroupBox - Left = 136 - Top = 24 + Left = 40 + Top = 48 Width = 249 Height = 193 Caption = 'Action gestion passage '#224' niveau' @@ -3344,7 +3398,7 @@ object FormConfig: TFormConfig Height = 21 Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 10 @@ -3595,11 +3649,17 @@ object FormConfig: TFormConfig object Label19: TLabel Left = 8 Top = 8 - Width = 538 + Width = 531 Height = 26 Caption = 'Configuration de l'#39'interface DCC++ pour le mode autonome (n'#233'cess' + 'ite de cocher le protocole DCC++ dans l'#39'onglet "Mode autonome")' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False WordWrap = True end object RichCdeDccpp: TRichEdit @@ -3676,11 +3736,17 @@ object FormConfig: TFormConfig object Label54: TLabel Left = 16 Top = 8 - Width = 392 + Width = 475 Height = 13 Caption = 'Liste des trains d'#233'clar'#233's du r'#233'seau - Pour utilisation en mode a' + 'utonome uniquement' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False end object LabelInfVitesse: TLabel Left = 320 @@ -3953,13 +4019,15 @@ object FormConfig: TFormConfig object Label73: TLabel Left = 8 Top = 8 - Width = 580 - Height = 26 - Caption = - 'Les p'#233'riph'#233'riques COM/USB ou Sockets sont utilis'#233's pour '#234'tre act' + - 'iv'#233's par un actionneur et leur envoyer des ordres ASCII. On peut' + - ' '#233'galement leur envoyer des informations sur les '#233'v'#232'nements aigu' + - 'illage, d'#233'tecteurs et actionneurs via les services.' + Width = 208 + Height = 13 + Caption = 'P'#233'riph'#233'riques COM/USB ou Sockets' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False WordWrap = True end object LabelInfoAcc: TLabel @@ -3970,7 +4038,7 @@ object FormConfig: TFormConfig end object SBMonte: TSpeedButton Left = 240 - Top = 160 + Top = 176 Width = 25 Height = 33 Hint = @@ -3994,7 +4062,7 @@ object FormConfig: TFormConfig end object SBDesc: TSpeedButton Left = 240 - Top = 200 + Top = 216 Width = 25 Height = 33 Hint = @@ -4016,9 +4084,21 @@ object FormConfig: TFormConfig ShowHint = True OnClick = SBDescClick end + object Label23: TLabel + Left = 8 + Top = 28 + Width = 570 + Height = 26 + Caption = + 'Ils sont utilis'#233's pour '#234'tre activ'#233's par un actionneur et leur en' + + 'voyer des ordres ASCII. On peut '#233'galement leur envoyer des infor' + + 'mations sur les '#233'v'#232'nements aiguillage, d'#233'tecteurs et actionneurs' + + ' via les services.' + WordWrap = True + end object ListBoxPeriph: TListBox Left = 8 - Top = 72 + Top = 88 Width = 233 Height = 273 Color = clBlack @@ -4039,7 +4119,7 @@ object FormConfig: TFormConfig end object ButtonAjAccCom: TButton Left = 8 - Top = 48 + Top = 64 Width = 65 Height = 17 Caption = 'Nouveau' @@ -4048,7 +4128,7 @@ object FormConfig: TFormConfig end object ButtonSupAccCom: TButton Left = 80 - Top = 48 + Top = 64 Width = 65 Height = 17 Caption = 'Supprime' @@ -4057,7 +4137,7 @@ object FormConfig: TFormConfig end object GroupBoxDesc: TGroupBox Left = 280 - Top = 72 + Top = 80 Width = 329 Height = 129 Caption = 'Description du p'#233'riph'#233'rique' @@ -4083,7 +4163,7 @@ object FormConfig: TFormConfig end object ButtonOuvreCom: TButton Left = 14 - Top = 357 + Top = 365 Width = 75 Height = 20 Hint = 'R'#233'ouvre les ports COMs et Sockets demand'#233's' diff --git a/UnitConfig.pas b/UnitConfig.pas index 5eb885b..12c1061 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -272,7 +272,6 @@ type EditFiltrDet: TEdit; CheckBoxVerifXpressNet: TCheckBox; ImageTrain: TImage; - ButtonPFCDM: TButton; PopupMenuRichedit: TPopupMenu; Copier1: TMenuItem; Coller1: TMenuItem; @@ -347,6 +346,11 @@ type ButtonCherche: TButton; SBMonte: TSpeedButton; SBDesc: TSpeedButton; + CheckBoxResa: TCheckBox; + Label23: TLabel; + Label28: TLabel; + EditPortServeur: TEdit; + ButtonPFCDM: TButton; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -521,6 +525,9 @@ type procedure EditChercherChange(Sender: TObject); procedure SBMonteClick(Sender: TObject); procedure SBDescClick(Sender: TObject); + procedure CheckBoxResaClick(Sender: TObject); + procedure EditPortServeurExit(Sender: TObject); + procedure EditPortServeurChange(Sender: TObject); private { Déclarations privées } @@ -539,6 +546,7 @@ const // constantes du fichier de configuration NomConfig='ConfigGenerale.cfg'; Debug_ch='Debug'; +PortServeur_ch='Port_Serveur'; AntiTimeoutEthLenz_ch='AntiTimeoutEthLenz'; Verif_AdrXpressNet_ch='Verif_AdrXpressNet'; Filtrage_det_ch='Filtrage_det'; @@ -573,6 +581,7 @@ Algo_Unisemaf_ch='Alg_Unisemaf'; NOTIF_VERSION_ch='notif_version'; verif_version_ch='verif_version'; Fonte_ch='Fonte'; +ModeResa_ch='ModeResa'; Protocole_ch='Protocole'; Raz_signaux_ch='RazSignaux'; EnvAigDccpp_ch='EnvAigDccpp'; @@ -608,11 +617,11 @@ var AdresseIPCDM,AdresseIP,PortCom,recuCDM,residuCDM,trainsauve : string; portCDM,TempoOctet,TimoutMaxInterface,Valeur_entete,PortInterface,prot_serie,NumPort,debug, - LigneCliqueePN,AncLigneCliqueePN,clicMemo,Nb_cantons_Sig,protocole,Port, + LigneCliqueePN,AncLigneCliqueePN,clicMemo,Nb_cantons_Sig,protocole,Port,PortServeur, ligneclicAig,AncLigneClicAig,ligneClicSig,AncligneClicSig,EnvAigDccpp,AdrBaseDetDccpp, ligneClicBr,AncligneClicBr,ligneClicAct,AncLigneClicAct,Indexfeuclic,NumTrameCDM, Algo_localisation,Verif_AdrXpressNet,ligneclicTrain,AncligneclicTrain,AntiTimeoutEthLenz, - ligneDCC,decCourant,AffMemoFenetre,ligneClicAccCOM,AncligneClicAccCOM,ligneCherche,compt_Ligne : integer; + ligneDCC,decCourant,AffMemoFenetre,ligneClicAccPeriph,AncligneClicAccPeriph,ligneCherche,compt_Ligne : integer; ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort, modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains,trouve_section_acccomusb, @@ -718,8 +727,10 @@ begin if Srvc_Aig then begin s:=s+'SRV=ATNT;';inc(i);end; // service changement aiguillage if Srvc_Act then begin s:=s+'SRV=AACT;';inc(i);end; // service actionneurs if Srvc_Det then begin s:=s+'SRV=ADET;';inc(i);end; // service détecteurs - if Srvc_Pos then begin s:=s+'SRV=TSXY;';inc(i);end ; // service position des trains + if Srvc_Pos then begin s:=s+'SRV=TSXY;';inc(i);end; // service position des trains if Srvc_Sig then begin s:=s+'SRV=ASIG;';inc(i);end; // service signaux + if Srvc_tdcc then begin s:=s+'SRV=TDCC;';inc(i);end; // service info train (si chgt vitesse) + // insère le nombre de paramètres ss:=format('%.*d',[2,i]) ; @@ -825,6 +836,7 @@ begin end; // vérifie si la config de la com série/usb est ok +// COM7:9600,n,8,1 function config_com(s : string) : boolean; var sa : string; i,erreur,vitesse : integer; @@ -877,7 +889,7 @@ begin i:=pos('COM',sa); if i<>0 then delete(sa,1,3); val(sa,Numport,erreur); - config_com:=not( (i=0) or (NumPort>MaxPortCom) or (prot_serie=-1) or (prot_serie>4) or (i=0) ); + config_com:=not( (i=0) or (prot_serie=-1) or (prot_serie>4) or (i=0) ); end; function encode_Periph(index : integer) : string; @@ -1174,388 +1186,368 @@ var s,chaine,sa : string; multiple,fini : boolean; begin decode_ligne_feux:=true; // pas de doublon - if i=0 then + if i=0 then + begin + AfficheDebug('Erreur 670 : index nul',clred); + exit; + end; + s:=chaine_signal; + j:=pos(',',s); + if j>1 then + 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 + for id:=1 to NbreFeux do + begin + if feux[id].adresse=adresse then begin - AfficheDebug('Erreur 670 : index nul',clred); + decode_ligne_feux:=false; exit; end; - s:=chaine_signal; - j:=pos(',',s); - if j>1 then + end; + inc(nbreFeux); + index_accessoire[adresse]:=i; + Delete(s,1,j); + feux[i].adresse:=adresse; + j:=pos(',',s); + if j>1 then + begin + sa:=copy(s,1,j-1); + if sa[1]='D' then + // feu directionnel ------------------------------------------ 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 - for id:=1 to NbreFeux do - begin - if feux[id].adresse=adresse then - begin - decode_ligne_feux:=false; - exit; - end; - end; - inc(nbreFeux); - index_accessoire[adresse]:=i; - - Delete(s,1,j); - feux[i].adresse:=adresse; + delete(sa,1,1); j:=pos(',',s); - if j>1 then + val(sa,l,erreur); // nombre de feux du signal directionnel + if l>6 then begin - sa:=copy(s,1,j-1); - if sa[1]='D' then - // feu directionnel ------------------------------------------ - begin - delete(sa,1,1); - j:=pos(',',s); - val(sa,l,erreur); // nombre de feux du signal directionnel - if l>6 then - begin - Affiche('Erreur 672 ligne '+chaine_signal+' 6 feux maximum pour un panneau directionnel',clred); - exit; - end; - feux[i].aspect:=l+10;Delete(s,1,j); - // décodeur - val(s,adr,erreur); - Feux[i].decodeur:=adr; - if (adr>NbDecodeur-1) then Affiche('Erreur 673 ligne '+chaine_signal+' : erreur décodeur inconnu',clred); - j:=pos(',',s);Delete(s,1,j); - // liste des aiguillages - k:=1; // numéro de feu directionnel - repeat - // boucle de direction - delete(s,1,1); // supprimer ( ou le , - j:=1; // Nombre de descriptions d'aiguillages dans le feu - repeat - if s[1]<>'A' then begin Affiche('Erreur 674 ligne '+chaine_signal,clred);exit;end; - delete(s,1,1); - val(s,adr,erreur); // adresse - c:=#0; - if erreur<>0 then c:=s[erreur]; // type - setlength(feux[i].AigDirection[k],j+1); // augmenter le tableau dynamique - feux[i].AigDirection[k][j].PosAig:=c; - feux[i].AigDirection[k][j].Adresse:=adr; - - delete(s,1,erreur); // supprime jusque S - //Affiche(s,clLime); - if s[1]=',' then delete(s,1,1); - inc(j); - until s[1]=')'; - delete(s,1,1); - inc(k); - until length(s)<1; - dec(k); - if k<>l+1 then - begin - Affiche('Erreur 675 ligne '+chaine_signal,clred); - Affiche('Nombre incorrect de description des aiguillages: '+intToSTR(k)+' pour '+intToSTR(l)+' feux directionnels',clred); - end; - end - else - // feu de signalisation--------------------------------- - begin - val(sa,asp,erreur); //aspect - if (asp<2) or (asp=6) or (asp=8) or (asp>20) then - begin - Affiche('Erreur 676: configuration aspect ('+intToSTR(asp)+') signal incorrect à la ligne '+chaine_signal,clRed); - asp:=2; - end; - feux[i].aspect:=asp;Delete(s,1,j); - j:=pos(',',s); - if j>1 then begin Feux[i].FeuBlanc:=(copy(s,1,j-1))='1';delete(s,1,j);end; - j:=pos(',',s); - val(s,Feux[i].decodeur,erreur); - - if (Feux[i].decodeur>NbDecodeurdeBase+NbreDecPers-1) then Affiche('Erreur 677 Ligne '+chaine_signal+' : erreur décodeur inconnu: '+intToSTR(Feux[i].decodeur),clred); - if j<>0 then delete(s,1,j); - feux[i].Adr_el_suiv1:=0;feux[i].Adr_el_suiv2:=0;feux[i].Adr_el_suiv3:=0;feux[i].Adr_el_suiv4:=0; - feux[i].Btype_Suiv1:=rien;feux[i].Btype_Suiv2:=rien;feux[i].Btype_Suiv3:=rien;feux[i].Btype_Suiv4:=rien; - feux[i].Adr_det1:=0;feux[i].Adr_det2:=0;feux[i].Adr_det3:=0;feux[i].Adr_det4:=0; - // éléments optionnels des voies supplémentaires - if j<>0 then - begin - sa:=s; - multiple:=s[1]='('; - if multiple then - begin - delete(s,1,1); - j:=0; - repeat - adr:=0; - k:=pos(',',s); - if k>1 then - begin - val(s,adr,erreur); // extraire l'adresse - Delete(s,1,k); - if Adr>NbMemZone then - begin - Affiche('Erreur 677A : ligne '+chaine_signal+' : adresse détecteur trop grand: '+intToSTR(adr),clred); - Adr:=NbMemZone; - end; - end; - inc(j); - if (j=1) then feux[i].Adr_det1:=adr; - if (j=2) then feux[i].Adr_det2:=adr; - if (j=3) then feux[i].Adr_det3:=adr; - if (j=4) then feux[i].Adr_det4:=adr; - //type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri - if s[1]='A' then - begin - if (j=1) then feux[i].Btype_Suiv1:=aig; - if (j=2) then feux[i].Btype_Suiv2:=aig; - if (j=3) then feux[i].Btype_Suiv3:=aig; - if (j=4) then feux[i].Btype_Suiv4:=aig; - delete(s,1,1); - end - else - begin // détecteur - if (j=1) then feux[i].Btype_Suiv1:=det; - if (j=2) then feux[i].Btype_Suiv2:=det; - if (j=3) then feux[i].Btype_Suiv3:=det; - if (j=4) then feux[i].Btype_Suiv4:=det; - end; - Val(s,adr,erreur); - if Adr>NbMemZone then - begin - Affiche('Erreur 677B : ligne '+chaine_signal+' : adresse élément trop grand: '+intToSTR(adr),clred); - Adr:=NbMemZone; - end; - - if (j=1) then feux[i].Adr_el_suiv1:=Adr; - if (j=2) then feux[i].Adr_el_suiv2:=Adr; - if (j=3) then feux[i].Adr_el_suiv3:=Adr; - if (j=4) then feux[i].Adr_el_suiv4:=Adr; - delete(s,1,erreur-1); - if s[1]=',' then delete(s,1,1); - fini:=s[1]=')'; - until (fini) or (j>4); - end; - end; - if (j>4) or (not(multiple)) then - begin - Affiche('Erreur 678: fichier de configuration ligne erronnée : '+chaine_signal,clred); - closefile(fichier); - exit; - end; - - k:=pos(',',s); - delete(s,1,k); - //Affiche('s='+s,clyellow); - if length(s)=0 then begin Affiche('Erreur 679: fichier de configuration ligne erronnée : '+chaine_signal,clred); closefile(fichier);exit;end; - feux[i].VerrouCarre:=s[1]='1'; + Affiche('Erreur 672 ligne '+chaine_signal+' 6 feux maximum pour un panneau directionnel',clred); + exit; + end; + feux[i].aspect:=l+10;Delete(s,1,j); + // décodeur + val(s,adr,erreur); + Feux[i].decodeur:=adr; + if (adr>NbDecodeur-1) then Affiche('Erreur 673 ligne '+chaine_signal+' : erreur décodeur inconnu',clred); + j:=pos(',',s);Delete(s,1,j); + // liste des aiguillages + k:=1; // numéro de feu directionnel + repeat + // boucle de direction + delete(s,1,1); // supprimer ( ou le , + j:=1; // Nombre de descriptions d'aiguillages dans le feu + repeat + if s[1]<>'A' then begin Affiche('Erreur 674 ligne '+chaine_signal,clred);exit;end; + delete(s,1,1); + val(s,adr,erreur); // adresse + c:=#0; + if erreur<>0 then c:=s[erreur]; // type + setlength(feux[i].AigDirection[k],j+1); // augmenter le tableau dynamique + feux[i].AigDirection[k][j].PosAig:=c; + feux[i].AigDirection[k][j].Adresse:=adr; + delete(s,1,erreur); // supprime jusque S + //Affiche(s,clLime); + if s[1]=',' then delete(s,1,1); + inc(j); + until s[1]=')'; delete(s,1,1); - if length(s)>0 then if s[1]=',' then delete(s,1,1); - if copy(s,1,3)='FVC' then - begin - delete(s,1,3); - if length(s)>0 then begin feux[i].checkFV:=s[1]='1';delete(s,1,1);end; - end; - if length(s)>0 then if s[1]=',' then delete(s,1,1); - if copy(s,1,3)='FRC' then - begin - delete(s,1,3); - if length(s)>0 then begin feux[i].checkFR:=s[1]='1';delete(s,1,1);end; - end; + inc(k); + until length(s)<1; + dec(k); + if k<>l+1 then + begin + Affiche('Erreur 675 ligne '+chaine_signal,clred); + Affiche('Nombre incorrect de description des aiguillages: '+intToSTR(k)+' pour '+intToSTR(l)+' feux directionnels',clred); + end; + end + else + // feu de signalisation--------------------------------- + begin + val(sa,asp,erreur); //aspect + if (asp<2) or (asp=6) or (asp=8) or (asp>20) then + begin + Affiche('Erreur 676: configuration aspect ('+intToSTR(asp)+') signal incorrect à la ligne '+chaine_signal,clRed); + asp:=2; + end; + feux[i].aspect:=asp;Delete(s,1,j); + j:=pos(',',s); + if j>1 then begin Feux[i].FeuBlanc:=(copy(s,1,j-1))='1';delete(s,1,j);end; + j:=pos(',',s); + val(s,Feux[i].decodeur,erreur); - if length(s)>0 then if s[1]=',' then delete(s,1,1); - if length(s)>0 then + if (Feux[i].decodeur>NbDecodeurdeBase+NbreDecPers-1) then Affiche('Erreur 677 Ligne '+chaine_signal+' : erreur décodeur inconnu: '+intToSTR(Feux[i].decodeur),clred); + if j<>0 then delete(s,1,j); + feux[i].Adr_el_suiv1:=0;feux[i].Adr_el_suiv2:=0;feux[i].Adr_el_suiv3:=0;feux[i].Adr_el_suiv4:=0; + feux[i].Btype_Suiv1:=rien;feux[i].Btype_Suiv2:=rien;feux[i].Btype_Suiv3:=rien;feux[i].Btype_Suiv4:=rien; + feux[i].Adr_det1:=0;feux[i].Adr_det2:=0;feux[i].Adr_det3:=0;feux[i].Adr_det4:=0; + // éléments optionnels des voies supplémentaires + if j<>0 then + begin + sa:=s; + multiple:=s[1]='('; + if multiple then begin - if copy(s,1,2)='NA' then - begin - delete(s,1,2); - val(s,j,erreur); - delete(s,1,1); - if (j<2) or (j>5) then + delete(s,1,1); + j:=0; + repeat + adr:=0; + k:=pos(',',s); + if k>1 then begin - j:=5;affiche('Paramètre NA incorrect dans ligne '+chaine_signal,clred) - end; - feux[i].na:=j; - end; - end; - - if length(s)>0 then if s[1]=',' then delete(s,1,1); - if length(s)>0 then - begin - if copy(s,1,3)='VCV' then - begin - delete(s,1,3); - val(s,j,erreur); - delete(s,1,1); - if (j<0) or (j>1) then - begin - j:=0;affiche('Paramètre VCV incorrect dans ligne '+chaine_signal,clred) - end; - feux[i].verscontrevoie:=j=1; - end; - end; - - if length(s)>0 then if s[1]=',' then delete(s,1,1); - if length(s)>0 then - begin - if copy(s,1,2)='CV' then - begin - delete(s,1,2); - val(s,j,erreur); - delete(s,1,1); - if (j<0) or (j>1) then - begin - j:=0;affiche('Paramètre CV incorrect dans ligne '+chaine_signal,clred) - end; - feux[i].contrevoie:=j=1; - end; - end; - - - if length(s)>0 then if s[1]='U' then delete(s,1,1); - - // si décodeur UniSemaf (6) champ supplémentaire U - if (Feux[i].decodeur=6) then - begin - Val(s,k,erreur); - delete(s,1,erreur); - if k=0 then - begin - if Feux[i].decodeur=6 then begin Affiche('Erreur 680 Ligne '+chaine_signal+' Manque définition décodeur UniSemaf signal '+intToSTR(adresse),clred);end; - end - else - begin - Feux[i].UniSemaf:=k; - if Feux[i].decodeur=6 then - begin - erreur:=verif_UniSemaf(adresse,k); - if erreur=1 then begin Affiche('Erreur 681 Ligne '+chaine_signal+' Erreur code Unisemaf',clred);end; - if erreur=2 then - begin - Affiche('Erreur 682 Ligne '+chaine_signal+' Erreur cohérence signal (Adresse='+intToSTR(adresse)+' Aspect='+intToSTR(asp)+' et code Unisemaf=('+intToSTR(k)+')',clred); - end; - end; - end; - end; - end; - - // voir si conditions supplémentaires de carré - l:=1; // nombre de parenthèses - repeat - t:=pos('(',s); - if t=1 then - begin - //Affiche('Conditions supplémentaires pour le feu '+IntToSTR(adresse)+' parenthèse '+intToSTR(l),clyellow); - k:=pos(')',s); - sa:=copy(s,t+1,k-t); // contient l'intérieur des parenthèses sans les parenthèses - delete(s,1,k+1);//Affiche(s,clYellow); - - // boucle dans la parenthèse - bd:=0; - repeat - inc(bd); - setlength(feux[i].condCarre[l],bd+1); // une condition en plus - k:=pos(',',sa); - if k<>0 then - chaine:=copy(sa,1,k-1) - else - chaine:=sa; - - if chaine[1]='A' then + val(s,adr,erreur); // extraire l'adresse + Delete(s,1,k); + if Adr>NbMemZone then begin - delete(chaine,1,1); - val(chaine,adresse,erreur); - feux[i].condCarre[l][bd].Adresse:=adresse; - if erreur<>0 then feux[i].condCarre[l][bd].PosAig:=chaine[erreur] else - Affiche('Erreur 683 Définition du signal '+IntToSTR(feux[i].adresse)+': Manque D ou S dans les conditions de carré des aiguillages',clred); + Affiche('Erreur 677A : ligne '+chaine_signal+' : adresse détecteur trop grand: '+intToSTR(adr),clred); + Adr:=NbMemZone; end; - - k:=pos(',',sa);if k<>0 then delete(sa,1,k); - until k=0; - inc(l); - end; - until t<>1; - if length(s)>1 then if s[1]=',' then delete(s,1,1); - - // si conditions supplémentaires de feu blanc (CFB) - l:=1; // nombre de parenthèses - repeat - t:=pos('CFB(',s); - if t=1 then - begin - //Affiche('Conditions supplémentaires pour le feu '+IntToSTR(adresse)+' parenthèse '+intToSTR(l),clyellow); - k:=pos(')',s); - sa:=copy(s,t+4,k-4); // contient l'intérieur des parenthèses sans les parenthèses - delete(s,1,k+1);//Affiche(s,clYellow); - - // boucle dans la parenthèse - bd:=0; - repeat - inc(bd); - setlength(feux[i].condFeuBlanc[l],bd+1); // une condition en plus - k:=pos(',',sa); - if k<>0 then - chaine:=copy(sa,1,k-1) // premier champ () - else // le reste - chaine:=sa; - - if chaine[1]='A' then - begin - delete(chaine,1,1); - val(chaine,adresse,erreur); - feux[i].condFeuBlanc[l][bd].Adresse:=adresse; - if erreur<>0 then feux[i].condFeuBlanc[l][bd].PosAig:=chaine[erreur] else - Affiche('Erreur 683 Définition du signal '+IntToSTR(feux[i].adresse)+': Manque D ou S dans les conditions de feu blanc des aiguillages',clred); - end; - - k:=pos(',',sa);if k<>0 then delete(sa,1,k); - until k=0; - inc(l); - end; - until t<>1; - if length(s)>1 then if s[1]=',' then delete(s,1,1); - - // champ SR - if length(s)>2 then - if copy(s,1,2)='SR' then - begin - delete(s,1,3); - for l:=1 to 8 do - begin - k:=pos(',',s); - val(s,j,erreur); - delete(s,1,k); - feux[i].SR[l].sortie1:=j; - - k:=pos(',',s); - val(s,j,erreur); - delete(s,1,k); - feux[i].SR[l].sortie0:=j; - end; - end; - - // champ motif - if length(s)>3 then - if copy(s,1,3)='MOT' then - begin - delete(s,1,4); - for l:=1 to 19 do - begin - k:=pos(',',s); - val(s,j,erreur); - delete(s,1,k); - feux[i].SR[l].sortie1:=j; - end; - j:=pos('NA',s); - if j<>1 then affiche('Manque paramètre NA dans ligne '+chaine_signal,clred) - else - begin - delete(s,1,2); - val(s,j,erreur); - if (j<0) or (j>5) then - begin - j:=5;affiche('Paramètre NA incorrect dans ligne '+chaine_signal,clred) end; - feux[i].na:=j; + inc(j); + if (j=1) then feux[i].Adr_det1:=adr; + if (j=2) then feux[i].Adr_det2:=adr; + if (j=3) then feux[i].Adr_det3:=adr; + if (j=4) then feux[i].Adr_det4:=adr; + //type de l'élément suivant (1=détecteur 2=aig ou TJD ou TJS 4=tri + if s[1]='A' then + begin + if (j=1) then feux[i].Btype_Suiv1:=aig; + if (j=2) then feux[i].Btype_Suiv2:=aig; + if (j=3) then feux[i].Btype_Suiv3:=aig; + if (j=4) then feux[i].Btype_Suiv4:=aig; + delete(s,1,1); + end + else + begin // détecteur + if (j=1) then feux[i].Btype_Suiv1:=det; + if (j=2) then feux[i].Btype_Suiv2:=det; + if (j=3) then feux[i].Btype_Suiv3:=det; + if (j=4) then feux[i].Btype_Suiv4:=det; + end; + Val(s,adr,erreur); + if Adr>NbMemZone then + begin + Affiche('Erreur 677B : ligne '+chaine_signal+' : adresse élément trop grand: '+intToSTR(adr),clred); + Adr:=NbMemZone; + end; + if (j=1) then feux[i].Adr_el_suiv1:=Adr; + if (j=2) then feux[i].Adr_el_suiv2:=Adr; + if (j=3) then feux[i].Adr_el_suiv3:=Adr; + if (j=4) then feux[i].Adr_el_suiv4:=Adr; + delete(s,1,erreur-1); + if s[1]=',' then delete(s,1,1); + fini:=s[1]=')'; + until (fini) or (j>4); + end; + end; + if (j>4) or (not(multiple)) then + begin + Affiche('Erreur 678: fichier de configuration ligne erronnée : '+chaine_signal,clred); + closefile(fichier); + exit; + end; + k:=pos(',',s); + delete(s,1,k); + //Affiche('s='+s,clyellow); + if length(s)=0 then begin Affiche('Erreur 679: fichier de configuration ligne erronnée : '+chaine_signal,clred); closefile(fichier);exit;end; + feux[i].VerrouCarre:=s[1]='1'; + delete(s,1,1); + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if copy(s,1,3)='FVC' then + begin + delete(s,1,3); + if length(s)>0 then begin feux[i].checkFV:=s[1]='1';delete(s,1,1);end; + end; + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if copy(s,1,3)='FRC' then + begin + delete(s,1,3); + if length(s)>0 then begin feux[i].checkFR:=s[1]='1';delete(s,1,1);end; + end; + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if length(s)>0 then + begin + if copy(s,1,2)='NA' then + begin + delete(s,1,2); + val(s,j,erreur); + delete(s,1,1); + if (j<2) or (j>5) then + begin + j:=5;affiche('Paramètre NA incorrect dans ligne '+chaine_signal,clred) + end; + feux[i].na:=j; + end; + end; + + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if length(s)>0 then + begin + if copy(s,1,3)='VCV' then + begin + delete(s,1,3); + val(s,j,erreur); + delete(s,1,1); + if (j<0) or (j>1) then + begin + j:=0;affiche('Paramètre VCV incorrect dans ligne '+chaine_signal,clred) + end; + feux[i].verscontrevoie:=j=1; + end; + end; + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if length(s)>0 then + begin + if copy(s,1,2)='CV' then + begin + delete(s,1,2); + val(s,j,erreur); + delete(s,1,1); + if (j<0) or (j>1) then + begin + j:=0;affiche('Paramètre CV incorrect dans ligne '+chaine_signal,clred) + end; + feux[i].contrevoie:=j=1; + end; + end; + if length(s)>0 then if s[1]='U' then delete(s,1,1); + // si décodeur UniSemaf (6) champ supplémentaire U + if (Feux[i].decodeur=6) then + begin + Val(s,k,erreur); + delete(s,1,erreur); + if k=0 then + begin + if Feux[i].decodeur=6 then begin Affiche('Erreur 680 Ligne '+chaine_signal+' Manque définition décodeur UniSemaf signal '+intToSTR(adresse),clred);end; + end + else + begin + Feux[i].UniSemaf:=k; + if Feux[i].decodeur=6 then + begin + erreur:=verif_UniSemaf(adresse,k); + if erreur=1 then begin Affiche('Erreur 681 Ligne '+chaine_signal+' Erreur code Unisemaf',clred);end; + if erreur=2 then + begin + Affiche('Erreur 682 Ligne '+chaine_signal+' Erreur cohérence signal (Adresse='+intToSTR(adresse)+' Aspect='+intToSTR(asp)+' et code Unisemaf=('+intToSTR(k)+')',clred); + end; end; end; end; end; + // voir si conditions supplémentaires de carré + l:=1; // nombre de parenthèses + repeat + t:=pos('(',s); + if t=1 then + begin + //Affiche('Conditions supplémentaires pour le feu '+IntToSTR(adresse)+' parenthèse '+intToSTR(l),clyellow); + k:=pos(')',s); + sa:=copy(s,t+1,k-t); // contient l'intérieur des parenthèses sans les parenthèses + delete(s,1,k+1);//Affiche(s,clYellow); + // boucle dans la parenthèse + bd:=0; + repeat + inc(bd); + setlength(feux[i].condCarre[l],bd+1); // une condition en plus + k:=pos(',',sa); + if k<>0 then chaine:=copy(sa,1,k-1) else chaine:=sa; + if chaine[1]='A' then + begin + delete(chaine,1,1); + val(chaine,adresse,erreur); + feux[i].condCarre[l][bd].Adresse:=adresse; + if erreur<>0 then feux[i].condCarre[l][bd].PosAig:=chaine[erreur] else + Affiche('Erreur 683 Définition du signal '+IntToSTR(feux[i].adresse)+': Manque D ou S dans les conditions de carré des aiguillages',clred); + end; + k:=pos(',',sa);if k<>0 then delete(sa,1,k); + until k=0; + inc(l); + end; + until t<>1; + if length(s)>1 then if s[1]=',' then delete(s,1,1); + + // si conditions supplémentaires de feu blanc (CFB) + l:=1; // nombre de parenthèses + repeat + t:=pos('CFB(',s); + if t=1 then + begin + //Affiche('Conditions supplémentaires pour le feu '+IntToSTR(adresse)+' parenthèse '+intToSTR(l),clyellow); + k:=pos(')',s); + sa:=copy(s,t+4,k-4); // contient l'intérieur des parenthèses sans les parenthèses + delete(s,1,k+1);//Affiche(s,clYellow); + + // boucle dans la parenthèse + bd:=0; + repeat + inc(bd); + setlength(feux[i].condFeuBlanc[l],bd+1); // une condition en plus + k:=pos(',',sa); + if k<>0 then chaine:=copy(sa,1,k-1) // premier champ () + else // le reste + chaine:=sa; + if chaine[1]='A' then + begin + delete(chaine,1,1); + val(chaine,adresse,erreur); + feux[i].condFeuBlanc[l][bd].Adresse:=adresse; + if erreur<>0 then feux[i].condFeuBlanc[l][bd].PosAig:=chaine[erreur] else + Affiche('Erreur 683 Définition du signal '+IntToSTR(feux[i].adresse)+': Manque D ou S dans les conditions de feu blanc des aiguillages',clred); + end; + k:=pos(',',sa);if k<>0 then delete(sa,1,k); + until k=0; + inc(l); + end; + until t<>1; + if length(s)>1 then if s[1]=',' then delete(s,1,1); + + // champ SR + if length(s)>2 then + if copy(s,1,2)='SR' then + begin + delete(s,1,3); + for l:=1 to 8 do + begin + k:=pos(',',s); + val(s,j,erreur); + delete(s,1,k); + feux[i].SR[l].sortie1:=j; + + k:=pos(',',s); + val(s,j,erreur); + delete(s,1,k); + feux[i].SR[l].sortie0:=j; + end; + end; + + // champ motif + if length(s)>3 then if copy(s,1,3)='MOT' then + begin + delete(s,1,4); + for l:=1 to 19 do + begin + k:=pos(',',s); + val(s,j,erreur); + delete(s,1,k); + feux[i].SR[l].sortie1:=j; + end; + j:=pos('NA',s); + if j<>1 then affiche('Manque paramètre NA dans ligne '+chaine_signal,clred) + else + begin + delete(s,1,2); + val(s,j,erreur); + if (j<0) or (j>5) then + begin + j:=5;affiche('Paramètre NA incorrect dans ligne '+chaine_signal,clred) + end; + feux[i].na:=j; + end; + end; + end; + end; end; // transforme l'actionneur type loco ou actionneur ou son du tableau en texte @@ -1569,20 +1561,11 @@ begin // type déclencheur case Tablo_Actionneur[i].typdeclenche of - 0 : - begin - s:=IntToSTR(adresse);// if tablo_actionneur[i].det then s:=s+'Z'; - end; - // type mémoire de zone - 3 : - begin - s:='Mem['+IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].adresse2)+']'; - end; - // type aiguillage - 2 : - begin - s:='A'+IntToSTR(adresse); - end; + 0 : s:=IntToSTR(adresse);// if tablo_actionneur[i].det then s:=s+'Z'; + // type mémoire de zone + 3 : s:='Mem['+IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].adresse2)+']'; + // type aiguillage + 2 : s:='A'+IntToSTR(adresse); end; if Tablo_Actionneur[i].loco then @@ -1691,6 +1674,7 @@ begin writeln(fichierN,Algo_localisation_ch+'=',Algo_localisation); writeln(fichierN,Avec_roulage_ch+'=',avecRoulage); writeln(fichierN,debug_ch+'=',debug); + writeln(fichierN,PortServeur_ch+'=',PortServeur); writeln(fichierN,Filtrage_det_ch+'=',filtrageDet0); writeln(fichierN,AntiTimeoutEthLenz_ch+'=',AntiTimeoutEthLenz); // taille de la fonte @@ -1812,6 +1796,9 @@ begin // algorithme Unisemaf writeln(fichierN,Algo_unisemaf_ch+'=',IntToSTR(algo_Unisemaf)); + if AvecResa then s:='1' else s:='0'; + writeln(fichierN,ModeResa_ch+'='+s); + // aiguillages writeln(fichierN,'/------------'); writeln(fichierN,section_aig_ch); @@ -1977,6 +1964,7 @@ var s,sa,SOrigine: string; virgule,i_detect,i,erreur,aig2,detect,offset,j,position, ComptEl,Compt_IT,Num_Element,adr,Nligne,postriple,itl, postjd,postjs,nv,it,Num_Champ,asp,adraig,poscroi : integer; + tabloDet : TTabloDet; function lit_ligne : string ; var esp,l1,l2 : integer; @@ -2912,6 +2900,20 @@ var s,sa,SOrigine: string; val(s,debug,erreur); end; + sa:=uppercase(PortServeur_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + delete(s,i,length(sa)); + val(s,portServeur,erreur); + if (portServeur<1) or (portServeur>65535) then + begin + Affiche('Erreur port serveur : '+intToSTR(portServeur),clred); + portServeur:=5000; + end; + end; + + sa:=uppercase(Verif_AdrXpressNet_ch)+'='; i:=pos(sa,s); if i=1 then @@ -3064,6 +3066,7 @@ var s,sa,SOrigine: string; Srvc_det:=testbit(i,2); Srvc_pos:=testbit(i,3); Srvc_sig:=testbit(i,4); + Srvc_tdcc:=false; end; // adresse ip et port de la centrale @@ -3144,12 +3147,9 @@ var s,sa,SOrigine: string; delete(s,i,length(sa)); trouve_Entete:=true; val(s,Valeur_entete,erreur); - entete:=''; - case Valeur_entete of - 0 : begin entete:='';suffixe:='';end; - 1 : begin entete:=#$FF+#$FE;suffixe:='';end; - end; - if (erreur<>0) or (valeur_entete>1) then Affiche('Erreur déclaration variable '+entete_ch,clred); + entete:='';suffixe:=''; + if Valeur_entete=1 then begin entete:=#$FF+#$FE;suffixe:='';end; + if (erreur<>0) or (valeur_entete>1) then Affiche('Erreur déclaration '+entete_ch,clred); end; // avec ou sans initialisation des aiguillages @@ -3185,7 +3185,7 @@ var s,sa,SOrigine: string; AvecDemandeInterfaceUSB:=s='1'; end; - // avec demande de connexion en ethernet au démarrage + // avec demande de connexion en ethernet au démarrage sa:=uppercase(Init_dem_interfaceEth_ch)+'='; i:=pos(sa,s); if i=1 then @@ -3208,7 +3208,7 @@ var s,sa,SOrigine: string; if fenetre=1 then Formprinc.windowState:=wsMaximized; end; - // mémo fenetre + // mémo fenetre sa:=uppercase(AffMemoFenetre_ch)+'='; i:=pos(sa,s); if i=1 then @@ -3366,6 +3366,15 @@ var s,sa,SOrigine: string; NomModuleCDM:=s; end; + sa:=uppercase(ModeResa_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + inc(nv); + delete(s,1,length(sa)); + AvecResa:=s='1' + end; + sa:=uppercase(SERVEUR_INTERFACE_ch)+'='; i:=pos(sa,s); if i=1 then @@ -3614,6 +3623,7 @@ begin Srvc_Det:=true; Srvc_Pos:=false; Srvc_Sig:=false; + Srvc_tdcc:=false; TimoutMaxInterface:=7; AvecInitAiguillages:=true; AvecDemandeInterfaceUSB:=true; @@ -3678,17 +3688,14 @@ begin if not(trouve_section_sig) then Affiche('Manque section '+section_sig_ch,clred); if not(trouve_section_branche) then Affiche('Manque section '+section_branches_ch,clred); - // fenetre - { - if largeurF>0 then formPrinc.width:=LargeurF; - if HauteurF>0 then formPrinc.Height:=hauteurF; - formPrinc.left:=offsetXF; - formPrinc.top:=offsetYF; - if (PosSplitter>0) and (PosSPlitter65535 then begin labelInfo.Caption:='Port CDM rail incorrect';ok:=false;end; + if (i>65535) or (i<0) then begin labelInfo.Caption:='Port CDM rail incorrect';ok:=false;end; changeCDM:=(portCDM<>i) or ChangeCDM; portCDM:=i; @@ -3738,6 +3745,10 @@ begin if CheckBoxVerifXpressNet.checked then Verif_AdrXpressNet:=1 else Verif_AdrXpressNet:=0; + Val(EditPortServeur.Text,i,erreur); + if (i<1) or (i>65535) then i:=4500; + portServeur:=i; + if checkRoulage.Checked then begin AvecRoulage:=1; @@ -3823,14 +3834,6 @@ begin connecte_USB; end; - { - if changeUSBcde then - begin - deconnecte_USB_cde(1); // &&& a revoir - connecte_port_usb_cde(1); - end; - } - verifVersion:=CheckVerifVersion.Checked; notificationVersion:=CheckInfoVersion.Checked; @@ -3899,7 +3902,7 @@ begin end; procedure TFormConfig.ButtonAppliquerEtFermerClick(Sender: TObject); -var ok : boolean; +var ok : boolean; begin ok:=verifie_panneau_config; if ok then @@ -3986,6 +3989,7 @@ begin EditFonte.text:=IntToSTR(TailleFonte); editdebug.Text:=IntToSTR(debug); CheckBoxVerifXpressNet.Checked:=Verif_AdrXpressNet=1; + editPortServeur.Text:=intToSTR(portServeur); checkRoulage.Checked:=AvecRoulage=1; EditTempoOctetUSB.text:=IntToSTR(TempoOctet); EditTempoReponse.Text:=IntToSTR(TimoutMaxInterface); @@ -3999,6 +4003,7 @@ begin SpeedButtonJoue.Top:=60; SpeedButtonCharger.Top:=60; EditSon.Top:=38;EditSon.Left:=16; + CheckBoxResa.Checked:=AvecResa; CheckVerifVersion.Checked:=verifVersion; CheckFenEt.Checked:=Fenetre=1; CheckInfoVersion.Checked:=notificationVersion; @@ -4168,98 +4173,92 @@ end; procedure maj_decodeurs; var nAdr,i,j,a,nation,typ : integer; begin + // si pas de décodeur courant, on rend invisible toutes les adresses + if decCourant=0 then nAdr:=0 else begin - // si pas de décodeur courant, on rend invisible toutes les adresses - if decCourant=0 then nAdr:=0 else + formConfig.ComboBoxNation.itemindex:=decodeur_pers[decCourant].nation-1; + nAdr:=decodeur_pers[decCourant].NbreAdr; + FormConfig.EditNbreAdr.Text:=intToSTR(decodeur_pers[decCourant].NbreAdr); + nation:=decodeur_pers[decCourant].nation; + typ:=decodeur_pers[decCourant].commande; //0=centrale 1=com/usb + end; + + if typ=0 then + begin + for i:=1 to nAdr do begin - formConfig.ComboBoxNation.itemindex:=decodeur_pers[decCourant].nation-1; - nAdr:=decodeur_pers[decCourant].NbreAdr; - FormConfig.EditNbreAdr.Text:=intToSTR(decodeur_pers[decCourant].NbreAdr); - nation:=decodeur_pers[decCourant].nation; - typ:=decodeur_pers[decCourant].commande; //0=centrale 1=com/usb - end; - - if typ=0 then - begin - for i:=1 to nAdr do + comboL1[i].Items.Clear; + comboL2[i].Items.Clear; + if nation=1 then begin - comboL1[i].Items.Clear; - comboL2[i].Items.Clear; - if nation=1 then + for j:=0 to 20 do begin - for j:=0 to 20 do - begin - comboL1[i].Items.add(Etats[j]); - comboL2[i].Items.add(Etats[j]); - end; - end - else - for j:=0 to 9 do - begin - begin - comboL1[i].Items.add(EtatSignBelge[j]); - comboL2[i].Items.add(EtatSignBelge[j]); - end; - end; - a:=decodeur_pers[decCourant].desc[i].etat1; - ComboL1[i].itemIndex:=a; - ComboL1[i].Visible:=true; - - a:=decodeur_pers[decCourant].desc[i].etat2; - ComboL2[i].Itemindex:=a; - ComboL2[i].Visible:=true; - - EditT[i].Text:=intToSTR(decodeur_pers[decCourant].desc[i].offsetAdresse); - EditT[i].Visible:=true; - a:=decodeur_pers[decCourant].desc[i].sortie1; - ComboTS1[i].Itemindex:=a-1; - ComboTS1[i].Visible:=true; - a:=decodeur_pers[decCourant].desc[i].sortie2; - ComboTS2[i].Itemindex:=a-1; - ComboTS2[i].Visible:=true; - ShapeT[i].Visible:=true; - - end; - - for i:=nADr+1 to 10 do + comboL1[i].Items.add(Etats[j]); + comboL2[i].Items.add(Etats[j]); + end; + end + else + for j:=0 to 9 do begin - ComboL1[i].Visible:=false; - ComboL2[i].Visible:=false; - EditT[i].Visible:=false; - ComboTS1[i].Visible:=false; - ComboTS2[i].Visible:=false; - ShapeT[i].Visible:=false; + begin + comboL1[i].Items.add(EtatSignBelge[j]); + comboL2[i].Items.add(EtatSignBelge[j]); + end; end; - end; + a:=decodeur_pers[decCourant].desc[i].etat1; + ComboL1[i].itemIndex:=a; + ComboL1[i].Visible:=true; + + a:=decodeur_pers[decCourant].desc[i].etat2; + ComboL2[i].Itemindex:=a; + ComboL2[i].Visible:=true; + + EditT[i].Text:=intToSTR(decodeur_pers[decCourant].desc[i].offsetAdresse); + EditT[i].Visible:=true; + a:=decodeur_pers[decCourant].desc[i].sortie1; + ComboTS1[i].Itemindex:=a-1; + ComboTS1[i].Visible:=true; + a:=decodeur_pers[decCourant].desc[i].sortie2; + ComboTS2[i].Itemindex:=a-1; + ComboTS2[i].Visible:=true; + ShapeT[i].Visible:=true; + end; + for i:=nADr+1 to 10 do + begin + ComboL1[i].Visible:=false; + ComboL2[i].Visible:=false; + EditT[i].Visible:=false; + ComboTS1[i].Visible:=false; + ComboTS2[i].Visible:=false; + ShapeT[i].Visible:=false; + end; + end; - FormConfig.RadioCdeDec.ItemIndex:=typ; if typ=0 then Champs_Dec_Centrale; if typ=1 then Champs_dec_Com; - end; - end; procedure TformConfig.Bt_onclick(sender : TObject); begin - liste_portcom; + liste_portcom; end; procedure TformConfig.cb_onclick(sender : TObject); var s : string; cb : TCheckBox; begin - if clicliste or (ligneClicAccCOM<0) then exit; + if clicliste or (ligneClicAccPeriph<0) then exit; cb:=(sender as Tcheckbox); s := cb.Name; - if pos('Aig',s)<>0 then Tablo_periph[ligneClicAccCOM+1].ScvAig:=cb.Checked; - if pos('Det',s)<>0 then Tablo_periph[ligneClicAccCOM+1].ScvDet:=cb.Checked; - if pos('Act',s)<>0 then Tablo_periph[ligneClicAccCOM+1].ScvAct:=cb.Checked; - if pos('Vis',s)<>0 then Tablo_periph[ligneClicAccCOM+1].ScvVis:=cb.Checked; - if s='CheckBoxCR' then Tablo_periph[ligneClicAccCOM+1].CR:=cb.Checked; - s:=encode_Periph(ligneClicAccCOM+1); - ListBoxPeriph.Items[ligneClicAccCOM]:=s; - ListBoxPeriph.Selected[ligneClicAccCOM]:=true; + if pos('Aig',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvAig:=cb.Checked; + if pos('Det',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvDet:=cb.Checked; + if pos('Act',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvAct:=cb.Checked; + if pos('Vis',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvVis:=cb.Checked; + if s='CheckBoxCR' then Tablo_periph[ligneClicAccPeriph+1].CR:=cb.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; end; // ajoute les champs des périphériques dans les combos @@ -4299,27 +4298,28 @@ begin end; -// met à jour le nom d'un champ d'index i dans les combos +// met à jour le nom d'un champ d'index i dans les combos des périphériques procedure maj_champs_combos(i: integer); var j,n : integer; s : string; begin j:=com_socket(i); - if j=1 then s:=Tablo_periph[i].nom+' (COM'+intToSTR(Tablo_periph[i].NumCom)+')'; - if j=2 then s:=Tablo_periph[i].nom+' ('+Tablo_periph[i].protocole+')'; + s:=Tablo_periph[i].nom; + if j=1 then s:=s+' (COM'+intToSTR(Tablo_periph[i].NumCom)+')'; + if j=2 then s:=s+Tablo_periph[i].nom+' ('+Tablo_periph[i].protocole+')'; with formconfig do begin n:=comboBoxACCComUSB.Items.Count; if n=0 then exit; - if nNbPeriph) then exit; clicliste:=true; @@ -8125,7 +8130,7 @@ begin for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin - if TCO[indexTCO,x,y].BImage=Id_Signal then // &&& balayer tous les tco + if TCO[indexTCO,x,y].BImage=Id_Signal then begin AdresseFeu:=feux[index].adresse; if tco[IndexTCO,x,y].Adresse=AdresseFeu then affiche_tco(indexTCO); @@ -8231,7 +8236,7 @@ begin Tablo_Actionneur[i].Act:=true; Tablo_Actionneur[i].Son:=false; Tablo_Actionneur[i].periph:=false; - champs_type_act; + champs_type_act; val(editact.Text,champ,erreur); Tablo_actionneur[i].adresse:=champ ; @@ -8439,13 +8444,10 @@ begin s:=encode_act_PN(lignecliqueePN+1); ListBoxPN.items[lignecliqueePN]:=s; ListBoxPN.selected[lignecliqueePN]:=true; - end; end; - - procedure ajoute_actionneur; var s: string; i : integer; @@ -11769,29 +11771,34 @@ begin clicListe:=false; end; -procedure TFormConfig.ButtonPFCDMClick(Sender: TObject); - var i : integer; +procedure regle(nom,chemin : string); +var i : integer; s : string; r : boolean; begin - i:=verifie_regle; + i:=verifie_regle(nom); if i=0 then begin - r:=cree_regle; + r:=cree_regle(nom,chemin); if r then begin - s:='La règle d''autorisation CDM rail a été ajoutée dans le pare-feu '; + s:='La règle d''autorisation '+nom+' a été ajoutée dans le pare-feu '; Affiche(s,clyellow); - i:=verifie_regle; - end; + i:=verifie_regle(nom); + end; end; - if i=0 then s:='La règle d''autorisation CDM rail n''a pas été trouvée dans le pare-feu '; - if i=1 then s:='La règle d''autorisation CDM rail a été trouvée dans le pare-feu mais elle est désactivée'; - if i=2 then s:='La règle d''autorisation CDM rail a été trouvée dans le pare-feu et elle est activée'; + if i=0 then s:='La règle d''autorisation '+nom+' n''a pas été trouvée dans le pare-feu '; + if i=1 then s:='La règle d''autorisation '+nom+' a été trouvée dans le pare-feu mais elle est désactivée'; + if i=2 then s:='La règle d''autorisation '+nom+' a été trouvée dans le pare-feu et elle est activée'; Affiche(s,clyellow); - formconfig.Labelinfo.caption:=s; +end; + +procedure TFormConfig.ButtonPFCDMClick(Sender: TObject); + begin activecontrol:=nil; + regle('CDM rail','\CDM-Rail\cdr.exe'); + regle('Signaux complexes','\Signaux_complexes\signaux_complexes_gl.exe'); end; procedure TFormConfig.EditLAYChange(Sender: TObject); @@ -12616,8 +12623,8 @@ var ss,s : string; end; end; MemoPeriph.Clear; - ligneclicAccCom:=-1; - AncligneclicAccCom:=-1; + ligneClicAccPeriph:=-1; + AncligneClicAccPeriph:=-1; clicliste:=false; end; @@ -12627,7 +12634,7 @@ var i : integer; begin if NbPeriph>=NbMaxi_Periph then begin - Affiche('Nombre maximal de périphériques COM/USB sockets',clRed); + formconfig.labelInfo.caption:='Nombre maximal de périphériques COM/USB sockets'; exit; end; clicliste:=true; @@ -12654,13 +12661,17 @@ begin end; formconfig.LabelInfo.caption:='Périphérique COM/USB/Socket créé'; - ligneClicAccCOM:=i-1; - AncligneClicAccCOM:=ligneClicAccCom; - Aff_champs_accCOMUSB_tablo(i); + ligneClicAccPeriph:=i-1; + AncligneClicAccPeriph:=ligneClicAccPeriph; + Aff_champs_accPeriph_tablo(i); s:='Nouveau périphérique'; formConfig.ComboBoxAccComUSB.Items.Add(s); formconfig.ComboBoxPNCom.Items.Add(s); - formconfig.EditNomPeriph.text:=s; + formconfig.ComboBoxDecCde.Items.Add(s); + + maj_champs_combos(i); + + formconfig.EditNomPeriph.text:=s; clicliste:=false; config_modifie:=true; end; @@ -12739,16 +12750,16 @@ end; procedure TFormConfig.EditNomPeriphChange(Sender: TObject); var s : string; begin - if clicliste or (ligneClicAccCOM<0) then exit; + if clicliste or (ligneClicAccPeriph<0) then exit; if affevt then affiche('Evt Edit act Change',clyellow); with Formconfig do begin s:=EditNomPeriph.Text; - Tablo_periph[ligneClicAccCOM+1].nom:=s; - maj_champs_combos(ligneClicAccCOM+1); - s:=encode_Periph(ligneClicAccCOM+1); - ListBoxPeriph.Items[ligneClicAccCOM]:=s; - ListBoxPeriph.Selected[ligneClicAccCOM]:=true; + Tablo_periph[ligneClicAccPeriph+1].nom:=s; + maj_champs_combos(ligneClicAccPeriph+1); + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; end; end; @@ -12767,15 +12778,15 @@ begin s:=Uppercase(items[lc]); // ligne cliquée if s='' then begin - ligneclicAccCom:=-1; + ligneClicAccPeriph:=-1; exit; end; - AncligneclicAccCom:=ligneclicAccCom; - ligneclicAccCom:=lc; + AncligneClicAccPeriph:=ligneClicAccPeriph; + ligneClicAccPeriph:=lc; end; - Aff_champs_accCOMUSB_tablo(lc+1); + Aff_champs_accPeriph_tablo(lc+1); s:=utilisateurs_peripheriques; MemoPeriph.Clear; repeat @@ -12820,13 +12831,13 @@ begin if affevt then affiche('Evt ListBoxPeriph.Items keydown',clyellow); with Formconfig.ListBoxPeriph.Items do begin - if ligneclicAccCom>0 then + if ligneClicAccPeriph>0 then begin - AncligneclicAccCom:=ligneclicAccCom; - dec(ligneclicAccCom); - if AncligneclicAccCom<>ligneclicAccCom then + AncligneClicAccPeriph:=ligneClicAccPeriph; + dec(ligneClicAccPeriph); + if AncligneClicAccPeriph<>ligneClicAccPeriph then begin - Aff_champs_accCOMUSB_tablo(ligneclicAccCom+1); + Aff_champs_accPeriph_tablo(ligneClicAccPeriph+1); end; end; end; @@ -12839,13 +12850,13 @@ begin if affevt then affiche('Evt ListBoxPeriph.Items keydown',clyellow); with Formconfig.ListBoxPeriph.Items do begin - if ligneclicAccComligneclicAccCom then + AncligneClicAccPeriph:=ligneClicAccPeriph; + inc(ligneClicAccPeriph); + if AncligneClicAccPeriph<>ligneClicAccPeriph then begin - Aff_champs_accCOMUSB_tablo(ligneclicAccCom+1); + Aff_champs_accPeriph_tablo(ligneClicAccPeriph+1); end; end; end; @@ -12972,8 +12983,8 @@ end; procedure raz_selection_periph; begin - ligneClicAccCOM:=-1; - AncligneClicAccCOM:=-1; + ligneClicAccPeriph:=-1; + AncligneClicAccPeriph:=-1; with formConfig do begin EditNomPeriph.text:=''; @@ -13020,11 +13031,16 @@ begin end; ListBoxPeriph.Selected[IndexListe-1]:=true; - ligneClicAccCOM:=IndexListe-1; - Aff_champs_accCOMUSB_tablo(indexListe); + ligneClicAccPeriph:=IndexListe-1; + Aff_champs_accPeriph_tablo(indexListe); - fabrique_combos_periph; reaffecte_index_combos(indexListe+1,IndexListe,IndexListe,IndexListe+1); + fabrique_combos_periph; + + // réaffiche les champs qui contiennent les 3 combobox de périphériques + maj_decodeurs; + aff_champs_Act(ligneclicAct+1); + Aff_champs_PN(lignecliqueePN+1); config_modifie:=true; end; @@ -13065,16 +13081,40 @@ begin end; ListBoxPeriph.Selected[IndexListe+1]:=true; - ligneClicAccCOM:=IndexListe+1; - Aff_champs_accCOMUSB_tablo(indexListe+2); + ligneClicAccPeriph:=IndexListe+1; + Aff_champs_accPeriph_tablo(indexListe+2); - fabrique_combos_periph; + // ancien1,ancien2,nouveau1,nouveau2 reaffecte_index_combos(indexListe+1,IndexListe+2,IndexListe+2,IndexListe+1); + fabrique_combos_periph; + + // réaffiche les champs qui contiennent les 3 combobox de périphériques + maj_decodeurs; + aff_champs_Act(ligneclicAct+1); + Aff_champs_PN(lignecliqueePN+1); config_modifie:=true; end; +procedure TFormConfig.CheckBoxResaClick(Sender: TObject); + begin + avecResa:=CheckBoxResa.Checked; +end; + + +procedure TFormConfig.EditPortServeurExit(Sender: TObject); + var i,erreur : integer; + begin + Val(EditPortServeur.Text,i,erreur); + if (i<1) or (i>65535) then EditPortServeur.Text:=IntToSTR(PortServeur); +end; + +procedure TFormConfig.EditPortServeurChange(Sender: TObject); + begin + if activ=false then config_modifie:=true; +end; + end. diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index dbf95f6..5a4f956 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -363,7 +363,7 @@ object FormConfCellTCO: TFormConfCellTCO end object EditAdrSortie: TEdit Left = 144 - Top = 68 + Top = 70 Width = 33 Height = 21 TabOrder = 5 @@ -371,7 +371,7 @@ object FormConfCellTCO: TFormConfCellTCO end object EditEtat: TEdit Left = 200 - Top = 68 + Top = 70 Width = 25 Height = 21 Hint = '1 ou 2' diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index b77961b..b346b75 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -91,7 +91,6 @@ procedure actualise(indexTCO : integer); var Bimage,oriente,piedFeu,xclic,yclic : integer; s : string; ip : Timage; - Bm : Tbitmap; r : trect; begin if (indexTCO=0) or (formConfCellTCO=nil) then exit; @@ -100,7 +99,6 @@ begin xclic:=XclicCell[indexTCO]; yclic:=YclicCell[indexTCO]; - Bm:=formConfCellTCO.imagepalettecc.Picture.Bitmap; //with FormConfCellTCO.ImagePaletteCC.Picture.Bitmap do with FormConfCellTCO.ImagePaletteCC do begin @@ -213,7 +211,7 @@ begin end; // si voie ou rien ou signal ou quai - if (Bimage=1) or (Bimage=0) or (Bimage=Id_signal) or (Bimage=51) then + if (Bimage=1) or (Bimage=0) or (Bimage=Id_signal) or (Bimage=Id_Quai) then begin s:=Tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].Texte; with formTCO[indexTCO] do @@ -812,12 +810,13 @@ begin val(EditNumTCO.Text,i,erreur); if erreur<>0 then exit; - if i>NbreTCO then + if (i>NbreTCO) or (i<1) then begin EditNumTCO.Text:=intToSTR(NbreTCO); i:=NbreTCO; end; tco[IndexTCOCourant,XclicCell[indexTCOCourant],YclicCell[indexTCOCourant]].FeuOriente:=i; + Affiche_cellule(IndexTCOCourant,XclicCell[indexTCOCourant],YclicCell[indexTCOCourant]); end; @@ -851,6 +850,7 @@ begin if erreur<>0 then exit; tco[IndexTCOCourant,XclicCell[indexTCOCourant],YclicCell[indexTCOCourant]].adresse:=i; + Affiche_cellule(IndexTCOCourant,XclicCell[indexTCOCourant],YclicCell[indexTCOCourant]); end; procedure TFormConfCellTCO.EditEtatChange(Sender: TObject); @@ -862,6 +862,7 @@ begin if erreur<>0 then exit; tco[IndexTCOCourant,XclicCell[indexTCOCourant],YclicCell[indexTCOCourant]].sortie:=i; + Affiche_cellule(IndexTCOCourant,XclicCell[indexTCOCourant],YclicCell[indexTCOCourant]); end; diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index b9c0f26..0923c2f 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -293,7 +293,7 @@ var s: string; i : integer; begin clicConf:=true; - s:='Configuration du tco '+inttostr(indextcocourant)+' Fichier '+NomFichierTCO[indextcocourant]; + s:='Configuration du tco '+inttostr(indextcocourant)+' - Fichier '+NomFichierTCO[indextcocourant]; caption:=s; groupBox3.caption:='Configuration du TCO '+inttostr(indextcocourant); @@ -315,7 +315,10 @@ begin s:='ColorA='+IntToHex(clfond[indexTCOcourant],6); // ajouter aux couleurs personnalisées colorDialog1.CustomColors.Add(s); for i:=1 to 10 do + begin stringGridTCO.Cells[1,i]:=NomFichierTCO[i]; + if i<=nbreTCO then stringGridTCO.Cells[2,i]:='X' else stringGridTCO.Cells[2,i]:=' '; + end; // stringGridTCO.canvas.Font.Style:=[fsBOld]; clicConf:=false; end; diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 8f717cf..6edbe37 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -181,9 +181,9 @@ object FormDebug: TFormDebug ParentFont = False end object ButtonSigSuiv: TButton - Left = 16 + Left = 8 Top = 16 - Width = 57 + Width = 49 Height = 49 Hint = 'Etat du signal suivant' Caption = 'Etat signal suivant' @@ -194,7 +194,7 @@ object FormDebug: TFormDebug OnClick = ButtonSigSuivClick end object ButtonCanSuivSig: TButton - Left = 80 + Left = 56 Top = 16 Width = 65 Height = 49 @@ -217,7 +217,7 @@ object FormDebug: TFormDebug TabOrder = 2 end object ButtonCP: TButton - Left = 152 + Left = 120 Top = 16 Width = 81 Height = 49 @@ -227,15 +227,25 @@ object FormDebug: TFormDebug OnClick = ButtonCPClick end object Button2: TButton - Left = 240 + Left = 200 Top = 16 - Width = 65 + Width = 57 Height = 49 Caption = 'Cond Carr'#233' aiguillages' TabOrder = 4 WordWrap = True OnClick = Button2Click end + object ButtonReserve: TButton + Left = 256 + Top = 16 + Width = 49 + Height = 49 + Caption = 'R'#233'serve canton signal' + TabOrder = 5 + WordWrap = True + OnClick = ButtonReserveClick + end end object GroupBox4: TGroupBox Left = 8 @@ -360,6 +370,9 @@ object FormDebug: TFormDebug Top = 96 Width = 233 Height = 17 + Hint = + 'Affiche les trames de la centrale XpressNet ou les trames CDM-Ra' + + 'il (COM_IP)' Caption = 'Trames '#233'chang'#233'es avec l'#39'interface ou CDM' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack @@ -367,6 +380,8 @@ object FormDebug: TFormDebug Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False + ParentShowHint = False + ShowHint = True TabOrder = 3 OnClick = CheckTrameClick end @@ -485,6 +500,22 @@ object FormDebug: TFormDebug TabOrder = 10 OnClick = CheckDetSIgClick end + object CheckBoxPrinc: TCheckBox + Left = 264 + Top = 96 + Width = 121 + Height = 17 + Alignment = taLeftJustify + Caption = 'Proc Principales' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 11 + OnClick = CheckBoxPrincClick + end end object RichDebug: TRichEdit Left = 8 diff --git a/UnitDebug.pas b/UnitDebug.pas index 0010771..babc16e 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -63,6 +63,8 @@ type Button0: TButton; MemoEvtDet: TRichEdit; CheckDetSIg: TCheckBox; + CheckBoxPrinc: TCheckBox; + ButtonReserve: TButton; procedure FormCreate(Sender: TObject); procedure ButtonEcrLogClick(Sender: TObject); procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char); @@ -101,6 +103,8 @@ type procedure FormActivate(Sender: TObject); procedure MemoEvtDetChange(Sender: TObject); procedure CheckDetSIgClick(Sender: TObject); + procedure CheckBoxPrincClick(Sender: TObject); + procedure ButtonReserveClick(Sender: TObject); private { Déclarations privées } public @@ -110,7 +114,8 @@ type var FormDebug: TFormDebug; NivDebug,signalDebug,compt_erreur,positionErreur,LigneErreur : integer; - AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg : boolean; + AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg, + ProcPrinc : boolean; N_event_det : integer; // index du dernier évènement (de 1 à 20) N_Event_tick : integer ; // dernier index @@ -399,7 +404,7 @@ begin Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit; ancdebug:=NivDebug; NivDebug:=3; - if PresTrainPrec(Adr,Nb_cantons_Sig,false,voie,adrtrain) then AfficheDebug('Présence train',clYellow) else + if PresTrainPrec(Adr,Nb_cantons_Sig,false,voie,adrtrain) then AfficheDebug('Présence train '+intToSTR(AdrTrain),clYellow) else AfficheDebug('Absence train',clyellow); NivDebug:=AncDebug; end; @@ -631,4 +636,24 @@ end; +procedure TFormDebug.CheckBoxPrincClick(Sender: TObject); +begin + ProcPrinc:=checkBoxPrinc.checked; +end; + +procedure TFormDebug.ButtonReserveClick(Sender: TObject); +var i,adr,erreur,AncDebug,det1,det2 : integer; +begin + {Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit; + ancdebug:=NivDebug; + NivDebug:=3; + i:=index_feu(adr); + feux[i].Adr_det1; + Cond_Carre(Adr); + d + reserve_canton( + NivDebug:=AncDebug; } + reserve_canton(524,521,1,1,3); +end; + end. diff --git a/UnitPareFeu.pas b/UnitPareFeu.pas index f566286..baa3685 100644 --- a/UnitPareFeu.pas +++ b/UnitPareFeu.pas @@ -3,8 +3,8 @@ unit UnitPareFeu; // créée une règle dans le parefeu windows pour autoriser tous les ports entre CDM et Signaux_complexes interface -function verifie_regle : integer; -function cree_regle : boolean; +function verifie_regle(sp : string) : integer; +function cree_regle(sp,chemin : string) : boolean; implementation @@ -22,16 +22,16 @@ Const NET_FW_MODIFY_STATE_OK=0; NET_FW_MODIFY_STATE_GP_OVERRIDE=1; NET_FW_MODIFY_STATE_INBOUND_BLOCKED=2; - nom_regle_cdm='CDM rail'; + // Ajoute une règle au pare feu pour un programme en utilisant Microsoft Windows Firewall APIs. -function AddApplicationRule : boolean; +function AddApplicationRule(sp,chemin : string) : boolean; var CurrentProfiles,fwPolicy2,RulesObject,NewRule : OleVariant; s,fichier : string; r : boolean; begin - fichier:=CheminProgrammes+'\CDM-Rail\cdr.exe'; + fichier:=CheminProgrammes+chemin; //'\CDM-Rail\cdr.exe'; // Crée l'objet FwPolicy2 fwPolicy2:=CreateOleObject('HNetCfg.FwPolicy2'); @@ -42,8 +42,8 @@ begin //Crée l'objet de la règle. NewRule:=CreateOleObject('HNetCfg.FWRule'); - NewRule.Name:=nom_regle_cdm; - NewRule.Description:='Autorise le socket de/vers CDM rail'; + NewRule.Name:=sp; // CDM rail + NewRule.Description:='Autorise le socket de/vers CDM rail'+sp; NewRule.Applicationname:=fichier; NewRule.Protocol:=NET_FW_IP_PROTOCOL_TCP; @@ -69,7 +69,8 @@ begin result:=r; end; -function cree_regle : boolean; +// +function cree_regle(sp,chemin : string) : boolean; var CoResult : Hresult; s : string; r : boolean; @@ -78,13 +79,13 @@ begin try CoResult:=CoInitializeEx(nil,COINIT_MULTITHREADED); try - r:=AddApplicationRule; + r:=AddApplicationRule(sp,chemin); finally begin CoUninitialize; if r then begin - s:='Ajout de la règle '+nom_regle_cdm+' dans le pare-feu'; + s:='Ajout de la règle '+sp+' dans le pare-feu'; formconfig.Labelinfo.caption:=s; Affiche(s,clyellow); end; @@ -109,8 +110,8 @@ end; // vérifie si la règle cdm est dans le parefeu windows // retour =0 : pas dans le pare feu // =1 oui mais inactive -// =2 oui et active -function CheckingRuleEnabled : integer; +// =2 oui et active sp=Nom regle CDM +function CheckingRuleEnabled(sp : string) : integer; var fwPolicy2,RulesObject,regle : OleVariant; CurrentProfiles : Integer; @@ -122,17 +123,17 @@ begin fwPolicy2:=CreateOleObject('HNetCfg.FwPolicy2'); RulesObject:=fwPolicy2.Rules; CurrentProfiles:=fwPolicy2.CurrentProfileTypes; - trouve:=false ; + trouve:=false; oEnum:=IUnknown(Rulesobject._NewEnum) as IEnumVariant; while (oEnum.Next(1,regle,iValue)=0) and not(trouve) do begin if (regle.Profiles And CurrentProfiles)<>0 then begin s:=regle.Name; - trouve:=s=nom_regle_cdm; + trouve:=s=sp; if trouve then begin - Affiche('Description de l''autorisation socket pour CDM rail dans le pare-feu Windows',clyellow); + Affiche('Description de l''autorisation socket pour '+sp+' dans le pare-feu Windows',clyellow); Affiche('Nom : ' + s,clLime); Affiche('Description : ' + regle.Description,clLime); Affiche('Nom d''application: ' + regle.ApplicationName,clLime); @@ -161,14 +162,14 @@ begin end; end; -function verifie_regle : integer; +function verifie_regle(sp : string) : integer; var i : integer; begin i:=0; try CoInitialize(nil); try - i:=CheckingRuleEnabled; + i:=CheckingRuleEnabled(sp); finally CoUninitialize; end; diff --git a/UnitPilote.dfm b/UnitPilote.dfm index eb40253..9b39ad4 100644 --- a/UnitPilote.dfm +++ b/UnitPilote.dfm @@ -40,16 +40,16 @@ object FormPilote: TFormPilote end object LabelNbFeux: TLabel Left = 208 - Top = 248 + Top = 256 Width = 120 Height = 13 Caption = 'Nombre de feux '#224' allumer' end object LabelDec: TLabel - Left = 200 - Top = 192 - Width = 72 - Height = 19 + Left = 208 + Top = 184 + Width = 113 + Height = 41 Alignment = taCenter Caption = 'LabelDec' Font.Charset = ANSI_CHARSET @@ -59,17 +59,18 @@ object FormPilote: TFormPilote Font.Style = [fsBold] ParentFont = False Layout = tlCenter + WordWrap = True end object Label1: TLabel Left = 240 - Top = 176 + Top = 168 Width = 50 Height = 13 Caption = 'D'#233'codeur:' end object ImageSignaux: TImage Left = 168 - Top = 96 + Top = 72 Width = 153 Height = 105 Picture.Data = { @@ -1130,7 +1131,7 @@ object FormPilote: TFormPilote end object EditNbreFeux: TEdit Left = 240 - Top = 264 + Top = 272 Width = 57 Height = 21 TabOrder = 3 @@ -1139,7 +1140,7 @@ object FormPilote: TFormPilote end object CheckVerrouCarre: TCheckBox Left = 216 - Top = 216 + Top = 240 Width = 113 Height = 17 Caption = 'Verrouiller au carr'#233 diff --git a/UnitPilote.pas b/UnitPilote.pas index 93ee06d..d0517b7 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -136,7 +136,7 @@ begin 5 : dessine_signal5(VCanvas,0,0,1,1,EtatFeupilote,1); 7 : dessine_signal7(VCanvas,0,0,1,1,EtatFeupilote,1); 9 : dessine_signal9(VCanvas,0,0,1,1,EtatFeupilote,1); - 20 : dessine_signal20(VCanvas,0,0,1,1,EtatFeupilote,1,feux[i].adresse,12); + 20 : dessine_signal20(VCanvas,0,0,1,1,EtatFeupilote,1,feux[i].adresse); // indicateurs de direction 12 : dessine_dirN(VCanvas,0,0,1,1,EtatFeupilote,1,2); 13 : dessine_dirN(VCanvas,0,0,1,1,EtatFeupilote,1,3); @@ -316,10 +316,17 @@ begin i:=Index_Signal(AdrPilote); d:=feux[i].decodeur; n:=feux[i].aspect; - LabelDec.Caption:=decodeur[d]; + with LabelDec do + begin + Caption:=decodeur[d]; + width:=114; + height:=42; + end; feux[0].decodeur:=d; feux[0].aspect:=n; feux[0].contrevoie:=feux[i].contrevoie; + + // signal belge if (n=20) then begin @@ -329,6 +336,7 @@ begin RadioJauneCli.Caption:='Deux jaunes clignotants'; RadioBlanc.caption:='Rouge Blanc'; RadioBlancCli.caption:='Rouge Blanc clignotants'; + RadioRouge.caption:='Rouge'; radiovertcli.visible:=false; radioJaunecli.visible:=false; @@ -346,6 +354,7 @@ begin groupBox3.Visible:=false; Radiocarre.Caption:='Carré'; Radioviolet.Caption:='Violet'; + RadioRouge.Caption:='Sémaphore'; RadioJauneCli.Caption:='Avertissement clignotant'; RadioJaune.Caption:='Avertissement'; RadioBlanc.caption:='Blanc'; @@ -354,18 +363,17 @@ begin radioJaunecli.visible:=true; radioRougecli.visible:=true; radioBlanccli.visible:=true; - end; // checkcarré if (n<4) or (n>10) then checkVerrouCarre.Visible:=false else begin - checkVerrouCarre.Visible:=true; + checkVerrouCarre.Visible:=false; //true; checkVerrouCarre.Checked:=feux[i].VerrouCarre; end; - with imagePIlote do + with imagePilote do begin Parent:=FormPilote; Picture.Bitmap.TransparentMode:=tmAuto; @@ -374,26 +382,43 @@ begin Picture.BitMap:=Feux[i].Img.Picture.Bitmap; //left:=groupBox1.width+50; end; - LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(AdrPilote); - feux[0].EtatSignal:=feux[i].EtatSignal; - if (feux[i].aspect>10) and (feux[i].aspect<20) then - begin - // signaux directionnels - GroupBox1.Visible:=false; - GroupBox2.Visible:=false; - LabelNbFeux.Visible:=true; - EditNbreFeux.Visible:=true; - EditNbreFeux.Text:='1'; - end - else - begin - LabelNbFeux.Visible:=False; - EditNbreFeux.Visible:=false; - GroupBox1.Visible:=true; - if (feux[i].aspect<10) then GroupBox2.Visible:=true else GroupBox2.Visible:=false; - end; + LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(AdrPilote); + feux[0].EtatSignal:=feux[i].EtatSignal; + if (feux[i].aspect>10) and (feux[i].aspect<20) then + begin + // signaux directionnels + GroupBox1.Visible:=false; + GroupBox2.Visible:=false; + LabelNbFeux.Visible:=true; + EditNbreFeux.Visible:=true; + EditNbreFeux.Text:='1'; + end + else + begin + LabelNbFeux.Visible:=False; + EditNbreFeux.Visible:=false; + GroupBox1.Visible:=true; + if (feux[i].aspect<10) then GroupBox2.Visible:=true else GroupBox2.Visible:=false; + end; + + radioVert.Checked:=false; + radioVertCli.Checked:=false; + radioJaune.Checked:=false; + radioJauneCli.Checked:=false; + radioRouge.Checked:=false; + radioRougeCli.Checked:=false; + radiocarre.Checked:=false; + radioBlanc.Checked:=false; + radioViolet.Checked:=false; + radioRalen30.Checked:=false; + radioRappel30.Checked:=false; + radioRalen60.Checked:=false; + radioRappel60.Checked:=false; + CheckChiffre.Checked:=false; + CheckChevron.Checked:=false; + CheckClignote.Checked:=false; end; procedure TFormPilote.CheckVerrouCarreClick(Sender: TObject); diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 70369c8..ae7439d 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,6 +1,6 @@ object FormPrinc: TFormPrinc - Left = 91 - Top = 235 + Left = 84 + Top = 223 Width = 1133 Height = 653 Anchors = [akLeft, akTop, akRight] @@ -19,8 +19,8 @@ object FormPrinc: TFormPrinc OnCreate = FormCreate OnResize = FormResize DesignSize = ( - 1125 - 602) + 1117 + 595) PixelsPerInch = 96 TextHeight = 13 object LabelTitre: TLabel @@ -37,8 +37,8 @@ object FormPrinc: TFormPrinc ParentFont = False end object Image9feux: TImage - Left = 944 - Top = -8 + Left = 1064 + Top = 0 Width = 57 Height = 105 Picture.Data = { @@ -227,7 +227,7 @@ object FormPrinc: TFormPrinc Visible = False end object Image7feux: TImage - Left = 376 + Left = 504 Top = 0 Width = 57 Height = 105 @@ -1081,7 +1081,7 @@ object FormPrinc: TFormPrinc Visible = False end object Image6Dir: TImage - Left = 1016 + Left = 960 Top = 0 Width = 81 Height = 25 @@ -1203,8 +1203,8 @@ object FormPrinc: TFormPrinc ParentFont = False end object ImageSignal20: TImage - Left = 1016 - Top = 0 + Left = 1072 + Top = 96 Width = 57 Height = 105 Picture.Data = { @@ -1443,8 +1443,8 @@ object FormPrinc: TFormPrinc end object StatusBar1: TStatusBar Left = 0 - Top = 580 - Width = 1125 + Top = 573 + Width = 1117 Height = 22 Panels = < item @@ -1470,18 +1470,18 @@ object FormPrinc: TFormPrinc end> OnDrawPanel = StatusBar1DrawPanel end - object MSCommUSBLenz: TMSComm + object MSCommUSBInterface: TMSComm Left = 1064 Top = 192 Width = 32 Height = 32 - OnComm = MSCommUSBLenzComm + OnComm = MSCommUSBInterfaceComm ControlData = { 2143341208000000ED030000ED03000001568A64000006000000010000040000 00020000802500000000080000000000000000003F00000011000000} end object Button1: TButton - Left = 400 + Left = 408 Top = 0 Width = 75 Height = 25 @@ -1600,8 +1600,8 @@ object FormPrinc: TFormPrinc end end object GroupBox3: TGroupBox - Left = 433 - Top = 32 + Left = 497 + Top = 104 Width = 265 Height = 129 Anchors = [akTop, akRight] @@ -1782,10 +1782,10 @@ object FormPrinc: TFormPrinc object EditVitesse: TEdit Left = 80 Top = 40 - Width = 25 + Width = 33 Height = 21 TabOrder = 2 - Text = '30' + Text = '0' OnChange = EditVitesseChange end object ComboTrains: TComboBox @@ -1830,6 +1830,7 @@ object FormPrinc: TFormPrinc Hint = 'Vitesse loco en %' Ctl3D = False Max = 100 + Min = -100 ParentCtl3D = False TabOrder = 7 OnChange = TrackBarVitChange @@ -1983,8 +1984,8 @@ object FormPrinc: TFormPrinc end end object GroupBox2: TGroupBox - Left = 457 - Top = 144 + Left = 505 + Top = 24 Width = 265 Height = 105 Anchors = [akTop, akRight] @@ -2046,8 +2047,8 @@ object FormPrinc: TFormPrinc end end object ButtonIndex: TButton - Left = 712 - Top = 0 + Left = 840 + Top = 176 Width = 75 Height = 25 Caption = 'Indexs' @@ -2128,6 +2129,11 @@ object FormPrinc: TFormPrinc Caption = 'Evenements detecteurs par train' OnClick = Evenementsdetecteurspartrain1Click end + object Listedesclientsconnects1: TMenuItem + Caption = 'Liste des clients connect'#233's' + Hint = 'Affiche la liste des clients connect'#233's par COM-IP' + OnClick = Listedesclientsconnects1Click + end object N3: TMenuItem Caption = '-' end @@ -2412,6 +2418,10 @@ object FormPrinc: TFormPrinc Caption = 'Mise '#224' z'#233'ro des r'#233'servations des aiguillages' OnClick = RazResaClick end + object Copierltatdesaiguillageseninitialisation1: TMenuItem + Caption = 'Copier l'#39#233'tat actuel des aiguillages en initialisation' + OnClick = Copierltatdesaiguillageseninitialisation1Click + end end end object ClientSocketCDM: TClientSocket @@ -2437,7 +2447,7 @@ object FormPrinc: TFormPrinc Top = 8 object outslectionner1: TMenuItem Caption = 'Tout s'#233'lectionner' - OnClick = outslectionner1Click + OnClick = Toutslectionner1Click end object N15: TMenuItem Caption = '-' @@ -2483,4 +2493,13 @@ object FormPrinc: TFormPrinc Left = 1072 Top = 376 end + object ServerSocket: TServerSocket + Active = False + Port = 0 + ServerType = stNonBlocking + OnAccept = ServerSocketAccept + OnClientDisconnect = ServerSocketClientDisconnect + OnClientRead = ServerSocketClientRead + Left = 368 + end end diff --git a/UnitPrinc.pas b/UnitPrinc.pas index a9bc9b5..cdad9c4 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,5 +1,5 @@ Unit UnitPrinc; -// 30/9 22h +// 1/12 10h (******************************************** Programme signaux complexes Graphique Lenz Delphi 7 + activeX Tmscomm + clientSocket @@ -8,7 +8,8 @@ Unit UnitPrinc; sinon une exception surgira au moment de l'ouverture du com Dans projet/option/fiches : fiches disponibles : formtco uniquement ******************************************** - pour tmscomm : impossible de générer une instance dynamiquement (avec CreateOleObject) à cause de la licence + Pour tmscomm : impossible de générer une instance dynamiquement (avec CreateOleObject) à cause de la licence + Attention si le répertoire d'install n'est pas autorisé, windows10-11 va sauver les fichiers dans C:\Users\moi\AppData\Local\VirtualStore\Program Files (x86)\Signaux_complexes il faut autoriser l'utilisateur: Utilisateurs (nom\utilisateurs) @@ -19,7 +20,7 @@ Unit UnitPrinc; + 2 = vert = aiguillage droit = sortie 2 de l'adresse d'accessoire - 1 = rouge = aiguillage dévié = sortie 1 de l'adresse d'accessoire - vitesse port com lenz=57600 + vitesse port com lenz par défaut=57600 ligne de commande en mode administrateur pour valider le socket du pare feu: netsh advfirewall firewall add rule name="cdm rail" dir=in action=allow program="C:\Program Files (x86)\CDM-Rail\cdr.exe" enable=yes @@ -53,7 +54,7 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB, MMSystem , - Buttons, NB30, comObj, activeX ; + Buttons, NB30, comObj, activeX; type TFormPrinc = class(TForm) @@ -68,7 +69,7 @@ type MenuConnecterEthernet: TMenuItem; MenuDeconnecterEthernet: TMenuItem; StatusBar1: TStatusBar; - MSCommUSBLenz: TMSComm; + MSCommUSBInterface: TMSComm; Afficher1: TMenuItem; Etatdesdtecteurs1: TMenuItem; Etatdesaiguillages1: TMenuItem; @@ -216,8 +217,11 @@ type ButtonEnv: TButton; N15: TMenuItem; outslectionner1: TMenuItem; + Copierltatdesaiguillageseninitialisation1: TMenuItem; + ServerSocket: TServerSocket; + Listedesclientsconnects1: TMenuItem; procedure FormCreate(Sender: TObject); - procedure MSCommUSBLenzComm(Sender: TObject); + procedure MSCommUSBInterfaceComm(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); @@ -348,8 +352,16 @@ type var ErrorCode: Integer); procedure ClientSocketCde2Read(Sender: TObject; Socket: TCustomWinSocket); - procedure outslectionner1Click(Sender: TObject); -// procedure MSCommCdeComm(Sender: TObject); + procedure Toutslectionner1Click(Sender: TObject); + procedure Copierltatdesaiguillageseninitialisation1Click( + Sender: TObject); + procedure ServerSocketAccept(Sender: TObject; + Socket: TCustomWinSocket); + procedure ServerSocketClientRead(Sender: TObject; + Socket: TCustomWinSocket); + procedure ServerSocketClientDisconnect(Sender: TObject; + Socket: TCustomWinSocket); + procedure Listedesclientsconnects1Click(Sender: TObject); private { Déclarations privées } procedure DoHint(Sender : Tobject); @@ -378,7 +390,7 @@ MaxElBranches=200; NbreMaxiAiguillages=200; NbreMaxiSignaux=200; NbreMaxiDecPers=10; // nombre maxi de décodeurs personnalisés -NbMaxi_Periph=10; // nombre maxi de périphériques +NbMaxi_Periph=10; // nombre maxi de périphériques LargImg=50;HtImg=91; // Dimensions image des feux MaxComUSBPeriph=2; // Nombre maxi de périphériques USB périphériques MaxComSocketPeriph=2; @@ -393,7 +405,7 @@ MaxCdeDccpp=20; clRose=$AAAAFF; clCyan=$FFA0A0; clviolet=$FF00FF; -GrisF=$333333; +GrisF=$191919; clOrange=$0077FF; couleurTrain : array[0..NbCouleurTrain] of Tcolor = (clRose,clYellow,clLime,ClCyan,clAqua,clFuchsia,clLtGray,clred,clWhite); Max_Simule=10000; @@ -477,7 +489,7 @@ Taiguillage = record modifie : boolean ; NumBranche,IndexBranche : integer; // index dans les branches end; - +TtabloDet = array[1..10] of integer; TSignal = record adresse, aspect : integer; // adresse du signal, aspect (2 feux..9 feux 12=direction 2 feux .. 16=direction 6 feux) (11=signal belge 1) Img : TImage; // Pointeur sur structure TImage du feu @@ -528,12 +540,13 @@ TSignal = record SR : array[1..19] of record // configuration du décodeur Stéphane Ravaut ou digikeijs ou cdf sortie1,sortie0 : integer; end; - Na : integer; // nombre d'adresses du feu occupées par le décodeur CDF/digikeijs + Na : integer; // nombre d'adresses du feu occupées par le décodeur CDF/digikeijs + DetAmont : TtabloDet; // tableau des détecteurs amonts, calculés à la lecture du fichier de config end; TPeripherique = record nom : string; - NumCom : integer; // numéro de port COM si c'est une liaison com usb + NumCom : integer; // numéro de port COM si c'est une liaison com usb numComposant : integer ; // numéro de composant MSCOM ou clientSocket ScvAig,ScvDet,ScvAct,ScvVis,cr : boolean ; // services, visible, avecCR protocole: string; @@ -551,17 +564,18 @@ var ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB, etape,idEl,avecRoulage,intervalle_courant,filtrageDet0,SauvefiltrageDet0, TpsTimeoutSL,formatY,OsBits,NbreDecPers,NbDecodeur,NbDecodeurdeBase, - LargeurF,HauteurF,OffsetXF,OffsetYF,PosSplitter,NbPeriph,NbPeriph_COMUSB,NbPeriph_Socket : integer; + LargeurF,HauteurF,OffsetXF,OffsetYF,PosSplitter,NbPeriph,NbPeriph_COMUSB,NbPeriph_Socket, + AigMal : integer; ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc, Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO, - Srvc_Pos,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif, + Srvc_Pos,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif,Srvc_tdcc, Hors_tension,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,doubleclic, NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,AffTiers,AvecDemandeAiguillages, TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM,AvecInitAiguillages, AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro, retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain, - avec_splitter,fichier_module_cdm,Diffusion,cdmDevant : boolean; + avec_splitter,fichier_module_cdm,Diffusion,cdmDevant,avecRESA : boolean; tick,Premier_tick : longint; @@ -575,12 +589,12 @@ var Ancien_detecteur : array[0..NbMemZone] of boolean; // anciens état des détecteurs et adresses des détecteurs et leur état detecteur : array[0..NbMemZone] of // détecteurs indexés par l'adresse record - etat : boolean; // état 0/1 du déecteur - train : string; // nom du train ayant enclenché le détecteur (CDM - pas fiable) + Etat : boolean; // état 0/1 du détecteur + Train : string; // nom du train ayant enclenché le détecteur (CDM - pas fiable) AdrTrain : integer; // adresse du train "train" - tempo0 : integer; // tempo de retombée à 0 du détecteur (filtrage) IndexTrain : integer; // index du train - NumBranche,IndexBranche : integer; // ou se trouve le détecteur dans les branches + Tempo0 : integer; // tempo de retombée à 0 du détecteur (filtrage) + NumBranche,IndexBranche : integer; // où se trouve le détecteur dans les branches end; Adresse_detecteur : array[0..NbMaxDet] of integer; // adresses des détecteurs par index @@ -594,6 +608,12 @@ var tamponRx : string; end; + Liste_clients : array[0..10] of record + adresse : string; + PortDistant,PortLocal : integer; + end; + + TypeGen : TEquipement; @@ -639,42 +659,41 @@ var record etat : boolean; // mémoires de zones des détecteurs train : string; - NumTrain, // index du tableau de tous les trains + IndexTrain, // index du tableau de tous les trains AdrTrain : integer; end; Tablo_actionneur : array[0..Max_actionneurs] of record loco,act,son,periph : boolean; // destinataire loco acessoire son ou périphérique - adresse,adresse2, // adresse: adresse de base ; adresse2=cas d'une Zone + adresse,adresse2, // adresse: adresse de base ; adresse2=cas d'une Zone etat, - fonction, // fonction F de train ou périphérique + fonction, // fonction F de train ou périphérique tempo,TempoCourante, accessoire,sortie, - typdeclenche : integer; // déclencheur: 0=actionneur/détecteur 2=evt aig 3=MemZone - Raz : boolean; + typdeclenche : integer; // déclencheur: 0=actionneur/détecteur 2=evt aig 3=MemZone + Raz : boolean; FichierSon,trainDecl, - TrainDest, // train destinataire ou Commande - TrainCourant : string; + TrainDest, // train destinataire ou Commande + TrainCourant : string; end; decodeur_pers : array[1..NbreMaxiDecPers] of record - nom : string; + nom : string; NbreAdr, - nation : integer; // 1=FR 2=BE - commande : integer; // =0 pilotage par centrale =1 pilotage par périphérique COM/USB/Socket - Peripherique : integer; // numéro du périphérique - desc : array[1..20] of //index=adresse d'offset + nation : integer; // 1=FR 2=BE + commande : integer; // =0 pilotage par centrale =1 pilotage par périphérique COM/USB/Socket + Peripherique : integer; // numéro du périphérique + desc : array[1..20] of // Description. Index=adresse d'offset record - etat1,etat2, // états (rouge, sémaphore etc) - offsetAdresse, // décalage d'adresse des deux sorties - sortie1,sortie2 : integer; // valeur des deux sorties pour les états - Chcommande : string; // si commande com/usb/socket + etat1,etat2, // états (rouge, sémaphore etc) + offsetAdresse, // décalage d'adresse des deux sorties + sortie1,sortie2 : integer; // valeur des deux sorties pour les états + Chcommande : string; // si commande com/usb/socket end; end; - Ancien_actionneur : array[0..1024] of integer; KeyInputs: array of TInput; @@ -721,7 +740,8 @@ var trains : array[1..Max_Trains] of record nom_train : string; adresse,vitmax,VitNominale,VitRalenti : integer; - vitesse : integer; // vitesse actuelle + vitesse : integer; // vitesse actuelle de pilotage + sens : boolean; compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s TempoArret : integer; // tempo d'arret pour le timer TempoDemarre : integer; @@ -732,22 +752,25 @@ var end; // éléments scannés et/ou verrouillés - elements : array[1..20] of record - adresse : integer; - typ : Tequipement; - end; + elements : array[1..20] of + record + adresse : integer; + typ : Tequipement; + end; // liste des trains placés - Placement : array[1..10] of record - train : string; - detecteur,detdir : integer; - inverse : boolean; + Placement : array[1..10] of + record + train : string; + detecteur,detdir : integer; + inverse : boolean; end; // liste des évènements détecteurs - event_det : array[1..Max_event_det] of record - adresse : integer; - etat : boolean; + event_det : array[1..Max_event_det] of + record + adresse : integer; + etat : boolean; end; event_det_train : array[0..Max_Trains] of record @@ -779,7 +802,7 @@ procedure dessine_signal4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSig procedure dessine_signal5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); procedure dessine_signal7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); procedure dessine_signal9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer); -procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,adresse,tailleChiffre : integer); +procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,adresse : integer); procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,N : integer); procedure Maj_Etat_Signal(adresse,aspect : integer); procedure Maj_Etat_Signal_Belge(adresse,aspect : integer); @@ -802,7 +825,7 @@ function detecteur_suivant_El(el1: integer;TypeDet1 : TEquipement;el2 : integer; function test_memoire_zones(adresse : integer) : boolean; function PresTrainPrec(Adresse,NbCtSig : integer;detect : boolean;var AdrTr,voie : integer) : boolean; function cond_carre(adresse : integer) : boolean; -function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean;Var AdrTrain : integer) : boolean; +function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean;Var AdrTrain : integer) : integer; procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); procedure Event_act(adr,adr2,etat : integer;trainDecl : string); function verif_UniSemaf(adresse,UniSem : integer) : integer; @@ -822,7 +845,7 @@ function index_train_adresse(adr : integer) : integer; procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;sens : boolean;repetition : boolean); procedure Maj_Feux(detect : boolean); procedure Det_Adj(adresse : integer); -procedure reserve_canton(detecteur1,detecteur2,adrtrain : integer); +procedure reserve_canton(detecteur1,detecteur2,adrtrain,NumTrain,NCantons : integer); function signal_detecteur(detecteur : integer) : integer; function det_suiv_cont(det1,det2,alg : integer) : integer; function BTypeToChaine(BT : TEquipement) : string; @@ -844,11 +867,13 @@ procedure liste_portcom; procedure mosaiqueH; procedure mosaiqueV; function InfoSignal(adresse : integer) : string; +procedure det_prec_signal(adresse : integer;var tabloDet : TTabloDet); implementation uses UnitDebug, UnitPilote, UnitSimule, UnitTCO, UnitConfig, - Unitplace, verif_version , UnitCDF, UnitAnalyseSegCDM, UnitConfigCellTCO; + Unitplace, verif_version , UnitCDF, UnitAnalyseSegCDM, UnitConfigCellTCO, + UnitConfigTCO; { procedure menu_interface(MA : TMA); @@ -1045,14 +1070,16 @@ procedure dessine_signal2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSig var Temp,rayon,xViolet,YViolet,xBlanc,yBlanc, LgImage,HtImage,code,combine : integer; ech : real; - begin code_to_aspect(Etatsignal,code,combine); rayon:=round(6*frX); // récupérer les dimensions de l'image d'origine du feu - LgImage:=Formprinc.Image2feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image2feux.Picture.Bitmap.Height; + with Formprinc.Image2feux.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; XBlanc:=13; YBlanc:=11; xViolet:=13; yViolet:=23; @@ -1074,6 +1101,13 @@ begin Temp:=LgImage-Xviolet;Xviolet:=Yviolet;Yviolet:=Temp; end; + // 180° + if orientation=4 then + begin + Xblanc:=LgIMage-Xblanc;Yblanc:=HtImage-Yblanc; + Xviolet:=LgIMage-Xviolet;Yviolet:=HtImage-Yviolet; + end; + XBlanc:=round(xBlanc*Frx)+x; YBlanc:=round(Yblanc*Fry)+Y; XViolet:=round(XViolet*FrX)+x; YViolet:=round(YViolet*FrY)+Y; @@ -1099,9 +1133,11 @@ begin rayon:=round(6*frX); - LgImage:=Formprinc.Image3feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image3feux.Picture.Bitmap.Height; - + with Formprinc.Image3feux.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; Xvert:=13; Yvert:=11; xSem:=13; ySem:=22; xJaune:=13; yJaune:=33; @@ -1123,6 +1159,15 @@ begin Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp; end; + if (orientation=4) then + begin + //rotation 180° + Xjaune:=LgImage-Xjaune;YJaune:=HtImage-YJaune; + XSem:=LgImage-XSem; YSem:=HtImage-YSem; + XVert:=LgImage-Xvert; Yvert:=HtImage-Yvert; + end; + + XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; @@ -1157,8 +1202,11 @@ begin code_to_aspect(Etatsignal,code,combine); // et aspect rayon:=round(6*frX); - LgImage:=Formprinc.Image4feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image4feux.Picture.Bitmap.Height; + with Formprinc.Image4feux.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; Xcarre:=13; ycarre:=11; Xvert:=13; Yvert:=22; @@ -1186,12 +1234,22 @@ begin Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; end; + if (orientation=4) then + begin + //rotation 180° + Xjaune:=LgImage-Xjaune;YJaune:=HtImage-YJaune; + XSem:=LgImage-XSem; YSem:=HtImage-YSem; + XVert:=LgImage-Xvert; Yvert:=HtImage-Yvert; + Xcarre:=LgImage-Xcarre;Ycarre:=HtImage-Ycarre; + end; + + XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y; - //extinctions + // extinctions cercle(ACanvas,Xcarre,yCarre,rayon,GrisF); if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,Xsem,Ysem,rayon,GrisF); if not((code=vert_cli) and clignotant) then cercle(ACanvas,Xvert,yvert,rayon,GrisF); @@ -1223,9 +1281,11 @@ begin XSem:=13; Ysem:=44; XVert:=13; YVert:=33; - LgImage:=Formprinc.Image5feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image5feux.Picture.Bitmap.Height; - + with Formprinc.Image5feux.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; if (orientation=2) then begin //rotation 90° vers la gauche des feux @@ -1250,6 +1310,17 @@ begin Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp; end; + if (orientation=4) then + begin + //rotation 180° + Xjaune:=LgImage-Xjaune;YJaune:=HtImage-YJaune; + XSem:=LgImage-XSem; YSem:=HtImage-YSem; + XVert:=LgImage-Xvert; Yvert:=HtImage-Yvert; + Xcarre:=LgImage-Xcarre;Ycarre:=HtImage-Ycarre; + Xblanc:=LgImage-Xblanc;Yblanc:=HtImage-YBlanc; + end; + + XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y; Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; @@ -1293,9 +1364,11 @@ begin XSem:=13; Ysem:=56; XVert:=13; YVert:=45; - LgImage:=Formprinc.Image7feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image7feux.Picture.Bitmap.Height; - + with Formprinc.Image7feux.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; if (orientation=2) then begin //rotation 90° vers la gauche des feux @@ -1321,7 +1394,19 @@ begin Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp; Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp; Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp; - Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp; + Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp; + end; + + if (orientation=4) then + begin + //rotation 180° + Xjaune:=LgImage-Xjaune;YJaune:=HtImage-YJaune; + XSem:=LgImage-XSem; YSem:=HtImage-YSem; + XVert:=LgImage-Xvert; Yvert:=HtImage-Yvert; + Xcarre:=LgImage-Xcarre;Ycarre:=HtImage-Ycarre; + Xblanc:=LgImage-Xblanc;Yblanc:=HtImage-YBlanc; + Xral1:=LgImage-Xral1; Yral1:=HtImage-Yral1; + Xral2:=LgImage-Xral2; Yral2:=HtImage-Yral2; end; XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; @@ -1382,9 +1467,11 @@ begin XSem:=13; Ysem:=69; XVert:=13; YVert:=58; - LgImage:=Formprinc.Image9feux.Picture.Bitmap.Width; - HtImage:=Formprinc.Image9feux.Picture.Bitmap.Height; - + with Formprinc.Image9feux.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; if (orientation=2) then begin //rotation 90° vers la gauche des feux : échange des coordonnées X et Y et translation sur HtImage @@ -1415,6 +1502,21 @@ begin Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp; end; + if (orientation=4) then + begin + //rotation 180° + Xjaune:=LgImage-Xjaune;YJaune:=HtImage-YJaune; + XSem:=LgImage-XSem; YSem:=HtImage-YSem; + XVert:=LgImage-Xvert; Yvert:=HtImage-Yvert; + Xcarre:=LgImage-Xcarre;Ycarre:=HtImage-Ycarre; + Xblanc:=LgImage-Xblanc;Yblanc:=HtImage-YBlanc; + Xral1:=LgImage-Xral1; Yral1:=HtImage-Yral1; + Xral2:=LgImage-Xral2; Yral2:=HtImage-Yral2; + Xrap1:=LgImage-Xrap1; Yrap1:=HtImage-Yrap1; + Xrap2:=LgImage-Xrap2; Yrap2:=HtImage-Yrap2; + end; + + XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y; XRal1:=round(XRal1*FrX)+x; YRal1:=round(YRal1*FrY)+Y; @@ -1545,10 +1647,10 @@ end; // dessine les feux sur une cible belge à 5 feux // cette image peut être inversée (contre voie) -procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,adresse,tailleChiffre : integer); +procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,adresse : integer); var xblanc,xvert,xrouge,Yblanc,xjauneBas,xJauneHaut,yJauneBas,yJauneHaut,YVert,Yrouge,largeur, index,Temp,rayon,LgImage,HtImage,code,combine,x1,y1,x2,y2,x3,y3,xChiffre,yChiffre,xfin,yfin,angle, - AdrAig,IndexAig,vitesse,indexTCO : integer; + AdrAig,IndexAig,vitesse,indexTCO,tailleFonte : integer; ech : real; inverse,etatChevron,EtatChiffre,codeClignote : boolean; r : Trect; @@ -1596,8 +1698,11 @@ begin if XChiffre>Xfin then echange(Xchiffre,Xfin); - LgImage:=Formprinc.ImageSignal20.Picture.Bitmap.Width; - HtImage:=Formprinc.ImageSignal20.Picture.Bitmap.Height; + with Formprinc.ImageSignal20.Picture.Bitmap do + begin + LgImage:=Width; + HtImage:=Height; + end; if (orientation=2) then begin @@ -1634,6 +1739,21 @@ begin Temp:=LgImage-Xfin;Xfin:=Yfin;Yfin:=Temp; end; + if orientation=4 then + begin + XjauneBas:=LgImage-XjauneBas;YjauneBas:=HtImage-YjauneBas; + XJauneHaut:=LgImage-XJauneHaut;YjauneHaut:=HtImage-YjauneHaut; + Xvert:=LgImage-Xvert;Yvert:=HtImage-Yvert; + Xrouge:=LgImage-Xrouge;Yrouge:=HtImage-Yrouge; + XBlanc:=LgImage-XBlanc;YBlanc:=HtImage-YBlanc; + + X1:=LgImage-X1;Y1:=HtImage-Y1; + X2:=LgImage-X2;Y2:=HtImage-Y2; + X3:=LgImage-X3;Y3:=HtImage-Y3; + XChiffre:=LgImage-XChiffre;YChiffre:=HtImage-YChiffre; + XFin:=LgImage-Xfin;Yfin:=HtImage-yFin; + end; + XJauneBas:=round(XjauneBas*Frx)+x; YJauneBas:=round(YjauneBas*Fry)+Y; XJauneHaut:=round(XjauneHaut*Frx)+x; YJauneHaut:=round(YjauneHaut*Fry)+Y; Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y; @@ -1704,13 +1824,17 @@ begin // écrit le chiffre if etatChiffre then - begin + begin + taillefonte:=round(frx*ZoomMax); + tailleFonte:=(taillefonte div 4)+2; + //Affiche(inttoSTR(taillefonte),clred); Brush.Color:=clblack; with font do begin - Font.Color:=clWhite; - font.Size:=taillechiffre; - font.Style:=[fsbold]; + Color:=clWhite; + Size:=taillefonte; + Style:=[fsbold]; + Name:='Arial'; end; if feux[index].Btype_suiv1=aig then @@ -1725,6 +1849,7 @@ begin case orientation of 2 : angle:=-900; 3 : angle:=900; + 4 : angle:=1800; end; AffTexteIncliBordeTexture(Acanvas,Xchiffre,Ychiffre,Acanvas.Font,clYellow,0,pmcopy,nil,intToSTR(vitesse),angle); end; @@ -1922,7 +2047,6 @@ end; procedure Affiche_CR(s: string;lacouleur : Tcolor); var i : integer; begin - repeat i:=pos(#13,s); Affiche(copy(s,1,i-1),lacouleur); @@ -2031,7 +2155,7 @@ begin 5 : dessine_signal5(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation); 7 : dessine_signal7(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation); 9 : dessine_signal9(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation); - 20 : dessine_signal20(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation,feux[i].adresse,10); + 20 : dessine_signal20(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation,feux[i].adresse); // indicateurs de direction 12..16 : dessine_dirN(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation,aspect-10); end; @@ -2053,7 +2177,7 @@ begin i:=pos(' ',s); if i<>0 then s:=copy(s,1,i-1); val(s,AdrPilote,erreur); - end; + end; end; // procédure activée quand on clique gauche sur l'image d'un signal @@ -2084,7 +2208,7 @@ end; function Select_dessin_feu(TypeFeu : integer) : TBitmap; var Bm : TBitMap; begin - case TypeFeu of + case TypeFeu of 2 : Bm:=Formprinc.Image2feux.picture.Bitmap; 3 : Bm:=Formprinc.Image3feux.picture.Bitmap; 4 : Bm:=Formprinc.Image4feux.picture.Bitmap; @@ -2132,15 +2256,15 @@ begin Height:=HtImg; // hint - s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+decodeur[feux[rang].Decodeur]+ - ' Adresse détecteur associé='+intToSTR(feux[rang].Adr_det1)+ + s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+decodeur[feux[rang].Decodeur]+#13+ + ' Adresse détecteur associé='+intToSTR(feux[rang].Adr_det1)+#13+ ' Adresse élement suivant='+intToSTR(feux[rang].Adr_el_suiv1); if feux[rang].Btype_suiv1=aig then s:=s+' (aig)'; Hint:=s; showHint:=true; - onClick:=Formprinc.Imageonclick; // affectation procédure clique sur image - onMouseDown:=Formprinc.ProcOnMouseDown; + onClick:=Formprinc.Imageonclick; // affectation procédure clique G sur image + onMouseDown:=Formprinc.ProcOnMouseDown; // clique G ou D PopUpMenu:=Formprinc.PopupMenuFeu; // affectation popupmenu sur clic droit // affecter le type d'image de feu dans l'image créée @@ -2210,6 +2334,7 @@ begin else Feux[rang].checkFB:=nil; end; +// affiche les signaux dans la fenêtre de droite procedure Affiche_signaux; var i : integer; begin @@ -2243,7 +2368,7 @@ begin end; -// ajoute en bout de chaine le checksum d'une trame (pour XpressNet) +// ajoute en bout de chaine le checksum d'une trame pour XpressNet Function Checksum(s : string) : string; var i : integer; check : byte; @@ -2286,6 +2411,7 @@ end; // envoi d'une chaîne à la centrale par USBLenz ou socket, n'attend pas l'ack +// pour le protole XpressNet (1), on ajoute l'entete et le suffixe dans la trame. // ici on envoie pas à CDM procedure envoi_ss_ack(s : string); var i,timeout,valto : integer; @@ -2311,12 +2437,12 @@ begin //Application.ProcessMessages; inc(timeout); Sleep(20); - until (Formprinc.MSCommUSBLenz.CTSHolding=true) or (timeout>valto); + until (Formprinc.MSCommUSBInterface.CTSHolding=true) or (timeout>valto); if timeout<=valto then begin //if formprinc.MSCommUSBLenz.CTSHolding then sa:='CTS=1 ' else sa:='CTS=0 '; - FormPrinc.MSCommUSBLenz.Output:=s[i]; + FormPrinc.MSCommUSBInterface.Output:=s[i]; if terminal then Affiche(chaine_hex(s[i]),clyellow); inc(i); end; @@ -2327,7 +2453,7 @@ begin // protocole Rts Cts ou sans temporisation if (prot_serie=2) or (tempoOctet=0) then begin - FormPrinc.MSCommUSBLenz.Output:=s; + FormPrinc.MSCommUSBInterface.Output:=s; exit; end; @@ -2336,12 +2462,12 @@ begin begin for i:=1 to length(s) do begin - FormPrinc.MSCommUSBLenz.Output:=s[i]; + FormPrinc.MSCommUSBInterface.Output:=s[i]; //Affiche(s[i],clyellow);// else Affiche(chaine_hex(s[i]),clyellow); Sleep(TempoOctet); end; end; - if (prot_serie=0) then FormPrinc.MSCommUSBLenz.Output:=s; + if (prot_serie=0) then FormPrinc.MSCommUSBInterface.Output:=s; end; // par socket (ethernet) @@ -2405,6 +2531,8 @@ begin so:=so+ '|'+format('%.*d',[3,length(s)+length(sx)])+'|'+sx; chaine_CDM_vitesseST:=so+s; + //Affiche(so+s,clyellow); + //C-C-02-0004-CMDTRN-SPEED|025|02|NAME=CC406526;UREQ=39; end; // renvoie une chaîne pour vitesse train INT par son adresse @@ -2701,17 +2829,19 @@ end; // répétition=avec répétition de la commande dans 1s procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;sens,repetition : boolean); var s : string; + v : integer; begin if not(hors_tension) and ((portCommOuvert or parSocketLenz)) then begin + Affiche('vitesse train '+inttostr(adr_loco)+' '+inttostr(vitesse),clLime); if protocole=1 then begin - //Affiche('X9 train '+inttostr(loco)+' '+inttostr(vitesse),clOrange); //AfficheDebug('X9 train '+inttostr(loco)+' '+inttostr(vitesse),clOrange); - + vitesse:=abs(vitesse); if vitesse>127 then vitesse:=127; - if sens then vitesse:=vitesse or 128; - s:=#$e4+#$13+#$0+char(adr_loco)+char(vitesse); + v:=vitesse; + if (sens) then v:=v or 128; + s:=#$e4+#$13+#$0+char(adr_loco)+char(v); s:=checksum(s); envoi(s); end; @@ -2726,7 +2856,7 @@ begin if cdm_connecte then begin s:=chaine_CDM_vitesseST(vitesse,nom_train); // par nom du train - //s:=chaine_CDM_vitesseINT(vitesse,adr_loco); // par adresse du train + //s:=chaine_CDM_vitesseINT(vitesse,adr_loco); // par adresse du train: ne fonctionne pas envoi_CDM(s); //affiche(s,clLime); end; @@ -2735,8 +2865,9 @@ begin if (index<>0) and repetition then begin trains[index].vitesse:=vitesse; + trains[index].sens:=sens; trains[index].compteur_consigne:=10; - end; + end; end; @@ -3202,7 +3333,7 @@ end; {========================================================================== -envoie les données au décodeur LEB +envoie les données du signal au décodeur LEB ===========================================================================*} procedure envoi_LEB(adresse : integer); var code,aspect,combine : integer; @@ -3370,7 +3501,7 @@ end; (*========================================================================== -envoie les données au décodeur NMRA étendu +envoie les données au décodeur NMRA étendu - ne peut pas marcher par XpressNet évidemment adresse=adresse sur le BUS DCC code=code d'allumage : 0. Carré @@ -4186,6 +4317,7 @@ begin end; // inverse l'ordre des bits dans un octet +// le bit 7 passe en 0 et inversement function inverse(b : byte) : byte; var r : byte; begin @@ -4377,7 +4509,7 @@ end; // pilote un signal par un décodeur personnalisé procedure envoi_decodeur_pers(Adresse : integer); var s : string; - d,dp,i,j,k,etat,asp,combine,aspect,nAdresses,v,numacc,cmd : integer; + d,dp,i,j,k,etat,asp,combine,aspect,numacc,nAdresses,v,cmd : integer; trouve1,trouve2,trouve3,trouve4 : boolean; begin i:=Index_Signal(adresse); @@ -4497,14 +4629,12 @@ begin if combine=ral_60 then j:=12; if combine=rappel_30 then j:=13; if combine=rappel_60 then j:=14; - end; + end; if (aspect=jaune_cli) and (combine=ral_60) then j:=15; if (aspect=jaune) and (combine=rappel_30) then j:=16; if (aspect=jaune_cli) and (combine=rappel_30) then j:=17; - if (aspect=jaune) and (combine=rappel_60) then j:=18; - if (aspect=jaune_cli) and (combine=rappel_60) then j:=19; - - + if (aspect=jaune) and (combine=rappel_60) then j:=18; + if (aspect=jaune_cli) and (combine=rappel_60) then j:=19; s:=intToSTR(adresse)+' '+decodeur_pers[dp].desc[j].Chcommande; if Tablo_periph[numacc].cr then s:=s+#13; @@ -4517,8 +4647,8 @@ begin if Tablo_com_cde[numacc].PortOuvert then begin cmd:=Tablo_periph[numacc].numComposant; - if numacc=1 then Formprinc.MSCommCde1.Output:=s; - if numacc=2 then Formprinc.MSCommCde2.Output:=s; + if cmd=1 then Formprinc.MSCommCde1.Output:=s; + if cmd=2 then Formprinc.MSCommCde2.Output:=s; if Tablo_periph[numacc].ScvVis then Affiche('Envoi COM'+intToSTR(v)+': '+s,clYellow); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -4529,14 +4659,12 @@ begin begin numAcc:=decodeur_pers[dp].Peripherique; cmd:=Tablo_periph[numacc].numComposant; - if numacc=1 then Formprinc.ClientSocketCde1.Socket.SendText(s); - if numacc=2 then Formprinc.ClientSocketCde2.Socket.SendText(s); + if cmd=1 then Formprinc.ClientSocketCde1.Socket.SendText(s); + if cmd=2 then Formprinc.ClientSocketCde2.Socket.SendText(s); if Tablo_periph[numacc].ScvVis then Affiche('Envoi Socket: '+s,clYellow); end end; - end; - end else @@ -4589,8 +4717,8 @@ begin if Tablo_com_cde[numacc].PortOuvert then begin cmd:=Tablo_periph[numacc].numComposant; - if numacc=1 then Formprinc.MSCommCde1.Output:=s; - if numacc=2 then Formprinc.MSCommCde2.Output:=s; + if cmd=1 then Formprinc.MSCommCde1.Output:=s; + if cmd=2 then Formprinc.MSCommCde2.Output:=s; if Tablo_periph[numacc].ScvVis then Affiche('Envoi COM'+intToSTR(v)+': '+s,clYellow); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -4599,8 +4727,8 @@ begin begin // socket cmd:=Tablo_periph[numacc].numComposant; - if numacc=1 then Formprinc.ClientSocketCde1.Socket.SendText(s); - if numacc=2 then Formprinc.ClientSocketCde2.Socket.SendText(s); + if cmd=1 then Formprinc.ClientSocketCde1.Socket.SendText(s); + if cmd=2 then Formprinc.ClientSocketCde2.Socket.SendText(s); if Tablo_periph[numacc].ScvVis then Affiche('Envoi Socket: '+s,clYellow); end; end; @@ -4664,6 +4792,7 @@ end; procedure envoi_signal(Adr : integer); var i,it,j,index_train,adresse,detect,detsuiv,a,b,aspect,x,y,TailleX,TailleY,Orientation, indexTCO,AdrTrain,dec : integer; + rougeA,rougeB : boolean; ImageFeu : TImage; frX,frY : real; s : string; @@ -4709,7 +4838,13 @@ begin a:=feux[i].AncienEtat; b:=feux[i].EtatSignal; // si l'ancien état était au rouge/violet et on quitte le rouge/violet - if ((a=semaphore_F) or (a=carre_F) or (a=violet_F)) and ((b<>semaphore_F) and (b<>carre_F) and (b<>violet_F)) then + if feux[i].aspect=20 then begin rougeA:=testbit(a,rouge);rougeB:=testbit(b,rouge);end // signal belge + else + begin + rougeA:=testbit(a,semaphore) or testbit(a,carre) or testbit(a,violet); + rougeB:=testbit(b,semaphore) or testbit(b,carre) or testbit(b,violet); + end; + if not(rougeB) and rougeA then // le signal quitte le rouge/violet begin // y a t il un train en face du signal detect:=feux[i].Adr_det1; @@ -4730,7 +4865,7 @@ begin // faire la réservation du canton if feux[i].Btype_suiv1<>det then detSuiv:=detecteur_suivant(detect,det,feux[i].Adr_el_suiv1,feux[i].Btype_suiv1,1) else detSuiv:=feux[i].Adr_el_suiv1; - if detSuiv<9990 then reserve_canton(detect,detSuiv,Adrtrain); + if detSuiv<9990 then reserve_canton(detect,detSuiv,Adrtrain,0,2); // démarrage d'un train j:=index_train_adresse(adrtrain); trains[j].tempoDemarre:=20; // armer la tempo à 2s @@ -4766,36 +4901,36 @@ begin // allume les signaux du feu dans le TCO if TCOACtive then begin - indexTCO:=1; - for y:=1 to NbreCellY[indexTCO] do - for x:=1 to NbreCellX[indexTCO] do - begin - if TCO[indexTCO,x,y].Bimage=Id_signal then - begin - adresse:=TCO[IndexTCO,x,y].adresse; // vérifie si le feu existe dans le TCO - aspect:=feux[Index_Signal(adresse)].Aspect; - case aspect of - 2 : ImageFeu:=Formprinc.Image2feux; - 3 : ImageFeu:=Formprinc.Image3feux; - 4 : ImageFeu:=Formprinc.Image4feux; - 5 : ImageFeu:=Formprinc.Image5feux; - 7 : ImageFeu:=Formprinc.Image7feux; - 9 : ImageFeu:=Formprinc.Image9feux; - 12 : ImageFeu:=Formprinc.Image2Dir; - 13 : ImageFeu:=Formprinc.Image3Dir; - 14 : ImageFeu:=Formprinc.Image4Dir; - 15 : ImageFeu:=Formprinc.Image5Dir; - 16 : ImageFeu:=Formprinc.Image6Dir; - 20 : ImageFeu:=formprinc.ImageSignal20; - else ImageFeu:=Formprinc.Image3feux; - end; - TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) - TailleX:=ImageFeu.picture.BitMap.Width; - Orientation:=tco[indextco,x,y].FeuOriente; - // réduction variable en fonction de la taille des cellules - calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]); - // décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G - Dessine_signal_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indextco,x,y].y,frx,fry,adresse,orientation); + indexTCO:=1; + for y:=1 to NbreCellY[indexTCO] do + for x:=1 to NbreCellX[indexTCO] do + begin + if TCO[indexTCO,x,y].Bimage=Id_signal then + begin + adresse:=TCO[IndexTCO,x,y].adresse; // vérifie si le feu existe dans le TCO + aspect:=feux[Index_Signal(adresse)].Aspect; + case aspect of + 2 : ImageFeu:=Formprinc.Image2feux; + 3 : ImageFeu:=Formprinc.Image3feux; + 4 : ImageFeu:=Formprinc.Image4feux; + 5 : ImageFeu:=Formprinc.Image5feux; + 7 : ImageFeu:=Formprinc.Image7feux; + 9 : ImageFeu:=Formprinc.Image9feux; + 12 : ImageFeu:=Formprinc.Image2Dir; + 13 : ImageFeu:=Formprinc.Image3Dir; + 14 : ImageFeu:=Formprinc.Image4Dir; + 15 : ImageFeu:=Formprinc.Image5Dir; + 16 : ImageFeu:=Formprinc.Image6Dir; + 20 : ImageFeu:=formprinc.ImageSignal20; + else ImageFeu:=Formprinc.Image3feux; + end; + TailleY:=ImageFeu.picture.BitMap.Height; // taille du signal d'origine + TailleX:=ImageFeu.picture.BitMap.Width; + Orientation:=tco[indextco,x,y].FeuOriente; + // réduction variable en fonction de la taille des cellules + calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]); + // décalage en X pour mettre la tete du signal alignée sur le bord droit de la cellule pour les signaux tournés à 90G + Dessine_signal_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indextco,x,y].y,frx,fry,adresse,orientation); end; end; end; @@ -4926,6 +5061,7 @@ begin IndexBranche_trouve:=i; end; +// vérifie la configuration du décodeur Unisemaf // si 0 = OK // si 1 = erreur code Unisemaf // si 2 = erreur cohérence entre code et aspect @@ -4941,19 +5077,19 @@ begin if i<>0 then begin aspect:=feux[i].aspect; - if ((aspect=2) and (UniSem=2)) or - ((aspect=3) and (UniSem=3)) or - ((aspect=4) and (UniSem=4)) or - ((aspect=5) and ((UniSem=51) or (UniSem=52))) or - ((aspect=7) and ((UniSem=71) or (UniSem=72) or (UniSem=73))) or - ((aspect=9) and ((UniSem>=90) or (UniSem<=99))) - then Verif_unisemaf:=0 + if ((aspect=2) and (UniSem=2)) or + ((aspect=3) and (UniSem=3)) or + ((aspect=4) and (UniSem=4)) or + ((aspect=5) and ((UniSem=51) or (UniSem=52))) or + ((aspect=7) and ((UniSem=71) or (UniSem=72) or (UniSem=73))) or + ((aspect=9) and ((UniSem>=90) or (UniSem<=99))) + then Verif_unisemaf:=0 else Verif_Unisemaf:=2; end else begin - Affiche('Erreur Signal '+intToSTR(adresse)+' inconnu',clred); - Verif_Unisemaf:=3; + Affiche('Erreur Signal '+intToSTR(adresse)+' inconnu',clred); + Verif_Unisemaf:=3; end; end; @@ -4997,9 +5133,8 @@ end; // trouve un élément dans les branches depuis les index. // Plus rapide que la procédure précédente. Renvoie branche_trouve IndexBranche_trouve // el : adresse de l'élément TypeEL=(1=détécteur 2=aig 3=aig Bis 4=aig triple - Buttoir) -// offset ne sert pas!!! -// avec cet algorithme, un détecteur et un aiguillage ne peut se trouver qu'à un seul endroit. -procedure trouve_element(el: integer; TypeEl : TEquipement; Offset : integer); +// avec cet algorithme, un détecteur et un aiguillage ne peut se trouver qu'à un seul endroit dans les branches +procedure trouve_element(el: integer; TypeEl : TEquipement); var s : string; begin if debug=3 then formprinc.Caption:='Trouve_element '+IntToSTR(el); @@ -5021,8 +5156,13 @@ begin indexBranche_trouve:=aiguillage[index_aig(el)].IndexBranche; // NumBranche et Indexbranche aiguillage[] sont indexés par un index end; - //Affiche_Suivi(intToSTR(el),clred); + if typeEL=buttoir then + begin + branche_trouve:=detecteur[el].NumBranche; // le détecteur det se trouve dans + indexBranche_trouve:=detecteur[el].IndexBranche; + end; + //Affiche_Suivi(intToSTR(el),clred); if IndexBranche_trouve=0 then begin @@ -5039,9 +5179,9 @@ end; // renvoie l'élément suivant des deux éléments dans le sens (prec,typeElprec) -> (actuel,typeElActuel) quels qu'ils soient mais contigus // *** attention, si les éléments ne sont pas contigus, le résultat est erronné!!! *** // un élément est constitué de son adresse et de son type -// et renvoie aussi en variable globale: typeGen le type de l'élément -// s'ils ne sont pas contigus, on aura une erreur -// alg= algorithme 1 à 8: +// et renvoie aussi en variable globale: typeGen le type de l'élément (det aig uniquement! pas tjd ni crois) +// : AigMal = aiguillage mal positionné ou inconnu +// alg= algorithme 1 à 8 sous forme de bits fonctionnels // bit0 (1)=arret sur suivant qu'il soit un détecteur ou un aiguillage // bit1 (2)=arret sur aiguillage en talon mal positionné // bit2 (4)=arret sur aiguillage réservé @@ -5079,7 +5219,7 @@ begin AfficheDebug('Alg3 précédent='+intToSTR(prec)+'/'+BtypeToChaine(TypeElprec)+' actuel='+intToSTR(actuel)+'/'+BtypeToChaine(typeElActuel)+' Alg='+intToSTr(alg),clyellow); // trouver les éléments du précédent dans les branches - trouve_element(prec,TypeELPrec,1); // branche_trouve IndexBranche_trouve + trouve_element(prec,TypeELPrec); // branche_trouve IndexBranche_trouve if IndexBranche_trouve=0 then begin if NivDebug=3 then AfficheDebug('Element '+intToSTR(prec)+' non trouvé',clred); @@ -5090,7 +5230,7 @@ begin branche_trouve_prec:=branche_trouve; BtypePrec:=BrancheN[branche_trouve_prec,indexBranche_prec].Btype; - trouve_element(actuel,typeElActuel,1); // branche_trouve IndexBranche_trouve + trouve_element(actuel,typeElActuel); // branche_trouve IndexBranche_trouve if IndexBranche_trouve=0 then begin if NivDebug=3 then AfficheDebug('Element '+intToSTR(actuel)+' non trouvé',clred); @@ -5213,7 +5353,7 @@ begin if adr<>0 then begin if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig - trouve_element(adr,typeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(adr,typeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype; end @@ -5245,7 +5385,7 @@ begin if adr<>0 then begin if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig) - trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(adr,TypeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype; end @@ -5259,6 +5399,7 @@ begin if NivDebug>=1 then AfficheDebug('134.2 - Aiguillage '+IntToSTR(adr)+' non résolu car position inconnue',clOrange); typeGen:=rien; suivant_alg3:=9996; + AigMal:=adr; exit; end; end @@ -5278,6 +5419,7 @@ begin begin if NivDebug=3 then AfficheDebug('135.1 - Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); suivant_alg3:=9998; + AigMal:=adr; exit; end else @@ -5293,10 +5435,11 @@ begin md:=aiguillage[index_aig(prec)].modele; if (md=tjd) or (md=tjs) then prec:=aiguillage[index_aig(prec)].Ddevie; end; - if prec<>aiguillage[index].Adevie then + if (prec<>aiguillage[index].Adevie) or (aiguillage[index].position=const_inconnu) then begin if NivDebug=3 then AfficheDebug('135.3 Aiguillage '+intToSTR(adr)+' mal positionné',clyellow); suivant_alg3:=9998; + AigMal:=adr; exit; end else @@ -5321,7 +5464,7 @@ begin begin // Affiche('trouvé '+intToSTR(adr),clyellow); if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig - trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(adr,TypeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype; end @@ -5337,6 +5480,7 @@ begin Affiche(s,clOrange); end; suivant_alg3:=9996; // position inconnue + AigMal:=adr; exit; end; @@ -5525,7 +5669,9 @@ begin if (nivdebug>1) or traceliste then AfficheDebug('135.5- TJD/S '+intToSTR(adr)+' mal positionnée cas 1.1',clyellow); if (alg and 2)=2 then begin - suivant_alg3:=9998;exit; + suivant_alg3:=9998; + AigMal:=adr; + exit; end; end; end; @@ -5540,7 +5686,9 @@ begin if (nivdebug>1) then AfficheDebug('135.6- TJD/S '+intToSTR(adr)+' mal positionnée cas 1.2',clyellow); if (alg and 2=2) then begin - suivant_alg3:=9998;exit; + suivant_alg3:=9998; + AigMal:=adr; + exit; end; end; end; @@ -5587,7 +5735,9 @@ begin if (nivdebug>1) or traceliste then AfficheDebug('135.7- TJD '+intToSTR(adr)+' mal positionnée - cas 2.1',clyellow); if (alg and 2)=2 then begin - suivant_alg3:=9998;exit; + suivant_alg3:=9998; + AigMal:=adr; + exit; end; end; end; @@ -5609,7 +5759,9 @@ begin if (nivdebug>1) or traceliste then AfficheDebug('135.18- TJD '+intToSTR(adr)+' mal positionnée cas 2.2',clyellow); if (alg and 2)=2 then begin - suivant_alg3:=9998;exit; + suivant_alg3:=9998; + AigMal:=adr; + exit; end; end; end; @@ -5655,6 +5807,7 @@ begin if (alg and 2)=2 then begin suivant_alg3:=9998; + AigMal:=adr; exit; end; end; @@ -5679,6 +5832,7 @@ begin if (alg and 2)=2 then begin suivant_alg3:=9998; + AigMal:=adr; exit; end; end; @@ -5718,7 +5872,9 @@ begin if (nivdebug>1) or traceliste then AfficheDebug('135.7- TJD '+intToSTR(adr)+' mal positionnée cas 4.1',clyellow); if (alg and 2)=2 then begin - suivant_alg3:=9998;exit; + suivant_alg3:=9998; + AigMal:=adr; + exit; end; end; end; @@ -5733,7 +5889,9 @@ begin if (nivdebug>1) or traceliste then AfficheDebug('135.8- TJD '+intToSTR(adr)+' mal positionnée cas 4.2',clyellow); if (alg and 2)=2 then begin - suivant_alg3:=9998;exit; + suivant_alg3:=9998; + AigMal:=adr; + exit; end; end; end; @@ -5789,7 +5947,9 @@ begin s:='1026 - position TJD/S '+IntToSTR(Adr)+'='+intToSTR(aiguillage[index].position)+' / '+intToSTR(index)+'='+intToSTR(aiguillage[index2].position)+' inconnue'; AfficheDebug(s,clOrange); end; - suivant_alg3:=9999;exit; + suivant_alg3:=9996; // position inconnue + AigMal:=aiguillage[index].adresse; + exit; end; end; @@ -5838,7 +5998,7 @@ begin Adr:=aiguillage[index].Adroit; if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; //TypeEL=(1=détécteur 2=aig if adr=0 then TypeEl:=buttoir; - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(Adr,TypeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; //?? suivant_alg3:=adr; @@ -5851,7 +6011,7 @@ begin Adr:=aiguillage[index].Adevie; if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; if adr=0 then TypeEl:=buttoir; - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(Adr,TypeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; suivant_alg3:=adr;exit; @@ -5862,13 +6022,17 @@ begin A:=aiguillage[index].Adevie2B; Adr:=aiguillage[index].Adevie2; if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(Adr,TypeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; suivant_alg3:=adr; exit; end; - if aiguillage[index].position=const_inconnu then begin suivant_alg3:=9996;exit;end; // pour échappement + if aiguillage[index].position=const_inconnu then + begin + AigMal:=aiguillage[index].adresse; + suivant_alg3:=9996;exit; + end; // pour échappement s:='Aiguillage triple '+IntToSTR(Adr)+' : configuration des aiguilles interdite'; if CDM_connecte then s:=s+': '+IntToSTR(aiguillage[index].position); AfficheDebug(s,clYellow); @@ -5887,6 +6051,7 @@ begin begin if (nivdebug>1) or traceliste then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow); suivant_alg3:=9998; + AigMal:=adr; exit; end else @@ -5900,6 +6065,7 @@ begin begin if (nivdebug>1) or traceliste then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow); suivant_alg3:=9998; + AigMal:=adr; exit; end else @@ -5913,6 +6079,7 @@ begin begin if (nivdebug>1) or traceliste then AfficheDebug('135.3 - Aiguillage '+intToSTR(adr)+'triple mal positionné',clyellow); suivant_alg3:=9998; + AigMal:=adr; exit; end else @@ -5924,7 +6091,7 @@ begin A:=aiguillage[index].ApointeB; Adr:=aiguillage[index].Apointe; if (A='Z') or (a=#0) then TypeEl:=det else TypeEL:=aig; - trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve + trouve_element(Adr,TypeEl); // branche_trouve IndexBranche_trouve if branche_trouve=0 then begin suivant_alg3:=9999;exit;end; typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType; suivant_alg3:=Adr; @@ -5936,6 +6103,7 @@ begin end; // renvoie l'adresse du signal s'il est associé au détecteur "detecteur" +// sinon renvoie 0 function signal_detecteur(detecteur : integer) : integer; var trouve : boolean; i : integer; @@ -5944,7 +6112,7 @@ begin repeat trouve:=(feux[i].Adr_det1=detecteur) or (feux[i].Adr_det2=detecteur) or (feux[i].Adr_det3=detecteur) or (feux[i].Adr_det4=detecteur); inc(i); - until (i>=NbreFeux) or trouve; + until (i>=NbreFeux+1) or trouve; if trouve then signal_detecteur:=feux[i-1].adresse else signal_detecteur:=0; end; @@ -5952,7 +6120,7 @@ end; // renvoie dans voie le numéro de la voie (1 à 4) du signal sur lequel le détecteur se trouve // attention , il peut y avoir plus d'un feu sur un detecteur (suivant le sens)! // si 2eme feu, son index est dans index2 -function index_feu_det(adr : integer;var voie,index2 : integer) : integer ; +function index_signal_det(adr : integer;var voie,index2 : integer) : integer ; var trouve,i,index1 : integer; trouve1,trouve2,trouve3,trouve4 : boolean; begin @@ -5982,7 +6150,7 @@ begin end; inc(i); until (trouve=2) or (i>NbreFeux); - Index_feu_det:=index1; + Index_signal_det:=index1; end; @@ -6253,7 +6421,7 @@ begin tp:=det; if det1=0 then tp:=buttoir; - trouve_element(det1,tp,1); // branche_trouve IndexBranche_trouve + trouve_element(det1,tp); // branche_trouve IndexBranche_trouve if IndexBranche_trouve=0 then begin if NivDebug=3 then AfficheDebug('Element '+intToSTR(det1)+' non trouvé',clred); @@ -6266,7 +6434,7 @@ begin tp:=det; if det2=0 then tp:=buttoir; - trouve_element(det2,tp,1); // branche_trouve IndexBranche_trouve + trouve_element(det2,tp); // branche_trouve IndexBranche_trouve if IndexBranche_trouve=0 then begin if NivDebug=3 then AfficheDebug('Element '+intToSTR(det2)+' non trouvé',clred); @@ -6365,7 +6533,7 @@ begin begin // détecteur suivant det_suiv_cont:=detecteur_suivant(dernier,dernierTyp,det2,det,alg); - //Affiche(intToSTR(suivant),clorange); + //Affiche(intToSTR(suivant),clorange); end else det_suiv_cont:=9999; end; @@ -6378,7 +6546,7 @@ var Adr,AdrFonc,Branche,AdrPrec,IndexBranche,i,Dir : integer; sortie : boolean; BtypeFonc,BtypePrec : TEquipement; begin - trouve_element(adresse,det,1); // branche_trouve IndexBranche_trouve + trouve_element(adresse,det); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin Affiche('Erreur 380 : élément '+IntToSTR(adresse)+' det non trouvé',clred); @@ -6418,6 +6586,343 @@ begin until dir=3; end; +// renvoie l'adresse des détecteurs précédents un signal après les aiguillages +// renvoie dans le tableau TabloDet +procedure det_prec_signal(adresse : integer;var tabloDet : TTabloDet); +var el1,el2,i,i2,index,it,voie : integer; + tq1,tq2 : tEquipement; + + // explore un aiguillage + procedure explore_branche(prec,adrAig : integer); + var i,el1,el2 : integer; + c: char; + typ : tEquipement; + begin + inc(it); + if it>20 then begin Affiche('Erreur 95',clred);exit;end; + i:=index_aig(adrAig); + typ:=aiguillage[i].modele; + + if (typ=triple) then + begin + // pris en pointe? + if aiguillage[i].APointe=prec then + begin + //Affiche('Aig'+inttostr(adraig)+' pointe droit',clyellow); + el1:=adraig;tq1:=typ; + // explore droit + el2:=aiguillage[i].ADroit; + c:=aiguillage[i].ADroitB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + + //Affiche('Aig'+inttostr(adraig)+' pointe dévié',clyellow); + // explore dévié 1 + i:=index_aig(adrAig); + el2:=aiguillage[i].ADevie; + c:=aiguillage[i].ADevieB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + + // explore dévié 2 + i:=index_aig(adrAig); + el2:=aiguillage[i].ADevie2; + c:=aiguillage[i].ADevie2B; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end + else + // pris en talon + begin + el1:=adraig;tq1:=typ; + //Affiche('Aig'+inttostr(adraig)+' talon',clyellow); + // pris en talon + el2:=aiguillage[i].APointe; + c:=aiguillage[i].APointeB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end; + end; + + if (typ=tjd) or (typ=tjs) then + begin + // 4 états + if index_aig(aiguillage[i].EtatTJD)=4 then + begin + i2:=index_aig(aiguillage[i].DDevie); // index de la tjd homologue + // provenance de la tjd + if (aiguillage[i].ADroit=prec) or (aiguillage[i].ADevie=prec) then + begin + // destination 1 de la tjd + el2:=aiguillage[i2].Adevie;c:=aiguillage[i2].ADevieB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + + // destination 2 de la tjd + el2:=aiguillage[i2].Adroit;c:=aiguillage[i2].ADroitB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end; + + { + // provenance 2 de la tjd + if (aiguillage[i].ADevie=prec) or (aiguillage[i].ADroit=prec) then + begin + // destination 2 de la tjd + el2:=aiguillage[i2].Adevie;c:=aiguillage[i2].ADevieB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + + el2:=aiguillage[i2].Adroit;c:=aiguillage[i2].ADroitB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end;} + end; + + // 2 états + if index_aig(aiguillage[i].EtatTJD)=2 then + begin + // provenance sens 1 + if (aiguillage[i].ADroit=prec) or (aiguillage[i].ADevie=prec) then + begin + // destination 1 de la tjd + el2:=aiguillage[i].Ddevie;c:=aiguillage[i].DDevieB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + // destination 2 de la tjd + el2:=aiguillage[i].Ddroit;c:=aiguillage[i].DDroitB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end; + + // provenance sens 2 + if (aiguillage[i].DDevie=prec) or (aiguillage[i].Ddroit=prec) then + begin + // destination 1 de la tjd + el2:=aiguillage[i].Adroit;c:=aiguillage[i].ADroitB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + // destination 2 de la tjd + el2:=aiguillage[i].Adevie;c:=aiguillage[i].AdevieB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end; + + end; + end; + + if typ=crois then + begin + //Affiche('croisement '+intToSTR(adrAig),clyellow); + if aiguillage[i].Adroit=prec then begin el2:=aiguillage[i].Ddroit;c:=aiguillage[i].DdroitB;end; + if aiguillage[i].Adevie=prec then begin el2:=aiguillage[i].Ddevie;c:=aiguillage[i].DdevieB;end; + if aiguillage[i].Ddevie=prec then begin el2:=aiguillage[i].Adevie;c:=aiguillage[i].AdevieB;end; + if aiguillage[i].Ddroit=prec then begin el2:=aiguillage[i].Adroit;c:=aiguillage[i].AdroitB;end; + if (c='P') or (c='D') or (c='S') then + begin + //i:=index_aig(el2); + //teq2:=aiguillage[i].modele; + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end; + if typ=aig then + begin + // pris en pointe? + if aiguillage[i].APointe=prec then + begin + //Affiche('Aig'+inttostr(adraig)+' pointe droit',clyellow); + el1:=adraig;tq1:=typ; + // explore droit + el2:=aiguillage[i].ADroit; + c:=aiguillage[i].ADroitB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + + //Affiche('Aig'+inttostr(adraig)+' pointe dévié',clyellow); + // explore dévié + i:=index_aig(adrAig); + el2:=aiguillage[i].ADevie; + c:=aiguillage[i].ADevieB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end + else + begin + el1:=adraig;tq1:=typ; + //Affiche('Aig'+inttostr(adraig)+' talon',clyellow); + // pris en talon + el2:=aiguillage[i].APointe; + c:=aiguillage[i].APointeB; + if (c='P') or (c='D') or (c='S') then + begin + explore_branche(Adraig,el2); + end + else + begin + //Affiche(IntToSTR(el2),clLime); + tabloDet[index]:=el2;inc(index); + end; + end; + end; + end; + +begin + // trouver élément avant le signal + for i:=1 to 10 do tabloDet[i]:=0; + i:=index_signal(adresse); + if i=0 then affiche('Erreur 842 : signal '+intToSTR(adresse)+' inconnu',clred); + + index:=1; + for voie:=1 to 4 do + begin + //Affiche('Voie '+intToStr(voie),clyellow); + case voie of + 1 : begin + el2:=feux[i].Adr_det1; + tq2:=det; + el1:=feux[i].Adr_el_suiv1; + tq1:=feux[i].Btype_suiv1; + end; + 2 : begin + el2:=feux[i].Adr_det2; + tq2:=det; + el1:=feux[i].Adr_el_suiv2; + tq1:=feux[i].Btype_suiv2; + end; + 3 : begin + el2:=feux[i].Adr_det3; + tq2:=det; + el1:=feux[i].Adr_el_suiv3; + tq1:=feux[i].Btype_suiv3; + end; + 4 : begin + el2:=feux[i].Adr_det4; + tq2:=det; + el1:=feux[i].Adr_el_suiv4; + tq1:=feux[i].Btype_suiv4; + end; + end; + + if el2<>0 then + begin + it:=0; + suivant:=suivant_alg3(el1,tq1,el2,det,0); //typeGen + if (typeGen=aig) or (typeGen=tjd) or (typeGen=tjs) or (typeGen=triple) then explore_branche(el2,suivant); + if typeGen=det then begin tabloDet[1]:=suivant;index:=2;end; + end; + end; + tabloDet[index]:=0; + { + for i:=1 to Index do + begin + Affiche(IntToSTR(tabloDet[i]),clyellow); + end; + } +end; + // renvoie l'adresse du détecteur suivant les deux éléments // les aiguillages doivent être correctement positionnés entre El1 et el2 @@ -6438,13 +6943,13 @@ begin AfficheDebug('Proc Detecteur_suivant_EL '+intToSTR(el1)+','+BTypeToChaine(Typedet1)+'/'+intToSTR(el2)+','+BTypeToChaine(Typedet2)+'-------------------------',clLime); if (el1>9000) or (el2>9000) then begin - if NivDebug=3 then AfficheDebug('paramètres incorrects >9000',clred); + if NivDebug=3 then AfficheDebug('Paramètres incorrects >9000',clred); detecteur_suivant_El:=9999; exit; end; // trouver détecteur 1 - trouve_element(el1,Typedet1,1); // branche_trouve IndexBranche_trouve + trouve_element(el1,Typedet1); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin if NivDebug=3 then @@ -6459,7 +6964,7 @@ begin branche_trouve_det1:=branche_trouve; // trouver détecteur 2 - trouve_element(el2,Typedet2,1); // branche_trouve IndexBranche_trouve + trouve_element(el2,Typedet2); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin if NivDebug=3 then @@ -6595,7 +7100,7 @@ begin end; // trouver détecteur 1 - trouve_element(el1,det,1); // branche_trouve IndexBranche_trouve + trouve_element(el1,det); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin if NivDebug=3 then @@ -6610,7 +7115,7 @@ begin branche_trouve_det1:=branche_trouve; // trouver détecteur 2 - trouve_element(el2,det,1); // branche_trouve IndexBranche_trouve + trouve_element(el2,det); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then begin if NivDebug=3 then @@ -6752,8 +7257,7 @@ begin end; -// renvoie vrai si les aiguillages déclarés dans la définition du signal sont mal positionnés -// (conditions supplémentaires) +// renvoie vrai si les aiguillages déclarés dans les conditions supplémentaires pour le signal "adresse" sont mal positionnés function cond_carre(adresse : integer) : boolean; var i,l,k,NCondCarre,adrAig,index : integer; resultatET,resultatOU: boolean; @@ -6805,11 +7309,12 @@ begin cond_carre:=ResultatOU; end; -// renvoie vrai si le signal adresse doit afficher un carré car les aiguillages au dela du signal sont mal positionnés +// renvoie l'adresse de l'aiguillage mal positionné si le signal adresse doit afficher un carré car les aiguillages au dela du signal +// sont mal positionnés. renvoie 0 si les aiguillages sont bien positionnés // et teste si les éléments jusqu'au signal suivant s'ils sont verrouillés // TrainReserve : adresse du train qui demande la fonction ou 0 // Si reserveTrainTiers=vrai, le parcours est réservé par un autre train -function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean;Var AdrTrain : integer) : boolean; +function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean;Var AdrTrain : integer) : integer; var i,j,k,prec,indexFeu,AdrSuiv,index2,voie,AdrFeu : integer; TypeELPrec,TypeElActuel : TEquipement; @@ -6818,7 +7323,7 @@ var begin AdrTrain:=0; ReserveTrainTiers:=false; - if (NivDebug>=1) then AfficheDebug('Proc carre_signal '+IntToSTR(adresse),clyellow); + if (NivDebug>=1) then AfficheDebug('Proc carre_signal '+IntToSTR(adresse)+' -----------',clyellow); i:=Index_Signal(adresse); if i=0 then @@ -6826,7 +7331,7 @@ begin s:='Erreur 603 - Signal '+IntToSTR(adresse)+' non trouvé'; Affiche(s,clred); if NivDebug=3 then AfficheDebug(s,clred); - carre_signal:=true; + carre_signal:=adresse; exit; end; @@ -6835,7 +7340,7 @@ begin s:='La demande de carré d''un signal directionnel '+IntToSTR(Adresse)+' est irrecevable'; Affiche(s,clred); AfficheDebug(s,clred); - carre_signal:=true; + carre_signal:=adresse; exit; end; @@ -6865,7 +7370,7 @@ begin begin // si pas de train avant signal : verrouiller au carré reserveTrainTiers:=false; - carre_signal:=true; + carre_signal:=adresse; exit; end; @@ -6894,10 +7399,11 @@ begin if (AdrSuiv=9999) or (AdrSuiv=9996) or (AdrSuiv=9995) then // élément non trouvé ou position aiguillage inconnu ou buttoir begin; - carre_signal:=true; + carre_signal:=AigMal; if debug=3 then formprinc.Caption:=''; exit; end; + if (AdrSuiv<>9998) then // arret sur aiguillage en talon mal positionnée begin prec:=actuel; @@ -6910,7 +7416,7 @@ begin indexFeu:=0; if (typeElPrec=det) then begin - indexFeu:=index_feu_det(prec,voie,index2); // trouve l'index du feu correspondant au détecteur AdrSuiv + indexFeu:=index_signal_det(prec,voie,index2); // trouve l'index du feu correspondant au détecteur AdrSuiv if indexFeu<>0 then begin @@ -6941,7 +7447,8 @@ begin if (adrFeu=Adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant begin - IndexFeu:=0;j:=10; // on ne trouve pas de suivant + IndexFeu:=0; + j:=10; // on ne trouve pas de suivant end; if (Feux[index2].Adr_el_suiv1=AdrSuiv) then // le feu est-il dans le bon sens de progression? begin @@ -6960,8 +7467,8 @@ begin //Affiche(IntToSTR(AdrFeu),clOrange); end; - // si le suivant est un aiguillage - if (typeElActuel=Aig) or (typeElActuel=Crois) then + // si le suivant est un aiguillage , mais ne vérifier que si pas trouvé de signal + if ((typeElActuel=Aig) or (typeElActuel=Crois)) and (AdrFeu=0) then begin // adresse k:=index_aig(actuel); @@ -6973,7 +7480,7 @@ begin reserveTrainTiers:=reserveTrainTiers or (AdrTrain<>Trainreserve); if (nivdebug>=1) then AfficheDebug('Aiguillage '+intToSTR(aiguillage[k].adresse)+' verrouillé par train @'+intToSTR(AdrTrain),clorange); end; - end; + end; end; sort:=(j=10) or (indexFeu<>0) or (AdrSuiv=9998) or (AdrSuiv=0); // arret si aiguillage en talon ou buttoir @@ -6986,12 +7493,13 @@ begin if AdrTrain<>0 then afficheDebug('Un aiguillage est réservé par le train '+intToSTR(AdrTrain),clyellow); if (AdrSuiv<>9998) and (AdrTrain=0) then AfficheDebug('Le signal '+intToSTR(adresse)+' ne doit pas afficher de carré',clyellow); end; - carre_signal:=AdrSuiv=9998; + if AdrSuiv=9998 then result:=actuel else result:=0; + //AdrSuiv=9998; if debug=3 then formprinc.Caption:=''; end; -// renvoie l'adresse du signal suivant à partir du détecteur det1 (non compris) et dans le sens det1 vers det2. +// renvoie l'adresse du signal suivant (et dans le bon sens) à partir du détecteur det1 (non compris) et dans le sens det1 vers det2. // Si renvoie 0, pas trouvé le signal suivant. function signal_suivant_det(det1,det2 : integer) : integer; var num_feu,AdrFeu,i,j,prec,AdrSuiv,index2,voie : integer; @@ -6999,7 +7507,7 @@ var num_feu,AdrFeu,i,j,prec,AdrSuiv,index2,voie : integer; s : string; begin //traceDet:=true; - if NivDebug>=2 then AfficheDebug('Cherche Signal suivant détecteur '+IntToSTR(det1),clyellow); + if NivDebug>=2 then AfficheDebug('Cherche signal suivant au détecteur '+IntToSTR(det1),clyellow); // trouve l'élément suivant contigu det_contigu(det2,det1,i,Typ); @@ -7064,7 +7572,7 @@ begin AdrFeu:=0; if (TypeActuel=det) then // détecteur? begin - i:=Index_feu_det(Actuel,voie,index2); // trouve l'index de feu affecté au détecteur "Actuel" + i:=Index_signal_det(Actuel,voie,index2); // trouve l'index de feu affecté au détecteur "Actuel" if i<>0 then begin AdrFeu:=Feux[i].Adresse; @@ -7119,7 +7627,6 @@ begin AdrFeu:=0; end; end; -// AdrFeu:=0; end; end end @@ -7132,15 +7639,25 @@ begin if (NivDebug=3) and (adrFeu=0) then AfficheDebug('Pas Trouvé de signal suivant au signal Adr='+IntToSTR(det1),clOrange); end; +function modele(adresse : integer;mdl : tEquipement) : tequipement; +begin + if mdl=det then result:=det; + if mdl=aig then + begin + result:=aiguillage[index_aig(adresse)].modele; + end; +end; + + // renvoie l'état du signal suivant du signal "adresse". Si renvoie 0, pas trouvé le signal suivant. // adresse : adresse du signal // rang=1 pour feu suivant, 2 pour feu suivant le 1, etc // retour dans AdrSignalsuivant : adresse du feu suivant // stocke les éléments trouvés dans Elements function etat_signal_suivant(Adresse,rang : integer;var AdrSignalsuivant : integer) : integer; -var num_feu,etat,AdrFeu,i,j,prec,AdrSuiv,index2,voie : integer; +var index,num_feu,etat,AdrFeu,i,j,prec,AdrSuiv,index2,voie : integer; aspect,combine : integer; - TypePrec,TypeActuel : TEquipement; + TypePrec,TypeActuel,typ : TEquipement; s : string; begin if NivDebug>=2 then AfficheDebug('Cherche état du signal suivant au '+IntToSTR(adresse),clyellow); @@ -7195,18 +7712,33 @@ begin end else begin - AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1); + AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,1); // 1 = if Nivdebug=3 then AfficheDebug('Suivant='+intToSTR(AdrSuiv),clyellow); prec:=actuel;TypePrec:=TypeActuel; actuel:=AdrSuiv;TypeActuel:=typeGen; if idEl<20 then begin - elements[idEl].adresse:=actuel;elements[IdEl].typ:=typeActuel; + // rectifier le type de l'élément + elements[idEl].adresse:=actuel; + typ:=modele(actuel,typeActuel); + elements[IdEl].typ:=typ; inc(idEl); + + if (typ=tjs) or (typ=tjd) then + begin + index:=index_aig(actuel); + if aiguillage[index].EtatTJD=4 then + begin + index:=index_aig(aiguillage[index].DDevie); // index de la tjd homologue + elements[idEl].adresse:=aiguillage[index].Adresse; + elements[idEl].typ:=typ; + inc(idel); + end; + end; end; - if (AdrSuiv=9999) or (AdrSuiv=9996) then + if (AdrSuiv=9999) or (AdrSuiv=9996) then // erreur fatale ou position inconnue begin Etat_signal_suivant:=0; AdrSignalsuivant:=0; @@ -7225,7 +7757,7 @@ begin AdrFeu:=0; if (TypeActuel=det) then // détecteur? begin - i:=Index_feu_det(Actuel,voie,index2); // trouve l'index de feu affecté au détecteur "Actuel" + i:=Index_signal_det(Actuel,voie,index2); // trouve l'index de feu affecté au détecteur "Actuel" if i<>0 then begin AdrFeu:=Feux[i].Adresse; @@ -7251,8 +7783,7 @@ begin if NivDebug=3 then begin s:='Trouvé signal suivant Adr='+IntToSTR(AdrFeu)+': '+IntToSTR(etat)+'='; - if aspect<>-1 then s:=s+EtatSign[aspect]+' '; - if combine<>-1 then s:=s+EtatSign[combine]; + s:=s+chaine_signal(AdrFeu); AfficheDebug(s,clorange); end; end @@ -7301,7 +7832,6 @@ begin etat_signal_suivant:=Etat; AdrSignalsuivant:=Signal_suivant; if (NivDebug=3) and (adrFeu=0) then AfficheDebug('Pas Trouvé de feu suivant au feu Adr='+IntToSTR(ADresse),clOrange); - exit; end; // renvoie l'adresse de la première aiguille déviée après le signal "adresse" et ce jusqu'au prochain signal @@ -7349,7 +7879,7 @@ begin AdrFeu:=0; if (TypeActuel=det) then // détecteur begin - i:=Index_feu_det(AdrSuiv,voie,index2); // trouve l'index de feu affecté au détecteur "AdrSuiv" + i:=Index_signal_det(AdrSuiv,voie,index2); // trouve l'index de feu affecté au détecteur "AdrSuiv" AdrFeu:=Feux[i].Adresse; if NivDebug=3 then AfficheDebug('trouvé signal '+intToSTR(AdrFeu)+' associé au détecteur '+IntToSTR(AdrSuiv),clyellow); end; @@ -7418,7 +7948,7 @@ begin end; -// renvoie vrai si une mémoire de zone est occupée après le signal "adresse" jusqu'au signal suivant +// renvoie vrai si une mémoire de zone est occupée après le signal "adresse" jusqu'au signal suivant (=canton) // sort de suite si on trouve un train // adresse=adresse du signal function test_memoire_zones(adresse : integer) : boolean; @@ -7535,7 +8065,7 @@ begin dernierdet:=actuel; - isi:=index_feu_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal + isi:=index_signal_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal if isi<>0 then begin AdrFeu:=feux[isi].adresse; // adresse du feu @@ -7642,7 +8172,7 @@ end; // renvoie l'adresse du signal précédent au signal "adresse" function Signal_precedent(adresse : integer) : integer; var - AdrSuiv,prec,ife,actuel,i,j,ifd, + AdrSuiv,prec,ife,actuel,i,j,ifd,index, dernierdet,AdrFeu,Nfeux,voie,index2 : integer; TypePrec,TypeActuel : TEquipement; malpositionne : boolean; @@ -7727,15 +8257,28 @@ begin if idEl<20 then begin - elements[idEl].adresse:=actuel;elements[idEl].typ:=typeActuel; + elements[idEl].adresse:=actuel; + elements[idEl].typ:=typeActuel; inc(idEl); + + if (typeActuel=tjs) or (typeActuel=tjd) then + begin + index:=index_aig(actuel); + if aiguillage[index].EtatTJD=4 then + begin + index:=index_aig(aiguillage[index].DDevie); // index de la tjd homologue + elements[idEl].adresse:=aiguillage[index].Adresse; + elements[idEl].typ:=typeActuel; + inc(idel); + end; + end; end; if typeactuel=det then begin dernierdet:=actuel; - ifd:=index_feu_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal + ifd:=index_signal_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal if ifd<>0 then begin AdrFeu:=feux[ifd].adresse; // adresse du feu @@ -7748,7 +8291,6 @@ begin if (feux[ifd].Adr_el_suiv1=prec) then // le feu est-il dans le bon sens de progression? begin inc(Nfeux); - j:=0; s:='Trouvé signal '+IntToSTR(AdrFeu); Signal_precedent:=AdrFeu; if debug=3 then formprinc.Caption:=''; @@ -7775,11 +8317,12 @@ end; // detecteur=true si on doit contrôler aussi sur les détecteurs // renvoie vrai si présence train // dans AdrTrain: renvoie 0 si pas de train -// renvoie l'adresse du 1er train rencontré dans AdrTrain ou 0 si elle est indisponible +// si on est en mode AvecRESA, renvoie l'index du train +// roulage, renvoie l'adresse du train // dans voie : numéro de la voie du signal sur laquelle on a trouvé le train function PresTrainPrec(Adresse,NbCtSig : integer;detect : boolean;var AdrTr,voie : integer) : boolean; var - AdrSuiv,prec,ife,actuel,i,j,ifd, + AdrSuiv,prec,ife,actuel,i,j,k,ifd,d, dernierdet,AdrFeu,Nfeux,NFeuxMax,voieLoc,index2 : integer; TypePrec,TypeActuel : TEquipement; Pres_train,malpositionne,etat,etatDet,EtatZone : boolean; @@ -7789,7 +8332,7 @@ begin if debug=3 then formprinc.Caption:='PresTrainPrec '+IntToSTR(adresse); if NivDebug>=1 then begin - s:='Proc testTrainPrec('+intToSTR(adresse)+') '; + s:='Proc PresTrainPrec('+intToSTR(adresse)+') '; if detect then s:=s+'avec zones de détecteurs et détecteurs' else s:=s+'sur zones de détecteurs uniquement'; AfficheDebug(s,clyellow); @@ -7805,11 +8348,12 @@ begin exit; end; + NFeuxMax:=NbCtSig; // nombre de feux à trouver (nombre de cantons) ife:=1; // index voie de 1 à 4 pour explorer les 4 détecteurs d'un feu repeat - if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange); + if NivDebug=3 then AfficheDebug('Boucle de test signal '+intToSTR(ife)+'/4',clOrange); if (ife=1) then begin actuel:=feux[i].Adr_det1; @@ -7841,9 +8385,15 @@ begin result:=false; exit; end; - pres_Train:=Detecteur[actuel].etat and detect; - if pres_train and (nivDebug=3) then AfficheDebug('Présence train sur dét '+intToSTR(actuel),clyellow); - if pres_train and (AdrTr=0) then AdrTr:=Detecteur[actuel].AdrTrain; + + pres_Train:=Detecteur[actuel].etat and detect; + + if pres_train and (AdrTr=0) then + begin + if avecRESA then AdrTR:=Detecteur[actuel].IndexTrain; + if roulage then AdrTr:=Detecteur[actuel].AdrTrain; + end; + if pres_train and (nivDebug=3) then AfficheDebug('Présence train '+intToSTR(AdrTr)+' sur dét '+intToSTR(actuel),clyellow); TypeActuel:=det; if actuel=0 then @@ -7856,6 +8406,23 @@ begin exit; end; + // lire la mémoire de zone des détecteurs précédent le signal + k:=1; + repeat + d:=feux[i].DetAmont[k]; + if d<>0 then + begin + pres_Train:=MemZone[d,actuel].etat or Pres_Train; + if MemZone[d,actuel].etat and (adrTr=0) then + begin + if avecRESA then AdrTR:=MemZone[d,actuel].indexTrain; + if roulage then AdrTr:=MemZone[d,actuel].AdrTrain; + end; + if (NivDebug=3) and MemZone[d,actuel].etat then AfficheDebug('Trouvé train '+intToSTR(AdrTr)+' sur mémoire de zone '+intToSTR(d)+','+intToSTR(actuel),clyellow); + end; + inc(k); + until (d=0) or (k=11); + dernierdet:=actuel; j:=0; nFeux:=0; @@ -7870,7 +8437,11 @@ begin begin EtatDet:=Detecteur[actuel].etat and detect; Pres_Train:=Pres_Train or etatDet; - if (adrTr=0) then AdrTr:=Detecteur[actuel].AdrTrain; + if Pres_Train and (adrTr=0) then + begin + if roulage then AdrTr:=Detecteur[actuel].AdrTrain; + if avecResa then AdrTr:=Detecteur[actuel].indexTrain; + end; end; if (AdrSuiv=0) and (nivdebug=3) then AfficheDebug('Buttoir',clyellow); @@ -7900,11 +8471,11 @@ begin etatDet:=Detecteur[actuel].etat and detect; etatZone:=MemZone[actuel,dernierdet].etat; Pres_train:=Pres_Train or EtatZone or EtatDet; - if adrTr=0 then AdrTr:=Detecteur[actuel].AdrTrain; - if adrtr=0 then AdrTr:=MemZone[actuel,dernierdet].AdrTrain; - if Pres_Train then + if Pres_Train and (AdrTr=0) then begin + if roulage then AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse + if AvecRESA then AdrTr:=MemZone[actuel,dernierdet].IndexTrain; // index if (nivDebug=3) then begin s:='Présence train '; @@ -7922,10 +8493,10 @@ begin dernierdet:=actuel; - ifd:=index_feu_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal + ifd:=index_signal_det(Actuel,voie,index2); // renvoie l'index du signal se trouvant au détecteur "AdrSuiv": il peut y avoir 4 détecteurs par signal if ifd<>0 then begin - AdrFeu:=feux[ifd].adresse; // adresse du feu + AdrFeu:=feux[ifd].adresse; // adresse du signal if (AdrFeu=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant begin AdrFeu:=0; // on ne trouve pas de suivant @@ -7941,19 +8512,36 @@ begin begin inc(Nfeux); j:=0; - s:='Trouvé signal ('+IntToSTR(nfeux)+'/'+intToSTR(NFeuxMax)+') '+IntToSTR(AdrFeu); + s:='Trouvé signal '+intToStr(AdrFeu)+' ('+IntToSTR(nfeux)+'/'+intToSTR(NFeuxMax)+') '+IntToSTR(AdrFeu); if (NivDebug=3) And Pres_Train then AfficheDebug(s+' et mémoire de zone à 1',clOrange); if (NivDebug=3) And (not(Pres_Train)) then AfficheDebug(s+' et mémoire de zone à 0',clOrange); - if nFeux=NFeuxMax then + if nFeux=NFeuxMax then // si atteint les 3 signaux (3 cantons) begin presTrainPrec:=pres_train; if debug=3 then formprinc.Caption:=''; - voie:=ife; + voie:=ife; // changer la voie exit; end; - end - else - begin + // explorer les présence trains sur les voies en convergence du signal + // lire la mémoire de zone des détecteurs n-2 précédent le signal + k:=1; + repeat + d:=feux[ifd].DetAmont[k]; + if d<>0 then + begin + pres_Train:=MemZone[d,actuel].etat or Pres_Train; + if Pres_Train and (adrtr=0) then + begin + if roulage then AdrTr:=MemZone[d,actuel].AdrTrain; // adresse + if avecRESA then AdrTr:=MemZone[d,actuel].IndexTrain; // index + if (NivDebug=3) then AfficheDebug('Trouvé train '+intToSTR(AdrTr)+' sur mémoire de zone '+intToSTR(d)+','+intToSTR(actuel),clyellow); + end; + end; + inc(k); + until (d=0) or (k=11); + end + else + begin if NivDebug=3 then AfficheDebug('Trouvé signal '+intToSTR(AdrFeu)+' mais dans le mauvais sens',clYellow); AdrFeu:=0; end; @@ -7970,9 +8558,19 @@ begin PresTrainPrec:=Pres_Train; end; +function signal_rouge(adresse : word) : boolean; +var etat,i : integer; +begin + i:=index_signal(adresse); + etat:=feux[i].EtatSignal; + if feux[i].aspect=20 then result:=testbit(etat,rouge) + else result:=testbit(etat,semaphore) or testbit(etat,carre) or testbit(etat,violet); +end; + + // met à jour l'état du signel belge selon l'environnement des aiguillages et des trains procedure signal_belge(Adrfeu : integer;detect : boolean); -var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant,AdrTrainRes : integer; +var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant,AdrTrainRes,detSuiv : integer; Btype_el_suivant : TEquipement; car,presTrain,reserveTrainTiers,Aff_Semaphore : boolean; s: string; @@ -7999,15 +8597,16 @@ begin // détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré //if (Feux[index].VerrouCarre) and (modele>=4) then + presTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,false,AdrTrainLoc,voie); //etape A // présence train par adresse train ; renvoie l'adresse du train dans AdrTrainLoc if AffSignal and roulage then AfficheDebug('L''@ du train avant le signal est '+intToSTR(AdrTrainLoc),clYellow); // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal // verrouillable au carré, afficher un carré - car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes); // si reserveTrainTiers, réservé par un autre train - if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train (@'+intToSTR(AdrTrainRes)+')',clYellow); - if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); + car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes)<>0; // si reserveTrainTiers, réservé par un autre train + if AffSignal and reserveTrainTiers then AfficheDebug('Trouvé aiguillage réservé par autre train (@'+intToSTR(AdrTrainRes)+')',clYellow); + if AffSignal and car then AfficheDebug('Le signal a des aiguilles en talon aval mal positionnées',clYellow); // En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré if roulage then car:=reserveTrainTiers or car; @@ -8015,7 +8614,6 @@ begin car:=cond_carre(AdrFeu) or car; if AffSignal and feux[index].VerrouCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); - if (Feux[index].VerrouCarre and not(presTrain)) or car then Maj_Etat_Signal_belge(AdrFeu,semaphore) else @@ -8023,16 +8621,13 @@ begin // si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation // pour ne pas passer au rouge un feu à contresens. // trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge - if AffSignal then AfficheDebug('test du sémaphore',clYellow); + if AffSignal then AfficheDebug('Test du sémaphore',clYellow); Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal if Aff_Semaphore then begin if AffSignal then AfficheDebug('Présence train après signal'+intToSTR(AdrFeu)+' -> sémaphore ou carré',clYellow); - if testBit(feux[index].EtatSignal,carre)=FALSE then - begin - if feux[index].checkFR then Maj_Etat_Signal_belge(AdrFeu,semaphore_cli) + if feux[index].checkFR then Maj_Etat_Signal_belge(AdrFeu,semaphore_cli) else Maj_Etat_Signal_belge(AdrFeu,semaphore); - end; end else begin @@ -8047,7 +8642,7 @@ begin if feux[index].verscontrevoie then Maj_Etat_Signal_belge(AdrFeu,chevron_F or bita1_F) else Maj_Etat_Signal_belge(AdrFeu,chevron_F); if aiguillage[indexAig].vitesse<>0 then Maj_Etat_Signal_belge(AdrFeu,chiffre_F or bita1_F) // allumer le chiffre else - Maj_Etat_Signal_belge(AdrFeu,chiffre_F); // effacer le chiffre + Maj_Etat_Signal_belge(AdrFeu,chiffre_F); // effacer le chiffre end else begin Maj_Etat_Signal_belge(AdrFeu,chiffre_F); Maj_Etat_Signal_belge(AdrFeu,chevron_F);end; end; @@ -8067,7 +8662,7 @@ begin else // aiguille signal suivant droite begin - if AffSignal then AfficheDebug('pas d''aiguille déviée',clYellow); + if AffSignal then AfficheDebug('Pas d''aiguille déviée',clYellow); // feu vert, vert cli ou blanc //if affsignal then AfficheDebug('test 405',clyellow); if feux[index].checkFB<>nil then @@ -8088,6 +8683,28 @@ begin end; end; envoi_signal(AdrFeu); + + // si le signal n'est pas rouge, réserver les aiguillages en aval + if (roulage or AvecResa) and (AdrTrainLoc<>0) then + begin + etat:=feux[index].EtatSignal; + if not(signal_rouge(AdrFeu)) then + begin + adr_Det:=feux[index].Adr_det1; + if detecteur[adr_det].Etat then + begin + if feux[index].Btype_suiv1<>det then detSuiv:=detecteur_suivant(feux[index].Adr_det1,det,feux[index].Adr_el_suiv1,feux[index].Btype_suiv1,1) + else detSuiv:=feux[index].Adr_el_suiv1; + if detSuiv<9990 then + begin + if roulage then reserve_canton(feux[index].Adr_det1,detSuiv,AdrtrainLoc,0,2) else + if AvecResa then reserve_canton(feux[index].Adr_det1,detSuiv,0,AdrtrainLoc,2) ; + end; + end; + end; + end; + + if signalDebug=AdrFeu then begin AffSignal:=false;nivDebug:=0;end; if debug=3 then formprinc.Caption:=''; end; @@ -8097,7 +8714,7 @@ end; // AdrFeu: adresse du signal // detect: si true, tient compte de la présence des trains par détecteurs dans la fonction signalPrec procedure Maj_Feu(Adrfeu : integer;detect : boolean); -var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie : integer ; +var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie,detSuiv : integer ; PresTrain,Aff_semaphore,car,reserveTrainTiers : boolean; code,combine,AdrSignalsuivant,AdrTrainRes : integer; Btype_el_suivant : TEquipement; @@ -8105,22 +8722,23 @@ var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie : intege begin if affsignal=false then begin - if signalDebug=AdrFeu then AffSignal:=true + if signalDebug=AdrFeu then + AffSignal:=true else affsignal:=false; end; - if AffSignal then + if AffSignal or ProcPrinc then begin s:='Traitement du signal '+intToSTR(Adrfeu)+'------------------------------------'; AfficheDebug(s,clOrange); - nivDebug:=3; + if AffSignal then nivDebug:=3; end; index:=Index_Signal(Adrfeu); - if (Nivdebug>=1) then AfficheDebug('Proc Maj_feu '+IntToSTR(adrFeu),clorange); + if (Nivdebug>=1) then AfficheDebug('Proc Maj_feu '+IntToSTR(adrFeu)+'-------------',clorange); if (AdrFeu=0) or (index=0) then exit; - modele:=Feux[index].aspect; + modele:=Feux[index].aspect; if modele=20 then begin @@ -8130,114 +8748,107 @@ begin // ici signal français - Adr_det:=Feux[index].Adr_det1; // détecteur sur le signal - Adr_El_Suiv:=Feux[index].Adr_el_suiv1; // adresse élément suivant au feu - Btype_el_suivant:=Feux[index].Btype_suiv1; - - // signal directionnel ? - if (modele>10) and (modele<20) then - begin - //Affiche('Signal directionnel '+IntToSTR(AdrFeu),clyellow); - Signal_direction(AdrFeu); - if debug=3 then formprinc.Caption:=''; - exit; - end; + Adr_det:=Feux[index].Adr_det1; // détecteur sur le signal + Adr_El_Suiv:=Feux[index].Adr_el_suiv1; // adresse élément suivant au feu + Btype_el_suivant:=Feux[index].Btype_suiv1; + // signal directionnel ? + if (modele>10) and (modele<20) then + begin + //Affiche('Signal directionnel '+IntToSTR(AdrFeu),clyellow); + Signal_direction(AdrFeu); + if debug=3 then formprinc.Caption:=''; + exit; + end; // signal non directionnel - etat:=etat_signal_suivant(AdrFeu,1,AdrSignalsuivant) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant - if AffSignal then - begin - code_to_aspect(etat,code,combine); - s:='Etat_signal_suivant ('+intToSTR(AdrSignalsuivant)+') est '; - s:=s+' à '; - if code<>-1 then s:=s+etatSign[code]; - if (Combine<>0) and (combine<>-1) then s:=s+' + '+etatSign[combine]; - AfficheDebug(s,clyellow); - end; - + etat:=etat_signal_suivant(AdrFeu,1,AdrSignalsuivant) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant + if AffSignal then + begin + code_to_aspect(etat,code,combine); + s:='Etat_signal_suivant ('+intToSTR(AdrSignalsuivant)+') est '; + s:=s+' à '; + if code<>-1 then s:=s+etatSign[code]; + if (Combine<>0) and (combine<>-1) then s:=s+' + '+etatSign[combine]; + AfficheDebug(s,clyellow); + end; // signal à 2 feux = carré violet+blanc - if (modele=2) then //or (feux[i].check<>nil) then // si carré violet + if (modele=2) then //or (feux[i].check<>nil) then // si carré violet + begin + // si aiguillage après signal mal positionnées ou réservé ou pas de train avant le signal + PresTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,detect,AdrTrainLoc,voie); + if (carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes)<>0) or not(PresTrain) or (feux[index].VerrouCarre) then begin - // si aiguillage après signal mal positionnées ou réservé ou pas de train avant le signal - PresTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,detect,AdrTrainLoc,voie); - if carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes) or not(PresTrain) or (feux[index].VerrouCarre) then + Maj_Etat_Signal(AdrFeu,violet); + if debug=3 then formprinc.Caption:=''; + end + else + begin + if not(cond_FeuBlanc(AdrFeu)) and test_memoire_zones(AdrFeu) then Maj_Etat_Signal(AdrFeu,violet) // test si présence train après signal + else Maj_Etat_Signal(AdrFeu,blanc); + // faire la réservation des aiguillages + if debug=3 then formprinc.Caption:=''; + end; + end; + //if AffSignal then AfficheDebug('Debut du traitement général',clYellow); + // traitement des feux >3 feux différents de violet (cas général) + if (modele>=3) and (feux[index].EtatSignal<>violet_F) then + begin + PresTrain:=false; + // détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré + //if (Feux[index].VerrouCarre) and (modele>=4) then + presTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,false,AdrTrainLoc,voie); //etape A // présence train par adresse train ; renvoie l'adresse du train dans AdrTrainLoc + if AffSignal and roulage then AfficheDebug('L''@ du train avant le signal est '+intToSTR(AdrTrainLoc),clYellow); + // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal + // verrouillable au carré, afficher un carré + car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes)<>0; // si reserveTrainTiers, réservé par un autre train + if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train',clYellow); + if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); + // En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré + if avecRESA or roulage then car:=(reserveTrainTiers and feux[index].VerrouCarre) or car; // tenir compte de la réservation si on est en mode avec réservation des aiguillages + // conditions supplémentaires de carré en fonction des aiguillages décrits + car:=cond_carre(AdrFeu) or car; + //if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); + if AffSignal and feux[index].VerrouCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); + if (modele>=4) and ((not(PresTrain) and feux[index].Verroucarre) or car ) then Maj_Etat_Signal(AdrFeu,carre) + else + begin + // si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation + // pour ne pas passer au rouge un feu à contresens. + // trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge + if AffSignal then AfficheDebug('test du sémaphore',clYellow); + Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal + if Aff_Semaphore then begin - Maj_Etat_Signal(AdrFeu,violet); - envoi_signal(AdrFeu); - if debug=3 then formprinc.Caption:=''; - exit; + if AffSignal then AfficheDebug('Présence train après signal'+intToSTR(AdrFeu)+' -> sémaphore ou carré',clYellow); + if testBit(feux[index].EtatSignal,carre)=FALSE then + begin + if feux[index].checkFR then Maj_Etat_Signal(AdrFeu,semaphore_cli) + else Maj_Etat_Signal(AdrFeu,semaphore); + end; end else begin - if not(cond_FeuBlanc(AdrFeu)) and test_memoire_zones(AdrFeu) then Maj_Etat_Signal(AdrFeu,violet) // test si présence train après signal - - else Maj_Etat_Signal(AdrFeu,blanc); - - envoi_signal(AdrFeu); - if debug=3 then formprinc.Caption:=''; - exit; - end; - end; - - //if AffSignal then AfficheDebug('Debut du traitement général',clYellow); - // traitement des feux >3 feux différents de violet (cas général) - if (modele>=3) and (feux[index].EtatSignal<>violet_F) then - begin - PresTrain:=false; - // détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré - //if (Feux[index].VerrouCarre) and (modele>=4) then - presTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,false,AdrTrainLoc,voie); //etape A // présence train par adresse train ; renvoie l'adresse du train dans AdrTrainLoc - if AffSignal and roulage then AfficheDebug('L''@ du train avant le signal est '+intToSTR(AdrTrainLoc),clYellow); - - // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal - // verrouillable au carré, afficher un carré - car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes); // si reserveTrainTiers, réservé par un autre train - if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train',clYellow); - if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); - // En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré - if roulage then car:=reserveTrainTiers or car; - - // conditions supplémentaires de carré en fonction des aiguillages décrits - car:=cond_carre(AdrFeu) or car; - //if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); - if AffSignal and feux[index].VerrouCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); - - if (modele>=4) and ((not(PresTrain) and feux[index].Verroucarre) or car ) then Maj_Etat_Signal(AdrFeu,carre) - else - begin - // si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation - // pour ne pas passer au rouge un feu à contresens. - // trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge - if AffSignal then AfficheDebug('test du sémaphore',clYellow); - Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal - if Aff_Semaphore then - begin - if AffSignal then AfficheDebug('Présence train après signal'+intToSTR(AdrFeu)+' -> sémaphore ou carré',clYellow); - if testBit(feux[index].EtatSignal,carre)=FALSE then - begin - if feux[index].checkFR then Maj_Etat_Signal(AdrFeu,semaphore_cli) - else Maj_Etat_Signal(AdrFeu,semaphore); - end; - end + if cond_feuBlanc(AdrFeu) then Maj_Etat_Signal(AdrFeu,blanc) else begin - if cond_feuBlanc(AdrFeu) then - Maj_Etat_Signal(AdrFeu,blanc) - else + Aig:=Aiguille_deviee(Adrfeu); + // si aiguille locale déviée + if (aig<>0) and (feux[index].aspect>=9) then // si le signal peut afficher un rappel et aiguille déviée begin - - Aig:=Aiguille_deviee(Adrfeu); - // si aiguille locale déviée - if (aig<>0) and (feux[index].aspect>=9) then // si le signal peut afficher un rappel et aiguille déviée - begin - indexAig:=Index_aig(aig); - if AffSignal then AfficheDebug('Aiguille '+intToSTR(aig)+' du signal '+intToSTR(AdrFeu)+' déviée',clYellow); - feux[index].EtatSignal:=0; - if (aiguillage[indexAig].vitesse=30) or (aiguillage[indexAig].vitesse=0) then Maj_Etat_Signal(AdrFeu,rappel_30); - if aiguillage[indexAig].vitesse=60 then Maj_Etat_Signal(AdrFeu,rappel_60); - + indexAig:=Index_aig(aig); + if AffSignal then AfficheDebug('Aiguillage '+intToSTR(aig)+' du signal '+intToSTR(AdrFeu)+' déviée',clYellow); + feux[index].EtatSignal:=0; + if (aiguillage[indexAig].vitesse<=30) then Maj_Etat_Signal(AdrFeu,rappel_30) else + if ((aiguillage[indexAig].vitesse>30) and (aiguillage[indexAig].vitesse<=60)) then Maj_Etat_Signal(AdrFeu,rappel_60) + else + begin + Maj_Etat_Signal(AdrFeu,rappel_30); + s:='Aiguillage '+intToSTR(aig)+'dévié mais vitesse de franchissement mal définie pour le signal '+intToSTR(AdrFeu)+' '; + Affiche(s,clred); + if AffSignal then AfficheDebug(s,clred); + end; // si signal suivant affiche rappel ou rouge - if (TestBit(etat,rappel_60)) or (testBit(etat,rappel_30)) or (testBit(etat,carre)) or (testBit(etat,semaphore)) + if TestBit(etat,rappel_60) or testBit(etat,rappel_30) or signal_rouge(AdrSignalSuivant) then Maj_Etat_Signal(AdrFeu,jaune) else begin @@ -8254,9 +8865,11 @@ begin // si le signal suivant est rouge begin if AffSignal then AfficheDebug('pas d''aiguille déviée',clYellow); - // effacer la signbalisation combinée + // effacer la signalisation combinée feux[index].EtatSignal:=feux[index].EtatSignal and not($3c00); - if TestBit(etat,carre) or testBit(etat,semaphore) or testBit(etat,semaphore_cli )then + + // si signal suivant rouge + if signal_rouge(AdrSignalSuivant) then begin Maj_Etat_Signal(AdrFeu,jaune); //if AffSignal then AfficheDebug('Mise du Feu à l''avertissement',clyellow); @@ -8311,14 +8924,42 @@ begin end; end; end; - end; end; end; end; end; end; + end; envoi_signal(AdrFeu); + + // si le signal n'est pas rouge avec un train sur le détecteur du signal, réserver les aiguillages en aval + if (roulage or AvecResa) and (AdrTrainLoc<>0) then + begin + etat:=feux[index].EtatSignal; + if not(signal_rouge(AdrFeu)) then + begin + adr_Det:=feux[index].Adr_det1; + if detecteur[adr_det].Etat then // détecteur doit être activé par loco + begin + // trouver si le signal est dans le bon sens + //id:=detecteur[adr_det].IndexTrain; + {det1:=event_det_train[id].Det[2].adresse; + det2:=event_det_train[id].suivant; + det3:=suivant_alg3(det1, + } + // trouver le détecteur suivant + if feux[index].Btype_suiv1<>det then detSuiv:=detecteur_suivant(feux[index].Adr_det1,det,feux[index].Adr_el_suiv1,feux[index].Btype_suiv1,1) + else detSuiv:=feux[index].Adr_el_suiv1; + if detSuiv<9990 then + begin + if roulage then reserve_canton(feux[index].Adr_det1,detSuiv,AdrtrainLoc,0,2) else + if AvecResa then reserve_canton(feux[index].Adr_det1,detSuiv,0,AdrtrainLoc,2) ; + end; + end; + end; + end; + if signalDebug=AdrFeu then begin AffSignal:=false;nivDebug:=0;end; if debug=3 then formprinc.Caption:=''; end; @@ -8328,7 +8969,7 @@ end; Procedure Maj_feux(detect : boolean); var i : integer; begin - if nivDebug=1 then AfficheDebug('Proc Maj_feux',clorange); + if (nivDebug=1) or ProcPrinc then AfficheDebug('Proc Maj_feux',clorange); if not(maj_feux_cours) then begin Maj_feux_cours:=TRUE; @@ -8361,7 +9002,7 @@ begin // déterminer la fin de la branche i:=1; repeat - inc(i); + inc(i); until (BrancheN[Num_Branche,i].adresse=0) and (BrancheN[Num_Branche,i].btype=rien); dernier:=i-1; // rechercher le détecteur depuis l'index i @@ -8375,7 +9016,7 @@ end; // trouve si le détecteur adr est contigu à un buttoir function buttoir_adjacent(adr : integer) : boolean; begin - trouve_element(adr,det,1); // branche_trouve IndexBranche_trouve + trouve_element(adr,det); // branche_trouve IndexBranche_trouve if Branche_trouve=0 then begin buttoir_adjacent:=false;exit;end; buttoir_adjacent:=( (BrancheN[branche_trouve,IndexBranche_trouve+1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve+1].BType=buttoir) or (BrancheN[branche_trouve,IndexBranche_trouve-1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve-1].BType=buttoir) ) @@ -8402,9 +9043,9 @@ begin typSuiv:=feux[i].Btype_suiv1; if suiv=det2 then begin - signal_sens:=true; - if debug=3 then formprinc.Caption:=''; - exit; + signal_sens:=true; + if debug=3 then formprinc.Caption:=''; + exit; end; repeat // parcourir les éléments jusque detecteur2 @@ -8419,20 +9060,20 @@ begin end; // libère le canton avant detecteur2 comportant un signal et le signal précédent -// attention le détecteur 2 n'est pas forcément associé à un signal (et dans le bon sens +// attention le détecteur 2 n'est pas forcément associé à un signal (et dans le bon sens) Procedure libere_canton(detecteur1,detecteur2 : integer); var sd2,i,j: integer; typ : tEquipement; begin - if not(roulage) then exit; - if traceliste then afficheDebug('demande libération canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clorange); + if not(roulage) and not(avecResa) then exit; + if traceliste or ProcPrinc then afficheDebug('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clorange); // est-on en limite de canton du detecteur 2 pour le libérer? sd2:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2 if sd2=0 then exit; // pas de signal associé // ce signal sd2 est il dans le bon sens - i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal associé au détecteur + i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal dans le bon sens associé au détecteur if i<>sd2 then exit; // trouver le signal précédent @@ -8452,18 +9093,29 @@ begin Maj_Feux(false); end; -// réserve le canton du detecteur équipé du feu (non compris) au feu suivant + +// réserve le nombre de cantons "nCantons" du detecteur1 (non compris) équipé du signal ou le prochain suivant si le signal n'est pas au rouge +// la réservation consiste à marquer un aiguillage avec l'adresse du train "adrTrain" ou "NumTrain" // det1 et det2 sont contigus -procedure reserve_canton(detecteur1,detecteur2,adrtrain : integer); -var AdrSig,i,j,etat,etatSuiv,AdrSignalsuivant : integer; +// adrTrain = adresse du train (mode roulage uniquement) +// NumTrain = index du train (pas mode roulage) +procedure reserve_canton(detecteur1,detecteur2,adrtrain,NumTrain,NCantons : integer); +var nc,AdrSig,i,j,etat,etatSuiv,AdrSignalsuivant : integer; rouge,cas2 : boolean; typ : tEquipement; + s : string; begin - if not(roulage) then exit; - if traceliste then afficheDebug('demande réservation canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2)+' par train @'+intToSTR(adrtrain),clorange); - + if not(roulage) and not(avecResa) then exit; + if traceliste or ProcPrinc then + begin + s:='Réservation '+intToSTR(nCantons)+' cantons après détecteur '+intToSTR(detecteur1)+' '+intToSTR(detecteur2)+' pour train '; + if roulage then s:=s+'@'+intToSTR(adrtrain) + else if avecResa then s:=s+intToSTR(NumTrain); + afficheDebug(s,clorange); + end; // y a t-il un signal sur le détecteur1 cas2:=false; + AdrSig:=signal_detecteur(detecteur1); // trouve le signal associé au detecteur1 if adrSig<>0 then begin @@ -8471,23 +9123,22 @@ begin if signal_sens(AdrSig,detecteur1,detecteur2) then cas2:=true; // oui end; - if not(cas2) then AdrSig:=signal_suivant_det(detecteur1,detecteur2); + if not(cas2) then AdrSig:=signal_suivant_det(detecteur1,detecteur2); // signal suivant dans le bon sens - if traceListe then afficheDebug('le signal suivant est '+intToSTR(AdrSig),clyellow); + if traceListe then afficheDebug('Le signal est '+intToSTR(AdrSig)+' ',clyellow); etat:=feux[Index_Signal(AdrSig)].etatSignal; + rouge:=signal_rouge(AdrSig); + if rouge then + begin + if TraceListe then AfficheDebug('Le signal '+intToSTR(AdrSig)+' étant rouge, pas de réservation aval ',clYellow); + exit; + end; etatSuiv:=etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal AdrSig au suivant : AdresseFeuSuivant // dans le bon sens - - rouge:=testbit(etat,semaphore) or testbit(etat,carre) or testbit(etat,violet); - if rouge then - begin - if TraceListe then AfficheDebug('Le signal '+intToSTR(AdrSig)+' étant rouge, pas de réservation aval pour le train @'+intToSTR(adrtrain),clYellow); - exit; - end; - - if TraceListe then AfficheDebug('Réservation canton det '+intToSTR(detecteur1)+' '+intToSTR(detecteur2)+' par train @'+intToSTR(adrTrain)+' : ',clLime); + // 1er canton // marquer les aiguillages réservés + if traceliste then AfficheDebug('A. Elements réservés: ',clOrange); for i:=1 to idEl-1 do begin j:=elements[i].adresse; @@ -8495,33 +9146,79 @@ begin if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then begin if TraceListe then AfficheDebug_Suivi(intToSTR(j)+' ',clOrange); - Aiguillage[index_aig(j)].AdrTrain:=AdrTrain; + // vérifier si l'aiguillage est libre + if AvecResa then + begin + if (Aiguillage[index_aig(j)].AdrTrain=0) then Aiguillage[index_aig(j)].AdrTrain:=numtrain; + end; + if roulage then + begin + if (Aiguillage[index_aig(j)].AdrTrain)=0 then Aiguillage[index_aig(j)].AdrTrain:=AdrTrain; + end; + + // maj tco + Texte_aig_fond(j) ; end; end; - // réservation canton suivant - AdrSig:=AdrSignalSuivant; - etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal AdrSig au suivant : AdresseFeuSuivant - if traceListe then afficheDebug('le signal sursuivant est '+intToSTR(AdrSig),clyellow); - rouge:=testbit(etatSuiv,semaphore) or testbit(etatSuiv,carre) or testbit(etatSuiv,violet); + // --------canton suivant + rouge:=signal_rouge(AdrSignalSuivant); if rouge then begin - if TraceListe then AfficheDebug('Le signal sursuivant '+intToSTR(AdrSig)+' étant rouge, pas de réservation aval pour le train @'+intToSTR(adrtrain),clYellow); + if TraceListe then + begin + s:='Le signal sursuivant '+intToSTR(AdrSignalSuivant)+' étant rouge, pas de réservation aval pour le train @'; + if roulage then s:=s+'@'+intToSTR(adrtrain) else if avecResa then s:=s+intToSTR(NumTrain); + AfficheDebug(s,clyellow); + end; exit; end; - etat:=etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal - // marquer les aiguillages réservés - if traceliste then AfficheDebug('Elements réservés: ',clOrange); - for i:=1 to idEl-1 do - begin - j:=elements[i].adresse; - typ:=elements[i].typ; - if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then + + nc:=2; + // réservation canton suivant sauf si signal est rouge + repeat + if Traceliste then AfficheDebug('Canton '+intToSTR(nc),clOrange); + + AdrSig:=AdrSignalSuivant; + etatsuiv:=etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal AdrSig au suivant : AdresseFeuSuivant + if traceListe then afficheDebug('Le signal sursuivant est '+intToSTR(AdrSig),clyellow); + rouge:=signal_rouge(AdrSignalSuivant); + if rouge then begin - if TraceListe then AfficheDebug_Suivi(intToSTR(j)+' ',clOrange); - Aiguillage[index_aig(j)].AdrTrain:=AdrTrain; // réserve l'aiguillage + if TraceListe then + begin + s:='Le signal sursuivant '+intToSTR(AdrSignalSuivant)+' étant rouge, pas de réservation aval pour le train @'; + if roulage then s:=s+'@'+intToSTR(adrtrain) else if avecResa then s:=s+intToSTR(NumTrain); + AfficheDebug(s,clyellow); + end; + exit; end; - end; + + etat:=etat_signal_suivant(AdrSig,1,AdrSignalsuivant); //réserve le canton du signal + // marquer les aiguillages réservés + if traceliste then AfficheDebug('B. Elements réservés: ',clOrange); + for i:=1 to idEl-1 do + begin + j:=elements[i].adresse; + typ:=elements[i].typ; + if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then + begin + if TraceListe then AfficheDebug_Suivi(intToSTR(j)+' ',clOrange); + if AvecResa then + begin + if (Aiguillage[index_aig(j)].AdrTrain=0) then Aiguillage[index_aig(j)].AdrTrain:=numtrain; + end; + if roulage then + begin + if (Aiguillage[index_aig(j)].AdrTrain)=0 then Aiguillage[index_aig(j)].AdrTrain:=AdrTrain; + end; + Texte_aig_fond(j); + end; + end; + + inc(nc); + until (nc>Ncantons); + Maj_feux(false); end; @@ -8536,7 +9233,7 @@ var entree_signal,jauneC,rappel30C,rappel60C,rouge : boolean; s : string; begin if not(roulage) or (adrtrain=0) then exit; - i:=index_feu_det(det2,voie,i2); // index du feu associé au det2 j:=signal_detecteur(det3); + i:=index_signal_det(det2,voie,i2); // index du signal associé au det2 j:=signal_detecteur(det3); if i=0 then exit; i2:=((it-1) mod NbCouleurTrain) +1; @@ -8550,7 +9247,7 @@ begin etat:=feux[i].EtatSignal; - rouge:=testbit(etat,semaphore) or testbit(etat,carre) or testbit(etat,violet); + rouge:=signal_rouge(feux[i].adresse); jauneC:=testbit(etat,jaune) or testbit(etat,blanc) or testbit(etat,blanc_cli); rappel30C:=testbit(etat,rappel_30); rappel60C:=testbit(etat,rappel_60); @@ -8572,263 +9269,58 @@ begin if (jauneC or Rappel30C) and entree_signal then begin - if traceListe then begin - if jauneC then AfficheDebug('Signal '+intToSTR(adresse)+' à l''avertissement - Ralentissement train @'+intToSTR(AdrTrain),clLime); - if Rappel30C and not(jauneC) then AfficheDebug('Signal '+intToSTR(adresse)+' au rappel30 - Ralentissement train @'+intToSTR(AdrTrain),clLime); + if jauneC then + begin + s:='Signal '+intToSTR(adresse)+' à l''avertissement - Ralentissement train @'+intToSTR(AdrTrain); + if traceListe then AfficheDebug(s,clLime); + Affiche(s,ClLime); + end; + if Rappel30C and not(jauneC) then + begin + s:='Signal '+intToSTR(adresse)+' au rappel30 - Ralentissement train @'+intToSTR(AdrTrain); + Affiche(s,clLime); + if traceliste then affichedebug(s,Cllime); + end; end; if (index_train<>0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train=9990) and not(casaig) then - begin - //Affiche('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed); - if (NivDebug=3) or TraceListe then AfficheDebug('Msg 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clorange); - end - else - begin - // en mode roulage, voir si on perd le détecteur si le train était arreté devat un signal rouge - {if roulage then - begin - AdrFeu:=event_det_train[i].signal_rouge; - if AdrFeu<>0 then - begin - s:='Erreur signal '+intToSTR(AdrFeu)+' au rouge et perte détecteur: ignoré'; - Affiche_Evt(s,clred); - if traceListe then AfficheDebug(s,clred); - event_det_tick[N_event_tick].reaffecte:=4; // fd sur un feu à 0 - exit; - end; - end;} - if (det20 then - begin - if n>MaxZones then n:=1; - with TrainZone[i] do - begin - Nbre:=n; - Zone[n].det1:=det3; - Zone[n].det2:=AdrSuiv; - Nbre:=n; - end; - end; - // zone suivante en prévision - det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1); - TrainPrevZone[i][1]:=det4; - end; - - event_act(det2,det3,0,''); // désactivation zone - event_act(det3,AdrSuiv,1,''); // activation zone - end - else - begin - s:='Erreur 740 : Adresse détecteur trop élevé '; - if det2>NbMemZone then s:=s+inttostr(det2)+' '; - if det3>NbMemZone then s:=s+inttostr(det2)+' '; - if AdrSuiv>NbMemZone then s:=s+inttostr(det2); - Affiche(s,clred); - end; - - // supprimer le 1er et décaler - with event_det_train[i] do - begin - det[1].adresse:=event_det_train[i].det[2].adresse; - det[1].etat:=event_det_train[i].det[2].etat; - det[2].adresse:=det3; - det[2].etat:=detecteur[det3].etat; - NbEl:=2; - end; - - // affichages - s:='2-0 Train n°'+intToSTR(i)+' route ok de '+intToSTR(det2)+' à '+IntToSTR(det3); - if casAig then s:=s+'A'; - s:=s+' à '+IntToSTR(Adrsuiv); - - Affiche_evt(s,couleur); - if traceListe then AfficheDebug(s,clyellow); - s:='Train '+IntToSTR(i); - if AdrTrainLoc<>0 then s:=s+' @'+intToSTR(AdrTrainLoc); - s:=s+' '+Train_ch+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv); - if traceListe then AfficheDebug(s,couleur); - - s:='Train '+IntToSTR(i); - if AdrTrainLoc<>0 then s:=s+' '+train_ch+' @'+intToSTR(AdrTrainLoc); - s:=s+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv); - Affiche(s,Couleur); - if AffAigDet then AfficheDebug(s,couleur); - - Affiche_Evt('1.Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur); - Affiche_Evt(intToSTR(event_det_train[i].det[1].adresse),couleur); - Affiche_Evt(intToStr(event_det_train[i].det[2].adresse),couleur); - if TraceListe or dupliqueEvt then - begin - AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur); - AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur); - end; - if TCOActive then - begin - for t:=1 to nbreTCO do - begin - zone_TCO(t,det2,det3,0); // désactivation - // activation - if ModeCouleurCanton=0 then zone_TCO(t,det3,AdrSuiv,1) - else zone_TCO(t,det3,AdrSuiv,2); // affichage avec la couleur de index_couleur du train - end; - end; - - // mettre à jour si présence signal sur det3 pour le passer au rouge de suite - j:=signal_detecteur(det3); - if j<>0 then - begin - Maj_Feu(j,false); - k:=Index_Signal(j); - // si le feu j est au rouge - etatSig:=feux[k].etatsignal; - if (testBit(etatSig,carre)) or (testBit(etatSig,semaphore)) or (testBit(etatSig,semaphore_cli)) then - begin - // Maj du signal précédent (pour l'avertissement) - j:=Signal_precedent(j); - if j<>0 then - begin - maj_feu(j,false); - j:=Signal_precedent(j); - if j<>0 then maj_feu(j,false); - end; - end; - end; - maj_feux(false); // mise à jour générale - maj_feux(false); // 2eme mise à jour - maj_feux(false); - exit; // sortir absolument - end; - end - else - begin - //Affiche_Evt('Route invalide: dét '+intToSTR(det2)+' '+intToSTR(det3)+' non contigus',clOrange); - if event_det_train[i].det[2].adresse=det3 then - begin - s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i); - FormDebug.MemoEvtDet.lines.add(s); - if dupliqueEvt then AfficheDebug(s,clyellow); - end; - end; - end; -end; - - // calcul des zones depuis le tableau des fronts montants ou descendants des évènements détecteurs // transmis dans le tableau Event_det // rattache le nouveau détecteur à un train @@ -8850,7 +9342,7 @@ begin Affiche_evt(s,clwhite) ; if dupliqueEvt then AfficheDebug(s,clyellow) ; - for i:=1 to N_trains do + for i:=1 to N_trains do // nombre de trains détectés en circulation begin index_couleur:=((i - 1) mod NbCouleurTrain) +1; couleur:=CouleurTrain[index_couleur]; @@ -8858,7 +9350,6 @@ begin det1:=event_det_train[i].det[1].adresse; det2:=event_det_train[i].det[2].adresse; - if ((det2=det3) and (nbre=2)) or ((det1=det3) and (nbre=1)) then begin //s:='Dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i); @@ -8877,7 +9368,7 @@ begin //if (roulage) then begin // traiter pour les cas avec 1 élément - if traceListe then AfficheDebug('1-0 traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow); + if traceListe or ProcPrinc then AfficheDebug('1-0 traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow); // vérifier si l'élément du tableau et le nouveau sont contigus if (Adj1=det1) or (Adj2=det1) then begin @@ -8890,58 +9381,54 @@ begin NbEl:=2; end; - // en mode roulage, on a placé les trains + adrTrainLoc:=event_det_train[i].Adrtrain; + Train_ch:=event_det_train[i].nom_train; + if (AdrTrainLoc=0) and roulage then + begin + Affiche('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred); + if TraceListe then AfficheDebug('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred); + end; if roulage then begin - adrTrainLoc:=event_det_train[i].Adrtrain; - Train_ch:=event_det_train[i].nom_train; - if (AdrTrainLoc=0) and roulage then - begin - Affiche('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred); - if TraceListe then AfficheDebug('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred); - end; j:=1; + trouve:=false; repeat trouve:=placement[j].detdir=det3; inc(j); until (j>6) or trouve; dec(j); //si début de démarrage train i - if not(trouve) or (TrainZone[i].Nbre>0) then - begin - exit; - end; + if not(trouve) or (TrainZone[i].Nbre>0) then exit; // affecter le nouveau détecteur detecteur[det3].train:=Train_ch; detecteur[det3].AdrTrain:=AdrTrainLoc; - // libérer l'ancien - //detecteur[event_det_train[i].Det[1].adresse].AdrTrain:=0; - //detecteur[event_det_train[i].Det[1].adresse].train:=''; + detecteur[det3].IndexTrain:=i; end; AdrSuiv:=detecteur_suivant_el(det1,det,det3,det,1); + det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1); //*** route validée *** if (det10 then trains[i2].index_event_det_train:=i; // lier l'index du train en circulation @@ -9316,10 +9803,10 @@ begin pilote_train(det2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant det_suiv:=det_suiv_cont(det2,det3,1); - if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); - // libère canton - libere_canton(det2,det3); - //event_act(det2,det3,1,''); // activation zone + if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc,i,2); + // libère canton + { libere_canton(det2,det3); + if TCOActive then for tco:=1 to nbreTCO do Maj_Aig_TCO(tco); // rafraichit les aiguillages déreservés } end else begin @@ -9358,9 +9845,8 @@ begin begin for tco:=1 to nbreTCO do begin - // activation - if ModeCouleurCanton=0 then zone_TCO(tco,det2,det3,1) - else zone_TCO(tco,det2,det3,2); // affichage avec la couleur de index_couleur du train + // désactivation du morceau avant l'aiguillage + efface_trajet(det3,i); end; end; exit; // sortir absolument @@ -9368,6 +9854,14 @@ begin else begin if TraceListe then AfficheDebug('La route est invalide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' ne sont pas contigus',clOrange); + s:='2-1 Train n°'+intToSTR(i)+' Route nok de '+intToSTR(det2)+' à '+IntToSTR(det3); + Affiche_evt(s,couleur); + for tco:=1 to nbreTCO do + begin + // désactivation du morceau avant l'aiguillage + efface_trajet(det3,i); + end; + {if rebond and (event_det_train[i].det[2].adresse=det3) then begin s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i); @@ -9420,7 +9914,7 @@ begin pilote_train(i2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant det_suiv:=det_suiv_cont(i2,det3,1); - if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); + if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc,i,2); // libère canton libere_canton(i2,det3); exit; @@ -9431,7 +9925,7 @@ begin // nouveau train front det=0 if not(etat) then begin - if traceListe then AfficheDebug('Nouveau train',clyellow); + if traceListe or ProcPrinc then AfficheDebug('Nouveau train',clyellow); // Nombre d'éléments à 0 : ici c'est un nouveau train donc créer un train, donc un tableau if N_Trains>=Max_Trains then begin @@ -9474,741 +9968,58 @@ begin if TraceListe then AfficheDebug('Création Train n°'+intToSTR(N_trains),clyellow); Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains); - // si on démarre d'un buttoir - if buttoir_adjacent(det3) then - begin - if TraceListe then AfficheDebug('Détection démarrage depuis détecteur '+IntToSTR(det3)+' buttoir',clyellow); - event_det_train[N_trains].det[1].adresse:=0; - event_det_train[N_trains].det[2].adresse:=det3; - event_det_train[N_trains].NbEl:=2; - s:='3. Nouveau Tampon train '+intToStr(N_Trains)+'--------'; - Affiche_Evt(s,couleur); - Affiche_Evt(intToSTR(event_det_train[N_Trains].det[1].adresse),couleur); - Affiche_Evt(intToSTR(event_det_train[N_Trains].det[2].adresse),couleur); - if dupliqueEvt then - begin - AfficheDebug(s,clyellow); - AfficheDebug(intToSTR(event_det_train[N_Trains].det[1].adresse),couleur); - AfficheDebug(intToSTR(event_det_train[N_Trains].det[2].adresse),couleur); - end; - end - else - begin - with event_det_train[N_trains] do - begin - det[1].adresse:=det3; - det[1].etat:=etat; - NbEl:=1; - nom_train:=detecteur[det3].train; - AdrTrain:=detecteur[det3].AdrTrain; - end; - - TrainZone[n_trains].train:=detecteur[det3].train; - TrainZone[n_trains].AdrTrain:=detecteur[det3].Adrtrain; - if roulage then - begin - j:=index_train_adresse(detecteur[det3].AdrTrain); - j:=placement[j].detdir; // detecteur destination - MemZone[det3,j].etat:=true; - MemZone[det3,j].train:=detecteur[det3].train; - MemZone[det3,j].AdrTrain:=detecteur[det3].AdrTrain; - end; - - s:=intToSTR(event_det_train[N_trains].det[1].adresse); - id_couleur:=((N_trains - 1) mod NbCouleurTrain) +1; - Affiche_Evt('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',CouleurTrain[id_couleur]); - Affiche_evt(s,CouleurTrain[id_couleur]); - if dupliqueEvt then - begin - AfficheDebug('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',clyellow); - AfficheDebug(s,clyellow); - end; - if TraceListe then - begin - AfficheDebug('0-0 Création train '+intToStr(N_trains)+' '+detecteur[det3].train+'--------',clyellow); - AfficheDebug(s,clyellow); - end; - end; - end; -end; - -// calcul des zones depuis le tableau des fronts montants ou descendants des évènements détecteurs -// transmis dans le tableau Event_det -// rattache le nouveau détecteur à un train -// adresse: adresse du detecteur, front: état du détecteur -procedure calcul_zones_V2(adresse: integer;etat : boolean); -var m,AdrFeu,AdrDetFeu,AdrTrainLoc,Nbre,i,j,k,n,det1,det2,det3,det4,AdrSuiv,AdrPrec,Prev, - id_couleur,det_suiv,nc,etatSig,t : integer ; - traite,trouve,SuivOk,casaig,rebond : boolean; - couleur : tcolor; - TypeSuiv : tEquipement; - s,train_ch : string; -begin - det3:=adresse; // c'est le nouveau détecteur - if det3=0 then exit; // pas de nouveau détecteur - traite:=false; - rebond:=false; - s:='Le nouveau détecteur est '+IntToSTR(det3); - if etat then s:=s+' 1' else s:=s+' 0'; - Affiche_evt(s,clwhite) ; - if dupliqueEvt then AfficheDebug(s,clyellow) ; - - for i:=1 to N_trains do - begin - index_couleur:=((i - 1) mod NbCouleurTrain) +1; - couleur:=CouleurTrain[index_couleur]; - Nbre:=event_det_train[i].NbEl ; // Nombre d'éléments du tableau courant exploré - det1:=event_det_train[i].det[1].adresse; - det2:=event_det_train[i].det[2].adresse; - - { - if ((det2=det3) and (nbre=2) ) or ((det1=det3) and (nbre=1)) then - begin - s:='Dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i); - Affiche_evt(s,clwhite); - event_det_tick[N_event_tick].train:=i; - event_det_tick[N_event_tick].reaffecte:=3; - if dupliqueEvt then AfficheDebug(s,clyellow); - rebond:=true; // possible rebond ? - end; } - - // 1 élément dans le tableau et détecteur à 0--------------------------------------------- - if (nbre=1) and not(etat) then - begin - Det_Adj(det3); // renvoie les adresses des détecteurs adjacents au détecteur "det3" résultat dans adj1 et adj2 - //if (roulage) then - begin - // traiter pour les cas avec 1 élément - if traceListe then AfficheDebug('1-0 traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow); - // vérifier si l'élément du tableau et le nouveau sont contigus - if (Adj1=det1) or (Adj2=det1) then - begin - event_det_tick[N_event_tick].train:=i; - - with event_det_train[i] do - begin - det[2].adresse:=det3; - det[2].etat:=etat; - NbEl:=2; - end; - - // en mode roulage, on a placé les trains - if roulage then - begin - adrTrainLoc:=event_det_train[i].Adrtrain; - Train_ch:=event_det_train[i].nom_train; - if (AdrTrainLoc=0) and roulage then Affiche('Démarrage train non placé depuis détecteur '+intToSTR(det3),clred); - - j:=1; - repeat - trouve:=placement[j].detdir=det3; - inc(j); - until (j>6) or trouve; - dec(j); - //si début de démarrage train i - if not(trouve) or (TrainZone[i].Nbre>0) then - begin - exit; - end; - // affecter le nouveau détecteur - detecteur[det3].train:=Train_ch; - detecteur[det3].AdrTrain:=AdrTrainLoc; - // libérer l'ancien - //detecteur[event_det_train[i].Det[1].adresse].AdrTrain:=0; - //detecteur[event_det_train[i].Det[1].adresse].train:=''; - end; - - AdrSuiv:=detecteur_suivant_el(det1,det,det3,det,1); - //*** route validée *** - if (det1MaxZones then n:=1; - with TrainZone[i] do - begin - Nbre:=n; - Zone[n].det1:=det1; - Zone[n].det2:=det3; - train:=train_ch; - AdrTrain:=AdrTrainLoc - end; - end; - //reserve_canton(det1,det3,false,0,false); // déreserve le canton précedent - //reserve_canton(det3,AdrSuiv,false,TrainZone[i].Adrtrain,true); // si feu réserve canton courant - libere_canton(det1,det3); // on quitte det3 - reserve_canton(det3,adrSuiv,adrtrainLoc); - event_act(det1,det3,1,''); // évènement actionneur - maj_feux(false); - - // affichages - Affiche_Evt('1-0 route ok de '+intToSTR(det1)+' à '+IntToSTR(det3),clWhite); - if traceListe then AfficheDebug(s,clyellow); - //Affiche(s,CouleurTrain[index_couleur]); - if AffAigDet then AfficheDebug(s,clyellow); - - Affiche_Evt('1-0. Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur); - s:=intToSTR(event_det_train[i].det[1].adresse); - Affiche_Evt(s,couleur); - if dupliqueEvt or traceliste then AfficheDebug(s,clyellow); - s:=intToSTR(event_det_train[i].det[2].adresse); - Affiche_evt(s,couleur); - if dupliqueEvt or traceliste then AfficheDebug(s,clyellow); - - if TCOActive then - begin - // activation - for t:=1 to nbreTCO do - begin - if ModeCouleurCanton=0 then zone_TCO(t,det3,AdrSuiv,1) - else zone_TCO(t,det3,adrSuiv,2); // affichage avec la couleur de index_couleur du train - end; - end; - exit; // sortir absolument - end - else - begin - Affiche_evt('1-0 Les éléments '+intToSTR(det1)+' et '+intToSTR(det3)+' ne sont pas contigus',clyellow); - // det3 et det1 non adjacents - end; - end; - end; - - // 1 élément dans le tableau et détecteur à 1 : on pilote le train si feu sur det3--------------------------------------------- - if (nbre=1) and etat then - begin - if traceListe then AfficheDebug('1-1 Traitement Train n°'+intToSTR(i)+' 1 détecteur',clyellow); - // vérifier si l'élément du tableau et le nouveau sont contigus - Det_Adj(det1); // renvoie les adresses des détecteurs adjacents au détecteur "det1" résultat dans adj1 et adj2 - suivok:=(Adj1=det3) or (Adj2=det3); - if suivok then - begin - Train_ch:=event_det_train[i].nom_train; - AdrTrainLoc:=event_det_train[i].AdrTrain; - - event_det_tick[N_event_tick].train:=i; - - // en mode roulage, on a placé les trains - if roulage then - begin - j:=1; - repeat - trouve:=placement[j].detdir=det3; - inc(j); - until (j>6) or trouve; - dec(j); - //si début de démarrage train i - if trouve and (TrainZone[i].Nbre=0) and (det10 then Maj_Feu(j,false); - exit; - end; - if Traceliste then AfficheDebug(inttoSTR(det3)+' n''est pas contigu à '+intToSTR(det1)+' pour le train '+intToSTR(i),clyellow); - traite:=true; // traiter le train suivant - end; - - // 2 éléments dans le tableau et détecteur à 0--------------------------------------------- - if (nbre=2) and not(etat) then - begin - if TraceListe or (NivDebug=3) then AfficheDebug('2-0 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur); - // test si det1, det2 et det3 sont contigus malgré aig mal positionnés - { - det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) - if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),couleur); - SuivOk:=det_suiv=det3; - CasAig:=false; - - if not(SuivOk) then - begin - // cas d'un aiguillage qui a changé - if det3=event_det_train[i].suivant then - begin - CasAig:=true; - s:='***CasAigChg train '+intToSTR(i)+' '+intToSTR(det1)+' '+intToSTR(det2)+' '+intToSTR(det3); - Affiche_Evt(s,couleur); - if TraceListe then AfficheDebug(s,couleur); - // trouver le suivant - det_Adj(det3); - if adj1<9990 then adrSuiv:=adj1; - if adj2<9990 then adrSuiv:=adj2; - event_det_tick[N_event_tick].reaffecte:=2; // réaffecté par changement d'aiguillage - end; - end; - } - casaig:=false; - suivok:=det2=det3; - - if SuivOk or CasAig then - begin - if TraceListe then AfficheDebug('Route est valide, dét '+intToSTR(det2)+' '+intToSTR(det3)+' contigus',couleur); - // ici on cherche le suivant à det2 det3, algo=1 - event_det_tick[N_event_tick].train:=i; - Adrsuiv:=det_suiv_cont(det1,det2,1); - //if not(casAig) then AdrSuiv:=detecteur_suivant_el(det2,det,det3,det,0); // dans le cas de CasAig, alors adrSuiv=9996 donc AdrSuiv est calculé plus haut - event_det_train[i].suivant:=AdrSuiv; - if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur); - if (Adrsuiv>=9990) and not(casaig) then - begin - //Affiche('Erreur 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clRed); - if (NivDebug=3) or TraceListe then AfficheDebug('Msg 1500 : pas de suivant sur la route de '+intToSTR(det2)+' à '+intToSTR(det3),clorange); - end - else - begin - if (det2MaxZones then n:=1; - with TrainZone[i] do - begin - Nbre:=n; - Zone[n].det1:=det3; - Zone[n].det2:=AdrSuiv; - Nbre:=n; - end; - // zone suivante en prévision - det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1); - TrainPrevZone[i][1]:=det4; - end; - - event_act(det2,det3,0,''); // désactivation zone - event_act(det3,AdrSuiv,1,''); // activation zone - end - else - begin - s:='Erreur 740 : Adresse détecteur trop élevé '; - if det2>NbMemZone then s:=s+inttostr(det2)+' '; - if det3>NbMemZone then s:=s+inttostr(det2)+' '; - if AdrSuiv>NbMemZone then s:=s+inttostr(det2); - Affiche(s,clred); - end; - { - // supprimer le 1er et décaler - with event_det_train[i] do - begin - det[1].adresse:=event_det_train[i].det[2].adresse; - det[1].etat:=event_det_train[i].det[2].etat; - det[2].adresse:=det3; - det[2].etat:=detecteur[det3].etat; - NbEl:=2; - end; - } - event_det_train[i].det[2].etat:=etat; - // affichages - s:='2-0 Train n°'+intToSTR(i)+' route ok de '+intToSTR(det2)+' à '+IntToSTR(det3); - if casAig then s:=s+'A'; - s:=s+' à '+IntToSTR(Adrsuiv); - - Affiche_evt(s,couleur); - if traceListe then AfficheDebug(s,clyellow); - s:='Train '+IntToSTR(i); - if AdrTrainLoc<>0 then s:=s+' @'+intToSTR(AdrTrainLoc); - s:=s+' '+Train_ch+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv); - if traceListe then AfficheDebug(s,couleur); - - s:='Train '+IntToSTR(i); - if AdrTrainLoc<>0 then s:=s+' '+train_ch+' @'+intToSTR(AdrTrainLoc); - s:=s+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv); - Affiche(s,Couleur); - if AffAigDet then AfficheDebug(s,couleur); - - Affiche_Evt('1.Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur); - Affiche_Evt(intToSTR(event_det_train[i].det[1].adresse),couleur); - Affiche_Evt(intToStr(event_det_train[i].det[2].adresse)+' 0',couleur); - if TraceListe or dupliqueEvt then - begin - AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur); - AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur); - end; - if TCOActive then - begin - for t:=1 to nbreTCO do - begin - //zone_TCO(tco,det2,det3,0); // désactivation - // activation - if ModeCouleurCanton=0 then zone_TCO(t,det3,AdrSuiv,1) - else zone_TCO(t,det3,AdrSuiv,2); // affichage avec la couleur de index_couleur du train - end; - end; - - // mettre à jour si présence signal sur det3 pour le passer au rouge de suite - j:=signal_detecteur(det3); - if j<>0 then - begin - Maj_Feu(j,false); - k:=Index_Signal(j); - // si le feu j est au rouge - etatSig:=feux[k].etatsignal; - if (testBit(etatSig,carre)) or (testBit(etatSig,semaphore)) or (testBit(etatSig,semaphore_cli)) then - begin - // Maj du signal précédent (pour l'avertissement) - j:=Signal_precedent(j); - if j<>0 then - begin - maj_feu(j,false); - j:=Signal_precedent(j); - if j<>0 then maj_feu(j,false); - end; - end; - end; - maj_feux(false); // mise à jour générale - maj_feux(false); // 2eme mise à jour - maj_feux(false); - exit; // sortir absolument - end; - end - else - begin - //Affiche_Evt('Route invalide: dét '+intToSTR(det2)+' '+intToSTR(det3)+' non contigus',clOrange); - if event_det_train[i].det[2].adresse=det3 then - begin - s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i); - FormDebug.MemoEvtDet.lines.add(s); - if dupliqueEvt then AfficheDebug(s,clyellow); - // exhit sortir - end; - end; - //traite:=true; - end; - - if (nbre=2) and etat then - begin - if TraceListe or (NivDebug=3) then AfficheDebug('2-1 traitement Train n°'+intToSTR(i)+' 2 détecteurs',clwhite); - // front descendant sur détecteur 2 - det_suiv:=det_suiv_cont(det1,det2,1); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) - if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),clWhite); - if (det_suiv=det3) then - begin - event_det_tick[N_event_tick].train:=i; - if TraceListe then AfficheDebug('La route est valide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' sont contigus',couleur); - if (det1NbMemZone then s:=s+inttostr(det2)+' '; - if det3>NbMemZone then s:=s+inttostr(det2)+' '; - if AdrSuiv>NbMemZone then s:=s+inttostr(det2); - Affiche(s,clred); - end; - // stockage dans historique de zones sauf s'il est déja stocké - if i0 then - begin - if (TrainZone[i].Zone[n].det1<>det2) or (TrainZone[i].Zone[n].det2<>det3) then - begin - n:=TrainZone[i].Nbre+1; - if n>MaxZones then n:=1; - TrainZone[i].Nbre:=n; - TrainZone[i].Zone[n].det1:=det2; - TrainZone[i].Zone[n].det2:=det3; - TrainZone[i].Nbre:=n; - end; - // zone suivante en prévision - det4:=detecteur_suivant_EL(det2,det,det3,det,1); - TrainPrevZone[i][1]:=det4; - end; - end; - // affichages - s:='2-1 Train n°'+intToSTR(i)+' Route ok de '+intToSTR(det2)+' à '+IntToSTR(det3); - Affiche_evt(s,couleur); - if traceListe then AfficheDebug(s,Couleur); - if AffAigDet then AfficheDebug(s,couleur); - if TCOActive then - begin - for t:=1 to nbreTCO do - begin - //zone_TCO(tco,det1,det2,0); // désactivation - // activation - if ModeCouleurCanton=0 then zone_TCO(t,det2,det3,1) - else zone_TCO(t,det2,det3,2); // affichage avec la couleur de index_couleur du train - end; - end; - exit; // sortir absolument - end - else - begin - if TraceListe then AfficheDebug('La route est invalide car les détecteurs '+intToSTR(det2)+' '+intToSTR(det3)+' ne sont pas contigus',clOrange); - {if rebond and (event_det_train[i].det[2].adresse=det3) then - begin - s:='7. Rebond dét. '+intToSTR(det3)+' déjà affecté au train '+IntToSTR(i); - FormDebug.MemoEvtDet.lines.add(s); - if dupliqueEvt then AfficheDebug(s,clyellow); - // désaffecter la zone - memzone[det2,det_suiv].etat:=false; - memZone[det1,det2].etat:=true; - exit; // rebond :sortir - end; } - end; - traite:=true; // non traité: train suivant - end; - end; // fin de la boucle for i - - // dans cette partie, le détecteur n'a pas encore été affecté à un train existant. - if rebond then exit; - - if etat then - begin - for i:=1 to N_trains do - begin - det2:=event_det_train[i].Suivant; - SuivOk:=event_det_train[i].Det[2].etat ; - det_adj(det3); - if (adj1=det2) or (adj2=det2) then - begin - Affiche_evt('Train '+intToSTR(i)+' Détection '+intToSTR(det3)+' à 1 avant RAZ du '+intToSTR(det2),clorange); - detecteur[det3].AdrTrain:=i; // récupération du train au détecteur - event_det_tick[N_event_tick].train:=i; - event_det_tick[N_event_tick].reaffecte:=1; // mauvais séquençage détecteurs contigus - exit; - end; - end; - end; - - // nouveau train front det=0 - if not(etat) then - begin - if traceListe then AfficheDebug('Nouveau train',clyellow); - // Nombre d'éléments à 0 : ici c'est un nouveau train donc créer un train, donc un tableau - if N_Trains>=Max_Trains then - begin - Affiche('Erreur nombre de train maximal atteint',clRed); - N_trains:=0; - end; - Inc(N_trains); - event_det_tick[N_event_tick].train:=n_trains; - with event_det_train[N_trains] do begin - det[1].adresse:=0; - det[2].adresse:=0; - NbEl:=0; - nom_train:=''; + det[1].adresse:=det3; + det[1].etat:=etat; + NbEl:=1; + nom_train:=detecteur[det3].train; + AdrTrain:=detecteur[det3].AdrTrain; end; - // vérifier si le détecteur du nouveau train est associé à un signal vers un buttoir - for i:=1 to NbreFeux do + TrainZone[n_trains].train:=detecteur[det3].train; + TrainZone[n_trains].AdrTrain:=detecteur[det3].Adrtrain; + if roulage then begin - AdrFeu:=Feux[i].Adresse; - AdrDetfeu:=Feux[i].Adr_Det1; - if (AdrDetFeu=Det3) and (feux[i].aspect<10) then - begin - AdrSuiv:=Feux[i].Adr_el_suiv1; - TypeSuiv:=Feux[i].Btype_suiv1; - AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,det,1) ; // détecteur précédent le feu ; algo 1 - if AdrPrec=0 then - begin - if TraceListe then Affiche('FD - Le signal '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow); - if AdrDetFeu'' then Formprinc.ServerSocket.Socket.connections[i].SendText(s); + end; +end; + + // traitement des évènements actionneurs (detecteurs aussi) // adr adr2 : pour mémoire de zone procedure Event_act(adr,adr2,etat : integer;trainDecl : string); @@ -10692,6 +10513,10 @@ begin end; end; + // Serveur envoi au clients + Envoi_serveur('A'+intToSTR(adr)+','+intToSTR(etat)+','+trainDecl); + + end; Procedure affiche_memoire; @@ -10707,6 +10532,7 @@ begin if not(configNulle) then Maj_feux(false); // on ne traite pas les calculs si CDM en envoie plusieurs end; + // traitement des évènements détecteurs procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); var dr,i,AdrSuiv,AdrFeu,AdrDetfeu,index,Etat01,AdrPrec : integer; @@ -10739,7 +10565,6 @@ begin end; end; - s:=detecteur[adresse].train; if (train='') and (s<>'') then train:=s; if Etat then Etat01:=1 else Etat01:=0; @@ -10756,7 +10581,7 @@ begin end; end; *) - if Traceliste then AfficheDebug('--------------- détecteur '+intToSTR(Adresse)+' à '+intToSTR(etat01)+' par train'+Detecteur[adresse].Train+' -----------------------',clOrange); + if Traceliste or ProcPrinc then AfficheDebug('--------------- détecteur '+intToSTR(Adresse)+' à '+intToSTR(etat01)+' par train'+Detecteur[adresse].Train+' -----------------------',clOrange); if AffAigDet then begin //s:='Evt Det '+intToSTR(adresse)+'='+intToSTR(etat01); @@ -10802,7 +10627,7 @@ begin event_det[N_event_det].etat:=true; if not(confignulle) then - //explore les feux pour voir si on démarre d'un buttoir + //explore les signaux pour voir si on démarre d'un buttoir for i:=1 to NbreFeux do begin AdrFeu:=Feux[i].Adresse; @@ -10873,7 +10698,7 @@ begin FormDebug.MemoEvtDet.lines.add('Raz sur débordement'); end; - // vers périphériques + // Envoyer évent vers périphériques si le service est demandé for i:=1 to NbPeriph do begin dr:=com_socket(i); @@ -10902,17 +10727,14 @@ begin if index=2 then Formprinc.ClientSocketCde2.Socket.SendText(s); end; end; - - end; - // attention à partir de cette section le code est susceptible de ne pas être exécuté?? + // Serveur envoi au clients + Envoi_serveur('D'+intToSTR(adresse)+','+intToSTR(etat01)+','+train); + + // Maj TCOs + for i:=1 to nbreTCO do Maj_TCO(i,Adresse); - // Mettre à jour le TCO - if TcoActive then - begin - Maj_TCO(1,Adresse); - end; end; // note: si on pilote un aiguillage par signaux complexes vers CDM et que celui ci est inversé, @@ -10963,7 +10785,6 @@ begin FormDebug.MemoEvtDet.lines.add(s) ; end; - if (n_Event_tick mod 10) =0 then affiche_memoire; inc(N_Event_tick); event_det_tick[N_event_tick].tick:=tick; @@ -10971,12 +10792,15 @@ begin event_det_tick[N_event_tick].modele:=aig; event_det_tick[N_event_tick].etat:=pos; - // Mettre à jour le TCO + // l'évaluation des routes est à faire selon conditions + if faire_event and not(confignulle) then + begin + evalue;evalue;evalue; + end; + + // Mettre à jour les TCOs if TCOActive then for i:=1 to NbreTCO do Maj_TCO(i,Adresse); - - // l'évaluation des routes est à faire selon conditions - if faire_event and not(confignulle) then begin evalue;evalue;end; end; // evt actionneur d'aiguillage @@ -11021,6 +10845,10 @@ begin end; end; end; + + // Serveur envoi au clients + Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(pos)); + end; // pilote une sortie à 0 à l'interface dont l'adresse est à 1 ou 2 (octet) @@ -11079,7 +10907,7 @@ begin begin if octet=1 then pilotage:=2 else pilotage:=1; end; - end; + end; end; // pilotage par CDM rail ----------------- @@ -11095,7 +10923,7 @@ begin envoi_CDM(s); event_aig(adresse,pilotage); result:=true; - exit; + exit; end; if (pilotage=0) or (pilotage>2) then exit; @@ -11158,7 +10986,11 @@ begin end; // pas de centrale et pas CDM connecté: on change la position de l'aiguillage - if acc=aigP then event_aig(adresse,octet); + if acc=aigP then event_aig(adresse,octet) + else + // Serveur envoi au clients + Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(octet)); + result:=true; end; @@ -11615,6 +11447,16 @@ begin result:=''; end; +// vérifie le checksum +procedure check(s : string;n : integer); +var x: byte; + i : integer; +begin + x:=0; + for i:=1 to n do x:=x xor ord(s[i]); + if x<>0 then AfficheDebug('Chk incorrect reçu : '+chaine_hex(s),clred); +end; + // décodage d'une chaine simple Xpressnet de la rétrosignalisation de la centrale // en sortie, la chaine chaineINT est supprimée de la partie traitée function decode_chaine_retro_Xpress(chaineINT : string) : string ; @@ -11625,28 +11467,32 @@ begin msg:=''; ack:=true;nack:=false; // décodage du 3eme octet de la chaîne - if chaineINT[1]=#1 then + if chaineINT[1]=#$01 then begin case chaineINT[2] of // page 13 doc XpressNet - #1 : begin nack:=true;msg:='erreur timout transmission';end; - #2 : begin nack:=true;msg:='erreur timout centrale';end; - #3 : begin nack:=true;msg:='erreur communication inconnue';end; - #4 : begin succes:=true;msg:='succès';end; - #5 : begin nack:=true;msg:='plus de time slot';end; - #6 : begin nack:=true;msg:='débordement tampon LI100';end; + #$01 : begin nack:=true;msg:='Erreur timout transmission';end; + #$02 : begin nack:=true;msg:='Erreur timout centrale';end; + #$03 : begin nack:=true;msg:='Erreur communication inconnue';end; + #$04 : begin succes:=true;msg:='Succès';end; + #$05 : begin nack:=true;msg:='Plus de time slot';end; + #$06 : begin nack:=true;msg:='Débordement tampon LI100';end; end; if traceTrames and (chaineINT[2]=#4) then AfficheDebug(msg,clYellow); if traceTrames and (chaineINT[2]<>#4) then AfficheDebug(msg,clRed); + + check(chaineINT,3); delete(chaineINT,1,3); decode_chaine_retro_Xpress:=chaineINT; + exit; end; - if chaineINT[1]=#2 then + if chaineINT[1]=#$02 then begin msg:='Version matérielle '+intTohex(ord(chaineINT[2]),2)+' - Version soft '+intToHex(ord(chaineINT[3]),2); Affiche(msg,clYellow); version_Interface:=chaineInt; + check(chaineINT,4); delete(chaineINT,1,4); decode_chaine_retro_Xpress:=chaineINT; exit; @@ -11654,20 +11500,20 @@ begin if chaineINT[1]=#$61 then begin - delete(chaineInt,1,1); - case chaineINT[1] of + case chaineINT[2] of #$00 : begin ack:=true;msg:='Voie hors tension';end; #$01 : begin ack:=true;msg:='Reprise';Hors_tension:=false;end; #$02 : begin ack:=true;msg:='Mode programmation ';end; - #$80 : begin nack:=true;msg:='erreurs de transferts- Voir doc XpressNet p29';end; + #$80 : begin nack:=true;msg:='Erreurs de transferts (Chk erroné) - Voir doc XpressNet p29';end; #$81 : begin nack:=true;msg:='Station occupée - Voir doc XpressNet p29';end; #$82 : begin nack:=true;msg:='Commande non implantée';end; else begin nack:=true;msg:='Réception inconnue';end; end; if nack then affiche(msg,clred) else affiche(msg,clyellow); - delete(chaineINT,1,2); + check(chaineINT,3); + delete(chaineINT,1,3); decode_chaine_retro_Xpress:=chaineINT; exit; end; @@ -11676,23 +11522,24 @@ begin begin // réception d'un CV. DocXpressNet p26 63 14 01 03 chk - delete(chaineInt,1,2); - cvLoc:=ord(chaineINT[1]); + cvLoc:=ord(chaineINT[3]); //Affiche('Réception CV'+IntToSTR(cvLoc)+' à '+IntToSTR(ord(chaineINT[2])),clyellow); if cvLoc>255 then Affiche('Erreur Recu CV>255',clRed) else begin - tablo_cv[cvLoc]:=ord(chaineINT[2]); + tablo_cv[cvLoc]:=ord(chaineINT[4]); inc(N_Cv); // nombre de CV recus end; recu_cv:=true; - delete(chaineInt,1,3); + check(chaineINT,5); + delete(chaineInt,1,5); decode_chaine_retro_Xpress:=chaineINT; exit; end; if chaineINT[1]=#$42 then begin + check(chaineINT,4); delete(chaineInt,1,1); decode_retro_XpressNet(ord(chaineInt[1]),ord(chaineInt[2])); delete(chaineInt,1,3); @@ -11702,22 +11549,14 @@ begin if chaineINT[1]=#$81 then begin - delete(chaineInt,1,2); + check(chaineINT,3); + delete(chaineInt,1,3); Affiche('Voie hors tension msg1',clRed); Hors_tension:=true; decode_chaine_retro_Xpress:=chaineINT; exit; end; - if chaineINT[1]=#$61 then - begin - delete(chaineInt,1,2); - Affiche('Voie hors tension msg2',clRed); - Hors_tension:=false; - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - if chaineINT[1]=#$46 then begin //FF FD 46 43 40 41 40 40 49 4D non documentée @@ -11725,6 +11564,7 @@ begin // 46 43 40 41 40 40 48 4C // 46 43 50 41 54 40 50 50 + check(chaineINT,8); Affiche('reprise puissance ',clLime); delete(chaineInt,1,8); Hors_tension:=false; @@ -11735,6 +11575,7 @@ begin i:=pos(#$46+#$43+#$50,chaineInt); if (i<>0) and (length(chaineInt)>=3) then begin + check(chaineINT,3); delete(chaineInt,1,3); Affiche('Reprise msg 2',clOrange); Hors_tension:=false; @@ -11744,6 +11585,7 @@ begin if chaineInt[1]=#$81 then begin + check(chaineINT,2); delete(chaineInt,1,2); Affiche('Court circuit msg 1',clRed); Hors_tension:=true; @@ -11755,6 +11597,7 @@ begin if chaineInt[1]=#$E3 then begin // la loco ah al est pilotée par le PC + check(chaineINT,5); delete(chaineInt,1,5); decode_chaine_retro_Xpress:=chaineINT; exit; @@ -11762,6 +11605,7 @@ begin if chaineInt[1]=#$E4 then begin + check(chaineINT,6); AdrTrainLoc:=ord(chaineInt[2]); // identification i:=ord(chaineInt[3]); // vitesse Fa:=ord(chaineInt[4]); // fonction A @@ -11956,12 +11800,10 @@ begin end end; - // connecte un port usb pour la comm périphériques. Si le port n'est pas ouvert, renvoie false // index= index du tableau tablo_com_cde function connecte_port_usb_periph(index : integer) : boolean; var i,j,nc,numport,vitesse,erreur : integer; - trouve : boolean; s,sc,portComCde : string; com : TMSComm; begin @@ -11972,7 +11814,6 @@ begin result:=false; exit; end; - trouve:=false; portComCde:=Tablo_periph[index].protocole; nc:=Tablo_periph[index].NumComposant; @@ -11988,44 +11829,44 @@ begin exit; end; - With com do - begin + if debug=1 then Affiche('Test port com cde'+intToSTR(port),clLime); + i:=pos(':',portComcde); + j:=pos(',',PortComcde); + j:=posEx(',',PortComcde,j+1); + j:=posEx(',',PortComcde,j+1); - if debug=1 then Affiche('Test port com cde'+intToSTR(port),clLime); - i:=pos(':',portComcde); - j:=pos(',',PortComcde); - j:=posEx(',',PortComcde,j+1); - j:=posEx(',',PortComcde,j+1); + sc:=copy(portComCde,i+1,j-i+1); + val(sc,vitesse,erreur); + if (vitesse<>300) and (vitesse<>1200) and (vitesse<>2400) and (vitesse<>4800) and (vitesse<>9600) and + (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) then + begin + Affiche('Vitesse périphérique COM ('+intToSTR(vitesse)+') incorrecte',clred); + tablo_com_cde[index].PortOuvert:=false; + result:=false; + exit; + end; - sc:=copy(portComCde,i+1,j-i+1); - val(sc,vitesse,erreur); - if (vitesse<>300) and (vitesse<>1200) and (vitesse<>2400) and (vitesse<>4800) and (vitesse<>9600) and - (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) then - begin - Affiche('Vitesse périphérique COM ('+intToSTR(vitesse)+') incorrecte',clred); - tablo_com_cde[index].PortOuvert:=false; - result:=false; - exit; - end; - Settings:=sc; // vitesse,n,8,1 - Handshaking:=0; {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff 4=5=protocoles "maison"} - SThreshold:=1; - RThreshold:=1; - InputLen:=0; - CommPort:=numport; - DTREnable:=false; // évite de reset de l'arduino à la connexion - RTSEnable:=false; // pour la genli - InputMode:=comInputModeBinary; - end; - - FormPrinc.StatusBar1.Panels[3].Style:=psOwnerDraw; // permet de déclencher l'event onDrawPanel tablo_com_cde[index].PortOuvert:=true; + With com do + begin + Settings:=sc; // vitesse,n,8,1 + Handshaking:=0; {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff 4=5=protocoles "maison"} + SThreshold:=1; + RThreshold:=1; + InputLen:=0; + CommPort:=numport; + DTREnable:=false; // évite de reset de l'arduino à la connexion + RTSEnable:=false; // pour la genli + InputMode:=comInputModeBinary; + end; try com.portopen:=true; except tablo_com_cde[index].PortOuvert:=false; end; + FormPrinc.StatusBar1.Panels[3].Style:=psOwnerDraw; // permet de déclencher l'event onDrawPanel + if tablo_com_cde[index].PortOuvert then begin s:='COM'+intToSTR(numport)+':'+sc; @@ -12051,7 +11892,7 @@ var s: string; i,erreur,NumSocket : integer; com : TClientSocket; begin - if (index<0) or (index>10) then + if (index<0) or (index>NbMaxi_Periph) then begin affiche('Le nombre maxi de périphériques est atteint - Le socket '+Tablo_periph[index].protocole+' ne sera pas ouvert',clred); result:=false; @@ -12065,7 +11906,7 @@ begin 1 : com:=formprinc.ClientsocketCde1; 2 : com:=formprinc.ClientSocketCde2; end; - + if (NumSocket>MaxComSocketPeriph) or (com=nil) then begin affiche('Le nombre maxi de Sockets périphériques est atteint - Le socket '+Tablo_periph[index].protocole+' ne sera pas ouvert',clred); @@ -12093,35 +11934,34 @@ var i,j : integer; begin result:=0; trouve:=false; - With Formprinc.MSCommUSBLenz do - begin - if debug=1 then Affiche('Test port com'+intToSTR(port),clLime); - version_interface:=''; - i:=pos(':',portCom); - j:=pos(',',PortCom); - j:=posEx(',',PortCom,j+1); - j:=posEx(',',PortCom,j+1); - j:=posEx(',',PortCom,j+1); + With Formprinc.MSCommUSBInterface do + begin + if debug=1 then Affiche('Test port com'+intToSTR(port),clLime); + version_interface:=''; + i:=pos(':',portCom); + j:=pos(',',PortCom); + j:=posEx(',',PortCom,j+1); + j:=posEx(',',PortCom,j+1); + j:=posEx(',',PortCom,j+1); - sc:=copy(portCom,i+1,j-i-1); - Settings:=sc; // vitesse,n,8,1 - if prot_serie>=4 then Handshaking:=0 {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff 4=5=protocoles "maison"} - else Handshaking:=prot_serie; - SThreshold:=1; - RThreshold:=1; - InputLen:=0; - CommPort:=Port; - if protocole=2 then DTREnable:=false // évite de reset de l'arduino à la connexion - else - DTREnable:=True; - if prot_serie=4 then RTSEnable:=True //pour la genli - else RTSenable:=False; - InputMode:=comInputModeBinary; - end; + sc:=copy(portCom,i+1,j-i-1); + Settings:=sc; // vitesse,n,8,1 + if prot_serie>=4 then Handshaking:=0 {0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff 4=5=protocoles "maison"} + else Handshaking:=prot_serie; + SThreshold:=1; + RThreshold:=1; + InputLen:=0; + CommPort:=Port; + if protocole=2 then DTREnable:=false // évite de reset de l'arduino à la connexion + else DTREnable:=True; + if prot_serie=4 then RTSEnable:=True //pour la genli + else RTSenable:=False; + InputMode:=comInputModeBinary; + end; portCommOuvert:=true; try - Formprinc.MSCommUSBLenz.portopen:=true; + Formprinc.MSCommUSBInterface.portopen:=true; except portCommOuvert:=false; end; @@ -12139,7 +11979,7 @@ begin if not(trouve) then begin portCommOuvert:=false; - Formprinc.MSCommUSBLenz.portopen:=false; + Formprinc.MSCommUSBInterface.portopen:=false; end; end; if trouve then result:=port else result:=0; @@ -12215,7 +12055,7 @@ begin numport:=1; repeat //Affiche('Test port COM'+intToSTR(numport),clyellow); - With Formprinc.MSCommUSBLenz do + With Formprinc.MSCommUSBInterface do begin //Affiche('Test port com'+intToSTR(numport),clyellow); port:=connecte_port_usb(numport); @@ -12402,7 +12242,10 @@ begin exit; end; - if lay<>'' then s:='-f '+lay else s:=''; + s:=''; + if lay<>'' then s:='-f '+lay; // lay + + s:=s+' -s COMIPC'; // démarre serveur comipc cdm_lanceLoc:=false; // lancement depuis le répertoire 32 bits d'un OS64 @@ -12432,11 +12275,12 @@ begin // On a lancé CDM, déconnecter l'USB deconnecte_USB; Affiche('Lance les fonctions automatiques de CDM',clyellow); - Sleep(3000); + Sleep(2000); // attend le lancement de CDM ProcessRunning(s); // récupérer le handle de CDM SetForegroundWindow(CDMhd); // met CDM en premier plan pour le télécommander par le clavier simulé Application.ProcessMessages; + { // démarre le serveur IP : il faut avoir chargé un réseau sinon le permier menu est fermé------------------------------------ // prépare le tableau pour sendinput KeybdInput(VK_MENU,0); // enfonce Alt @@ -12457,10 +12301,10 @@ begin i:=SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); // la fenetre serveur démarré est affichée Sleep(300); Application.ProcessMessages; + } KeybdInput(VK_RETURN,0); KeybdInput(VK_RETURN,KEYEVENTF_KEYUP); - SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); //fermer la fenetre Sleep(500); @@ -12791,6 +12635,7 @@ begin Result:='mac non trouvée'; end; +// positionne les composants de la fenêtre principale procedure positionne_elements(i : integer); begin with formprinc do @@ -12858,6 +12703,7 @@ begin ncrois:=0; EnvAigDccpp:=0; debugtrames:=false; + ProcPrinc:=false; algo_Unisemaf:=1; NbPeriph:=0; MaxPortCom:=30; @@ -12872,8 +12718,10 @@ begin Algo_localisation:=1; // normal AntiTimeoutEthLenz:=0; Verif_AdrXpressNet:=1; + portServeur:=4500; avecRoulage:=0; formatY:=-1; + avecResa:=false; // réservation des aiguillages en mode normal AvecInit:=true; // &&&& avec initialisation des aiguillages ou pas Diffusion:=AvecInit; // mode diffusion publique + debug mise au point etc ButtonIndex.Visible:=not(avecInit); @@ -12930,6 +12778,12 @@ begin detecteur[i].etat:=false; detecteur[i].train:=''; end; + for i:=0 to 10 do + begin + Liste_clients[i].adresse:=''; + Liste_Clients[i].PortLocal:=0; + Liste_Clients[i].PortDistant:=0; + end; Application.HintHidePause:=30000; Application.HintColor:=$70FFFF; @@ -12941,6 +12795,10 @@ begin procetape('Lecture de la configuration'); lit_config; + serverSocket.Port:=PortServeur; + ServerSocket.Open; + ServerSocket.Active:=true; + Menu_tco(NbreTCO); procetape('Lecture du TCO'); for i:=1 to NbreTCO do @@ -13082,6 +12940,8 @@ begin positionne_elements(PosSplitter); end; + for index:=1 to 10 do formTCO[index]:=nil; + for index:=1 to nbreTCO do begin tcoCree:=false; @@ -13142,7 +13002,6 @@ begin trains[i].SbitMap.height:=300; end; - // lancer CDM rail et le connecte si on le demande ; à faire après la création des feux et du tco if debug=1 then Affiche('Procédure CDM',clLime); procetape('Test CDM et son lancement'); @@ -13202,20 +13061,19 @@ begin //Menu_interface(valide); end; - + { //DoubleBuffered:=true; - { - aiguillage[index_aig(1)].position:=const_droit; + aiguillage[index_aig(1)].position:=const_devie; aiguillage[index_aig(2)].position:=const_droit; - aiguillage[index_aig(3)].position:=const_devie; + aiguillage[index_aig(3)].position:=const_droit; aiguillage[index_aig(4)].position:=const_devie; aiguillage[index_aig(5)].position:=const_droit; aiguillage[index_aig(6)].position:=const_devie; - aiguillage[index_aig(7)].position:=const_droit; + aiguillage[index_aig(7)].position:=const_devie; aiguillage[index_aig(8)].position:=const_droit; aiguillage[index_aig(10)].position:=const_devie; aiguillage[index_aig(11)].position:=const_droit; - aiguillage[index_aig(12)].position:=const_devie; + aiguillage[index_aig(12)].position:=const_droit; aiguillage[index_aig(17)].position:=const_devie; aiguillage[index_aig(18)].position:=const_devie; aiguillage[index_aig(19)].position:=const_devie; @@ -13278,16 +13136,16 @@ begin ConfCellTCO:=false; if debug=1 then Affiche('Fini',clLime); - + //reserve_canton(521,527,1,1); end; -// évènement réception d'une trame sur le port COM USB (centrale Lenz) -procedure TFormPrinc.MSCommUSBLenzComm(Sender: TObject); +// évènement réception d'une trame sur le port COM USB centrale Xpressnet +procedure TFormPrinc.MSCommUSBInterfaceComm(Sender: TObject); var i,tev : integer; tablo : array of byte; // tableau rx usb begin - tev:=MSCommUSBLenz.commEvent; + tev:=MSCommUSBInterface.commEvent; { Affiche('Evt '+intToSTR(tev),clOrange); Case tev of @@ -13316,7 +13174,7 @@ begin if tev=comEvReceive then begin - tablo:=MSCommUSBLenz.Input; + tablo:=MSCommUSBInterface.Input; for i:=0 to length(tablo)-1 do begin chaine_recue:=chaine_recue+char(tablo[i]); @@ -13333,14 +13191,14 @@ begin end; procedure TFormPrinc.FormClose(Sender: TObject; var Action: TCloseAction); -var i,res : integer ; +var i,res : integer; begin Ferme:=true; if portCommOuvert then begin portCommOuvert:=false; - MSCommUSBLenz.Portopen:=false; + MSCommUSBInterface.Portopen:=false; end; for res:=1 to 10 do begin @@ -13348,6 +13206,7 @@ begin if i=1 then deconnecte_USB_periph(res); if i=2 then deconnecte_socket_periph(res); end; + ServerSocket.Close; ClientSocketCDM.close; ClientSocketInterface.close; timer1.Enabled:=false; @@ -13521,11 +13380,8 @@ begin end else begin - if feux[0].aspect=20 then - begin - // signal belge - if TestBit(a,clignote) or feux[0].contrevoie then Dessine_feu_pilote; - end; + // signal belge + if TestBit(a,clignote) or feux[0].contrevoie then Dessine_feu_pilote; end; end; @@ -13569,7 +13425,7 @@ begin dec(a); trains[i].TempoArret:=a; if a=0 then vitesse_loco('',i,trains[i].adresse,0,true,false) else - if (a mod 10)=0 then vitesse_loco('',i,trains[i].adresse,trains[i].VitRalenti div 2,true,false); + if (a mod 10)=0 then vitesse_loco('',i,trains[i].adresse,trains[i].VitRalenti div 2,not(placement[i].inverse),false); end; a:=trains[i].TempoDemarre; @@ -13589,15 +13445,15 @@ begin begin dec(a); trains[i].compteur_consigne:=a; - if a=0 then + if a=0 then begin - vitesse_loco('',i,trains[i].vitesse,0,true,false); + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,trains[i].vitesse,trains[i].sens,false); //Affiche('vitesse ' +intToSTR(i)+' '+intToSTR(trains[i].vitesse),clred); - end; + end; end; end; - //simulation + // simulation if (i_simule<>0) then begin if not(MsgSim) then @@ -13673,9 +13529,11 @@ begin exit; end; - pilote_acc(adr,const_droit,aigP); - s:='accessoire '+IntToSTR(adr)+' droit'; - Affiche(s,clyellow); + if pilote_acc(adr,const_droit,aigP) then + begin + s:='accessoire '+IntToSTR(adr)+' droit'; + Affiche(s,clyellow); + end; Self.ActiveControl:=nil; end; @@ -13690,9 +13548,11 @@ begin exit; end; - pilote_acc(adr,const_devie,aigP); - s:='accessoire '+IntToSTR(adr)+' dévié'; - Affiche(s,clyellow); + if pilote_acc(adr,const_devie,aigP) then + begin + s:='accessoire '+IntToSTR(adr)+' dévié'; + Affiche(s,clyellow); + end; Self.ActiveControl:=nil; end; @@ -13733,9 +13593,8 @@ begin ErrorCode:=0; end; -procedure TFormPrinc.ClientSocketCDMError(Sender: TObject; - Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); - var s : string; +procedure TFormPrinc.ClientSocketCDMError(Sender: TObject;socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); +var s : string; begin s:='Erreur '+IntToSTR(ErrorCode)+' socket IP CDM Rail'; case ErrorCode of @@ -13865,7 +13724,7 @@ begin if portCommOuvert then begin portCommOuvert:=false; - Formprinc.MSCommUSBLenz.Portopen:=false; + Formprinc.MSCommUSBInterface.Portopen:=false; Affiche('Port USB déconnecté',clyellow); Formprinc.StatusBar1.Panels[3].Text:=''; end; @@ -13888,12 +13747,13 @@ begin tablo_com_cde[index].PortOuvert:=false; if index=1 then Formprinc.MscommCde1.Portopen:=false; if index=2 then Formprinc.MscommCde2.Portopen:=false; + if debug>0 then Affiche('Port COM'+intToSTR(Tablo_periph[index].NumCom)+' périphérique déconnecté',clyellow); Formprinc.StatusBar1.Panels[3].Text:=''; end; end; -// déconnecte le périphérique socket +// déconnecte le périphérique socket procedure deconnecte_socket_periph(index : integer); begin if tablo_com_cde[index].PortOuvert then @@ -13975,7 +13835,7 @@ var i,j,pos,r : integer; model : TEquipement; s : string; begin - Affiche('Position des aiguillages:',ClLime); + Affiche('Etat des aiguillages:',ClLime); for i:=1 to maxaiguillage do begin s:=''; @@ -13999,13 +13859,13 @@ begin begin j:=aiguillage[i].AdrTriple; s:=s+' Aig '+IntToSTR(j)+': '+intToSTR(aiguillage[index_aig(j)].position); - if aiguillage[index_aig(j)].position=1 then s:=s+' (dévié)' else s:=s+' (droit)'; + if aiguillage[index_aig(j)].position=const_devie then s:=s+' (dévié)' else s:=s+' (droit)'; end; if (model=Crois) then s:='Croisement '+IntToSTR(aiguillage[i].Adresse); r:=aiguillage[i].AdrTrain; - if r<>0 then s:=s+': réservé par train @'+intToSTR(r); + if r<>0 then s:=s+' Réservé par train @'+intToSTR(r); if s<>'' then Affiche(s,clWhite); end; end; @@ -14151,38 +14011,6 @@ begin k:=0; repeat - {// inutile de vérifier les numéros de trames, elles peuvent ne pas être envoyées dans l'ordre!! - if length(trame_CDM)>3 then - begin - if copy(trame_CDM,1,3)='S-E' then - begin - // numéro de la trame - i:=pos('-',trame_CDM); - if i<>0 then - begin - i:=posEx('-',trame_CDM,i+1); - if i<>0 then - begin - i:=posEx('-',trame_CDM,i+1); - if i<>0 then - begin - j:=posEx('-',trame_CDM,i+1); - AncNumTrameCDM:=NumTrameCDM; - val(copy(trame_CDM,i+1,j-1),NumTrameCDM,erreur); - if AncNumTrameCDM=0 then AncNumTrameCDM:=NumTrameCDM-1; - affiche(IntToSTR(NumTrameCDM),clLime); - if AncNumTrameCDM+1<>NumTrameCDM then - begin - s:='Erreur trames CDM perdues: #dernière='+intToSTR(AncNumTrameCDM)+' #Nouvelle='+intToSTR(NumTrameCDM); - Affiche(s,clred); - AfficheDebug(s,clred); - end; - end; - end; - end; - end; - end;} - // trouver la longueur de la chaîne de paramètres entre les 2 premiers |xxx| i:=pos('|',trame_CDM); if i=0 then @@ -14372,7 +14200,7 @@ begin val(ss,adr2,erreur); //s:='AD='+IntToSTR(adr); Delete(commandeCDM,i,l-i+1); - end; + end; i:=posEx('STATE=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then @@ -14406,26 +14234,26 @@ begin adr2:=aiguillage[index].Ddroit; // 2eme adresse de la TJD if (aiguillage[index].inversionCDM=0) and (aiguillage[index_aig(adr2)].inversionCDM=0) then // pas d'inversions case etat of - 0 : begin etatAig:=const_droit;EtatAig2:=const_droit;end; - 1 : begin etatAig:=const_devie;EtatAig2:=const_droit;end; - 4 : begin etatAig:=const_devie;EtatAig2:=const_devie;end; - 5 : begin etatAig:=const_droit;EtatAig2:=const_devie;end; + 0 : begin etatAig:=const_droit;EtatAig2:=const_droit;end; + 1 : begin etatAig:=const_devie;EtatAig2:=const_droit;end; + 4 : begin etatAig:=const_devie;EtatAig2:=const_devie;end; + 5 : begin etatAig:=const_droit;EtatAig2:=const_devie;end; end; if (aiguillage[index].inversionCDM=1) then // inversion tjd1 case etat of - 0 : begin etatAig:=const_devie;EtatAig2:=const_droit;end; - 1 : begin etatAig:=const_droit;EtatAig2:=const_droit;end; - 4 : begin etatAig:=const_droit;EtatAig2:=const_devie;end; - 5 : begin etatAig:=const_devie;EtatAig2:=const_devie;end; + 0 : begin etatAig:=const_devie;EtatAig2:=const_droit;end; + 1 : begin etatAig:=const_droit;EtatAig2:=const_droit;end; + 4 : begin etatAig:=const_droit;EtatAig2:=const_devie;end; + 5 : begin etatAig:=const_devie;EtatAig2:=const_devie;end; end; if (aiguillage[index_aig(adr2)].inversionCDM=1) then // inversion tjd2 case etat of - 0 : begin etatAig:=const_droit;EtatAig2:=const_devie;end; - 1 : begin etatAig:=const_devie;EtatAig2:=const_devie;end; - 4 : begin etatAig:=const_devie;EtatAig2:=const_droit;end; - 5 : begin etatAig:=const_droit;EtatAig2:=const_droit;end; + 0 : begin etatAig:=const_droit;EtatAig2:=const_devie;end; + 1 : begin etatAig:=const_devie;EtatAig2:=const_devie;end; + 4 : begin etatAig:=const_devie;EtatAig2:=const_droit;end; + 5 : begin etatAig:=const_droit;EtatAig2:=const_droit;end; end; Event_Aig(adr,etatAig); @@ -14436,14 +14264,14 @@ begin begin if (aiguillage[index].inversionCDM=0) then case etat of - 0 : etatAig:=const_droit; - 1 : etatAig:=const_devie; + 0 : etatAig:=const_droit; + 1 : etatAig:=const_devie; end; if (aiguillage[index].inversionCDM=1) then case etat of - 0 : etatAig:=const_devie; - 1 : etatAig:=const_droit; + 0 : etatAig:=const_devie; + 1 : etatAig:=const_droit; end; Event_Aig(adr,etatAig); end; @@ -14540,7 +14368,7 @@ begin val(ss,objet,erreur); Delete(commandeCDM,i,l-i+1); end; - + i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then begin @@ -14621,7 +14449,7 @@ begin Event_act(adr,0,etat,train); // déclenche évent actionneur end; - // évènement position des trains - non stocké ni interprété + // évènement position des trains // S-E-01-0039-CDMTRN-SPDXY|063|07|NAME=TRAIN_3;AD=0;SPEED=3;X=24735;Y=19630;X2=16874;Y2=19630; i:=pos('CMDTRN-SPDXY',commandeCDM); if i<>0 then @@ -14634,7 +14462,7 @@ begin val(ss,adr,erreur); s:='Train AD='+IntToSTR(adr); Delete(commandeCDM,i,l-i+1); - end; + end; i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then @@ -14651,7 +14479,7 @@ begin val(ss,vitesse,erreur); s:=s+' SPEED='+IntToSTR(vitesse); Delete(commandeCDM,i,l-i+1); - end; + end; i:=posEx('X=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then @@ -14688,6 +14516,7 @@ begin s:=s+' Y2='+IntTostr(y2); Delete(commandeCDM,i,l-i+1); end; + // fait bouger le train dans la fenetre cdm if fichier_module_CDM then Aff_train(adr,train,x,y,x2,y2); if afftiers then afficheDebug(s,clAqua); end; @@ -14695,7 +14524,7 @@ begin // évènement vitesse des trains - non stocké ni interprété //S-E-01-0189-CDMTRN-SPEED|054|06|NAME=TRAIN_3;AD=0;SPEED=99;RMAX=120;CMAX=120;REQ=8; i:=pos('CMDTRN-SPEED',commandeCDM); - if i<>0 then + if i<>0 then begin Delete(commandeCDM,i,12); i:=posEx('AD=',commandeCDM,1);l:=posEx(';',commandeCDM,i); @@ -14732,7 +14561,7 @@ begin s:=s+' RMAX='+IntTostr(x); Delete(commandeCDM,i,l-i+1); end; - + i:=posEx('CMAX=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then begin @@ -14740,7 +14569,7 @@ begin val(ss,y,erreur); s:=s+' CMAX='+IntTostr(y); Delete(commandeCDM,i,l-i+1); - end; + end; i:=posEx('REQ=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then @@ -14750,11 +14579,12 @@ begin s:=s+' REQ='+IntTostr(x2); Delete(commandeCDM,i,l-i+1); end; - + if afftiers then afficheDebug(s,clAqua); end; + // évènement port CDM - non stocké ni interprété // S-E-01-0188-CDMTRN-P_CDM|060|07|NAME=TRAIN_3;AD=0;SPEED=99;SEG=38;PORT=1;X=35565;Y=12364; i:=pos('CMDTRN-P_CDM',commandeCDM); @@ -14769,7 +14599,7 @@ begin s:='Train AD='+IntToSTR(adr); Delete(commandeCDM,i,l-i+1); end; - + i:=posEx('NAME=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then begin @@ -14777,7 +14607,7 @@ begin s:=s+' '+train; Delete(commandeCDM,i,l-i+1); end; - + i:=posEx('SPEED=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then begin @@ -14803,7 +14633,7 @@ begin val(ss,y,erreur); s:=s+' PORT='+IntTostr(y); Delete(commandeCDM,i,l-i+1); - end; + end; i:=posEx('X=',commandeCDM,1);l:=posEx(';',commandeCDM,i); if (i<>0) and (l<>0) then @@ -14813,7 +14643,7 @@ begin s:=s+' X='+IntTostr(x2); Delete(commandeCDM,i,l-i+1); end; - + if afftiers then afficheDebug(s,clAqua); i:=posEx('Y=',commandeCDM,1);l:=posEx(';',commandeCDM,i); @@ -14826,8 +14656,12 @@ begin end; if afftiers then afficheDebug(s,clAqua); - end; - + end; + + //S-E-03-0477-CMDTRN-DCCSF|137|19|NAME=CC406526;AD=4;MODE=128;STEP=100;CSTEP=75;FX0=0;FX1=0;FX2=0;FX3=0;FX4=0;FX5=0;FX6=0;FX7=0;FX8=0;FX9=0;FX10=0;FX11=0;FX12=0;FX13=0; + // évènement train + // pas traité !! + inc(k); //Affiche('k='+intToSTR(k),clyellow); end; @@ -14879,7 +14713,7 @@ begin end; procedure TFormPrinc.CodificationdessignauxClick(Sender: TObject); -var nation,i,j,k,l,NfeuxDir,nc,asp : integer; +var nation,i,j,k,l,d,NfeuxDir,nc,asp : integer; s,s2 : string; begin Affiche('Codification interne des signaux:',ClYellow); @@ -14941,6 +14775,18 @@ begin if l<19 then s:=s+',' else s:=s+')'; end; end; + + k:=1; + s:=s+'Dét amont niv 2 : '; + repeat + d:=feux[i].DetAmont[k]; + if d<>0 then + begin + s:=s+IntToSTR(d)+' '; + end; + inc(k); + until (d=0) or (k=11); + end else @@ -15283,9 +15129,12 @@ var i : integer; begin for i:=1 to NbreTCO do begin - formTCO[i].windowState:=wsNormal; //Maximized; - formTCO[i].show; - formTCO[i].BringToFront; + if formTCO[i]<>nil then + begin + formTCO[i].windowState:=wsNormal; //Maximized; + formTCO[i].show; + formTCO[i].BringToFront; + end; end; end; @@ -15306,6 +15155,7 @@ end; procedure TFormPrinc.locoClick(Sender: TObject); var i,adr,vit,erreur : integer; s : string; + sens : boolean; begin // vitesse et direction 18 pas s:=editAdrTrain.Text; @@ -15314,15 +15164,16 @@ begin //if not(portCommOuvert) and not(parSocketLenz) and not(CDM_Connecte) then exit; s:=editVitesse.Text; val(s,vit,erreur); - if (erreur<>0) or (vit<0) then exit; + if (erreur<>0) or (vit<-100) or (vit>100) then exit; i:=0;s:=''; if combotrains.itemindex<>-1 then begin - s:=trains[combotrains.itemindex+1].nom_train; + s:=combotrains.Items[combotrains.itemindex]; i:=index_train_nom(s); end; Affiche('Commande vitesse train '+s+' ('+intToSTR(adr)+') à '+IntToSTR(vit)+'%',cllime); - vitesse_loco(s,i,adr,vit,true,true); + sens:=vit>0; + vitesse_loco(s,i,adr,vit,sens,true); if s='' then s:=intToSTR(adr); end; @@ -15339,19 +15190,18 @@ begin end; -procedure TFormPrinc.outslectionner1Click(Sender: TObject); +procedure TFormPrinc.Toutslectionner1Click(Sender: TObject); begin FenRich.SelectAll; end; procedure TFormPrinc.Etatdessignaux1Click(Sender: TObject); -var Adr,etat,i : integer; +var Adr,i : integer; s : string; begin for i:=1 to NbreFeux do begin Adr:=Feux[i].Adresse; - Etat:=Feux[i].EtatSignal; s:='Signal '+IntToSTR(Adr)+' Etat='; s:=s+chaine_signal(adr); Affiche(s,clYellow); @@ -15391,7 +15241,7 @@ begin aff:=MemZone[i,j].etat; if aff then begin - Affiche('MemZone['+intToSTR(i)+','+intToSTR(j)+'] '+MemZone[i,j].train+' @='+intToSTR(MemZone[i,j].AdrTrain)+' Train n°'+intToSTR(MemZone[i,j].Numtrain),couleurTrain[MemZone[i,j].Numtrain]); + Affiche('MemZone['+intToSTR(i)+','+intToSTR(j)+'] '+MemZone[i,j].train+' @='+intToSTR(MemZone[i,j].AdrTrain)+' Train n°'+intToSTR(MemZone[i,j].IndexTrain),couleurTrain[MemZone[i,j].IndexTrain]); rien:=false; end; inc(j); @@ -15440,6 +15290,7 @@ begin end; procedure TFormPrinc.Apropos1Click(Sender: TObject); +var i,t,t1 : integer; begin Affiche(' ',clyellow); Affiche('Signaux complexes GL version '+version+sousVersion+' (C) 2022-23 F1IWQ Gily TDR',clWhite); @@ -15467,13 +15318,17 @@ begin Affiche('En orange : pilotage des signaux / erreurs mineures',ClWhite); Affiche('En bleu : pilotage des aiguillages',ClWhite); Affiche('En jaune : rétrosignalisation reçue depuis l''interface',ClWhite); - //Affiche('Taille du TCO : '+intToSTR(length(tco))+'x'+intToSTR(length(tco[1])),clorange); - Affiche('Taille des aiguillages : '+intToSTR(SizeOf(aiguillage) div 1024)+' ko',clorange); - Affiche('Taille des signaux : '+intToSTR(SizeOf(feux) div 1024)+' ko',clorange); - Affiche('Taille des branches : '+intToSTR(SizeOf(brancheN) div 1024)+' ko',clorange); - Affiche('Taille des actionneurs standards: '+intToSTR(SizeOf(Tablo_actionneur) div 1024)+' ko',clorange); - Affiche('Taille des actionneurs PN: '+intToSTR(SizeOf(Tablo_PN) div 1024)+' ko',clorange); - Affiche('Taille du tableau d''évènements détecteurs '+intToSTR(SizeOf(event_det) div 1024)+' ko',clorange); + t:=0; + t1:=sizeof(TTCO); + for i:=1 to nbreTCO do + t:=t+t1*NbreCellX[i]*NbreCellY[i]; + Affiche('Taille des '+intToSTR(NbreTCO)+' TCOs : '+intToSTR(t)+' octets',clOrange); + Affiche('Taille des aiguillages : '+intToSTR(SizeOf(aiguillage) )+' octets',clorange); + Affiche('Taille des signaux : '+intToSTR(SizeOf(feux) )+' octets',clorange); + Affiche('Taille des branches : '+intToSTR(SizeOf(brancheN) )+' octets',clorange); + Affiche('Taille des actionneurs standards: '+intToSTR(SizeOf(Tablo_actionneur))+' octets',clorange); + Affiche('Taille des actionneurs PN: '+intToSTR(SizeOf(Tablo_PN) )+' octets',clorange); + Affiche('Taille du tableau d''évènements détecteurs '+intToSTR(SizeOf(event_det) )+' octets',clorange); Affiche(' ',clyellow); end; @@ -15492,8 +15347,8 @@ begin end; function InfoSignal(adresse : integer) : string; -var s : string; - nation,etat,i,aspect,n,combine,aig,trainReserve,AdrSignalsuivant,voie,AdrTrainRes : integer; +var s,ss : string; + nation,etat,i,j,aspect,n,combine,aig,trainReserve,AdrSignalsuivant,voie,AdrTrainRes,adraig : integer; reserveTrainTiers : boolean; code : word; begin @@ -15509,12 +15364,32 @@ begin //Affiche(IntToSTR(combine),clred); s:='Le signal '+intToSTR(adresse)+' présente '+chaine_signal(adresse)+#13; + + if aspect=blanc then + begin + if cond_feuBlanc(adresse) then s:=s+'Des conditions d''affichage du feu blanc ont été définies sur la'+#13+'position d''aiguillages et elles sont remplies'; + end; + // carré if (aspect=carre) and (nation=1) then begin //Affiche(s,clyellow); - if carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes) then s:=s+'les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues'+#13; - if reserveTrainTiers then s:=s+'un aiguillage ou un croisement en aval du signal sont réservés par un autre train (@'+intToSTR(AdrTrainRes)+')'+#13; + adraig:=carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes); + if adraig<>0 then s:=s+'les aiguillages en aval du signal sont mal positionnés (A'+IntToSTR(AdrAig)+') ou leur positions inconnues'+#13; + if reserveTrainTiers then + begin + ss:='';j:=0; + for voie:=1 to maxaiguillage do + begin + if aiguillage[voie].AdrTrain=AdrTrainRes then + begin + ss:=ss+'A'+intToSTR(aiguillage[voie].Adresse)+' '; + inc(j); + end; + end; + if j=1 then s:=s+'Un aiguillage ou un croisement en aval du signal ('+ss+') est réservé par le train (@'+intToSTR(AdrTrainRes)+')'+#13 + else s:=s+'Des aiguillages ou des croisements en aval du signal ('+ss+') sont réservés par le train (@'+intToSTR(AdrTrainRes)+')'+#13 + end; if Cond_Carre(Adresse) then s:=s+'les aiguillages déclarés dans la définition du signal sont mal positionnés'+#13; if feux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,false,TrainReserve,voie)) then s:=s+'le signal est verrouillable au carré et aucun train n''est présent avant le signal'+#13; if test_memoire_zones(Adresse) then s:=s+'présence train dans canton suivant le signal'+#13; @@ -15536,7 +15411,8 @@ begin if n=20 then begin // signal belge - if carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes) then s:=s+'les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues'+#13; + AdrAig:=carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes); + if AdrAig<>0 then s:=s+'les aiguillages en aval du signal sont mal positionnés (A'+intToSTr(AdrAig)+') ou leur positions inconnues'+#13; if reserveTrainTiers then s:=s+'un aiguillage ou un croisement en aval du signal sont réservés par un autre train (@'+intToSTR(AdrTrainRes)+')'+#13; if Cond_Carre(Adresse) then s:=s+'les aiguillages déclarés dans la définition du signal sont mal positionnés'+#13; if feux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,false,TrainReserve,voie)) then s:=s+'le signal est verrouillable au carré et aucun train n''est présent avant le signal'+#13; @@ -15777,7 +15653,7 @@ procedure TFormPrinc.EditVitesseChange(Sender: TObject); var i,e : integer; begin val(EditVitesse.Text,i,e); - if (e=0) and (i>=0) and (i<=100) then TrackBarVit.position:=i; + if (e=0) and (i>=-100) and (i<=100) then TrackBarVit.position:=i; end; procedure TFormPrinc.ButtonEnvClick(Sender: TObject); @@ -15860,6 +15736,21 @@ begin // ouvre_simulation('C:\temp\Signaux_complexes_GL\2trains_autonome.txt'); end; +procedure affiche_com(s : string;var n : integer); +var i : integer; +begin + i:=pos('COM',Uppercase(s)); + if i=0 then exit; + if i+3<=length(s) then + begin + if s[i+3] in ['0'..'9'] then + begin + Affiche(s,clLime); + inc(n); + end; + end; +end; + procedure GetWin32_SerialPortInfo; const WbemUser=''; @@ -15875,18 +15766,38 @@ var begin FSWbemLocator:=CreateOleObject('WbemScripting.SWbemLocator'); FWMIService:=FSWbemLocator.ConnectServer(WbemComputer,'root\CIMV2',WbemUser,WbemPassword); // nom de l'espace par défaut et classes du matériel du pc + // exception + // SELECT * FROM MSSerial_PortName ou SELECT * FROM Win32_SerialPort ou SELECT * FROM Win32_PnPEntity + + // requete 1 pour les com natifs FWbemObjectSet:=FWMIService.ExecQuery('SELECT * FROM Win32_SerialPort','WQL',wbemFlagForwardOnly); // retourne les infos des ports série + oEnum:=IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant; - i:=0; while oEnum.Next(1,FWbemObject,iValue)=0 do begin inc(i); // pour les autres champs: https://learn.microsoft.com/en-us/windows/win32/cimwin32prov/win32-serialport - s:=FWbemObject.DeviceID+' '+FWbemObject.Name+' '+FWbemObject.Description; - Affiche(s,clyellow); + if FWbemObject.DeviceID<>null then s:=FWbemObject.DeviceID+' '; + if FWbemObject.name<>null then s:=s+FWbemObject.Name+' '; + if FWbemObject.Description<>null then s:=s+FWbemObject.Description; + Affiche_com(s,i); FWbemObject:=Unassigned; end; - if i=0 then Affiche('Aucun port com',clyellow); + if i=0 then Affiche('R1 : Aucun port com natif',clLIme); + + // requete 2 pour les com sur usb + FWbemObjectSet:=FWMIService.ExecQuery('SELECT * FROM Win32_PnPEntity WHERE ConfigManagerErrorCode = 0','WQL',wbemFlagForwardOnly); // retourne les infos des ports série + oEnum:=IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant; + i:=0; + while oEnum.Next(1,FWbemObject,iValue)=0 do + begin + if FWbemObject.DeviceID<>null then s:=FWbemObject.DeviceID+' '; + if FWbemObject.name<>null then s:=s+FWbemObject.Name+' '; + if FWbemObject.Description<>null then s:=s+FWbemObject.Description; + Affiche_com(s,i); + FWbemObject:=Unassigned; + end; + if i=0 then Affiche('R2 : Aucun port com sur usb',clLime); end; procedure liste_portcom ; @@ -15898,12 +15809,13 @@ begin finally CoUninitialize; end; + except on E:EOleException do Affiche(Format('EOleException %s %x', [E.Message,E.ErrorCode]),clyellow); on E:Exception do Affiche(E.Classname+ ':'+ E.Message,clyellow); - end; + end; end; procedure TFormPrinc.Evenementsdetecteurspartrain1Click(Sender: TObject); @@ -16105,9 +16017,12 @@ var i : integer; begin for i:=1 to NbreTCO do begin - formTCO[i].windowState:=wsNormal; //Maximized; - formTCO[i].show; - formTCO[i].BringToFront; + if formTCO[i]<>nil then + begin + formTCO[i].windowState:=wsNormal; //Maximized; + formTCO[i].show; + formTCO[i].BringToFront; + end; end; end; @@ -16349,7 +16264,7 @@ begin largTCO:=largEcran div 2; with formtco[1] do begin - Top:=Topecran; Left:=0; + Top:=Topecran; Left:=0; width:=largTCO+8; height:=HautTCO; windowState:=wsNormal; show; @@ -16395,6 +16310,7 @@ begin end; end; +// Affiche le TCO i sur l'écran désigné dans la structure du TCO procedure Affiche_Fenetre_TCO(i : integer;laisseOuvert : boolean); var e : integer; begin @@ -16410,7 +16326,6 @@ begin formTCO[i].BringToFront; if not(laisseOuvert) then formTCO[i].Close; // .. et si on en veut pas, on la ferme. - end; procedure TFormPrinc.AfficherTCO11Click(Sender: TObject); @@ -16463,7 +16378,7 @@ begin Affiche_Fenetre_TCO(10,true); end; -// mise à jour des menus TCO +// mise à jour des menus TCO en fonction du nombre i de TCO Procedure Menu_tco(i : integer); begin with formprinc do @@ -16734,7 +16649,7 @@ begin formTCO[NbreTCO]:=nil; try - formTCO[nbreTCO]:=TformTCO.Create(self); + formTCO[nbreTCO]:=TformTCO.Create(self); // génère formCreate except Affiche('Erreur 6800 Impossible de créer la fenêtre du TCO',clred); dec(NbreTCO); @@ -16751,6 +16666,7 @@ begin config_modifie:=true; formTCO[nbreTCO].show; // génère formActivate ce qui implique que le nom de la form soit à jour, et que le TCO soit initialisé + FormConfigTCO.show; end; procedure Supprimer_TCO(TcoS : integer); @@ -16920,9 +16836,60 @@ begin end; end; -// réception des périphériques +function telecommande(s : string) : boolean; +var adresse,i,erreur : integer; +begin + result:=false; + s:=uppercase(s); + if s='' then + begin + Lance_CDM(true); + result:=true; + end; + if s='' then + begin + if cdmHd=0 then exit; + if not(cdmDevant) then ShowWindow(CDMhd,SW_MINIMIZE) else ShowWindow(CDMhd,SW_MAXIMIZE); + cdmDevant:=not(cdmDevant); + result:=true; + end; + if s='' then + begin + with formprinc do + begin + windowState:=wsNormal; //Maximized; + show; + BringToFront; + end; + result:=true; + end; + if copy(s,1,4)='0) and (i<=10) and (formTCO[i]<>nil) then + begin + formTCO[i].windowState:=wsNormal; //Maximized; + formTCO[i].show; + formTCO[i].BringToFront; + end; + result:=true; + end; + if copy(s,1,4)='#31) and (c<#128) then tablo_com_cde[1].tamponrx:=tablo_com_cde[1].tamponrx+c;; end; end; end; +// réception COM/USB du périphérique 2 procedure TFormPrinc.MSCommCde2Comm(Sender: TObject); -var recu : string; +var s : string; tablo : array of byte; // tableau rx usb c : char; i : integer; @@ -16954,26 +16924,26 @@ begin if MSCommCde2.commEvent=ComEvReceive then begin tablo:=MSCommCde2.Input; - recu:=''; for i:=0 to length(tablo)-1 do begin c:=char(tablo[i]); //Affiche(intToSTR(ord(c)),clorange); if c=#13 then begin - affiche(tablo_com_cde[2].tamponrx,clyellow); + s:=tablo_com_cde[2].tamponrx; + affiche(s,clyellow); tablo_com_cde[2].tamponrx:=''; + telecommande(s); end; if (c>#31) and (c<#128) then tablo_com_cde[2].tamponrx:=tablo_com_cde[2].tamponrx+c;; end; end; end; -procedure TFormPrinc.ClientSocketCde1Connect(Sender: TObject; +procedure TFormPrinc.ClientSocketCde1Connect(Sender: TObject; Socket: TCustomWinSocket); begin Affiche('Socket '+ClientSocketCde1.Address+':'+intToSTR(ClientSocketCde1.port)+' connecté ',clYellow); - end; procedure TFormPrinc.ClientSocketCde1Error(Sender: TObject; @@ -16997,8 +16967,11 @@ begin end; procedure TFormPrinc.ClientSocketCde1Read(Sender: TObject; Socket: TCustomWinSocket); +var s : string; begin - Affiche(CLientSocketCde1.Socket.ReceiveText,clWhite); + s:=ClientSocketCde1.Socket.ReceiveText; + if not(telecommande(s)) then Affiche(s,clWhite); + end; procedure TFormPrinc.ClientSocketCde2Connect(Sender: TObject;Socket: TCustomWinSocket); @@ -17029,12 +17002,80 @@ end; procedure TFormPrinc.ClientSocketCde2Read(Sender: TObject; Socket: TCustomWinSocket); +var s : string; begin - Affiche(CLientSocketCde2.Socket.ReceiveText,clWhite); + s:=ClientSocketCde2.Socket.ReceiveText; + Affiche(s,clWhite); + telecommande(s); end; - +procedure TFormPrinc.Copierltatdesaiguillageseninitialisation1Click( + Sender: TObject); +var i,p : integer; +begin + for i:=1 to maxaiguillage do + begin + p:=aiguillage[i].position; + if p<>const_inconnu then aiguillage[i].posInit:=p; + end; + config_modifie:=true; + Affiche('La position initiale des aiguillages dont la position est connue a été mise à jour',clYellow); +end; +procedure TFormPrinc.ServerSocketAccept(Sender: TObject; + Socket: TCustomWinSocket); +var n : integer; +begin + n:=serverSocket.Socket.ActiveConnections; + if n<=10 then + begin + Liste_clients[n-1].Adresse:=Socket.remoteAddress; + Liste_clients[n-1].PortLocal:=Socket.LocalPort; + Liste_clients[n-1].PortDistant:=Socket.RemotePort; + end; + Affiche('Client '+intToSTR(n)+' '+Socket.remoteAddress+':'+intToSTR(Socket.RemotePort)+':'+intToSTR(Socket.LocalPort)+' connecté',clyellow); +end; + + + +procedure TFormPrinc.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket); +var s :string; +begin + s:=socket.ReceiveText; + if not(telecommande(s)) then Affiche(s,clWhite); + +end; + +procedure TFormPrinc.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); +var n : integer; +begin + for n:=0 to 10 do + begin + if (Liste_clients[n].adresse=socket.remoteAddress) and (Liste_clients[n].portDistant=socket.remotePort) and (Liste_clients[n].portLocal=socket.LocalPort) then + begin + Liste_clients[n].adresse:='';Liste_clients[n].portDistant:=0;Liste_clients[n].PortLocal:=0; + Affiche('Client '+intToSTR(n+1)+' '+socket.remoteAddress+':'+intToSTR(socket.remotePort)+':'+intToSTR(socket.LocalPort)+' déconnecté',clyellow); + end; + end; +end; + +procedure TFormPrinc.Listedesclientsconnects1Click(Sender: TObject); +var i,n : integer; +begin + n:=0; + for i:=0 to 10 do + begin + if Liste_clients[n].adresse<>'' then + begin + Affiche('Client '+intToSTR(n+1)+' '+Liste_clients[n].adresse+':'+intToSTR(Liste_clients[n].portDistant)+':'+intToSTR(Liste_clients[n].portLocal),clyellow); + inc(n); + end; + end; + if n=0 then affiche('Aucun client connecté',clYellow); + if n=1 then affiche('1 client connecté',clyellow); + if n>1 then affiche(intToSTR(n)+' clients connectés',clyellow); +end; end. + diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 892c892..6ade91e 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,6 +1,6 @@ object FormTCO: TFormTCO - Left = 14 - Top = 171 + Left = 89 + Top = 111 Width = 1212 Height = 580 VertScrollBar.Visible = False @@ -23,8 +23,8 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1204 - 529) + 1196 + 521) PixelsPerInch = 96 TextHeight = 13 object LabelZoom: TLabel @@ -42,22 +42,24 @@ object FormTCO: TFormTCO ParentFont = False end object ImageTemp: TImage - Left = 731 - Top = 123 + Left = 1020 + Top = 3 Width = 121 Height = 121 + Anchors = [akTop, akRight] end object ImageTemp2: TImage - Left = 995 - Top = 76 + Left = 1019 + Top = 132 Width = 121 Height = 121 + Anchors = [akTop, akRight] end object ScrollBox: TScrollBox Left = 10 - Top = 7 - Width = 946 - Height = 258 + Top = 15 + Width = 687 + Height = 266 HorzScrollBar.Smooth = True HorzScrollBar.Tracking = True VertScrollBar.Smooth = True @@ -68,13 +70,13 @@ object FormTCO: TFormTCO ParentColor = False TabOrder = 1 DesignSize = ( - 942 - 254) + 683 + 262) object ImageTCO: TImage - Left = 56 - Top = 33 - Width = 745 - Height = 168 + Left = 120 + Top = 41 + Width = 486 + Height = 176 Anchors = [akLeft, akTop, akRight, akBottom] AutoSize = True ParentShowHint = False @@ -1260,9 +1262,13 @@ object FormTCO: TFormTCO OnClick = Tourner90DClick end object Pos_vert: TMenuItem - Caption = 'Signal vertical' + Caption = 'Signal vertical 0'#176 OnClick = Pos_vertClick end + object Signalvertical180: TMenuItem + Caption = 'Signal vertical 180'#176 + OnClick = Signalvertical180Click + end object N4: TMenuItem Caption = '-' end @@ -1278,9 +1284,9 @@ object FormTCO: TFormTCO object N2: TMenuItem Caption = '-' end - object outslectionner1: TMenuItem + object Toutslectionner1: TMenuItem Caption = 'Tout s'#233'lectionner' - OnClick = outslectionner1Click + OnClick = Toutslectionner1Click end object Inserer: TMenuItem Caption = 'Inserer' @@ -1331,8 +1337,8 @@ object FormTCO: TFormTCO Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] - Left = 256 - Top = 432 + Left = 264 + Top = 408 end object ColorDialog1: TColorDialog OnShow = ColorDialog1Show @@ -1353,19 +1359,17 @@ object FormTCO: TFormTCO end object DessinerleTCO1: TMenuItem Caption = 'Dessiner le TCO' + Hint = 'Dessine le TCO '#224' la souris' OnClick = DessinerleTCO1Click end object ConfigurationduTCO1: TMenuItem Caption = 'Configuration du TCO' OnClick = ConfigurationduTCO1Click end - object N9: TMenuItem - Caption = '-' - end - object Redessine1: TMenuItem - Caption = 'Redessine' - OnClick = Redessine1Click - end + end + object RafrachirleTCO1: TMenuItem + Caption = 'Rafra'#238'chir le TCO' + OnClick = Redessine1Click end object Affichebandeau1: TMenuItem Caption = 'Affiche bandeau' diff --git a/UnitTCO.pas b/UnitTCO.pas index 5a8ed15..8757c47 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -1,5 +1,5 @@ unit UnitTCO; -// na pas utiliser les éléments 30 et 31 qui sont les anciens signaux et quais +// ne pas utiliser les éléments 30 et 31 qui sont les anciens signaux et quais interface uses @@ -117,7 +117,7 @@ type ImagePalette8: TImage; ImageTemp: TImage; ImageTemp2: TImage; - outslectionner1: TMenuItem; + Toutslectionner1: TMenuItem; ButtonDessiner: TButton; ImagePalette26: TImage; Label26: TLabel; @@ -145,14 +145,14 @@ type N8: TMenuItem; DessinerleTCO1: TMenuItem; ConfigurationduTCO1: TMenuItem; - N9: TMenuItem; - Redessine1: TMenuItem; Affichebandeau1: TMenuItem; Affichage1: TMenuItem; Mosaquehorizontale1: TMenuItem; Mosaqueverticale1: TMenuItem; N10: TMenuItem; AfficherSignauxComplexes1: TMenuItem; + Signalvertical180: TMenuItem; + RafrachirleTCO1: TMenuItem; //TimerTCO: TTimer; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -354,7 +354,7 @@ type procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure EditTypeImageChange(Sender: TObject); - procedure outslectionner1Click(Sender: TObject); + procedure Toutslectionner1Click(Sender: TObject); procedure ButtonDessinerClick(Sender: TObject); procedure ImagePalette26DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); @@ -421,7 +421,7 @@ type procedure Mosaquehorizontale1Click(Sender: TObject); procedure Mosaqueverticale1Click(Sender: TObject); procedure AfficherSignauxComplexes1Click(Sender: TObject); - // procedure TimerTCOTimer(Sender: TObject); + procedure Signalvertical180Click(Sender: TObject); private { Déclarations privées } @@ -482,29 +482,29 @@ type coulFonte : Tcolor; TailleFonte : integer; CouleurFond : Tcolor; // couleur de fond - // pour les signaux seulement + // pour les signaux seulement ou action PiedFeu : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie OU si action: type d'action x,y : integer; // coordonnées pixels relativés du coin sup gauche du signal pour le décalage par rapport au 0,0 cellule Xundo,Yundo : integer; // coordonnées x,y de la cellule pour le undo FeuOriente : integer; // orientation du signal : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit / OU si action : numéro du TCO etc - liaisons : integer; // quadrants des liaisons + liaisons : integer; // quadrants des liaisons epaisseurs : integer; // épaisseur des liaisons : si le bit n est à 1 : liaison fine pont : integer; // définition du pont : si le bit n est à 1 : pont (bits symétriques) buttoir : integer; // définition des buttoirs : si le bit n est à 1 : buttoir sortie : integer; // si action sortie : état end; - Trect_Select= record - NumTCO : integer; // affection du rectangle à ce tco - Gd, // grand rectangle - rN,rE,rS,rO,rNE,rNO,rSE,rSO : Trect; // poignées + // Outil graphique de sélection + Trect_Select= record + NumTCO : integer; // affectation du rectangle à ce tco + Gd, // grand rectangle + rN,rE,rS,rO,rNE,rNO,rSE,rSO : Trect; // 8 poignées end; var couleurAdresse,cltexte,CoulFonte : Tcolor; - formTCO : array[1..10] of TformTCO; - //TCO_Timer : array[1..10] of Ttimer; + formTCO : array[1..10] of TformTCO; // pointeur vers forms TamponAffecte,TCO_modifie,clicsouris,prise_N, clicTCO,piloteAig,BandeauMasque,eval_format,sauve_tco,prise_droit,prise_haut, @@ -521,16 +521,18 @@ var titre_Fonte : string; + // structure de tous les tco TCO : array[1..10] of - array of array of TTco ; // tco[x,y].variable + array of array of TTco ; + // tampon undo Undo : array[1..MaxUndo] of record nombre : integer; element : array[1..100] of TTCO ; end; // pour copier coller - TamponTCO : array of array of TTco ; // tco[x,y].variable + TamponTCO : array of array of TTco ; TamponTCO_Org : record numTCO,x1,y1,x2,y2,NbreCellX,NbreCellY : integer; end; @@ -538,15 +540,19 @@ var Rect_select : Trect_Select; Sauv_rect_select : Trect; - routeTCO : array[1..500] of record - x,y : integer; + // tracé du train dans les TCO + Trace_Train : array[1..10] of record + train : array[1..Max_Trains] of record + nombre : integer; + route : array[1..500] of record x,y : integer; + end; + end; end; - // tracé + // tracé en mode dessin traceXY : Array[1..50] of record x,y : integer; // en coordonnées grille end; - rAncien : TRect; VBm,OldBmp : TBitMap; PScrollBoxTCO : TScrollBox; @@ -566,7 +572,7 @@ var procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY : integer); procedure calcul_cellules(indextco : integer); procedure sauve_fichiers_tco; -procedure zone_TCO(indexTCO,det1,det2,mode: integer); +procedure zone_TCO(indexTCO,det1,det2,train,mode: integer); procedure _entoure_cell_clic(indexTCO: integer); procedure Affiche_TCO(indexTCO : integer) ; procedure affiche_cellule(indexTCO,x,y : integer); @@ -590,7 +596,9 @@ function IsAigTCO(i : integer) : boolean; function index_TCO(t : Tobject) : integer; procedure Init_TCO(indexTCO : integer); procedure init_tampon_copiercoller; -//procedure zone_tco_V2(indexTCO,det1,det2,mode: integer); +procedure efface_trajet(det,train : integer); +Procedure Texte_aig_fond(adresse : integer); +procedure Maj_Aig_TCO(indexTCO : integer); implementation @@ -600,16 +608,15 @@ uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO ; // renvoie l'index du tco d'après le nom de la forme (TCO1 TCO2) // ne fonctionne que si t est un composant dont on peut remonter jusqu'à la form parent -// Exemple : si T est un popup menu, ca ne marche pas!!! +// attention : si T est un popup menu, ca ne marche pas!!! function index_TCO(t : Tobject) : integer; var s : string; trouve : boolean; f : tcustomform; i,erreur : integer; begin - s:=(t as Tcomponent).name; + //s:=(t as Tcomponent).name; // Affiche(s,clWhite); - f:=getparentForm(t as Tcontrol); s:=(f as Tcomponent).Name; //Affiche(s,clYellow); @@ -737,217 +744,220 @@ var dx,dy : integer; r : Trect; rien : boolean; begin - rien:=not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_haut) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO); + rien:=not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_haut) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO); - //poignée haut - r:=Rect_Select.rN; - if ((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_haut then + //poignée haut + r:=Rect_Select.rN; + if ((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_haut then + begin + screen.cursor:=crSizeNS; + //if (not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then + if (rien and clicsouris) or prise_haut then begin - screen.cursor:=crSizeNS; - //if (not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then - if (rien and clicsouris) or prise_haut then + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + if y=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_droit) then - begin - screen.cursor:=crSizeWE; - //if (not(prise_haut) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then - if (rien and clicsouris) or prise_droit then - begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_droit:=true; - if x>rect_select.Gd.Left then - begin - rect_Select.gd.right:=x; - end - else - begin - // inversion - rect_Select.gd.left:=x; - end; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); - end; - exit; - end; - - // poignée bas - r:=Rect_Select.rS; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_bas) then - begin - screen.cursor:=crSizeNS; - if (rien and clicsouris) or prise_bas then - begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_bas:=true; - if y>rect_select.Gd.top then - begin - rect_Select.gd.bottom:=y; - end - else - begin - // inversion - rect_Select.gd.top:=y; - end; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); - end; - exit; - end; - - // poignée gauche - r:=Rect_Select.rO; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_gauche) then - begin - screen.cursor:=crSizeWE; - if (rien and clicsouris) or prise_gauche then - begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_gauche:=true; - if x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NE) then - begin - screen.cursor:=crSizeNESW; - if (rien and clicsouris) or prise_NE then - begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_NE:=true; - rect_Select.gd.right:=x; rect_Select.gd.top:=y; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); - end; - exit; - end; - - // poignée NO - r:=Rect_Select.rNO; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NO) then - begin - screen.cursor:=crSizeNWSE; - if (rien and clicsouris) or prise_NO then + end + else begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_NO:=true; - rect_Select.gd.left:=x; - rect_Select.gd.top:=y; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); + // inversion + rect_Select.gd.bottom:=y; end; - exit; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + prise_haut:=true; // mémorise si la souris va vite end; + exit; + end; - // poignée SE - r:=Rect_Select.rSE; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SE) then + // poignée droite + r:=Rect_Select.re; + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_droit) then + begin + screen.cursor:=crSizeWE; + //if (not(prise_haut) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then + if (rien and clicsouris) or prise_droit then begin - screen.cursor:=crSizeNWSE; - if (rien and clicsouris) or prise_SE then + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_droit:=true; + if x>rect_select.Gd.Left then begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_SE:=true; rect_Select.gd.right:=x; - rect_Select.gd.bottom:=y; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); - end; - exit; - end; - - // poignée SO - r:=Rect_Select.rSO; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SO) then - begin - screen.cursor:=crSizeNESW; - if (rien and clicsouris) or prise_SO then + end + else begin - // efface l'ancien - Affiche_Rectangle(IndexTCO,Rect_select); - prise_SO:=true; + // inversion rect_Select.gd.left:=x; - rect_Select.gd.bottom:=y; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); end; - exit; - end; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + end; + exit; + end; - // selec ractangle : bouger en toutes directions - r:=Rect_select.Gd; - if ((y>r.top) and (yr.Left) and (x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_bas) then + begin + screen.cursor:=crSizeNS; + if (rien and clicsouris) or prise_bas then + begin + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_bas:=true; + if y>rect_select.Gd.top then + begin + rect_Select.gd.bottom:=y; + end + else + begin + // inversion + rect_Select.gd.top:=y; + end; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + end; + exit; + end; - top:=Sauv_rect_select.top+dy-DeltaYrect; - bottom:=Sauv_rect_select.Bottom+dy-DeltaYrect; - left:=x-deltaXrect; - right:=Sauv_rect_select.right+dx-DeltaXrect; - end; - init_rectangle(indexTCO,rect_select); - Affiche_Rectangle(indexTCO,rect_Select); - end; - exit; + // poignée gauche + r:=Rect_Select.rO; + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_gauche) then + begin + screen.cursor:=crSizeWE; + if (rien and clicsouris) or prise_gauche then + begin + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_gauche:=true; + if x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NE) then + begin + screen.cursor:=crSizeNESW; + if (rien and clicsouris) or prise_NE then + begin + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_NE:=true; + rect_Select.gd.right:=x; + rect_Select.gd.top:=y; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + end; + exit; + end; + + // poignée NO + r:=Rect_Select.rNO; + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NO) then + begin + screen.cursor:=crSizeNWSE; + if (rien and clicsouris) or prise_NO then + begin + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_NO:=true; + rect_Select.gd.left:=x; + rect_Select.gd.top:=y; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + end; + exit; + end; + + // poignée SE + r:=Rect_Select.rSE; + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SE) then + begin + screen.cursor:=crSizeNWSE; + if (rien and clicsouris) or prise_SE then + begin + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_SE:=true; + rect_Select.gd.right:=x; + rect_Select.gd.bottom:=y; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + end; + exit; + end; + + // poignée SO + r:=Rect_Select.rSO; + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SO) then + begin + screen.cursor:=crSizeNESW; + if (rien and clicsouris) or prise_SO then + begin + // efface l'ancien + Affiche_Rectangle(IndexTCO,Rect_select); + prise_SO:=true; + rect_Select.gd.left:=x; + rect_Select.gd.bottom:=y; + init_rectangle(indexTCO,rect_select); + Affiche_Rectangle(indexTCO,rect_Select); + end; + exit; + end; + + // selec rectangle : bouger en toutes directions + r:=Rect_select.Gd; + if ((y>r.top) and (yr.Left) and (x0 then begin - case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; @@ -1743,6 +1746,7 @@ begin // détecteur + Adr:=tco[indextco,x,y].adresse; if adr<>0 then begin if detecteur[Adr].etat then @@ -1762,9 +1766,6 @@ begin FillRect(r); end; - // voie - jy1:=y0+(HauteurCell[indexTCO] div 2); - case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; @@ -1780,9 +1781,8 @@ end; // renvoie vrai si l'élément i est un aiguillage ou une TJD/S ou un croisement function IsAigTCO(i : integer) : boolean; begin - result:=((i=2) or (i=3) or (i=4) or (i=5) or (i=12) or (i=13) or (i=14) or - (i=15) or - ((i>=21) and (i<=34) )) ; + result:=((i=2) or (i=3) or (i=4) or (i=5) or (i=12) or (i=13) or (i=14) or (i=15) or + ((i>=21) and (i<=34) )) ; end; // écrit le texte réparti sur plusieurs lignes. @@ -1792,7 +1792,7 @@ end; Procedure Texte_reparti(s : string;indexTCO,x,y,tf : integer); var c : Tcanvas; st : array[1..10] of string; - b,haut,larg,i,l,PixelLength,NombreMots,yl : integer; + haut,larg,i,l,PixelLength,NombreMots,yl : integer; begin if (s='') or (indexTCO=0) then exit; // supprimer les espaces en fin @@ -1817,7 +1817,6 @@ begin until (i>l) or (i=0); dec(NombreMots); - b:=tco[indexTCO,x,y].Bimage; PixelLength:=tf; // x y en cellules @@ -1907,198 +1906,6 @@ begin c.Textout(x0+xt,y0+yt,s); end; - -// essai pour dessiner les icones de façon paramétrées en fonction du numéro de dessin -// et des points de connexion -// numéro = numéro d'icone -procedure dessin(indexTCO : integer;Canvas : Tcanvas;x,y,Mode,numero : integer); -var i,j,x0,y0,xc,yc,jy2,xf,yf,position,jy1,connect1,connect2,connect3,connect4 : integer; - r : Trect; - fond : tcolor; - - procedure trace_point(canvas : Tcanvas;i : integer); - begin - with canvas do - begin - case i of - 0 : moveto(x0,y0); - 1 : moveto(xc,y0); - 2 : moveto(xf,y0); - 3 : moveto(xf,yc); - 4 : moveto(xf,yf); - 5 : moveto(xc,yf); - 6 : moveto(x0,yf); - 7 : moveto(x0,yc); - end; - end; - end; - - procedure trace_ligne(canvas : Tcanvas;i : integer); - begin - with canvas do - begin - case i of - 0 : lineto(x0,y0); - 1 : lineto(xc,y0); - 2 : lineto(xf,y0); - 3 : lineto(xf,yc); - 4 : lineto(xf,yf); - 5 : lineto(xc,yf); - 6 : lineto(x0,yf); - 7 : lineto(x0,yc); - end; - end; - end; - - - procedure trajet_droit; - begin - couleur:=clvoies[indexTCO]; - if mode>0 then - begin - if position=const_droit then - begin - if mode=1 then couleur:=clcanton[indexTCO]; - if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; - end; - end; - - with canvas do - begin - pen.color:=couleur; - pen.Width:=epaisseur; - {case numero of - 2 : begin moveto(x0,yc);lineto(xf,yc);end; // partie droite - end;} - //ou - - // trace le premier point - trace_point(canvas,connect1); - lineto(xc,yc); - // trace le 2eme point - trace_ligne(canvas,connect1); - end; - end; - - procedure trajet_devie; - begin - couleur:=clvoies[indexTCO]; - if mode>0 then - begin - if position=const_devie then - begin - if mode=1 then couleur:=clcanton[indexTCO]; - if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; - end; - end; - - with canvas do - begin - pen.color:=couleur; - pen.Width:=epaisseur; - {case numero of - 2 : begin moveto(x0,yf);lineto(xc,yc);lineto(xf,yc);end; - end; } - trace_point(canvas,connect1); - lineto(xc,yc); - // trace le 2eme point - trace_ligne(canvas,connect1); - end; - end; - -begin - x0:=(x-1)*LargeurCell[indexTCO]; // x origine - y0:=(y-1)*HauteurCell[indexTCO]; // y origine - yc:=y0+(HauteurCell[indexTCO] div 2); // y centre - xc:=x0+(LargeurCell[indexTCO] div 2); // x centre - xf:=x0+largeurCell[indexTCO]; // x fin - yf:=y0+HauteurCell[indexTCO]; // y fin - - //Efface_Cellule(CanvasDest,x,y,pmCopy); - // ((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; - //f:=getparent(canvasDest.Handle); - //indexTCO:=index_TCO(getParentForm(canvas).name); - //f:=getParentForm(canvas as tcontrol); - - - - fond:=tco[indextco,x,y].CouleurFond; - position:=positionTCO(indexTCO,x,y); - - // extraire les points de connexion de l'icone (de 0 à 7) - connect1:=0;connect2:=0;connect3:=0;connect4:=0; - j:=0; - for i:=0 to 7 do - begin - if testBit(liaisons[numero],i) then - begin - case j of - 0 : connect1:=i; - 1 : connect2:=i; - 2 : connect3:=i; - 3 : connect4:=i; - end; - inc(j); - end; - end; - - - with canvas do - begin - Pen.Width:=1; - Brush.Color:=fond; - Pen.Color:=fond; - - Pen.Width:=epaisseur; - Brush.Color:=clVoies[indexTCO]; - Pen.Color:=clVoies[indexTCO]; - Pen.Mode:=pmCopy; - - if mode>0 then - begin - if (position=const_devie) or (position=const_inconnu) then - begin - trajet_droit; - trajet_devie; - end; - if (position=const_droit) then - begin - trajet_devie; - trajet_droit; - end; - end - - else - begin - trajet_devie; - trajet_droit; - end; - - if (position=const_Devie) then - begin - // effacement du morceau - pen.color:=fond; - Brush.Color:=fond; - pen.width:=1; - jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup - pen.width:=1; - Polygon([point(x0+1,y0+hauteurCell[indexTCO]-epaisseur),Point(xc-(epaisseur div 2),jy1),Point(xc-epaisseur-epaisseur,jy1),Point(x0+1,y0+hauteurCell[indexTCO]-epaisseur-epaisseur)]); - end; - - if position=const_droit then - begin - // effacement du morceau - pen.color:=fond; - Brush.Color:=fond; - pen.Width:=1; - jy2:=yc+(Epaisseur div 2); // pos Y de la bande inf - r:=rect(x0+1,jy2+1,x0+LargeurCell[indexTCO]-1,jy2+epaisseur); - FillRect(r); - end; - end; -end; - -// sert de référence11 procedure dessin_2L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy2,xf,yf,position,jy1,ep : integer; r : Trect; @@ -2120,7 +1927,7 @@ var x0,y0,xc,yc,jy2,xf,yf,position,jy1,ep : integer; begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; - moveto(x0,yc);lineto(xc,yc); + moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; @@ -2215,8 +2022,7 @@ begin end; end; - -// courbe +// courbe procedure dessin_2C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4,ep : integer; r : Trect; @@ -2583,13 +2389,6 @@ begin FillRect(r); end; end; - { - with canvas do - begin - pen.Color:=clwhite; - pen.width:=1; - moveto(x1,y1);lineto(x2,y2); - end; } end; @@ -3528,7 +3327,7 @@ begin Adr:=tco[indextco,x,y].adresse; -// détecteur + // détecteur if adr<>0 then begin if detecteur[Adr].etat then @@ -4849,12 +4648,9 @@ begin pen.Color:=Clred; moveto(x0+round(20*fryGlob[indexTCO]),yc); LineTo(xf-round(20*fryGlob[indexTCO]),yc); - exit; end; - - // état détecteur Adr:=tco[indextco,x,y].adresse; if Adr<>0 then @@ -4893,8 +4689,9 @@ end; // Element 21 - croisement - TJD procedure dessin_21(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); -var yp,x1,x2,y1,y2,x0,y0,xc,yc,xf,yf,trajet,ep,pont : integer; +var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont : integer; a1,b1,a2,b2 : double; + md : tequipement; procedure horizontale; begin with canvas do @@ -4917,6 +4714,34 @@ var yp,x1,x2,y1,y2,x0,y0,xc,yc,xf,yf,trajet,ep,pont : integer; end; end; + procedure TjdHaut; + begin + x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); + x2:=xf+(LargeurCell[indexTCO] div 3)+3;y2:=yc; + x3:=x0;y3:=yc; + x4:=xf;y4:=y0; + + with canvas do + begin + if testbit(ep,2) or testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + + procedure TjdBas; + begin + x1:=xf-x0; + x1:=x0-(x1 div 3);y1:=yc; + x2:=xf+xf-x1;y2:=yf+hauteurCell[indexTCO]*2+(hauteurCell[indexTCO] div 2); + x3:=xf;y3:=yc; + x4:=x0;y4:=yf; + + with canvas do + begin + if testbit(ep,6) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; begin x0:=(x-1)*LargeurCell[indexTCO]; @@ -4936,6 +4761,12 @@ begin horizontale; diagonale; + md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; + if (md=tjd) or (md=tjs) then + begin + tjdbas; + tjdhaut; + end; // horizontale if testbit(pont,3) or testbit(pont,7) then @@ -5012,19 +4843,21 @@ begin pen.color:=couleur; if trajet=1 then horizontale; // horizontale if trajet=2 then diagonale; // diagonale - if trajet=3 then + if trajet=3 then // SO C E /- begin - if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + { if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xf,yc); + lineTo(xf,yc);} + tjdbas; end; - if trajet=4 then + if trajet=4 then // -/ O C NE begin - if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + {if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);LineTo(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xf,y0); + lineTo(xf,y0);} + tjdhaut; end; end; end; @@ -5032,7 +4865,8 @@ end; // Element 22 procedure dessin_22(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); -var pont,yp,x1,y1,x2,y2,x0,y0,xc,yc,xf,yf,trajet,ep : integer; +var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep : integer; + md : tequipement; a1,b1,a2,b2 : double; procedure horizontale; begin @@ -5056,6 +4890,33 @@ var pont,yp,x1,y1,x2,y2,x0,y0,xc,yc,xf,yf,trajet,ep : integer; end; end; + procedure TJDbas; + begin + x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc; + x2:=xf+(LargeurCell[indexTCO] div 3);y2:=yf+2*hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 2); + x3:=xf;y3:=yf; + x4:=x0;y4:=yc; + ep:=tco[indextco,x,y].epaisseurs; + with canvas do + begin + if testbit(ep,7) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + + procedure TJDHaut; + begin + x1:=x0-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); + x2:=xf+LargeurCell[indexTCO]+(LargeurCell[indexTCO] div 3);y2:=yc; + x3:=x0;y3:=y0; + x4:=xf;y4:=yc; + with canvas do + begin + if testbit(ep,0) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; @@ -5079,6 +4940,12 @@ begin diagonale; horizontale; + md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; + if (md=tjd) or (md=tjs) then + begin + TJDbas; + TJDHaut; + end; // horizontale if testbit(pont,3) or testbit(pont,7) then @@ -5153,19 +5020,21 @@ begin pen.color:=couleur; if trajet=1 then horizontale; if trajet=2 then diagonale; - if trajet=3 then + if trajet=3 then // NO centre E \- begin - if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + { if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xf,yc); + lineTo(xf,yc);} + tjdhaut; end; - if trajet=4 then + if trajet=4 then // O C SE -\ begin - if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + { if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xf,yf); + lineTo(xf,yf); } + tjdbas; end; end; end; @@ -5265,7 +5134,7 @@ begin //texte_reparti(s,indexTCO,x,y,tf); affiche_texte(indextco,x,y); end; - + end; end; @@ -5509,8 +5378,9 @@ end; // Element 23 croisement procedure dessin_23(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); -var x1,x2,y1,y2,xp,x0,y0,xf,yf,xc,yc,trajet,ep,pont : integer; +var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont : integer; a1,b1,a2,b2 : double; + md : tEquipement; procedure verticale; begin with canvas do @@ -5533,6 +5403,36 @@ var x1,x2,y1,y2,xp,x0,y0,xf,yf,xc,yc,trajet,ep,pont : integer; end; end; + procedure tjd_d; + begin + x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); + x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); + x3:=xf;y3:=y0; + x4:=xc;y4:=yf; + ep:=tco[indextco,x,y].epaisseurs; + + with canvas do + begin + if testbit(ep,2) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + + procedure tjd_G; + begin + x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); + x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 2.5); + x3:=x0;y3:=yf; + x4:=xc;y4:=y0; + ep:=tco[indextco,x,y].epaisseurs; + + with canvas do + begin + if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; @@ -5556,6 +5456,12 @@ begin diagonale; verticale; + md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; + if (md=tjd) or (md=tjs) then + begin + tjd_G; + tjd_D; + end; // verticale if testbit(pont,1) or testbit(pont,5) then @@ -5632,19 +5538,21 @@ begin pen.color:=couleur; if trajet=1 then verticale; if trajet=2 then diagonale; - if trajet=3 then + if trajet=3 then // NE C S begin - if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + {if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xc,yf); + lineTo(xc,yf);} + tjd_d; end; - if trajet=4 then + if trajet=4 then // N C SO begin - if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + {if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);LineTo(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(x0,yf); + lineTo(x0,yf);} + tjd_g; end; end; end; @@ -5658,8 +5566,9 @@ end; // Element 25 croisement procedure dessin_25(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); -var xp,x0,y0,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2 : integer; +var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2 : integer; a1,b1,a2,b2 : double; + md : tEquipement; procedure verticale; begin with canvas do @@ -5682,6 +5591,36 @@ var xp,x0,y0,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2 : integer; end; end; + procedure tjd_g; + begin + x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); + x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); + x3:=xc;y3:=yf; + x4:=x0;y4:=y0; + ep:=tco[indextco,x,y].epaisseurs; + + with canvas do + begin + if testbit(ep,0) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + + procedure tjd_d; + begin + x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); + x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 3); + x3:=xc;y3:=y0; + x4:=xf;y4:=yf; + ep:=tco[indextco,x,y].epaisseurs; + + with canvas do + begin + if testbit(ep,1) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + Arc(x1,y1,x2,y2,x3,y3,x4,y4); + end; + end; + begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; @@ -5705,6 +5644,12 @@ begin verticale; diagonale; + md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; + if (md=tjd) or (md=tjs) then + begin + tjd_g; + tjd_d; + end; // verticale if testbit(pont,1) or testbit(pont,5) then @@ -5781,19 +5726,21 @@ begin pen.color:=couleur; if trajet=1 then verticale; if trajet=2 then diagonale; - if trajet=3 then + if trajet=3 then // NO C S begin - if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + {if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xc,yf); + lineTo(xc,yf);} + tjd_g; end; if trajet=4 then begin - if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + {if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineTo(xf,yf); + lineTo(xf,yf);} + tjd_d; end; end; end; @@ -5821,7 +5768,7 @@ var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - moveto(xc,y0);lineto(xc,yc); + moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; @@ -6229,7 +6176,7 @@ begin // mode rond x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 3);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); - x2:=xc;y2:=yf+round(hauteurCell[indexTCO] / 2.9); + x2:=xc;y2:=yf+round(hauteurCell[indexTCO] / 2.9); x3:=x0;y3:=yf; x4:=xc;y4:=y0; @@ -6917,7 +6864,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - moveto(xf,y0);lineto(xc,yc); + moveto(xf,y0);lineto(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yf); end; @@ -6943,8 +6890,6 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; end; end; - - begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine @@ -7440,7 +7385,6 @@ procedure trajet_droit; end; end; - begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine @@ -7530,11 +7474,51 @@ procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY : integer); begin //frX:=DimDestX/DimOrgX; //frY:=DimDestY/DimOrgY; - frx:=DimDestX/50; - fry:=DimDestY/50; + frx:=DimDestX/ZoomMax; + fry:=DimDestY/ZoomMax; //Affiche(formatfloat('0.000000',frY),clyellow); end; +procedure Feu_180(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); +var p : array[0..2] of TPoint; + TailleY,TailleX : integer; +begin + TailleY:=ImageSource.Picture.Height+0; + TailleX:=ImageSource.Picture.Width+0; + + // copie à 180° sans mise à l'échelle dans l'image provisoire + // il y a un décalage observé par la fonction PlgBlt d'1 pixel quand on tourne de 180°. Les corrections +1 et -1 servent à corriger cet effet. + // coin supérieur gauche NO + p[0].X:=TailleX+1; + p[0].Y:=TailleY+1; + // coin supérieur droit NE + p[1].X:=0; + p[1].Y:=TailleY; + // coin inférieur gauche SO + p[2].X:=TailleX+1; + p[2].Y:=0; + + {with PImageTemp[index].Canvas do + begin + pen.Color:=clred; + moveTO(00,0);lineTo(100,0); + moveto(0,00);lineto(0,100); + end; + } + if inverse then + begin + inverse_image(FormTCO[index].ImageTemp2,ImageSource); + // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 180° + PlgBlt(PImageTemp[Index].Canvas.Handle,p,FormTCO[index].ImageTemp2.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); + end + else // source facultatif + PlgBlt(PImageTemp[index].Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); + + TransparentBlt(PcanvasTCO[index].Handle,x-1,y,round(TailleX*FrX),round(TailleY*FrY), // destination + PImageTemp[index].Canvas.Handle,0,0,TailleX,TailleY,clBlue); // source - clblue est la couleur de transparence +end; + + // Affiche dans le TCO en x,y un signal à 90° d'après l'image transmise // x y en coordonnées pixels procedure Feu_90G(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); @@ -7600,6 +7584,219 @@ begin PImageTCO[index].Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; +procedure affiche_pied2_180(index,x,y : integer;FrX,frY : real;pied : integer); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + x1:=13;y1:=-3; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); + end; +end; + +procedure affiche_pied3_180(index,x,y : integer;FrX,frY : real;pied : integer); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + x1:=13;y1:=-3; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); + end; +end; + +procedure affiche_pied4_180(index,x,y : integer;FrX,frY : real;pied : integer); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + x1:=13;y1:=-3; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); + end; +end; + +procedure affiche_pied5_180(index,x,y : integer;FrX,frY : real;pied : integer); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + x1:=13;y1:=-3; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); + end; +end; + +procedure affiche_pied7_180(index,x,y : integer;FrX,frY : real;pied : integer); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + x1:=38;y1:=0; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); + end; +end; + +procedure affiche_pied9_180(index,x,y : integer;FrX,frY : real;pied : integer); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + x1:=38;y1:=0; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); + end; +end; + +procedure affiche_pied20_90G(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + + if contrevoie then + begin + x1:=0;y1:=34; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + x1:=x1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round(x1*frX),y+round((y1+40)*frY) ) else // a gauche + LineTo( x+round(x1*frX),y+round((y1-65)*frY) ); // a droite + end + else + begin + x1:=0;y1:=14; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + x1:=x1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round(x1*frX),y+round((y1+60)*frY) ) else + LineTo( x+round(x1*frX),y+round((y1-45)*frY) ); + end; + end; +end; + +procedure affiche_pied20_90D(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + + if contrevoie then + begin + x1:=65;y1:=-8; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + x1:=x1+6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round(x1*frX),y+round((y1+65)*frY) ) else // a gauche + LineTo( x+round(x1*frX),y+round((y1-40)*frY) ); // a droite + end + else + begin + x1:=65;y1:=10; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + x1:=x1+6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round(x1*frX),y+round((y1-57)*frY) ) else + LineTo( x+round(x1*frX),y+round((y1+45)*frY) ); + end; + end; +end; + +procedure affiche_pied20_180(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + + if contrevoie then + begin + x1:=20;y1:=0; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else // a gauche + LineTo( x+round((x1+55)*frX),y+round(y1*frY) ); // a droite + end + else + begin + x1:=38;y1:=0; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1-6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); + end; + end; +end; + +procedure affiche_pied20_vertical(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); +var x1,y1 : integer; +begin + with PcanvasTCO[index] do + begin + Pen.Width:=2; + Pen.Color:=clPiedSignal[index]; + + if contrevoie then + begin + x1:=38;y1:=102; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1+6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1+40)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1-65)*frX),y+round(y1*frY) ); + end + else + begin + x1:=18;y1:=102; + moveTo( x+round(x1*frX),y+round(y1*frY) ); + y1:=y1+6; + LineTo( x+round(x1*frX),y+round(y1*frY) ); + if pied=1 then LineTo( x+round((x1+62)*frX),y+round(y1*frY) ) else + LineTo( x+round((x1-40)*frX),y+round(y1*frY) ); + end; + end; +end; + + procedure affiche_pied2G_90G(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,frYR : real; @@ -7956,6 +8153,7 @@ end; procedure dessin_Signal(indexTCO : integer;CanvasDest : Tcanvas;x,y : integer ); var index,x0,y0,xp,yp,orientation,adresse,aspect,PiedFeu,TailleX,TailleY,larg,haut : integer; ImageFeu : Timage; + Contrevoie : boolean; frX,frY : real; begin if (x>NbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x<1) or (y<1) or (NbreFeux=0) then exit; @@ -7963,7 +8161,7 @@ begin larg:=LargeurCell[indexTCO]; haut:=hauteurCell[indexTCO]; - xp:=(x-1)*larg; + xp:=(x-1)*larg; // coordonnées cellule yp:=(y-1)*haut; Adresse:=tco[indextco,x,y].Adresse; @@ -7972,6 +8170,7 @@ begin index:=Index_Signal(adresse); aspect:=feux[index].aspect; + if aspect=0 then aspect:=9; //if aspect>9 then exit; //Affiche(IntToSTR(i)+' '+intToSTR(aspect),clred); @@ -8001,7 +8200,9 @@ begin calcul_reduction(frx,fry,Larg,haut); x0:=0;y0:=0; // pour les signaux directionnels - if orientation=3 then //D + + // point d'origine dans la cellule du signal + if orientation=3 then //90°D begin if aspect=20 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-round(tailleX*frY);end; if aspect=9 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-round(tailleX*frY);end; @@ -8013,7 +8214,7 @@ begin end; // décalage en X pour mettre la tete du signal alignée sur le bord droit de la cellule pour les signaux tournés à 90G - if orientation=2 then + if orientation=2 then //90°G begin if aspect=20 then begin x0:=0; y0:=0;end; if aspect=9 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-round(tailleX*frY);end; @@ -8025,7 +8226,7 @@ begin end; // décalage en X pour rapprocher le signal du le bord droit de la cellule pour les feux verticaux - if orientation=1 then + if (orientation=1) then begin if aspect=20 then begin x0:=0; y0:=0; end; if aspect=9 then begin x0:=0; y0:=0; end; @@ -8036,10 +8237,22 @@ begin if aspect=2 then begin x0:=round(13*frx); y0:=0;end; end; - x0:=x0+xp;y0:=y0+yp; + if orientation=4 then + begin + if aspect=2 then begin x0:=round(14*frx);y0:=round(15*fry);end; + if aspect=3 then begin x0:=round(14*frx);y0:=round(15*fry);end; + if aspect=4 then begin x0:=round(14*frx);y0:=round(15*fry);end; + if aspect=5 then begin x0:=round(14*frx);y0:=round(15*fry);end; + if aspect=7 then begin x0:=round(2*frx);y0:=round(15*fry);end; + if aspect=9 then begin x0:=round(2*frx);y0:=round(15*fry);end; + end; + + x0:=x0+xp;y0:=y0+yp; // coordonnées cellule + décalage tco[indextco,x,y].x:=x0; tco[indextco,x,y].y:=y0; + Contrevoie:=feux[index].contrevoie; + // affichage du signal et du pied - orientation verticale if (Orientation=1) then begin @@ -8058,7 +8271,7 @@ begin PImageTCO[indexTCO].Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. case aspect of - 20 : affiche_pied_Vertical5G(indexTCO,x0+round(10*frx),y0+hauteurCell[indexTCO]-round(10*fry),frX,frY,piedFeu); + 20 : affiche_pied20_vertical(indexTCO,x0,y0,frX,frY,piedFeu,contrevoie); 9 : affiche_pied_Vertical9G(indexTCO,x0,y0,frX,frY,piedFeu); 7 : affiche_pied_Vertical7G(indexTCO,x0,y0,frX,frY,piedFeu); 5 : affiche_pied_Vertical5G(indexTCO,x0,y0,frX,frY,piedFeu); @@ -8071,10 +8284,10 @@ begin // affichage du feu et du pieds - orientation 90°G if Orientation=2 then begin - Feu_90G(indexTCO,ImageFeu,x0,y0,frX,frY,feux[index].contrevoie); // ici on passe l'origine du signal + Feu_90G(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); // ici on passe l'origine du signal // dessiner le pied case aspect of - 20 : affiche_pied5G_90G(indexTCO,x0+2,y0+round(fry*5),frX,frY,piedFeu); + 20 : affiche_pied20_90G(indexTCO,x0+2,y0+round(fry*5),frX,frY,piedFeu,contrevoie); 9 : affiche_pied9G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 7 : affiche_pied7G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 5 : affiche_pied5G_90G(indexTCO,x0,y0,frX,frY,piedFeu); @@ -8087,10 +8300,10 @@ begin // affichage du signal et du pied - orientation 90°D if Orientation=3 then begin - Feu_90D(indexTCO,ImageFeu,x0,y0,frX,frY,feux[index].contrevoie); + Feu_90D(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); // dessiner le pied case aspect of - 20 : affiche_pied5G_90D(indexTCO,x0+(LargeurCell[indexTCO] div 2)+round(frx*12),y0+(hauteurCell[indexTCO] div 2),frX,frY,piedFeu); + 20 : affiche_pied20_90D(indexTCO,x0+(LargeurCell[indexTCO] div 2)+round(frx*12),y0+(hauteurCell[indexTCO] div 2),frX,frY,piedFeu,contrevoie); 9 : affiche_pied9G_90D(indexTCO,x0,y0,frX,frY,piedFeu); 7 : affiche_pied7G_90D(indexTCO,x0,y0,frX,frY,piedFeu); 5 : affiche_pied5G_90D(indexTCO,x0,y0,frX,frY,piedFeu); @@ -8100,6 +8313,21 @@ begin end; end; + // 180° + if orientation=4 then + begin + Feu_180(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); + case aspect of + 2 : affiche_pied2_180(indexTCO,x0,y0,frX,frY,PiedFeu); + 3 : affiche_pied3_180(indexTCO,x0,y0,frX,frY,PiedFeu); + 4 : affiche_pied4_180(indexTCO,x0,y0,frX,frY,PiedFeu); + 5 : affiche_pied5_180(indexTCO,x0,y0,frX,frY,PiedFeu); + 7 : affiche_pied7_180(indexTCO,x0,y0,frX,frY,PiedFeu); + 9 : affiche_pied9_180(indexTCO,x0,y0,frX,frY,PiedFeu); + 20 : affiche_pied20_180(indexTCO,x0,y0,frX,frY,PiedFeu,contrevoie); + end; + end; + // allumage des feux du signal ----------------- dessine_signal_mx(canvasDest,x0,y0,frX,frY,adresse,orientation); end; @@ -8154,7 +8382,8 @@ end; // affiche la cellule x et y en cases // index est utilisé pour accéder au tableau du tracé de la fonction zone_tco procedure affiche_cellule(indexTCO,x,y : integer); -var i,index,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied : integer; +var i,index,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied,AdrTr : integer; + typ : tequipement; inverse : boolean; s : string; begin @@ -8184,7 +8413,26 @@ begin if adresse<>0 then s:='A'+s+' ' else s:=' '; with PCanvasTCO[indexTCO] do begin - Brush.Color:=tco[indextco,x,y].CouleurFond; + // si réservation par train + i:=index_aig(adresse); + AdrTr:=aiguillage[i].AdrTrain; + typ:=aiguillage[i].modele; + + if AdrTr=0 then + begin + Brush.Color:=tco[indextco,x,y].CouleurFond; + //SetBkMode(PCanvasTCO[indexTCO].Handle,TRANSPARENT); + s:=s+' '; // efface l'adresse de réservation + end + else + begin + // couleur de fond de la réservation + Brush.style:=bsSolid; + Brush.Color:=clBlue; + s:=s+intToSTR(AdrTr); + //SetBkMode(PCanvasTCO[indexTCO].Handle,OPAQUE); + end; + //Brush.Style:=Bsclear; Font.Color:=tco[indextco,x,y].coulFonte; Font.Name:='Arial'; @@ -8198,10 +8446,11 @@ begin if Bimage=13 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=14 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=1;end; if Bimage=15 then begin xt:=3;yt:=1;end; - if Bimage=21 then begin xt:=3;yt:=1;end; - if Bimage=22 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + if Bimage=21 then begin xt:=(LargeurCell[indexTCO] div 2)+round(2*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; + if Bimage=22 then begin xt:=(LargeurCell[indexTCO] div 2);yt:=-2;end; + if Bimage=23 then begin xt:=round(33*frxGlob[indexTCO]);yt:=round(35*fryGlob[indexTCO]);end; if Bimage=24 then begin xt:=LargeurCell[indexTCO]-round(20*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - if Bimage=25 then begin xt:=(LargeurCell[indexTCO] div 2) + round(6*frxGlob[indexTCO]);yt:=(hauteurCell[indexTCO] div 2)-round(15*fryGlob[indexTCO]);end; + if Bimage=25 then begin xt:=round(34*frxGlob[indexTCO]);yt:=round(8*fryGlob[indexTCO]);end; if Bimage=26 then begin xt:=1;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=27 then begin xt:=1;yt:=1;end; if Bimage=28 then begin xt:=1;yt:=1;end; @@ -8209,8 +8458,6 @@ begin if Bimage=32 then begin xt:=1;yt:=1;end; if Bimage=33 then begin xt:=1;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=34 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - - TextOut(xOrg+xt,yOrg+yt,s); end; end; @@ -8298,7 +8545,7 @@ begin aspect:=feux[index].Aspect; oriente:=tco[indextco,x,y].FeuOriente; pied:=tco[indextco,x,y].PiedFeu; - inverse:=feux[index].contrevoie; + inverse:=feux[index].contrevoie; // pour signal belge xt:=0;yt:=0; // signal belge if (aspect=20) then @@ -8320,27 +8567,52 @@ begin if inverse then begin xt:=LargeurCell[indexTCO]+round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end else begin xt:=LargeurCell[indexTCO]+round(10*frxGlob[indexTCO]);yt:=round(1*fryGlob[indexTCO]);end; end; + if (oriente=4) then + begin + if inverse then begin xt:=LargeurCell[indexTCO]+round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end + else begin xt:=round(2*frxGlob[indexTCO]);yt:=round(1*fryGlob[indexTCO]);end; + end; end; if (aspect=9) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=2*hauteurCell[indexTCO]-round(25*fryGlob[indexTCO]);end; if (aspect=9) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]);end; // orientation G if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+round(25*frxGlob[indexTCO]);yt:=1;end; + if (aspect=9) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; + if (aspect=9) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=7) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; if (aspect=7) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+2;yt:=1;end; + if (aspect=7) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; + if (aspect=7) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=5) and (Oriente=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]+round(25*fryGlob[indexTCO]);end; if (aspect=5) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO] ;end; if (aspect=5) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; + if (aspect=5) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=5) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=4) and (Oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]+round(20*fryGlob[indexTCO]);end; if (aspect=4) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; if (aspect=4) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; + if (aspect=4) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=4) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=3) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite if (aspect=3) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche - if (aspect=3) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; + if (aspect=3) and (Oriente=2) and (pied=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // signal à G + if (aspect=3) and (Oriente=2) and (pied=2) then begin xt:=round(20*frxGlob[indexTCO]);yt:=0;end; // signal à droite if (aspect=3) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; + if (aspect=3) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=3) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=2) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite if (aspect=2) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche if (aspect=2) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; // orientation G - if (aspect=2) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; // orientation D + if (aspect=2) and (Oriente=3) then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // orientation D + if (aspect=2) and (Oriente=4) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(2*fryglob[indexTCO]);end; // orientation 180 + // signaux directionnels if (aspect>10) and (aspect<20) and(oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end; if (aspect>10) and (aspect<20) and (oriente=2) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; @@ -8359,6 +8631,7 @@ begin //if AvecGrille entoure_cell_grille(x,y); // grille devant end; + procedure Entoure_cell(indexTCO,x,y : integer); var r : Trect; x0,y0 : integer; @@ -8381,11 +8654,11 @@ end; procedure efface_entoure(indexTCO : integer); begin - if (entoure[indexTCO]) then - begin - Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]); - entoure[indexTCO]:=false; - end + if (entoure[indexTCO]) then + begin + Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]); + entoure[indexTCO]:=false; + end end; procedure _entoure_cell_clic(indexTCO: integer); @@ -8525,10 +8798,7 @@ procedure TFormTCO.FormCreate(Sender: TObject); var s : string; begin if affevt or (debug=1) then Affiche('FormTCO'+intToSTR(indexTCOCreate)+' create',clyellow); - {TCO_Timer[indexTCOCreate]:=TTimer.create(formTCO[indexTCOCreate]); - tco_timer[indexTCOCreate].Interval:=500; - tco_timer[indexTCOCreate].OnTimer:=} - offsetSourisY:=-10; + offsetSourisY:=-10; // permet de tenir l'icone au milieu quand on fait un glisser offsetSourisX:=-10; RadioGroupSel.ItemIndex:=0; auto_tcurs:=true; @@ -8594,8 +8864,8 @@ begin ImagePalette20.Hint:=s;ImagePalette20.ShowHint:=true; s:='Voie ou buttoir'; - ImagePalette10.Hint:=s;ImagePalette1.ShowHint:=true; - ImagePalette11.Hint:=s;ImagePalette20.ShowHint:=true; + ImagePalette10.Hint:=s;ImagePalette10.ShowHint:=true; + ImagePalette11.Hint:=s;ImagePalette11.ShowHint:=true; s:='Aiguillage'; ImagePalette2.Hint:=s;ImagePalette2.ShowHint:=true; @@ -8618,7 +8888,7 @@ begin s:='Croisement ou TJD ou TJS ou pont'; ImagePalette21.Hint:=s;ImagePalette21.ShowHint:=true; ImagePalette22.Hint:=s;ImagePalette22.ShowHint:=true; - ImagePalette23.Hint:=s;ImagePalette22.ShowHint:=true; + ImagePalette23.Hint:=s;ImagePalette23.ShowHint:=true; ImagePalette25.Hint:=s;ImagePalette25.ShowHint:=true; tcoCree:=true; @@ -8639,10 +8909,10 @@ begin inc(xc); b:=tco[indextco,xc,yc].Bimage; trouve:=(tco[indextco,xc,yc].Adresse=det) and - ( (b=1) or (b=10) or (b=11) or (b=20) ); // trouvé détecteur- obligé de regarder le type d'objet car un détecteur et un signal peuvent avoir la même adresse! + ( (b=1) or (b=10) or (b=11) or (b=20) ); // trouvé détecteur- obligé de regarder le type d'objet car un détecteur et un signal peuvent avoir la même adresse! until (xc=NbreCellX[indexTCO]) or trouve; inc(yc); - until (yc=NbreCellY[indexTCO]) or trouve; + until (yc>NbreCellY[indexTCO]) or trouve; dec(yc); if trouve then begin @@ -8668,32 +8938,63 @@ begin Affiche(s,clred); end; -procedure affiche_trajet(indexTCO,ir,mode : integer); -var i,j,sx,sy,x,y,ax,ay,Bimage,adresse : integer; - mdl : tEquipement; +// efface le trajet du tco du train depuis le détecteur jusqu'au premier aiguillage +procedure efface_trajet(det,train : integer); +var i,j,t,n,Bimage,x,y : integer; + trouve : boolean; begin -// et affichage de la route + for t:=1 to NbreTCO do + begin + n:=Trace_Train[t].train[train].nombre; + if n=0 then exit; + i:=n; + repeat + x:=Trace_Train[t].train[train].route[i].x; + y:=Trace_Train[t].train[train].route[i].y; + Bimage:=tco[t,x,y].BImage; + trouve:=isAigTCO(Bimage); + dec(i); + until trouve or (i=0); + + if trouve then + begin + for j:=i+1 downto 1 do + begin + x:=Trace_Train[t].train[train].route[j].x; + y:=Trace_Train[t].train[train].route[j].y; + tco[t,x,y].mode:=0; + Affiche_cellule(t,x,y); + end; + end; + end; +end; + +// affiche le trajet dans le tco du train,ir =nombre d'éléments du tableau trace_train mode=couleur +procedure affiche_trajet(indexTCO,train,ir,mode : integer); +var i,sx,sy,x,y,ax,ay,Bimage,adresse : integer; +begin + // et affichage de la route for i:=1 to ir do begin - x:=routetco[i].x; - y:=routetco[i].y; + x:=Trace_Train[indexTCO].Train[train].route[i].x; + y:=Trace_Train[indexTCO].Train[train].route[i].y; + tco[Indextco,x,y].mode:=mode; //mode; // pour la couleur - TCO[IndexTCO,x,y].train:=index_couleur; + TCO[IndexTCO,x,y].train:=index_couleur; // = numéro du train //Affiche(intToSTR(x)+' '+intToSTR(y),clorange); bimage:=tco[indextco,x,y].BImage; adresse:=tco[indextco,x,y].Adresse; tco[indextco,x,y].trajet:=0; - // croisement + // pour les croisements il faut mettre à jour la variable "trajet" pour l'affichage dans la cellule if (bimage=21) and (i>1) then begin - j:=index_aig(adresse); - mdl:=aiguillage[j].modele; - ax:=routetco[i-1].x; - ay:=routetco[i-1].y; - sx:=routetco[i+1].x; // suivant - sy:=routetco[i+1].y; + ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; + ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; + sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; + sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; + tco[indextco,x,y].trajet:=0; if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de gauche à droite if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de droite à gauche @@ -8709,33 +9010,29 @@ begin // croisement if (bimage=22) and (i>1) then begin - j:=index_aig(adresse); - mdl:=aiguillage[j].modele; - ax:=routetco[i-1].x; // précédent - ay:=routetco[i-1].y; - sx:=routetco[i+1].x; // suivant - sy:=routetco[i+1].y; + ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; + ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; + sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; + sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; - if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de gauche à droite - if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de droite à gauche - if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[indextco,x,y].trajet:=2; // de haut gauche vers bas droit - if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[indextco,x,y].trajet:=2; // de bas droit vers haut gauche - if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=-1) then tco[indextco,x,y].trajet:=3; // de droit vers en haut à gauche - if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=3; // de haut à gauche vers droit - if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=4; // de bas à droite vers gauche - if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=1) then tco[indextco,x,y].trajet:=4; // de gauche vers en bas a droite + if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de gauche à droite + if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=1; // de droite à gauche + if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[indextco,x,y].trajet:=2; // de haut gauche vers bas droit + if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[indextco,x,y].trajet:=2; // de bas droit vers haut gauche + if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=-1) then tco[indextco,x,y].trajet:=3; // de droit vers en haut à gauche + if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=0) then tco[indextco,x,y].trajet:=3; // de haut à gauche vers droit + if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=0) then tco[indextco,x,y].trajet:=4; // de bas à droite vers gauche + if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=1) then tco[indextco,x,y].trajet:=4; // de gauche vers en bas a droite if tco[indextco,x,y].trajet=0 then affiche('Erreur 71 TCO - Cellule '+intToSTR(x)+','+intToSTR(y),clred); end; // croisement if (bimage=23) and (i>1) then begin - j:=index_aig(adresse); - mdl:=aiguillage[j].modele; - ax:=routetco[i-1].x; // précédent - ay:=routetco[i-1].y; - sx:=routetco[i+1].x; // suivant - sy:=routetco[i+1].y; + ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; + ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; + sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; + sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; if (ax-x=0) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[indextco,x,y].trajet:=1; // de haut à bas if (ax-x=0) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[indextco,x,y].trajet:=1; // de bas à haut @@ -8751,12 +9048,10 @@ begin // croisement if (bimage=25) and (i>1) then begin - j:=index_aig(adresse); - mdl:=aiguillage[j].modele; - ax:=routetco[i-1].x; // précédent - ay:=routetco[i-1].y; - sx:=routetco[i+1].x; // suivant - sy:=routetco[i+1].y; + ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; + ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; + sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; + sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; if (ax-x=0) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[indextco,x,y].trajet:=1; // de haut à bas if (ax-x=0) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[indextco,x,y].trajet:=1; // de bas à haut @@ -8773,40 +9068,48 @@ begin end; -// allume ou éteint (mode=0 ou 1) la voie, zone de det1 à det2 sur le TCO +// allume ou éteint (mode=0 ou 1) la voie du train "train", zone de det1 à det2 sur le TCO // si mode=0 : éteint // =1 : couleur détecteur allumé // =2 : couleur de l'index train // Ne nécessite pas que les aiguillages aoient bien positionnés entre det1 et det2 -// procédure récursive quand on passe par un aiguillage -procedure zone_tco(indexTCO,det1,det2,mode: integer); +// procédure récursive quand on passe par un aiguillage pour explorer les éléments opposés d'ou on vient si on l'aborde en pointe +procedure zone_tco(indexTCO,det1,det2,train,mode: integer); var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteration,indexIr : integer; memtrouve,sortir,casok,indextrouve : boolean; s : string; -// stocke la route dans le tableau, et incrémente l'index -procedure maj_route(x,y : integer;var ir : integer); -begin - if debugTCO then AfficheDebug('Ir='+IntToSTR(ir)+'->'+intToSTR(x)+' '+intToSTR(y),clyellow); - routetco[ir].x:=x; - routetco[ir].y:=y; - if ir<500 then inc(ir); -end; + // stocke la route dans le tableau, et incrémente l'index + procedure maj_route(indexTCO,x,y,train : integer;var ir : integer); + begin + if debugTCO then AfficheDebug('Ir='+IntToSTR(ir)+'->'+intToSTR(x)+' '+intToSTR(y),clyellow); -// mise à jour de x,y, nouvelles coordonnées par xn,yn (var globales de la procédure zone_tco) -procedure Maj_coords(var ancienX,ancienY,x,y : integer); -begin - ancienX:=x; - ancienY:=y; - x:=xn; - y:=yn; -end; + if (train<0) or (train>Max_Trains) then + begin + Affiche('Erreur index train',clred); + exit; + end; + + Trace_Train[indexTCO].train[train].route[ir].x:=x; + Trace_Train[indexTCO].train[train].route[ir].y:=y; + Trace_Train[indexTCO].train[train].Nombre:=ir; + if ir<500 then inc(ir); + end; + + // mise à jour de x,y, nouvelles coordonnées par xn,yn (var globales de la procédure zone_tco) + procedure Maj_coords(var ancienX,ancienY,x,y : integer); + begin + ancienX:=x; + ancienY:=y; + x:=xn; + y:=yn; + end; // El_Tco : trouve l'élément en x,y et constuit la route à l'élément de destination suivant, suivant // les variables ancienX et ancienY // x, y et ir sont locales pour des récursivités différentes, donc on les passe en paramètre pour transmettre à la // récursivité suivante leur valeur, mais elles reprennent leur valeurs initiales à la remontée vers la résursivité appellante. -procedure El_tco(x,y : integer; ir : integer); +Procedure El_tco(x,y,train : integer; ir : integer); var mdl : Tequipement; i,j :integer; sortir : boolean; @@ -8817,7 +9120,7 @@ begin i:=0; repeat - maj_route(x,y,ir); + maj_route(indextco,x,y,train,ir); adresse:=tco[indextco,x,y].Adresse ; Bimage:=tco[indextco,x,y].Bimage; if debugTCO then @@ -8852,7 +9155,7 @@ begin ancienX:=x; ancienY:=y; x:=x-1; - el_tco(x,y,ir); // essaye droit + el_tco(x,y,train,ir); // essaye droit // essayer dévié if not(memtrouve) then begin @@ -8860,7 +9163,7 @@ begin AncienX:=x+1; y:=y+1; x:=x; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -8873,7 +9176,7 @@ begin // essayer droit ancienX:=x;AncienY:=y; x:=x+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin @@ -8881,7 +9184,7 @@ begin AncienX:=x-1; y:=y-1; x:=x; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -8895,14 +9198,14 @@ begin // essai droit AncienX:=x;AncienY:=y; x:=x+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y; AncienX:=x-1; y:=y+1;x:=x; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -8911,17 +9214,17 @@ begin if (ancienXx) and (ancienY=Y) then begin - // pris en pointe droite - x:=x-1;y:=y; + // pris en pointe pos droite ancienx:=x;ancieny:=y; - el_tco(x,y,ir); + x:=x-1;y:=y; + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y; AncienX:=x+1; y:=y-1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -8938,14 +9241,14 @@ begin // droit ancienX:=x;ancienY:=y; x:=x+1;y:=y+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y-1; AncienX:=x-1; y:=y-1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -8956,14 +9259,14 @@ begin // pris en pointe ancienX:=x;ancienY:=y; x:=x-1;y:=y+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y-1; AncienX:=x+1; y:=y-1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -8974,14 +9277,14 @@ begin // pris en pointe droit ancienX:=x;ancienY:=y; x:=x-1;y:=y-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y+1; AncienX:=x+1; y:=y+1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -8993,7 +9296,7 @@ begin ancienX:=x;ancienY:=y; x:=x+1;y:=y-1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin @@ -9001,7 +9304,7 @@ begin AncienX:=x-1; y:=y+1; x:=x; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; @@ -9035,14 +9338,14 @@ begin // essayer vers E ancienX:=x;ancienY:=y; x:=x+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NE AncienY:=y; AncienX:=x-1; y:=y-1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; if (ancienX>x) and not(Memtrouve) then // on va à gauche @@ -9050,14 +9353,14 @@ begin // essayer vers O ancienX:=x;ancienY:=y; x:=x-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers SO AncienY:=y; AncienX:=x+1; y:=y+1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -9094,14 +9397,14 @@ begin // essayer vers E ancienX:=x;ancienY:=y; x:=x+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers SE AncienY:=y; AncienX:=x-1; y:=y+1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; if (ancienX>x) and not(Memtrouve) then // on va à gauche @@ -9109,14 +9412,14 @@ begin // essayer vers O ancienX:=x;ancienY:=y; x:=x-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NO AncienY:=y; AncienX:=x+1; y:=y-1;x:=x; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -9155,14 +9458,14 @@ begin // essayer vers S ancienX:=x;ancienY:=y; y:=y+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers SO AncienY:=y-1; AncienX:=x; x:=x-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; if (ancienY>y) and not(Memtrouve) then // on monte @@ -9170,14 +9473,14 @@ begin // essayer vers N ancienX:=x;ancienY:=y; y:=y-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NE AncienY:=y+1; AncienX:=x; x:=x+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -9209,14 +9512,14 @@ begin ancienX:=x;ancienY:=y; y:=y-1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x; x:=x-1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9236,14 +9539,14 @@ begin // essayer vers S ancienX:=x;ancienY:=y; y:=y+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers SE AncienY:=y-1; AncienX:=x; x:=x+1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; if (ancienY>y) and not(Memtrouve) then // on monte @@ -9251,14 +9554,14 @@ begin // essayer vers N ancienX:=x;ancienY:=y; y:=y-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NO AncienY:=y+1; AncienX:=x; x:=x-1; - el_tco(x,y,ir); + el_tco(x,y,train,ir); end; end; end; @@ -9289,14 +9592,14 @@ begin ancienX:=x;ancienY:=y; y:=y-1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x; x:=x+1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9310,14 +9613,14 @@ begin ancienX:=x;ancienY:=y; y:=y+1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y-1; AncienX:=x; x:=x-1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9332,14 +9635,14 @@ begin ancienX:=x;ancienY:=y; y:=y+1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y-1; AncienX:=x; x:=x+1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9353,14 +9656,14 @@ begin ancienX:=x;ancienY:=y; y:=y+1;x:=x+1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y-1; AncienX:=x-1; x:=x-1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9375,14 +9678,14 @@ begin ancienX:=x;ancienY:=y; y:=y+1;x:=x-1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y-1; AncienX:=x+1; x:=x+1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9397,14 +9700,14 @@ begin ancienX:=x;ancienY:=y; y:=y-1;x:=x-1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x+1; x:=x+1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9417,14 +9720,14 @@ begin ancienX:=x;ancienY:=y; y:=y-1;x:=x+1; // essayer droit - el_tco(x,y,ir); + el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x-1; x:=x-1; - el_tco(x,y,ir); // nouvelle itération + el_tco(x,y,train,ir); // nouvelle itération end; end; end; @@ -9437,15 +9740,15 @@ begin AfficheDebug('Sortie de calcul route TCO par élement '+intToSTR(Bimage)+' inconnu en x='+intToSTR(x)+' y='+intToSTR(y)+' sur route '+intToSTR(det1)+' à '+intToSTR(det2),clOrange); sortir:=true; end; - end; - - inc(i); - if (adresse=det2) then memTrouve:=true; - if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and ((adresse<>det2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; - if (i>200) or (iteration>200) then sortir:=true; - Maj_coords(AncienX,AncienY,x,y); + end; + inc(i); + if (adresse=det2) then memTrouve:=true; + if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and ((adresse<>det2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; + if (i>200) or (iteration>200) then sortir:=true; + Maj_coords(AncienX,AncienY,x,y); until sortir or memtrouve; + if DebugTCO and not(memtrouve) then AfficheDebug('Fin de boucle',clOrange); //mémoriser l'index de route si on a trouvé det2, et uniquement sur la première itération quand on l'a trouvé if memTrouve and not(indextrouve) then @@ -9460,7 +9763,7 @@ end; // Début de la procédure zone_tco begin - if debugTCO then AfficheDebug('Zone_TCO det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' mode='+intToSTR(mode),clyellow); + if debugTCO then AfficheDebug('Zone_TCO det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' Train'+intToSTR(Train)+' mode='+intToSTR(mode),clyellow); trouve_det(indexTCO,det1,Xdet1,Ydet1); if (Xdet1=0) or (Ydet1=0) then exit; @@ -9509,7 +9812,7 @@ begin // Affiche la cellule en fonction du mode iteration:=0; ir:=1; - El_tco(x,y,ir); // trouve l'élément suivant, et explore les ports de l'aiguillage en récursif + El_tco(x,y,train,ir); // trouve l'élément suivant, et explore les ports de l'aiguillage en récursif inc(i); if (adresse=det2) then memTrouve:=true; @@ -9522,7 +9825,7 @@ begin if memTrouve then begin if debugTco then afficheDebug('TCO: Trouvé route de '+intToSTR(det1)+' à '+intToSTR(det2)+' en '+intToSTR(x)+','+intToSTR(y),clLime); - Affiche_trajet(indexTCO,indexIr,mode); // affiche le trajet dans le TCO + Affiche_trajet(indexTCO,train,indexIr,mode); // affiche le trajet dans le TCO end; end; @@ -9533,8 +9836,8 @@ end; // nécessite que les aiguillages aoient bien positionnés entre det1 et det2 procedure zone_TCO_ancien(indexTCO,det1,det2,mode: integer); var direction,i,j,x,y,xn,yn,ancienY,ancienX,Xdet1,Ydet1,Xdet2,Ydet2,Bimage,adresse, - pos,pos2,ir,ay,sx,sy: integer; - memtrouve,sortir,horz,diag,casok : boolean; + pos,pos2,ir: integer; + memtrouve,sortir,casok : boolean; mdl : Tequipement; s : string; begin @@ -9596,8 +9899,8 @@ begin // boucle de remplissage du tableau routeTCO de det1 à det2 repeat - routetco[ir].x:=x; - routetco[ir].y:=y; +// routetco[indexTCO,ir].x:=x; +// routetco[indexTCO,ir].y:=y; if ir<500 then inc(ir); if debugTCO then AfficheDebug('X='+intToSTR(x)+' Y='+IntToSTR(Y)+' AncienX='+intToSTR(ancienX)+' AncienY='+IntToSTR(ancienY),clyellow); @@ -9929,10 +10232,8 @@ begin Affiche('mais la cellule représente un croisement ou une TJD/S',clred); exit; end; - end; - 24 : begin if debugTCO then AfficheDebug('El 24',clyellow); pos:=positionTCO(indexTCO,x,y); @@ -10170,7 +10471,7 @@ begin if DebugTCO then AfficheDebug('trouvé liaison de '+IntToSTR(det1)+' à '+IntToSTR(det2),clLime); dec(ir); - Affiche_trajet(indexTCO,ir,mode); + Affiche_trajet(indexTCO,1,ir,mode); end; @@ -10388,6 +10689,7 @@ begin with ScrollBox do begin Width:=clLarge-55; // laisser 50 pixels pour la trackbarzoom + scrollBar + //Width:=clLarge-300; // mode pour voir les imageTemp top:=1; left:=1; end; @@ -10442,12 +10744,25 @@ begin ImageTCO.Picture.Bitmap.Height:=hauteurCell[indexTCO]*NbreCellY[indexTCO]; ImageTCO.Picture.BitMap.Width:=LargeurCell[indexTCO]*NbreCellX[indexTCO]; + //initialiser les pointeurs images du tco PCanvasTCO[indextco]:=FormTCO[indextco].ImageTCO.Picture.Bitmap.Canvas; PBitMapTCO[indextco]:=FormTCO[indextco].ImageTCO.Picture.Bitmap; - PImageTCO[indextco]:=FormTCO[indextco].ImageTCO; + + // initialiser le pointeur image temporaire du TCO PImageTemp[indextco]:=FormTCO[indextco].ImageTemp; - PImageTemp[indextco].Canvas.Rectangle(0,0,PImageTemp[indextco].Width,PimageTemp[indextco].Height); + // peindre l'image en bleu pour la transparence , nécessaire en cas de décalage des signaux à 180° mais correction apportée dans feu_180 + with PImageTemp[indextco].Canvas do + begin + Pen.Color:=ClBlue; + Brush.Color:=CLBlue; + // FillRect(Rect(0,0,100,100)); + end; + + //PImageTemp[indextco].Canvas.Rectangle(0,0,PImageTemp[indextco].Width,PimageTemp[indextco].Height); + //PImageTemp[indextco].Picture.Bitmap.TransparentMode:=tmAuto; + //PImageTemp[indextco].Picture.Bitmap.TransparentColor:=clblue; + //PImageTemp[indextco].Transparent:=true; //déclenche l'Affiche_tco @@ -10463,7 +10778,7 @@ begin end; -// vérifie que les icones adjacentes sont cohérentes +// vérifie que les icones adjacentes sont cohérentes - ne pas utiliser.... function verif_cellule(IndexTCO,x,y,Bim : integer) : boolean; var res,verif : boolean; Bimz,i,bl : integer; @@ -10693,6 +11008,32 @@ begin end; end; +// efface le contenu de la cellule, sauf le fond +procedure raz_cellule(indexTCO,x,y : integer); +begin + tco[indextco,x,y].Adresse:=0; + tco[indextco,x,y].Mode:=0; + tco[indextco,x,y].Trajet:=0; + tco[indextco,x,y].inverse:=false; + tco[indextco,x,y].repr:=0; + tco[indextco,x,y].Bimage:=0; + tco[indextco,x,y].liaisons:=0; + tco[indextco,x,y].epaisseurs:=0; + tco[indextco,x,y].buttoir:=0; + tco[indextco,x,y].pont:=0; + tco[indextco,x,y].sortie:=0; + tco[indextco,x,y].Texte:=''; + tco[indextco,x,y].Fonte:=''; + tco[indextco,x,y].FontStyle:=''; + tco[indextco,x,y].CoulFonte:=0; + // tco[indextco,x,y].CouleurFond:=0; + tco[indextco,x,y].PiedFeu:=0; + tco[indextco,x,y].x:=0; + tco[indextco,x,y].y:=0; + tco[indextco,x,y].xUndo:=0; + tco[indextco,x,y].yUndo:=0; + tco[indextco,x,y].FeuOriente:=0; +end; procedure copier(indexTCO : integer); var x,y : integer; @@ -10745,14 +11086,7 @@ begin TamponTCO_org.x1:=XclicCell[indexTCO];TamponTCO_org.y1:=YclicCell[indexTCO]; TamponTCO_org.x2:=XclicCell[indexTCO];TamponTCO_org.y2:=YclicCell[indexTCO]; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].Adresse:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].Bimage:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].liaisons:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].epaisseurs:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].buttoir:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].pont:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].sortie:=0; - tco[indextco,XclicCell[indexTCO],YClicCell[indexTCO]].Texte:=''; + raz_cellule(indextco,XclicCell[indexTCO],YClicCell[indexTCO]); efface_entoure(indexTCO); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XclicCell[indexTCO],YClicCell[indexTCO],PmCopy); @@ -10775,16 +11109,7 @@ begin for y:=yCell1 to yCell2 do for x:=xCell1 to xCell2 do begin - tco[indextco,x,y].Adresse:=0; - tco[indextco,x,y].BImage:=0; - tco[indextco,x,y].epaisseurs:=0; - tco[indextco,x,y].pont:=0; - tco[indextco,x,y].buttoir:=0; - tco[indextco,x,y].sortie:=0; - tco[indextco,x,y].liaisons:=0; - tco[indextco,x,y].epaisseurs:=0; - tco[indextco,x,y].pont:=0; - tco[indextco,x,y].Texte:=''; + raz_cellule(indextco,x,y); //Affiche('Efface cellules '+IntToSTR(X)+' '+intToSTR(y),clyellow); efface_entoure(indexTCO); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,X,Y,PmCopy); @@ -11004,7 +11329,7 @@ begin clicTCO:=false; end; end; - +{ procedure Elmentdroit1Click(Sender: TObject); var indexTCO : integer; begin @@ -11031,7 +11356,6 @@ begin GetCursorPos(Position); end; - procedure CourbeSupD1Click(Sender: TObject); var Position: TPoint; indexTCO : integer; @@ -11049,6 +11373,7 @@ begin dessin_6(indexTCO,FormTCO[indexTCO].ImageTCO.canvas,XClicCellInserer,YClicCellInserer,0); GetCursorPos(Position); end; +} procedure debut_drag(image : TImage); var h,l,indexTCO : integer; @@ -11069,10 +11394,11 @@ begin image.Canvas.Handle,0,0,l,h,srccopy); drag:=true; TCODrag:=indexTCO; - oldx:=offsetSourisX;oldy:=offsetSourisY; + oldx:=offsetSourisX; + oldy:=offsetSourisY; end; - +// on bouge l'icone du composant dans le tco procedure TFormTCO.ImageTCODragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean); var indexTCO,xl,yl : integer; begin @@ -11081,7 +11407,7 @@ begin if TCODrag<>indexTCO then begin accept:=false; - exit; // le drag source et destination sont diférents + exit; // le drag source et destination sont différents end; xl:=x+offsetSourisX; yl:=y+offsetSourisY; @@ -11287,21 +11613,18 @@ begin debut_drag(ImagePalette9); end; - procedure TFormTCO.ImagePalette12MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette12); end; - procedure TFormTCO.ImagePalette13MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette13); end; - procedure TFormTCO.ImagePalette14MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin @@ -11476,7 +11799,7 @@ begin Annule(indexTCO); end; -// renvoie un élément du TCO par l'icone en fonction des 4 tracés désiré +// renvoie un élément du TCO par l'icone en fonction des 4 tracés désirés // exemple : deux lignes qui se croisent renvoie un croisement // el = élement à remplacer // Bim = élément d'origine @@ -11916,7 +12239,6 @@ begin end; - // évènement qui se produit quand on clique gauche ou droit procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); var position : Tpoint; @@ -12124,68 +12446,71 @@ begin end else begin - xMiniSel:=99999;yMiniSel:=99999; - xMaxiSel:=0;yMaxiSel:=0; + xMiniSel:=99999;yMiniSel:=99999; + xMaxiSel:=0;yMaxiSel:=0; - // si une zone de sélection est affichée sur un des TCO, annuler toutes - for n:=1 to NbreTCO do - if SelectionAffichee[n] then - begin - //Affiche('efface sélection',clOrange); - with formTCO[n].imageTCO.Canvas do + // si une zone de sélection est affichée sur un des TCO, annuler toutes + for n:=1 to NbreTCO do + if SelectionAffichee[n] then begin - Pen.Mode:=PmXor; - Pen.color:=clGrille[n]; - Brush.Color:=clblue; - Rectangle(rAncien); - end; - SelectionAffichee[n]:=false; - end; - - // clic gauche - clicTCO:=true; - //Affiche('xcliccell='+IntToSTR(XclicCell[indexTCO])+' ycliccell='+IntToSTR(YclicCell[indexTCO]),clyellow); - if Bimage=id_signal then - begin - adresse:=tco[IndexTCO,xClic,yClic].Adresse; - if (adresse=0) or (index_signal(adresse)=0) then s:='Signal sans adresse' else - s:=infosignal(adresse); - ImageTCO.Hint:=s; - end - else - if IsAigTCO(Bimage) then - begin - adresse:=tco[IndexTCO,xClic,yClic].Adresse; - if adresse=0 then s:='Aiguillage sans adresse' - else - begin - i:=index_aig(adresse); - if aiguillage[i].modele<>crois then - begin - if Adresse<>0 then + //Affiche('efface sélection',clOrange); + with formTCO[n].imageTCO.Canvas do begin - s:='Aiguillage '+intToSTR(adresse)+' Position='; - n:=aiguillage[i].position; - case n of - const_inconnu : s:=s+'inconnue '; - const_droit : s:=s+'droit '; - const_devie : s:=s+'devie '; - end; - if ((aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs)) and (aiguillage[i].EtatTJD=4) then + Pen.Mode:=PmXor; + Pen.color:=clGrille[n]; + Brush.Color:=clblue; + Rectangle(rAncien); + end; + SelectionAffichee[n]:=false; + end; + + // clic gauche, gestion des Hints + clicTCO:=true; + //Affiche('xcliccell='+IntToSTR(XclicCell[indexTCO])+' ycliccell='+IntToSTR(YclicCell[indexTCO]),clyellow); + if Bimage=id_signal then + begin + adresse:=tco[IndexTCO,xClic,yClic].Adresse; + if (adresse=0) or (index_signal(adresse)=0) then s:='Signal sans adresse' else + s:=infosignal(adresse); + ImageTCO.Hint:=s; + end + else + if IsAigTCO(Bimage) then + begin + adresse:=tco[IndexTCO,xClic,yClic].Adresse; + if adresse=0 then s:='Aiguillage sans adresse' + else + begin + i:=index_aig(adresse); + if aiguillage[i].modele<>crois then + begin + if Adresse<>0 then begin - adresse:=aiguillage[i].DDevie; - s:=s+#13+'Aiguillage '+intToSTR(adresse)+' Position='; - i:=index_aig(adresse); + s:='Aiguillage '+intToSTR(adresse)+' Position='; n:=aiguillage[i].position; case n of - const_inconnu : s:=s+'inconnue'; - const_droit : s:=s+'droit'; - const_devie : s:=s+'devie'; + const_inconnu : s:=s+'inconnue '; + const_droit : s:=s+'droit '; + const_devie : s:=s+'devie '; end; - end; + if ((aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs)) and (aiguillage[i].EtatTJD=4) then + begin + adresse:=aiguillage[i].DDevie; + s:=s+#13+'Aiguillage '+intToSTR(adresse)+' Position='; + i:=index_aig(adresse); + n:=aiguillage[i].position; + case n of + const_inconnu : s:=s+'inconnue'; + const_droit : s:=s+'droit'; + const_devie : s:=s+'devie'; + end; + end; + end end - end - else s:='Croisement '+intToSTR(adresse); + else s:='Croisement '+intToSTR(adresse); + // réservation + n:=aiguillage[i].AdrTrain; + if n<>0 then s:=s+#13+'Réservé par train '+intToSTR(n); end; ImageTCO.Hint:=s; end @@ -12247,7 +12572,6 @@ begin cellX:=x div LargeurCell[indexTCO]+1; // variables globales cellY:=y div hauteurCell[indexTCO]+1; - if (AncienXClicCell=CellX) and (AncienYClicCell=CellY) then exit; PimageTCO[indexTCO].Hint:=''; @@ -12259,7 +12583,6 @@ begin if CellX>NbreCellX[indexTCO] then exit; if CellY>NbreCellY[indexTCO] then exit; - if modeTrace[indexTCO] then begin if indexTrace>0 then @@ -12280,8 +12603,8 @@ begin if debugTCO then Affiche('Trace',clyellow); ancienTraceX:=cellx; ancienTraceY:=celly; - ok:=( abs(cellX-traceXY[indexTrace].x)=abs(cellY-traceXY[indexTrace].y) ) or - ( cellX-traceXY[indexTrace].x=0 ) or ( cellY-traceXY[indexTrace].y=0 ) ; + ok:=( abs(cellX-traceXY[indexTrace].x)=abs(cellY-traceXY[indexTrace].y) ) or + ( cellX-traceXY[indexTrace].x=0 ) or ( cellY-traceXY[indexTrace].y=0 ) ; if (ancienok=false) and ok then screen.cursor:=crUpArrow; if ancienok and (ok=false) then screen.cursor:=crNoDrop; @@ -12430,6 +12753,45 @@ begin end; end; +// mise à jour des aiguillages +procedure Maj_Aig_TCO(indexTCO :integer); +var x,y: integer; +begin + for y:=1 to NbreCellY[indexTCO] do + for x:=1 to NbreCellX[indexTCO] do + begin + if IsAigTCO(tco[indextco,x,y].Bimage) then + begin + affiche_cellule(indexTCO,x,y); + end; + end; +end; + +// affiche les cellules des tco dont l'adresse d'aiguillage est adresse +Procedure Texte_aig_fond(adresse : integer); +var ntco,i,x,y,Bim : integer; +begin + for ntco:=1 to NbreTCO do + begin + // trouver les cellules comportant l'aiguillage adresse + for y:=1 to NbreCellY[ntco] do + for x:=1 to NbreCellX[ntco] do + begin + Bim:=TCO[ntco,x,y].BImage; + if IsAigTCO(Bim) then + begin + if TCO[ntco,x,y].Adresse=adresse then + begin + affiche_cellule(ntco,x,y); + end; + end; + end; + end; +end; + + + + procedure TFormTCO.Button1Click(Sender: TObject); begin Detecteur[569].etat:=true; @@ -12493,18 +12855,11 @@ begin stocke_undo(indexTCO,1,XClic,YClic); maj_undo(1); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,PmCopy); + raz_cellule(indextco,xClic,yClic); tco[indextco,XClic,YClic].BImage:=Id_signal; - tco[indextco,XClic,YClic].liaisons:=0; - tco[indextco,XClic,YClic].Adresse:=0; - tco[indextco,XClic,YClic].epaisseurs:=0; - tco[indextco,XClic,YClic].pont:=0; - tco[indextco,XClic,YClic].buttoir:=0; - tco[indextco,Xclic,YClic].sortie:=0; tco[indextco,XClic,YClic].FeuOriente:=1; tco[indextco,XClic,YClic].PiedFeu:=1; tco[indextco,XClic,YClic].coulFonte:=clWhite; - tco[indextco,XClic,YClic].x:=0; - tco[indextco,XClic,YClic].y:=0; // ne pas convertir l'adresse sinon evt changement du composant et on écrase l'aspect EditAdrElement.Text:=IntToSTR( tco[indextco,XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[indextco,XClic,YClic].BImage); Dessin_Signal(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XClic,YClic); @@ -12516,7 +12871,7 @@ var l,h,indexTCO : integer; begin l:=Formprinc.Image9feux.width; //57 h:=Formprinc.Image9feux.height; //105 - indexTCO:=Index_tco(sender); + indexTCO:=Index_tco(sender); TCODrag:=IndexTCO; ImagePalette50.BeginDrag(true); BitBlt(OldBmp.Canvas.Handle,0,0,LargeurCell[indexTCO],hauteurCell[indexTCO],ImageTCO.Canvas.Handle,offsetSourisX,offsetSourisY,SRCCOPY); @@ -12633,6 +12988,50 @@ begin tourne90D(indextco); end; +procedure vertical_180(indexTCO : integer); +var BImage ,aspect,Adresse : integer; +begin + if actualize then exit; + BImage:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage; + // si c'est autre chose qu'un signal, sortir + if Bimage<>Id_signal then exit; + + TCO_modifie:=true; + adresse:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Adresse; + aspect:=feux[Index_Signal(adresse)].Aspect; + if aspect=0 then aspect:=9; + + // effacement de l'ancien signal + + // ancien signal orienté orienté 90D + if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=3 then + begin + Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); + // si le signal occupe 2 cellules + if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); + end; + + // ancien signal orienté orienté 90G + if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=2 then + begin + Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); + // si le signal occupe 2 cellules + if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); + end; + + // si l'image était verticale, il faut effacer la cellule en bas + if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=1 then + begin + Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); + Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO]+1,PmCopy); + end; + + tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente:=4; // signal orienté à 180° + affiche_tco(indexTCO); + actualise(indexTCO); // met à jour la fenetre de config de la cellule +end; + + procedure vertical(indexTCO : integer); var BImage ,aspect,Adresse : integer; begin @@ -12685,6 +13084,15 @@ begin vertical(index_tco(c)); end; +procedure TFormTCO.Signalvertical180Click(Sender: TObject); +var c : tcomponent; +begin + c:=popupmenu1.PopupComponent ; // imageTCO + c:=c.GetParentComponent; // scrollBox + c:=c.GetParentComponent; // formTCO + vertical_180(index_tco(c)); +end; + procedure TFormTCO.TrackBarZoomChange(Sender: TObject); var indextco : integer; begin @@ -12756,7 +13164,7 @@ begin aiguillage[Index_Aig(117)].position:=const_devie; //debugTco:=true; - zone_tco(1,518,514,1); + zone_tco(1,518,514,1,1); // zone_tco(518,515,1); //zone_tco(522,514,1); @@ -12804,7 +13212,7 @@ begin begin if EvtClicDet then event_detecteur(adresse,not(detecteur[adresse].etat),'') else detecteur[adresse].etat:=not(detecteur[adresse].etat); - Affiche_tco(indexTCO); + Maj_TCO(indexTCO,Adresse) end; tjdC:=false; @@ -13225,35 +13633,47 @@ begin if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then begin PopUpMenu1.Items[6].Enabled:=true; + // coche sur l'orientation du signal oriente:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Feuoriente; if oriente=1 then begin PopUpMenu1.Items[6][0].checked:=false; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=true; + PopUpMenu1.Items[6][3].checked:=false; end; if oriente=2 then begin PopUpMenu1.Items[6][0].checked:=true; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=false; + PopUpMenu1.Items[6][3].checked:=false; end; if oriente=3 then begin PopUpMenu1.Items[6][0].checked:=false; PopUpMenu1.Items[6][1].checked:=true; PopUpMenu1.Items[6][2].checked:=false; + PopUpMenu1.Items[6][3].checked:=false; end; + if oriente=4 then + begin + PopUpMenu1.Items[6][0].checked:=false; + PopUpMenu1.Items[6][1].checked:=false; + PopUpMenu1.Items[6][2].checked:=false; + PopUpMenu1.Items[6][3].checked:=true; + end; + // coche sur l'orientation du pied PiedFeu:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu; if PiedFeu=1 then begin - PopUpMenu1.Items[6][4].checked:=true; - PopUpMenu1.Items[6][5].checked:=false; + PopUpMenu1.Items[6][5].checked:=true; + PopUpMenu1.Items[6][6].checked:=false; end; if PiedFeu=2 then begin - PopUpMenu1.Items[6][4].checked:=false; - PopUpMenu1.Items[6][5].checked:=true; + PopUpMenu1.Items[6][5].checked:=false; + PopUpMenu1.Items[6][6].checked:=true; end; end else @@ -13293,15 +13713,7 @@ begin for x:=1 to NbreCellX[indexTCO] do begin - tco[indextco,x,YClicCell[indexTCO]].Adresse:=0; - tco[indextco,x,YClicCell[indexTCO]].BImage:=0; - tco[indextco,x,YClicCell[indexTCO]].inverse:=false; - tco[indextco,x,YClicCell[indexTCO]].repr:=0; - tco[indextco,x,YClicCell[indexTCO]].texte:=''; - tco[indextco,x,YClicCell[indexTCO]].fonte:=''; - tco[indextco,x,YClicCell[indexTCO]].CouleurFond:=Clfond[IndexTCO]; - tco[indextco,x,YClicCell[indexTCO]].PiedFeu:=0; - tco[indextco,x,YClicCell[indexTCO]].FeuOriente:=0; + raz_cellule(indextco,x,YClicCell[indexTCO]); end; inc(NbreCellY[indexTCO]); affiche_TCO(indexTCO); @@ -13325,15 +13737,7 @@ begin end; for x:=1 to NbreCellX[indexTCO] do begin - tco[indextco,x,YClicCell[indexTCO]+1].Adresse:=0; - tco[indextco,x,YClicCell[indexTCO]+1].BImage:=0; - tco[indextco,x,YClicCell[indexTCO]+1].inverse:=false; - tco[indextco,x,YClicCell[indexTCO]+1].repr:=0; - tco[indextco,x,YClicCell[indexTCO]+1].texte:=''; - tco[indextco,x,YClicCell[indexTCO]+1].fonte:=''; - tco[indextco,x,YClicCell[indexTCO]+1].Couleurfond:=Clfond[IndexTCO]; - tco[indextco,x,YClicCell[indexTCO]+1].PiedFeu:=0; - tco[indextco,x,YClicCell[indexTCO]+1].FeuOriente:=0; + raz_cellule(indextco,x,YClicCell[indexTCO]); end; inc(NbreCellY[indexTCO]); affiche_TCO(indexTCO); @@ -13374,19 +13778,8 @@ begin end; for x:=1 to NbreCellX[indexTCO] do begin - tco[indextco,x,NbreCellY[indexTCO]].Adresse:=0; - tco[indextco,x,NbreCellY[indexTCO]].BImage:=0; - tco[indextco,x,NbreCellY[indexTCO]].inverse:=false; - tco[indextco,x,NbreCellY[indexTCO]].repr:=0; - tco[indextco,x,NbreCellY[indexTCO]].texte:=''; - tco[indextco,x,NbreCellY[indexTCO]].fonte:=''; + raz_cellule(indextco,x,NbreCellY[indexTCO]); tco[indextco,x,NbreCellY[indexTCO]].Couleurfond:=Clfond[IndexTCO]; - tco[indextco,x,NbreCellY[indexTCO]].PiedFeu:=0; - tco[indextco,x,NbreCellY[indexTCO]].FeuOriente:=0; - tco[indextco,x,NbreCellY[indexTCO]].Buttoir:=0; - tco[indextco,x,NbreCellY[indexTCO]].Sortie:=0; - tco[indextco,x,NbreCellY[indexTCO]].epaisseurs:=0; - tco[indextco,x,NbreCellY[indexTCO]].Pont:=0; end; dec(NbreCellY[indexTCO]); @@ -13411,18 +13804,8 @@ begin end; for y:=1 to NbreCellY[indexTCO] do begin - tco[indextco,XClicCell[indexTCO],y].Adresse:=0; - tco[indextco,XClicCell[indexTCO],y].BImage:=0; - tco[indextco,XClicCell[indexTCO],y].inverse:=false; - tco[indextco,XClicCell[indexTCO],y].repr:=0; - tco[indextco,XClicCell[indexTCO],y].texte:=''; - tco[indextco,XClicCell[indexTCO],y].fonte:=''; + raz_cellule(indextco,XClicCell[indexTCO],y); tco[indextco,XClicCell[indexTCO],y].Couleurfond:=Clfond[IndexTCO]; - tco[indextco,XClicCell[indexTCO],y].PiedFeu:=0; - tco[indextco,XClicCell[indexTCO],y].FeuOriente:=0; - tco[indextco,xClicCell[indexTCO],y].Buttoir:=0; - tco[indextco,xClicCell[indexTCO],y].sortie:=0; - end; inc(NbreCellX[indexTCO]); affiche_TCO(indexTCO); @@ -13447,17 +13830,8 @@ begin end; for y:=1 to NbreCellY[indexTCO] do begin - tco[indextco,XClicCell[indexTCO]+1,y].Adresse:=0; - tco[indextco,XClicCell[indexTCO]+1,y].BImage:=0; - tco[indextco,XClicCell[indexTCO]+1,y].inverse:=false; - tco[indextco,XClicCell[indexTCO]+1,y].repr:=0; - tco[indextco,XClicCell[indexTCO]+1,y].texte:=''; - tco[indextco,XClicCell[indexTCO]+1,y].fonte:=''; + raz_cellule(indextco,XClicCell[indexTCO]+1,y); tco[indextco,XClicCell[indexTCO]+1,y].Couleurfond:=Clfond[IndexTCO]; - tco[indextco,XClicCell[indexTCO]+1,y].PiedFeu:=0; - tco[indextco,XClicCell[indexTCO]+1,y].FeuOriente:=0; - tco[indextco,XClicCell[indexTCO]+1,y].sortie:=0; - tco[indextco,XClicCell[indexTCO]+1,y].Buttoir:=0; end; inc(NbreCellX[indexTCO]); affiche_TCO(indexTCO); @@ -13497,17 +13871,8 @@ begin end; for y:=1 to NbreCellY[indexTCO] do begin - tco[indextco,NbreCellx[indexTCO],y].Adresse:=0; - tco[indextco,NbreCellx[indexTCO],y].BImage:=0; - tco[indextco,NbreCellx[indexTCO],y].inverse:=false; - tco[indextco,NbreCellx[indexTCO],y].repr:=0; - tco[indextco,NbreCellx[indexTCO],y].texte:=''; - tco[indextco,NbreCellx[indexTCO],y].fonte:=''; + raz_cellule(indextco,NbreCellx[indexTCO],y); tco[indextco,NbreCellx[indexTCO],y].CouleurFond:=Clfond[IndexTCO]; - tco[indextco,NbreCellx[indexTCO],y].PiedFeu:=0; - tco[indextco,NbreCellx[indexTCO],y].FeuOriente:=0; - tco[indextco,NbreCellx[indexTCO],y].Buttoir:=0; - tco[indextco,NbreCellx[indexTCO],y].Sortie:=0; end; dec(NbreCellX[indexTCO]); @@ -13665,7 +14030,7 @@ begin if actualize then exit; indexTCO:=index_tco(sender); Val(EditTypeImage.Text,Bimage,erreur); - if (erreur<>0) or not(Bimage in[0..22,24..25,id_signal,id_quai,id_action]) then + if (erreur<>0) or not(Bimage in[0..29,32..34,id_signal,id_quai,id_action]) then begin exit; end; @@ -13678,7 +14043,7 @@ begin affiche_cellule(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); end; -procedure TFormTCO.outslectionner1Click(Sender: TObject); +procedure TFormTCO.Toutslectionner1Click(Sender: TObject); var c: tcomponent; indextco : integer; begin @@ -13998,5 +14363,9 @@ begin end; + + + + end. diff --git a/Unit_Pilote_aig.dfm b/Unit_Pilote_aig.dfm index 3eb6eed..288adc6 100644 --- a/Unit_Pilote_aig.dfm +++ b/Unit_Pilote_aig.dfm @@ -1,6 +1,6 @@ object FormAig: TFormAig - Left = 400 - Top = 204 + Left = 630 + Top = 144 Width = 363 Height = 204 Caption = 'Pilotage de l'#39'aiguillage' diff --git a/Unit_Pilote_aig.pas b/Unit_Pilote_aig.pas index 86fa026..b90cb44 100644 --- a/Unit_Pilote_aig.pas +++ b/Unit_Pilote_aig.pas @@ -44,7 +44,10 @@ begin LabelAdr1.Visible:=false; ButtonDev2.Visible:=false; ButtonDroit2.Visible:=false; - ButtonOk.Visible:=false; + ButtonOk.Visible:=true; + buttonDev.Visible:=true; + buttonDroit.Visible:=true; + ButtonDev.Left:=48; ButtonDroit.Left:=216; end; @@ -55,6 +58,22 @@ var i : integer; s : string; begin i:=Index_aig(Aiguille); + 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; + buttonDev.Visible:=false; + buttonDroit.Visible:=false; + buttonDev2.Visible:=false; + buttonDroit2.Visible:=false; + LabelAdr2.Visible:=false; + exit; + end; + aigC:=(aiguillage[i].modele=aig); tjdC:=(aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs); if aigC then @@ -79,6 +98,10 @@ begin ButtonDroit2.Visible:=true; ButtonDev.Left:=8; ButtonDroit.Left:=88; + + buttonDroit.Visible:=true; + buttonDev.Visible:=true; + end; end; if aiguillage[i].EtatTJD=2 then diff --git a/Unitplace.pas b/Unitplace.pas index 1b0b9db..01ac41c 100644 --- a/Unitplace.pas +++ b/Unitplace.pas @@ -361,6 +361,7 @@ begin rouge:=false; trouve:=true; roulage:=true; + avecResa:=false; // pour adrTrain ou NumTrain AdrTrain:=detecteur[AdrDet].AdrTrain; AdrFeu:=signal_detecteur(AdrDet); // trouve l'adresse du signal correspondant au détecteur @@ -381,7 +382,7 @@ begin s:='Lancement du train '+detecteur[adrDet].train+' depuis détecteur '+intToSTR(adrDet); Affiche(s,clYellow); if traceListe then AfficheDebug(s,clyellow); - reserve_canton(AdrDet,placement[j].detdir,adrtrain); + reserve_canton(AdrDet,placement[j].detdir,adrtrain,0,2); end Else Affiche('Le signal '+intToSTR(AdrFeu)+' étant rouge, le train '+detecteur[adrDet].train+' @'+intToSTR(AdrTrain)+' ne démarre pas',clyellow); @@ -405,6 +406,7 @@ procedure TFormPlace.ButtonArretTrainsClick(Sender: TObject); var i : integer; begin roulage:=false; + avecRESA:=formConfig.CheckBoxRESA.Checked; Affiche('Arrêt du roulage de tous les trains',clorange); Formprinc.LabelTitre.caption:=titre+' '; for i:=1 to ntrains do diff --git a/verif_version.pas b/verif_version.pas index 8a4a48f..bdb71bc 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -25,7 +25,7 @@ var verifVersion,notificationVersion : boolean; date_creation,nombre_tel : string; -Const Version='8.27'; // sert à la comparaison de la version publiée +Const Version='8.3'; // sert à la comparaison de la version publiée SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace function GetCurrentProcessEnvVar(const VariableName: string): string; diff --git a/versions.txt b/versions.txt index b49d2ef..371eb62 100644 --- a/versions.txt +++ b/versions.txt @@ -204,6 +204,10 @@ version 8.26 : Am version 8.27 : Nouvel algorithme de suivi des trains dans les TCO. Correction suivi de deux trains consécutifs. Création d'une action TCO "pilotage d'accessoire" - - +version 8.28 : Amélioration de l'affichage du suivi des trains dans les TCOs. + Affichage des TJD dans le TCO. +version 8.3 : Possibilité d'afficher des signaux à 180° sur le TCO. + Création d'un mode sélectionnable de réservation des aiguillages par les trains. + Création d'un serveur de données socket pour la transmission des évènements. + Possibilité de télécommander Signaux_Complexes depuis les périphériques ou le serveur socket.