diff --git a/Notice d'utilisation des signaux_complexes_GL_V8.43.pdf b/Notice d'utilisation des signaux_complexes_GL_V8.5.pdf similarity index 79% rename from Notice d'utilisation des signaux_complexes_GL_V8.43.pdf rename to Notice d'utilisation des signaux_complexes_GL_V8.5.pdf index b715b51..dd940cf 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V8.43.pdf and b/Notice d'utilisation des signaux_complexes_GL_V8.5.pdf differ diff --git a/Signaux_complexes_GL.dpr b/Signaux_complexes_GL.dpr index 754fd43..d052485 100644 --- a/Signaux_complexes_GL.dpr +++ b/Signaux_complexes_GL.dpr @@ -18,6 +18,7 @@ uses UnitPareFeu in 'UnitPareFeu.pas', UnitAnalyseSegCDM in 'UnitAnalyseSegCDM.pas' {FormAnalyseCDM}, Importation in 'Importation.pas' {FormImportation}; + {$R *.res} begin diff --git a/Signaux_complexes_GL.map b/Signaux_complexes_GL.map index 065f23b..b7ff0da 100644 --- a/Signaux_complexes_GL.map +++ b/Signaux_complexes_GL.map @@ -1,104 +1,104 @@ Start Length Name Class - 0001:00000000 0017B6DCH .text CODE - 0002:00000000 00002C84H .data DATA - 0002:00002C84 045E33F9H .bss BSS + 0001:00000000 0018322CH .text CODE + 0002:00000000 00002C88H .data DATA + 0002:00002C88 045E33F9H .bss BSS Detailed map of segments - 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 00000F38 C=CODE S=.text G=(none) M=Windows ACBP=A9 - 0001:00007048 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 - 0001:00007080 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 - 0001:000073B8 00006FF8 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 - 0001:0000E3B0 0000081B C=CODE S=.text G=(none) M=VarUtils ACBP=A9 - 0001:0000EBCC 0000809E C=CODE S=.text G=(none) M=Variants ACBP=A9 - 0001:00016C6C 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 - 0001:00016E0C 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 - 0001:00017648 00000358 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 - 0001:000179A0 0000A7EA C=CODE S=.text G=(none) M=Classes ACBP=A9 - 0001:0002218C 00000370 C=CODE S=.text G=(none) M=Consts ACBP=A9 - 0001:000224FC 00009BFB C=CODE S=.text G=(none) M=Graphics ACBP=A9 - 0001:0002C0F8 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 - 0001:0002C21C 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 - 0001:0002C4D4 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 - 0001:0002C66C 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 - 0001:0002CDF4 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 - 0001:0002CE2C 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 - 0001:0002DE24 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 - 0001:0002DE7C 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 - 0001:0002EF44 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 - 0001:0002F264 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 - 0001:0002F654 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 - 0001:00030010 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 - 0001:00030048 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 - 0001:00030080 00000048 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 - 0001:000300C8 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 - 0001:00030100 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 - 0001:00030158 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 - 0001:00030190 0000007C C=CODE S=.text G=(none) M=ShlObj ACBP=A9 - 0001:0003020C 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 - 0001:0003026C 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 - 0001:000302A4 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 - 0001:00033978 00004ADA C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 - 0001:00038454 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 - 0001:000384E4 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 - 0001:00038C84 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 - 0001:00038DAC 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 - 0001:0003C5D0 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 - 0001:0003C608 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 - 0001:0003C670 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 - 0001:0003C6D8 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 - 0001:0003C744 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 - 0001:0003C79C 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 - 0001:0003C7D4 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 - 0001:0004611C 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 - 0001:00046FBC 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 - 0001:00053654 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 - 0001:000537BC 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 - 0001:000544DC 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 - 0001:000658E0 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 - 0001:00066B74 00001B9C C=CODE S=.text G=(none) M=ImgList ACBP=A9 - 0001:00068710 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 - 0001:0006EDF4 0000CF8C C=CODE S=.text G=(none) M=Forms ACBP=A9 - 0001:0007BD80 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 - 0001:0007BDE0 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 - 0001:0007D03C 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 - 0001:0007D074 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 - 0001:0007E808 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 - 0001:0007E868 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 - 0001:00081D84 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 - 0001:00081DD4 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 - 0001:000951C0 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 - 0001:000954D4 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 - 0001:000955FC 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 - 0001:00099074 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 - 0001:00099960 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 - 0001:00099EF8 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 - 0001:00099F38 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 - 0001:00099F70 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 - 0001:0009A988 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 - 0001:0009CA90 0000924C C=CODE S=.text G=(none) M=Grids ACBP=A9 - 0001:000A5CDC 00002A08 C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 - 0001:000A86E4 000017B8 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 - 0001:000A9E9C 00000574 C=CODE S=.text G=(none) M=Importation ACBP=A9 - 0001:000AA410 000147BC C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 - 0001:000BEBCC 000027E0 C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 - 0001:000C13AC 00000C64 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 - 0001:000C2010 00003BEC C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 - 0001:000C5BFC 000312F0 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 - 0001:000F6EEC 00002D1C C=CODE S=.text G=(none) M=UnitSR ACBP=A9 - 0001:000F9C08 00002594 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 - 0001:000FC19C 0003C444 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 - 0001:001385E0 0000284B C=CODE S=.text G=(none) M=verif_version ACBP=A9 - 0001:0013AE2C 000011D0 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 - 0001:0013BFFC 00000C00 C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 - 0001:0013CBFC 00002670 C=CODE S=.text G=(none) M=Unitplace ACBP=A9 - 0001:0013F26C 0003BFAF C=CODE S=.text G=(none) M=UnitPrinc ACBP=A9 - 0001:0017B21C 000004C0 C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 + 0001:00000000 00005F13 C=CODE S=.text G=(none) M=System ACBP=A9 + 0001:00005F14 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 + 0001:00006054 00000108 C=CODE S=.text G=(none) M=Types ACBP=A9 + 0001:0000615C 00000F38 C=CODE S=.text G=(none) M=Windows ACBP=A9 + 0001:00007094 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 + 0001:000070CC 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 + 0001:00007404 00006FF8 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 + 0001:0000E3FC 0000081B C=CODE S=.text G=(none) M=VarUtils ACBP=A9 + 0001:0000EC18 0000809E C=CODE S=.text G=(none) M=Variants ACBP=A9 + 0001:00016CB8 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 + 0001:00016E58 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 + 0001:00017694 00000358 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 + 0001:000179EC 0000A7EA C=CODE S=.text G=(none) M=Classes ACBP=A9 + 0001:000221D8 00000370 C=CODE S=.text G=(none) M=Consts ACBP=A9 + 0001:00022548 00009BFB C=CODE S=.text G=(none) M=Graphics ACBP=A9 + 0001:0002C144 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 + 0001:0002C268 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 + 0001:0002C520 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 + 0001:0002C6B8 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 + 0001:0002CE40 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 + 0001:0002CE78 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 + 0001:0002DE70 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 + 0001:0002DEC8 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 + 0001:0002EF90 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 + 0001:0002F2B0 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 + 0001:0002F6A0 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 + 0001:0003005C 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 + 0001:00030094 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 + 0001:000300CC 00000048 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 + 0001:00030114 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 + 0001:0003014C 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 + 0001:000301A4 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 + 0001:000301DC 0000007C C=CODE S=.text G=(none) M=ShlObj ACBP=A9 + 0001:00030258 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 + 0001:000302B8 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 + 0001:000302F0 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 + 0001:000339C4 00004ADA C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 + 0001:000384A0 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 + 0001:00038530 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 + 0001:00038CD0 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 + 0001:00038DF8 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 + 0001:0003C61C 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 + 0001:0003C654 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 + 0001:0003C6BC 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 + 0001:0003C724 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 + 0001:0003C790 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 + 0001:0003C7E8 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 + 0001:0003C820 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 + 0001:00046168 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 + 0001:00047008 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 + 0001:000536A0 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 + 0001:00053808 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 + 0001:00054528 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 + 0001:0006592C 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 + 0001:00066BC0 00001B9C C=CODE S=.text G=(none) M=ImgList ACBP=A9 + 0001:0006875C 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 + 0001:0006EE40 0000CF8C C=CODE S=.text G=(none) M=Forms ACBP=A9 + 0001:0007BDCC 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 + 0001:0007BE2C 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 + 0001:0007D088 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 + 0001:0007D0C0 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 + 0001:0007E854 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 + 0001:0007E8B4 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 + 0001:00081DD0 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 + 0001:00081E20 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 + 0001:0009520C 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 + 0001:00095520 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 + 0001:00095648 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 + 0001:000990C0 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 + 0001:000999AC 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 + 0001:00099F44 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 + 0001:00099F84 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 + 0001:00099FBC 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 + 0001:0009A9D4 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 + 0001:0009CADC 0000924C C=CODE S=.text G=(none) M=Grids ACBP=A9 + 0001:000A5D28 0000191C C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 + 0001:000A7644 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 + 0001:000A7BC0 00019434 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 + 0001:000C0FF4 0000289B C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 + 0001:000C3890 00000D78 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 + 0001:000C4608 00003D24 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 + 0001:000C832C 00031BF8 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 + 0001:000F9F24 000031F0 C=CODE S=.text G=(none) M=UnitSR ACBP=A9 + 0001:000FD114 00002BF0 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 + 0001:000FFD04 0000283F C=CODE S=.text G=(none) M=verif_version ACBP=A9 + 0001:00102544 000011D0 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 + 0001:00103714 0003C750 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 + 0001:0013FE64 00002BCC C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 + 0001:00142A30 00000D2C C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 + 0001:0014375C 000027E8 C=CODE S=.text G=(none) M=Unitplace ACBP=A9 + 0001:00145F44 0003CE27 C=CODE S=.text G=(none) M=UnitPrinc ACBP=A9 + 0001:00182D6C 000004C0 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 @@ -207,29 +207,28 @@ Detailed map of segments 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 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 - 0002:00003E90 00000010 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 - 0002:00003EA0 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 - 0002:00003EB0 000148B0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 - 0002:00018760 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 - 0002:00018774 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 - 0002:00018788 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 - 0002:0001879C 00418700 C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 - 0002:00430E9C 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 - 0002:00430EAC 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 - 0002:00430EC0 00000560 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 - 0002:00431420 00000020 C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 - 0002:00431440 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 - 0002:00431444 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 - 0002:00431450 00000008 C=BSS S=.bss G=DGROUP M=Unitplace ACBP=A9 - 0002:00431458 041B4FA0 C=BSS S=.bss G=DGROUP M=UnitPrinc 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 000148B0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 + 0002:00018734 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 + 0002:00018748 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 + 0002:0001875C 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 + 0002:00018770 00418704 C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 + 0002:00430E74 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 + 0002:00430E84 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 + 0002:00430E98 00000020 C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 + 0002:00430EB8 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 + 0002:00430EBC 00000560 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 + 0002:0043141C 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 + 0002:00431448 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 + 0002:00431454 00000008 C=BSS S=.bss G=DGROUP M=Unitplace ACBP=A9 + 0002:0043145C 041B4F9C C=BSS S=.bss G=DGROUP M=UnitPrinc ACBP=A9 Bound resource files c:\program files (x86)\borland\delphi7\Lib\Buttons.res c:\program files (x86)\borland\delphi7\Lib\ExtDlgs.res c:\program files (x86)\borland\delphi7\Lib\Controls.res -UnitDebug.dfm UnitPilote.dfm Importation.dfm UnitAnalyseSegCDM.dfm @@ -239,8 +238,9 @@ UnitConfigCellTCO.dfm UnitTCO.dfm UnitSR.dfm UnitCDF.dfm -UnitConfig.dfm verif_version.dfm +UnitConfig.dfm +UnitDebug.dfm UnitSimule.dfm Unitplace.dfm UnitPrinc.dfm @@ -248,4 +248,4 @@ Signaux_complexes_GL.res Signaux_complexes_GL.drf -Program entry point at 0001:0017B52C +Program entry point at 0001:0018307C diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index b18c415..ad594c4 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -4221,6 +4221,7 @@ procedure TFormAnalyseCDM.ButtonAffPortClick(Sender: TObject); var i,j,numport,erreur : integer; begin val(editPort.text,numport,erreur); + if numport<1 then exit; trouve_IndexPort(numport,i,j); if i<>-1 then begin @@ -4523,6 +4524,7 @@ begin val(s,adresse2,erreur); erreur:=0; end; + if (adresse<1) or (adresse2<0) then exit; if erreur=0 then begin @@ -4937,6 +4939,7 @@ procedure TFormAnalyseCDM.ButtonAffDetClick(Sender: TObject); var i,erreur : integer; begin val(EditDetecteur.text,i,erreur); + if i<1 then exit; if erreur=0 then dessine_det(i); end; @@ -5021,8 +5024,6 @@ end; - - end. diff --git a/UnitCDF.pas b/UnitCDF.pas index dcf72c8..95bd0e5 100644 --- a/UnitCDF.pas +++ b/UnitCDF.pas @@ -128,13 +128,13 @@ begin begin caption:='Configuration du décodeur Digikeijs'; label20.caption:='Tables d''aspects du signal en fonction du motif envoyé au décodeur Digikeijs'; - label24.Caption:='1 à 5'; + label24.Caption:='1 à 5 - Aspects de 0 à 255'; end; if erreur=2 then begin caption:='Configuration du décodeur CDF'; label20.Caption:='Tables d''aspects du signal en fonction du motif envoyé au décodeur CDF'; - label24.Caption:='1 à 4'; + label24.Caption:='1 à 4 - Aspects de 0 à 255'; end; Label1.caption:=etats[1]; @@ -229,11 +229,13 @@ begin end; procedure TFormCDF.Edit1Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit1.Text,Signaux[index].SR[1].sortie1,erreur); + val(Edit1.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[1].sortie1:=i; Maj_DB; if label1.Caption=etats[1] then Maj_Etat_Signal(0,carre); dessine_signal_CDF; @@ -241,11 +243,13 @@ begin end; procedure TFormCDF.Edit2Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit2.Text,Signaux[index].SR[2].sortie1,erreur); + val(Edit2.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[2].sortie1:=i; Maj_DB; if label2.Caption=etats[2] then Maj_Etat_Signal(0,semaphore); dessine_signal_CDF; @@ -253,11 +257,13 @@ begin end; procedure TFormCDF.Edit3Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit3.Text,Signaux[index].SR[3].sortie1,erreur); + val(Edit3.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[2].sortie1:=i; Maj_DB; if label3.Caption=etats[3] then Maj_Etat_Signal(0,semaphore_cli); dessine_signal_CDF; @@ -265,11 +271,13 @@ begin end; procedure TFormCDF.Edit4Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit4.Text,Signaux[index].SR[4].sortie1,erreur); + val(Edit4.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[4].sortie1:=i; Maj_DB; if label4.Caption=etats[4] then Maj_Etat_Signal(0,vert); dessine_signal_CDF; @@ -277,11 +285,13 @@ begin end; procedure TFormCDF.Edit5Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit5.Text,Signaux[index].SR[5].sortie1,erreur); + val(Edit5.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[5].sortie1:=i; Maj_DB; if label5.Caption=etats[5] then Maj_Etat_Signal(0,vert_cli); dessine_signal_CDF; @@ -289,11 +299,13 @@ begin end; procedure TFormCDF.Edit6Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit6.Text,Signaux[index].SR[6].sortie1,erreur); + val(Edit6.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[6].sortie1:=i; Maj_DB; if label6.Caption=etats[6] then Maj_Etat_Signal(0,violet); dessine_signal_CDF; @@ -301,11 +313,13 @@ begin end; procedure TFormCDF.Edit7Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit7.Text,Signaux[index].SR[7].sortie1,erreur); + val(Edit7.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[7].sortie1:=i; Maj_DB; if label7.Caption=etats[7] then Maj_Etat_Signal(0,blanc); dessine_signal_CDF; @@ -313,11 +327,13 @@ begin end; procedure TFormCDF.Edit8Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit8.Text,Signaux[index].SR[8].sortie1,erreur); + val(Edit8.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[8].sortie1:=i; Maj_DB; if label8.Caption=etats[8] then Maj_Etat_Signal(0,blanc_cli); dessine_signal_CDF; @@ -325,23 +341,31 @@ begin end; procedure TFormCDF.Edit9Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit9.Text,Signaux[index].SR[9].sortie1,erreur); + val(Edit9.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[9].sortie1:=i; Maj_DB; - if label9.Caption=etats[9] then begin Maj_Etat_Signal(0,semaphore);Maj_Etat_Signal(0,jaune);end; + if label9.Caption=etats[9] then + begin + Maj_Etat_Signal(0,semaphore); + Maj_Etat_Signal(0,jaune); + end; dessine_signal_CDF; end; end; procedure TFormCDF.Edit10Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit10.Text,Signaux[index].SR[10].sortie1,erreur); + val(Edit10.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[10].sortie1:=i; Maj_DB; if label10.Caption=etats[10] then begin @@ -353,11 +377,13 @@ begin end; procedure TFormCDF.Edit11Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit11.Text,Signaux[index].SR[11].sortie1,erreur); + val(Edit11.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[11].sortie1:=i; Maj_DB; if label11.Caption=etats[11] then begin Maj_Etat_Signal(0,semaphore);Maj_Etat_Signal(0,ral_30);end; dessine_signal_CDF; @@ -365,11 +391,13 @@ begin end; procedure TFormCDF.Edit12Change(Sender: TObject); -var erreur : integer; +var erreur,i: integer; begin if index<>0 then begin - val(Edit12.Text,Signaux[index].SR[12].sortie1,erreur); + val(Edit12.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[12].sortie1:=i; Maj_DB; if label12.Caption=etats[12] then begin Maj_Etat_Signal(0,semaphore);Maj_Etat_Signal(0,ral_60);end; dessine_signal_CDF; @@ -377,11 +405,13 @@ begin end; procedure TFormCDF.Edit13Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit13.Text,Signaux[index].SR[13].sortie1,erreur); + val(Edit13.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[13].sortie1:=i; Maj_DB; if label13.Caption=etats[13] then begin Maj_Etat_Signal(0,ral_60);Maj_Etat_Signal(0,jaune_cli);end; dessine_signal_CDF; @@ -389,11 +419,13 @@ begin end; procedure TFormCDF.Edit14Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit14.Text,Signaux[index].SR[14].sortie1,erreur); + val(Edit14.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[14].sortie1:=i; Maj_DB; if label14.Caption=etats[14] then begin Maj_Etat_Signal(0,semaphore);Maj_Etat_Signal(0,rappel_30);end; dessine_signal_CDF; @@ -401,11 +433,13 @@ begin end; procedure TFormCDF.Edit15Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit15.Text,Signaux[index].SR[15].sortie1,erreur); + val(Edit15.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[15].sortie1:=i; Maj_DB; if label15.Caption=etats[15] then begin Maj_Etat_Signal(0,semaphore);Maj_Etat_Signal(0,rappel_60);end; dessine_signal_CDF; @@ -413,11 +447,13 @@ begin end; procedure TFormCDF.Edit16Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit16.Text,Signaux[index].SR[16].sortie1,erreur); + val(Edit16.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[16].sortie1:=i; Maj_DB; if label16.Caption=etats[16] then begin Maj_Etat_Signal(0,rappel_30); Maj_Etat_Signal(0,jaune);end; dessine_signal_CDF; @@ -425,11 +461,13 @@ begin end; procedure TFormCDF.Edit17Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit17.Text,Signaux[index].SR[17].sortie1,erreur); + val(Edit17.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[17].sortie1:=i; Maj_DB; if label17.Caption=etats[17] then begin Maj_Etat_Signal(0,rappel_30); Maj_Etat_Signal(0,jaune_cli);end; dessine_signal_CDF; @@ -437,11 +475,13 @@ begin end; procedure TFormCDF.Edit18Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit18.Text,Signaux[index].SR[18].sortie1,erreur); + val(Edit18.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[18].sortie1:=i; Maj_DB; if label18.Caption=etats[18] then begin Maj_Etat_Signal(0,rappel_60); Maj_Etat_Signal(0,jaune);end; dessine_signal_CDF; @@ -449,13 +489,19 @@ begin end; procedure TFormCDF.Edit19Change(Sender: TObject); -var erreur : integer; +var erreur,i : integer; begin if index<>0 then begin - val(Edit19.Text,Signaux[index].SR[19].sortie1,erreur); + val(Edit19.Text,i,erreur); + if (i<0) or (i>255) or (erreur<>0) then exit; + Signaux[index].SR[19].sortie1:=i; Maj_DB; - if label19.Caption=etats[19] then begin Maj_Etat_Signal(0,rappel_60); Maj_Etat_Signal(0,jaune_cli);end; + if label19.Caption=etats[19] then + begin + Maj_Etat_Signal(0,rappel_60); + Maj_Etat_Signal(0,jaune_cli); + end; dessine_signal_CDF; end; end; diff --git a/UnitConfig.dfm b/UnitConfig.dfm index fb1410f..8fe655b 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,6 +1,6 @@ object FormConfig: TFormConfig - Left = 347 - Top = 101 + Left = 246 + Top = 114 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' @@ -681,7 +681,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetTrains + ActivePage = TabSheetCDM Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -1163,7 +1163,7 @@ object FormConfig: TFormConfig ImageIndex = 1 object Label9: TLabel Left = 16 - Top = 448 + Top = 456 Width = 294 Height = 13 Caption = 'Ces param'#232'tres sont utilis'#233's en fonctionnement sans CDM Rail' @@ -1228,14 +1228,14 @@ object FormConfig: TFormConfig end object GroupBox4: TGroupBox Left = 8 - Top = 128 + Top = 208 Width = 297 Height = 65 Caption = '4. Ent'#234'te des trames XpressNet vers l'#39'interface' TabOrder = 1 object RadioButton1: TRadioButton Left = 8 - Top = 24 + Top = 20 Width = 225 Height = 17 Caption = '0 : Sans ent'#234'te (interfaces s'#233'rie, Genli...)' @@ -1252,7 +1252,7 @@ object FormConfig: TFormConfig end object GroupBox3: TGroupBox Left = 8 - Top = 200 + Top = 128 Width = 297 Height = 73 Caption = 'Acc'#232's r'#233'seau '#224' l'#39'interface vers la centrale' @@ -1337,7 +1337,7 @@ object FormConfig: TFormConfig end object GroupBox9: TGroupBox Left = 8 - Top = 280 + Top = 282 Width = 297 Height = 161 Caption = 'Au d'#233'marrage de signaux complexes en mode autonome' @@ -1429,7 +1429,7 @@ object FormConfig: TFormConfig end object GroupBox22: TGroupBox Left = 312 - Top = 256 + Top = 248 Width = 297 Height = 65 Caption = 'Protocole de connexion '#224' la centrale ou '#224' l'#39'interface' @@ -3009,8 +3009,8 @@ object FormConfig: TFormConfig end end object GroupBox19: TGroupBox - Left = 48 - Top = 144 + Left = 24 + Top = 152 Width = 233 Height = 137 Caption = 'Destinataire de l'#39'action ' @@ -3150,7 +3150,7 @@ object FormConfig: TFormConfig OnChange = EditTempoChange end object CheckRAZ: TCheckBox - Left = 32 + Left = 40 Top = 48 Width = 145 Height = 17 @@ -3197,13 +3197,13 @@ object FormConfig: TFormConfig OnChange = EditTrainDestChange end object ComboBoxAccComUSB: TComboBox - Left = 8 - Top = 32 + Left = 24 + Top = 64 Width = 201 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 @@ -3224,24 +3224,24 @@ object FormConfig: TFormConfig end end object GroupBoxPNA: TGroupBox - Left = 152 - Top = 240 + Left = 32 + Top = 40 Width = 169 Height = 121 Caption = 'Actionneurs PN simples' TabOrder = 2 end object GroupBoxPNZ: TGroupBox - Left = 88 - Top = 320 + Left = 72 + Top = 368 Width = 169 Height = 65 Caption = 'Zones de d'#233'tection' TabOrder = 3 end object GroupBoxPN: TGroupBox - Left = 152 - Top = 24 + Left = 24 + Top = 32 Width = 249 Height = 193 Caption = 'Action gestion passage '#224' niveau' @@ -3378,13 +3378,13 @@ object FormConfig: TFormConfig OnClick = RadioGroupActPNClick end object ComboBoxPNCom: TComboBox - Left = 8 - Top = 104 + Left = 72 + Top = 128 Width = 145 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 diff --git a/UnitConfig.pas b/UnitConfig.pas index c4e20b1..5212315 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -649,9 +649,9 @@ var ligneDCC,decCourant,AffMemoFenetre,ligneClicAccPeriph,AncligneClicAccPeriph,ligneCherche, compt_Ligne,Style_aff,Ancien_Style,Ecran_SC,Mode_reserve,Max_Signal_Sens,nCantonsRes : integer; - ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort, + ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort,fermeSC, modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains,trouve_section_acccomusb, - trouveAvecVerifIconesTCO,Affiche_avert,activ,trouve_section_dec_pers : boolean; + trouveAvecVerifIconesTCO,Affiche_avert,activ,trouve_section_dec_pers,Z21 : boolean; fichier : text; @@ -693,7 +693,7 @@ var function config_com(s : string) : boolean; function envoi_CDM(s : string) : boolean; -procedure connecte_CDM; +function connecte_CDM : boolean; function place_id(s : string) : string; procedure decodeAig(s : string;var adr : integer;var B : char); function sauve_config : boolean; @@ -729,7 +729,7 @@ begin repeat inc(temps);Sleep(100); Application.processMessages; - until ferme or ackCDM or nackCDM or (temps>30); // CDM répond < 1s + until fermeSC or ackCDM or nackCDM or (temps>30); // CDM répond < 1s if not(ackCDM) or nack then begin @@ -803,16 +803,17 @@ begin ack_cdm:=false; end; -procedure connecte_CDM; +function connecte_CDM : boolean; var s : string; i : integer; begin + result:=false; // déconnexion de l'ancienne liaison éventuelle Formprinc.ClientSocketCDM.Close; - if (AdresseIPCDM<>'0') then + if (AdresseIPCDM<>'0') and IpOk(AdresseIPCDM) then begin - if(ProcessRunning('CDR')) then + if (ProcessRunning('CDR')) then begin // ouverture du socket CDM with Formprinc do @@ -854,13 +855,14 @@ begin Application.ProcessMessages; SauvefiltrageDet0:=filtrageDet0; filtrageDet0:=0; + result:=true; end; end; - //else Affiche('CDM Rail non lancé',clOrange); end else begin if adresseIPCDM='0' then Affiche('La connexion à CDM n''est pas demandée car l''adresse IP est nulle dans '+NomConfig,clcyan); + if not(IpOk(AdresseIPCDM)) then Affiche('Adresse IP CDM incorrecte : '+AdresseIPCDM,clcyan); end; end; @@ -1927,7 +1929,7 @@ begin if k=1 then for j:=1 to 19 do begin - s:=etats[j]+','+decodeur_pers[i].desc[j].Chcommande; + s:=utf8encode(etats[j])+','+decodeur_pers[i].desc[j].Chcommande; writeln(fichierN,s); end; if k=2 then @@ -2869,8 +2871,9 @@ var s,sa,SOrigine: string; end; if c=1 then begin - k:=pos(',',sOrigine); - decodeur_pers[NbreDecPers].desc[adr].Chcommande:=copy(sOrigine,k+1,length(sOrigine)-k+1); + k:=pos(',',sOrigine); // on ne tient compte que du 2ème champ + s:=copy(sOrigine,k+1,length(sOrigine)-k+1); // on ne copie que le 2eme champ + decodeur_pers[NbreDecPers].desc[adr].Chcommande:=s; s:=''; inc(adr); end; @@ -3631,7 +3634,6 @@ var s,sa,SOrigine: string; Ecran_SC:=i; end; - sa:=uppercase(Z21_ch)+'='; i:=pos(sa,s); if i=1 then @@ -4158,7 +4160,9 @@ begin if (AdrBaseDetDccpp<0) or (AdrBaseDetDccpp>2048) then AdrBaseDetDccpp:=513; mode_Reserve:=RadioReserve.ItemIndex; // 0 = par canton - 1=par détecteurs + val(EditAlgo.Text,i,erreur); + if (i<1) or (i>1) then i:=1; Algo_localisation:=i; val(EditMaxSignalSens.Text,i,erreur); @@ -4454,8 +4458,8 @@ begin with formconfig do begin ComboBoxDecCde.ItemIndex:=decodeur_pers[DecCourant].Peripherique-1; - formconfig.labelDecal.caption:='Commande'+#13+'Ascii'; - LabelDecal.Left:=150; + formconfig.labelDecal.caption:='Commandes'+#13+'Ascii'; + LabelDecal.Left:=160; formconfig.LabelSorties.visible:=false; end; end; @@ -4535,13 +4539,14 @@ begin liste_portcom; end; +// cliqué sur les checkbox de l'onglet des périphériques procedure TformConfig.cb_onclick(sender : TObject); var s : string; cb : TCheckBox; begin if clicliste or (ligneClicAccPeriph<0) then exit; cb:=(sender as Tcheckbox); - s := cb.Name; + s:=cb.Name; 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; @@ -4574,7 +4579,6 @@ procedure fabrique_combos_periph; var i : integer; s : string; begin - with FormConfig.ListBoxPeriph,FormConfig do begin ComboBoxAccComUSB.Clear; @@ -4608,7 +4612,6 @@ begin // réaffiche le champ modifié dans le comboboxAccComUSB if Tablo_Actionneur[ligneclicAct+1].periph then if tablo_actionneur[ligneclicAct+1].fonction=i then ComboBoxAccComUSB.ItemIndex:=i-1; - ComboBoxPNCom.items[i-1]:=s; if tablo_PN[lignecliqueePN+1].TypeCde=1 then if tablo_PN[lignecliqueePN+1].AdresseFerme=i then ComboBoxPNCom.ItemIndex:=i-1; @@ -4702,7 +4705,7 @@ var i : integer; begin if clicListe then exit; i:=ComboStyle.ItemIndex; - // il faut changer le style dans la fenetre principale, sinon çà plante si on choisit windows. + // il faut changer le style dans la fenetre principale (formPrinc), sinon çà plante si on choisit windows. Style_Aff:=i; end; {$IFEND} @@ -4928,10 +4931,11 @@ begin visible:=false; end; + // décalage d'adresse EditT[i]:=TEdit.create(FormConfig.TabSheetDecodeurs); with EditT[i] do begin - Name:='EditT'+intToSTR(i); + Name:='EditDecalT'+intToSTR(i); left:=180;Top:=y+10;Width:=30;Height:=15; text:=''; parent:=TabSheetDecodeurs; @@ -5870,7 +5874,8 @@ begin text:=''; parent:=GroupBoxAvance; hint:='Nombre de détecteurs considérés comme trop distants'+#13+ - 'Cette valeur dépend de la taille du réseau'; + 'Cette valeur dépend de la taille du réseau:'+#13+ + '3 pour les petits réseaux jusque 5 ou 6 pour les grands'; ShowHint:=true; end; @@ -6016,11 +6021,7 @@ begin ShowHint:=true; end; - // oui - {if FileExists('Image_Signaux.jpg') then ImageSignaux.Picture.LoadFromFile('Image_Signaux.jpg') - else - Affiche('Manque fichier "Image_Signaux.jpg"',clOrange); - } + ImageSignaux.picture.Assign(formpilote.ImageSignaux.Picture); EditComUSB.Hint:='COMX:vitesse,parité,nombre de bits,bits de stop,protocole'+#13+ @@ -6067,14 +6068,19 @@ begin i:=pos(',',s); if i<>0 then delete(s,i,length(s)-i+1); val(s,adr,erreur); - if adr<0 then begin B:='?';adr:=0;exit;end; - if erreur<>0 then + if (adr<0) then begin B:='?';adr:=0;exit;end; + if (erreur<>0) and (erreur<=length(s)) then begin if s[erreur]='S' then begin B:='S';exit;end; if s[erreur]='P' then begin B:='P';exit;end; if s[erreur]='D' then begin B:='D';exit;end; end; - + if erreur>length(s) then + begin + adr:=0; + B:='?'; + exit; + end; B:='Z'; end; @@ -7975,7 +7981,7 @@ begin begin s:=EditDet1.Text; Val(s,i,erreur); - if (s<>'') and (erreur<>0) then begin LabelInfo.caption:='Erreur détecteur1 ';exit;end; + if (s='') or (erreur<>0) or (i<1) then begin LabelInfo.caption:='Erreur détecteur1 ';exit;end; LabelInfo.caption:=' '; Signaux[ligneClicSig+1].Adr_det1:=i; maj_hint_Signal(ligneClicSig+1); @@ -7992,7 +7998,7 @@ var i,erreur : integer; begin s:=editTempoFeu.Text; Val(s,i,erreur); - if (s<>'') and (erreur<>0) then begin LabelInfo.caption:='Erreur temporisation décodeurs ';exit;end; + if (s='') or (erreur<>0) or (i<0) then begin LabelInfo.caption:='Erreur temporisation décodeurs ';exit;end; LabelInfo.caption:=' '; Tempo_Signal:=i; end; @@ -8013,13 +8019,15 @@ begin if s<>'' then begin Val(s,i,erreur); - if erreur<>0 then + if (i<0) then begin LabelInfo.caption:='Erreur élément suivant 1';exit;end; + if (erreur<>0) and (erreur<=length(s)) then begin if (s[erreur]='A') and (erreur=1) then begin bt:=aig; delete(s,erreur,1); Val(s,i,erreur); + if i<0 then begin LabelInfo.caption:='Erreur élément suivant 1';exit;end; end else begin LabelInfo.caption:='Erreur élément suivant 1';exit;end; end @@ -8057,7 +8065,7 @@ begin begin s:=EditDet2.Text; Val(s,i,erreur); - if (s<>'') and (erreur<>0) then begin LabelInfo.caption:='Erreur détecteur2 ';exit;end; + if (s='') or (erreur<>0) or (i<1) then begin LabelInfo.caption:='Erreur détecteur2 ';exit;end; LabelInfo.caption:=' '; Signaux[ligneClicSig+1].Adr_det2:=i; maj_hint_Signal(ligneClicSig+1); @@ -8120,13 +8128,15 @@ begin if s<>'' then begin Val(s,i,erreur); - if erreur<>0 then + if (i<0) then begin LabelInfo.caption:='Erreur élément suivant 2';exit;end; + if (erreur<>0) and (erreur<=length(s)) then begin if (s[erreur]='A') and (erreur=1) then begin bt:=aig; delete(s,erreur,1); Val(s,i,erreur); + if i<0 then begin LabelInfo.caption:='Erreur élément suivant 2';exit;end; end else begin LabelInfo.caption:='Erreur élément suivant 2';exit;end; end @@ -8155,16 +8165,16 @@ end; procedure det3; var s : string; i,erreur : integer; -begin +begin if clicliste or (ligneClicSig<0) then exit; if affevt then Affiche('Evt detecteur 3',clOrange); - + if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then with Formconfig do begin s:=EditDet3.Text; Val(s,i,erreur); - if (s<>'') and (erreur<>0) then begin LabelInfo.caption:='Erreur détecteur3 ';exit;end; + if (s='') or (erreur<>0) or (i<1) then begin LabelInfo.caption:='Erreur détecteur3 ';exit;end; LabelInfo.caption:=' '; Signaux[ligneClicSig+1].Adr_det3:=i; maj_hint_Signal(ligneClicSig+1); @@ -8196,13 +8206,15 @@ begin if s<>'' then begin Val(s,i,erreur); - if erreur<>0 then + if (i<0) then begin LabelInfo.caption:='Erreur élément suivant 3';exit;end; + if (erreur<>0) and (erreur<=length(s)) then begin if (s[erreur]='A') and (erreur=1) then begin bt:=aig; delete(s,erreur,1); Val(s,i,erreur); + if i<0 then begin LabelInfo.caption:='Erreur élément suivant 3';exit;end; end else begin LabelInfo.caption:='Erreur élément suivant 3';exit;end; end @@ -8240,7 +8252,7 @@ begin begin s:=EditDet4.Text; Val(s,i,erreur); - if (s<>'') and (erreur<>0) then begin LabelInfo.caption:='Erreur détecteur4 ';exit;end; + if (s='') or (erreur<>0) or (i<1) then begin LabelInfo.caption:='Erreur détecteur4 ';exit;end; LabelInfo.caption:=' '; Signaux[ligneClicSig+1].Adr_det4:=i; maj_hint_Signal(ligneClicSig+1); @@ -8272,13 +8284,16 @@ begin if s<>'' then begin Val(s,i,erreur); - if erreur<>0 then + if (i<0) then begin LabelInfo.caption:='Erreur élément suivant 4';exit;end; + + if (erreur<>0) and (erreur<=length(s)) then begin if (s[erreur]='A') and (erreur=1) then begin bt:=aig; delete(s,erreur,1); Val(s,i,erreur); + if i<0 then begin LabelInfo.caption:='Erreur élément suivant 4';exit;end; end else begin LabelInfo.caption:='Erreur élément suivant 4';exit;end; end @@ -8320,7 +8335,7 @@ begin if radioButtonLoc.Checked or RadioButtonAccess.Checked or RadioButtonSon.Checked or radioButtonCde.checked then begin Val(s,act,erreur); - if s='' then exit; + if (s='') or (act<1) then exit; // 0=actionneur/détecteur 2=evt aig 3=MemZone if (Tablo_Actionneur[ligneClicAct+1].typdeclenche=3) or (Tablo_Actionneur[ligneClicAct+1].typdeclenche=0) then @@ -8371,7 +8386,7 @@ begin if radioButtonLoc.Checked or RadioButtonAccess.Checked or RadioButtonSon.Checked then begin Val(s,det2,erreur); - if s='' then exit; + if (s='') or (det2<1) then exit; if erreur<>0 then begin LabelInfo.caption:='Erreur adresse détecteur';exit @@ -8383,7 +8398,7 @@ begin // vérifier si les détecteurs sont contigus Val(EditAct.Text,det1,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (det1<1) then exit; det_contigu(det1,det2,suiv,elSuiv); if (suiv=0) or (suiv>9995) then LabelInfo.Caption:='Les détecteurs '+intToSTR(det1)+' et '+intToSTR(det2)+' ne sont pas contigus' else LabelInfo.Caption:=''; @@ -8548,7 +8563,7 @@ begin if radioButtonLoc.Checked or RadioButtonAccess.Checked or RadioButtonCde.Checked then begin Val(s,fonction,erreur); - if erreur<>0 then + if (erreur<>0) or (fonction<1) then begin LabelInfo.caption:='Erreur fonction actionneur';exit end else LabelInfo.caption:=' '; @@ -8603,7 +8618,7 @@ begin if radioButtonLoc.Checked then begin Val(s,tempo,erreur); - if erreur<>0 then + if (erreur<>0) or (tempo<0) then begin LabelInfo.caption:='Erreur Tempo actionneur';exit end else LabelInfo.caption:=' '; @@ -8929,7 +8944,7 @@ begin begin s:=EditAdrFerme.Text; Val(s,act,erreur); - if erreur<>0 then + if (erreur<>0) or (act<1) then begin LabelInfo.caption:='Erreur adresse actionneur ferme';exit end else LabelInfo.caption:=' '; @@ -8978,7 +8993,7 @@ begin begin s:=EditAdrOuvre.Text; Val(s,act,erreur); - if erreur<>0 then + if (erreur<>0) or (act<1) then begin LabelInfo.caption:='Erreur adresse actionneur ouvre';exit end else LabelInfo.caption:=' '; @@ -9393,10 +9408,10 @@ begin else with Signaux[j].Img do begin - Parent:=Formprinc.ScrollBox1; // dire que l'image est dans la scrollBox1 + Parent:=Formprinc.ScrollBoxSig; // dire que l'image est dans la scrollBox1 Top:=(HtImg+espY+20)*((j-1) div NbreImagePLigne); // détermine les points d'origine Left:=10+ (LargImg+5)*((j-1) mod (NbreImagePLigne)); - Name:='ImageFeu'+IntToSTR(Signaux[j].adresse); + Name:='ImageSignal'+IntToSTR(Signaux[j].adresse); Maj_Hint_Signal(j); end; @@ -11679,7 +11694,7 @@ begin s:=encode_aig(ligneclicAig+1); ListBoxAig.items[ligneclicAig]:=s; formconfig.ListBoxAig.selected[ligneclicAig]:=true; - end ; + end; end; end; @@ -11749,13 +11764,13 @@ begin // créer les nouveau checkBox de feux blancs si de nouveaux ont été cochés if Signaux[index].FeuBlanc and (Signaux[index].checkFB=nil) then begin - Signaux[index].CheckFB:=TCheckBox.create(Formprinc.ScrollBox1); // crée le handle + Signaux[index].CheckFB:=TCheckBox.create(Formprinc.ScrollBoxSig); // crée le handle with Signaux[index].CheckFB do begin onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus Hint:=intToSTR(index); caption:='dem FB'; - Parent:=Formprinc.ScrollBox1; + Parent:=Formprinc.ScrollBoxSig; width:=100;height:=15; Top:=HtImg+15+((HtImg+EspY+20)*((index-1) div NbreImagePLigne)); Left:=10+ (LargImg+5)*((index-1) mod (NbreImagePLigne)); @@ -12318,29 +12333,33 @@ begin end; procedure TFormConfig.EditAdresseTrainChange(Sender: TObject); -var erreur :integer; +var erreur,i :integer; begin if clicliste then exit; if affevt then affiche('Evt change adresse train',clyellow); if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; - val(EditAdresseTrain.text,trains[ligneclicTrain+1].adresse,erreur); + val(EditAdresseTrain.text,i,erreur); + if i<1 then exit; + trains[ligneclicTrain+1].adresse:=i; formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; procedure TFormConfig.EditVitesseMaxiChange(Sender: TObject); -var erreur :integer; +var erreur,i :integer; begin if clicliste then exit; if affevt then affiche('Evt change vitesse maxi train',clyellow); if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; - val(EditVitesseMaxi.text,trains[ligneclicTrain+1].vitmax,erreur); + val(EditVitesseMaxi.text,i,erreur); + if i<1 then exit; + trains[ligneclicTrain+1].vitmax:=i; formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; end; procedure TFormConfig.EditVitNomChange(Sender: TObject); - var erreur : integer; + var erreur,i : integer; begin if clicliste then exit; if affevt then affiche('Evt change vitesse nominale train',clyellow); @@ -12348,14 +12367,16 @@ begin if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then with Formconfig do begin - val(EditVitNom.text,trains[ligneclicTrain+1].vitNominale,erreur); + val(EditVitNom.text,i,erreur); + if i<1 then exit; + trains[ligneclicTrain+1].vitNominale:=i; ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; end; procedure TFormConfig.EditVitRalentiChange(Sender: TObject); - var erreur : integer; + var erreur,i : integer; begin if clicliste then exit; if affevt then affiche('Evt change vitesse ralenti train',clyellow); @@ -12363,7 +12384,9 @@ end; if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then with Formconfig do begin - val(EditVitRalenti.text,trains[ligneclicTrain+1].vitRalenti,erreur); + val(EditVitRalenti.text,i,erreur); + if i<1 then exit; + trains[ligneclicTrain+1].vitRalenti:=i; ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -12771,16 +12794,16 @@ procedure Tformconfig.modif_editT(Sender : TObject); var te : tEdit; adr,i,NbVoies,erreur,act,voie,det,numDet :integer; ouvre,ferme,v2Valide,v3valide,v4valide,v5valide : boolean; - s : string; + s,sb : string; begin if deccourant=0 then exit; te:=Sender as Tedit; s:=lowercase(te.Name); + sb:=te.Text; - if pos('EditOuvreEcran',s)<>0 then + if pos('editouvreecran',s)<>0 then begin - adr:=extract_int(s); - val(s,i,erreur); + val(sb,i,erreur); if (erreur<>0) or (i<1) then begin labelInfo.caption:='Erreur écran'; @@ -12791,11 +12814,11 @@ begin exit; end; - if pos('tditt',s)<>0 then + if pos('editdecalt',s)<>0 then begin adr:=extract_int(s); - val(s,i,erreur); - if erreur<>0 then + val(sb,i,erreur); + if (erreur<>0) or (i<0) then begin labelInfo.caption:='Erreur adresse'; exit; @@ -12809,17 +12832,16 @@ begin if pos('editv',s)<>0 then begin i:=lignecliqueePN+1; - voie:=extract_int(s); - ouvre:=pos('o',s)<>0; - ferme:=pos('f',s)<>0; + voie:=extract_int(s); // numéro de voie modifiée + ouvre:=pos('o',s)<>0; // champ ouvre + ferme:=pos('f',s)<>0; // champ ferme if clicliste or (lignecliqueePN<0) then exit; if affevt then affiche('Evt EditVXX Change',clyellow); if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then with Formconfig do begin - s:=te.Text; - Val(s,act,erreur); - if (erreur<>0) then + Val(sb,act,erreur); + if (erreur<>0) or (act<=0) then begin LabelInfo.caption:='Erreur adresse actionneur'; if ferme then tablo_PN[i].voie[voie].ActFerme:=0; @@ -12882,7 +12904,7 @@ begin s:=te.Text; Val(s,det,erreur); - if (erreur<>0) then + if (erreur<>0) or (det<=0) then begin LabelInfo.caption:='Erreur adresse détecteur';exit end else LabelInfo.caption:=' '; @@ -13092,7 +13114,6 @@ begin k:=comBoBoxDec.ItemIndex; ComboBoxDec.Items[NbDecodeurdeBase+DecCourant-1]:=s; // combobox du décodeur, onglet signaux - change son itemindex ComboBoxDec.ItemIndex:=k; - //vérifier si le décodeur est utilisé dans les signaux pour changer son hint for i:=1 to NbreSignaux do begin @@ -13102,7 +13123,7 @@ begin EditNbreAdr.Text:=intToSTR(decodeur_pers[decCourant].NbreAdr); //Affiche('Décodeur courant = '+intToSTR(decCourant),clyellow); - if it=-1 then maj_decodeurs; + maj_decodeurs; end; @@ -14273,7 +14294,7 @@ begin if (modele=aig) or (modele=triple) or (modele=crois) then begin - EditAdrAig.Color:=clWindow; + if sombre then editAdrAig.Color:=couleurfond else EditAdrAig.Color:=clWindow; LabelInfo.caption:=' '; aiguillage[index].adresse:=i; aiguillage[index].modifie:=true; diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index 4bbd19a..26a9a06 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -301,7 +301,7 @@ object FormConfCellTCO: TFormConfCellTCO end object GroupBoxAction: TGroupBox Left = 16 - Top = 240 + Top = 144 Width = 249 Height = 129 Caption = 'Action' @@ -314,14 +314,14 @@ object FormConfCellTCO: TFormConfCellTCO TabOrder = 6 object Label3: TLabel Left = 104 - Top = 74 + Top = 73 Width = 38 Height = 13 Caption = 'Adresse' end object Labela: TLabel - Left = 184 - Top = 74 + Left = 192 + Top = 73 Width = 6 Height = 13 Caption = #224 @@ -371,7 +371,7 @@ object FormConfCellTCO: TFormConfCellTCO OnClick = RadioButtonActionClick end object EditAdrSortie: TEdit - Left = 144 + Left = 152 Top = 70 Width = 33 Height = 21 @@ -379,9 +379,9 @@ object FormConfCellTCO: TFormConfCellTCO OnChange = EditAdrSortieChange end object EditEtat: TEdit - Left = 200 + Left = 208 Top = 70 - Width = 25 + Width = 17 Height = 21 Hint = '1 ou 2' ParentShowHint = False @@ -389,6 +389,18 @@ object FormConfCellTCO: TFormConfCellTCO TabOrder = 6 OnChange = EditEtatChange end + object RadioButtonStop: TRadioButton + Left = 8 + Top = 88 + Width = 177 + Height = 17 + Hint = 'Arr'#234'te tous les trains (mode autonome et CDM)' + Caption = 'Arr'#234'ter toutes les trains' + ParentShowHint = False + ShowHint = True + TabOrder = 7 + OnClick = RadioButtonStopClick + end end end object CheckPinv: TCheckBox diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index 72427ea..fbb4d03 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -42,6 +42,7 @@ type EditEtat: TEdit; Labela: TLabel; RadioButtonV180: TRadioButton; + RadioButtonStop: TRadioButton; procedure EditAdrElementChange(Sender: TObject); procedure EditTexteCCTCOChange(Sender: TObject); procedure ButtonFonteClick(Sender: TObject); @@ -69,6 +70,7 @@ type procedure EditEtatChange(Sender: TObject); procedure RadioButtonActionClick(Sender: TObject); procedure RadioButtonV180Click(Sender: TObject); + procedure RadioButtonStopClick(Sender: TObject); private { Déclarations privées } public @@ -140,6 +142,8 @@ begin RadioButtonSC.Checked:=tco[indexTCO,Xclic,Yclic].PiedFeu=2; RadioButtonCDM.Checked:=tco[indexTCO,Xclic,Yclic].PiedFeu=3; RadioButtonAction.Checked:=tco[indexTCO,Xclic,Yclic].PiedFeu=4; + RadioButtonStop.Checked:=tco[indexTCO,Xclic,Yclic].PiedFeu=5; + editNumTCO.Text:=intToSTR(tco[indexTCO,Xclic,Yclic].FeuOriente); if RadioButtonAction.Checked then begin @@ -212,36 +216,36 @@ begin end; end; - // si voie ou rien ou signal ou quai - if (Bimage=1) or (Bimage=0) or (Bimage=Id_signal) or (Bimage=Id_Quai) then + // si voie ou rien ou signal ou quai + 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 begin - s:=Tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].Texte; - with formTCO[indexTCO] do - begin - EditTexte.Text:=s; - EditTexte.Visible:=true; - ComboRepr.Enabled:=true; - end; - end - else - begin - formTCO[indexTCO].EditTexte.Visible:=false; - formTCO[indexTCO].comboRepr.Enabled:=false; + EditTexte.Text:=s; + EditTexte.Visible:=true; + ComboRepr.Enabled:=true; end; + end + else + begin + formTCO[indexTCO].EditTexte.Visible:=false; + formTCO[indexTCO].comboRepr.Enabled:=false; + end; - s:=IntToSTR(Xclic)+','+intToSTR(yClic); - FormTCO[indexTCO].GroupBox1.Caption:='Configuration cellule '+s; - XclicCellInserer:=XclicCell[indexTCO]; - YclicCellInserer:=YclicCell[indexTCO]; - FormTCO[indexTCO].EditAdrElement.Text:=IntToSTR(tco[indexTCO,XclicCellInserer,YclicCellInserer].Adresse); - FormTCO[indexTCO].EdittypeImage.Text:=IntToSTR(BImage); - FormTCO[indexTCO].ComboRepr.ItemIndex:=tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].repr; - FormTCO[indexTCO].ShapeCoulFond.Brush.Color:=tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].CouleurFond; - FormTCO[indexTCO].CheckPinv.Checked:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].inverse; + s:=IntToSTR(Xclic)+','+intToSTR(yClic); + FormTCO[indexTCO].GroupBox1.Caption:='Configuration cellule '+s; + XclicCellInserer:=XclicCell[indexTCO]; + YclicCellInserer:=YclicCell[indexTCO]; + FormTCO[indexTCO].EditAdrElement.Text:=IntToSTR(tco[indexTCO,XclicCellInserer,YclicCellInserer].Adresse); + FormTCO[indexTCO].EdittypeImage.Text:=IntToSTR(BImage); + FormTCO[indexTCO].ComboRepr.ItemIndex:=tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].repr; + FormTCO[indexTCO].ShapeCoulFond.Brush.Color:=tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].CouleurFond; + FormTCO[indexTCO].CheckPinv.Checked:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].inverse; - s:='El='+intToSTR(tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].BImage); - if tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].adresse<>0 then s:=s+' Adr='+intToSTR(tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].adresse); - //hint:=s; + s:='El='+intToSTR(tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].BImage); + if tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].adresse<>0 then s:=s+' Adr='+intToSTR(tco[indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]].adresse); + //hint:=s; if not(ConfCellTCO) then exit; @@ -682,11 +686,9 @@ begin Xclic:=XclicCell[indexTCOCourant]; Yclic:=YclicCell[indexTCOCourant]; - //Affiche(IntToSTR(x)+' '+IntToSTR(y),clyellow); val(editTypeImage.text,element,erreur); - if erreur<>0 then exit; extrait_connect(element,c1,c2,c3,c4); @@ -875,6 +877,8 @@ begin end; end; + + procedure TFormConfCellTCO.EditAdrSortieChange(Sender: TObject); var i,erreur : integer; begin @@ -915,9 +919,22 @@ begin end; end; +procedure TFormConfCellTCO.RadioButtonStopClick(Sender: TObject); +var x,y : integer; begin + if clicTCO or actualize then exit; + if RadioButtonStop.Checked then + begin + x:=XClicCell[IndexTCOCourant]; + y:=yClicCell[IndexTCOCourant]; + tco[IndexTCOCourant,x,y].PiedFeu:=5; + efface_cellule(indexTCOCourant,PCanvasTCO[indexTCOcourant],x,y,pmcopy); + affiche_cellule(IndexTCOCourant,x,y); + actualise(indexTCOCourant); + end; +end; - +begin end. diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index 5ba8131..f42c1f4 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -13,12 +13,13 @@ object FormConfigTCO: TFormConfigTCO Font.Style = [] OldCreateOrder = False OnActivate = FormActivate + OnClose = FormClose OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object LabelErreur: TLabel - Left = 16 - Top = 216 + Left = 104 + Top = 384 Width = 3 Height = 13 end @@ -202,9 +203,28 @@ object FormConfigTCO: TFormConfigTCO Top = 384 Width = 75 Height = 25 + Caption = 'OK' + Default = True TabOrder = 3 OnClick = BitBtnOkClick - Kind = bkOK + Glyph.Data = { + DE010000424DDE01000000000000760000002800000024000000120000000100 + 0400000000006801000000000000000000001000000000000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333330000333333333333333333333333F33333333333 + 00003333344333333333333333388F3333333333000033334224333333333333 + 338338F3333333330000333422224333333333333833338F3333333300003342 + 222224333333333383333338F3333333000034222A22224333333338F338F333 + 8F33333300003222A3A2224333333338F3838F338F33333300003A2A333A2224 + 33333338F83338F338F33333000033A33333A222433333338333338F338F3333 + 0000333333333A222433333333333338F338F33300003333333333A222433333 + 333333338F338F33000033333333333A222433333333333338F338F300003333 + 33333333A222433333333333338F338F00003333333333333A22433333333333 + 3338F38F000033333333333333A223333333333333338F830000333333333333 + 333A333333333333333338330000333333333333333333333333333333333333 + 0000} + NumGlyphs = 2 end object RadioGroup1: TRadioGroup Left = 304 diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index 363013c..6daf7f0 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -80,6 +80,7 @@ type procedure RadioButtonCourbesClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TrackBarEpaisseurChange(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Déclarations privées } public @@ -262,12 +263,18 @@ begin end; val(EditRatio.text,RatioC,erreur); + if (ratioC<5) or (ratioC>15) then + begin + LabelErreur.caption:='Erreur: ratio'; + ok:=false; + end; AvecGrille[IndexTCO]:=checkDessineGrille.Checked; if checkCouleur.checked then ModeCouleurCanton:=1 else ModeCouleurCanton:=0; end; verif_config_TCO:=ok; + if ok then formConfigTCO.LabelErreur.caption:=''; NbCellulesTCO[indexTCO]:=NbreCellX[indexTCO]*NbreCellY[indexTCO]; end; @@ -444,66 +451,8 @@ begin end; procedure TFormConfigTCO.BitBtnOkClick(Sender: TObject); -var ok : boolean; - i,x,y,erreur : integer; - s : string; begin - ok:=true; - if verif_config_TCO(indexTCOCourant) then - begin - with FormTCO[indexTCOCourant].ImageTCO do - begin - Width:=LargeurCell[indexTCOCourant]*NbreCellX[indexTCOCourant]; - Height:=HauteurCell[indexTCOCourant]*NbreCellY[indexTCOCourant]; - end; - - for y:=1 to NbreCellY[indexTCOCourant] do - for x:=1 to NbreCellX[indexTCOCourant] do - begin - if tco[indexTCOCourant,x,y].CouleurFond=0 then tco[indexTCOCourant,x,y].CouleurFond:=clfond[indexTCOCourant]; - end; - - if RadioButtonLignes.Checked then - begin - if graphisme=2 then TCO_modifie:=true; - graphisme:=1 ; - end; - if RadioButtonCourbes.Checked then - begin - if graphisme=1 then TCO_modifie:=true; - graphisme:=2; - end; - - epaisseur_voies:=trackBarEpaisseur.Position; - - val(editEcran.Text,i,erreur); - if i<1 then i:=1; - if i<>EcranTCO[indexTCOcourant] then tco_modifie:=true; - EcranTCO[indexTCOcourant]:=i; - AvecGrille[IndexTCOCourant]:=checkDessineGrille.Checked; - if ok then - begin - for i:=1 to 10 do - begin - if NomFichierTCO[i]<>stringGridTCO.Cells[1,i] then - begin - config_modifie:=true; - s:=stringGridTCO.Cells[1,i]; - // on peut vérifier le .cfg mais bon - Affiche('Le nom du fichier '+NomFichierTCO[i]+' sera sauvegardé en '+s,clyellow); - NomFichierTCO[i]:=s; - end - else - NomFichierTCO[i]:=stringGridTCO.Cells[1,i]; - end; - calcul_cellules(IndexTCOcourant); - affiche_TCO(indexTCOcourant); - - dessine_icones(indexTCOCourant); - LabelErreur.caption:=''; - close; - end; - end; + close; end; procedure TFormConfigTCO.CheckBoxCreerEvtClick(Sender: TObject); @@ -593,8 +542,68 @@ begin TrackBarEpaisseur.Hint:='Epaisseur = '+IntToSTR(i); end; +procedure TFormConfigTCO.FormClose(Sender: TObject;var Action: TCloseAction); +var ok : boolean; + i,x,y,erreur : integer; + s : string; +begin + ok:=true; + if verif_config_TCO(indexTCOCourant) then + begin + with FormTCO[indexTCOCourant].ImageTCO do + begin + Width:=LargeurCell[indexTCOCourant]*NbreCellX[indexTCOCourant]; + Height:=HauteurCell[indexTCOCourant]*NbreCellY[indexTCOCourant]; + end; + for y:=1 to NbreCellY[indexTCOCourant] do + for x:=1 to NbreCellX[indexTCOCourant] do + begin + if tco[indexTCOCourant,x,y].CouleurFond=0 then tco[indexTCOCourant,x,y].CouleurFond:=clfond[indexTCOCourant]; + end; + if RadioButtonLignes.Checked then + begin + if graphisme=2 then TCO_modifie:=true; + graphisme:=1 ; + end; + if RadioButtonCourbes.Checked then + begin + if graphisme=1 then TCO_modifie:=true; + graphisme:=2; + end; + epaisseur_voies:=trackBarEpaisseur.Position; + val(editEcran.Text,i,erreur); + if i<1 then i:=1; + if i<>EcranTCO[indexTCOcourant] then tco_modifie:=true; + EcranTCO[indexTCOcourant]:=i; + AvecGrille[IndexTCOCourant]:=checkDessineGrille.Checked; + if ok then + begin + for i:=1 to 10 do + begin + if NomFichierTCO[i]<>stringGridTCO.Cells[1,i] then + begin + config_modifie:=true; + s:=stringGridTCO.Cells[1,i]; + // on peut vérifier le .cfg mais bon + Affiche('Le nom du fichier '+NomFichierTCO[i]+' sera sauvegardé en '+s,clyellow); + NomFichierTCO[i]:=s; + end + else + NomFichierTCO[i]:=stringGridTCO.Cells[1,i]; + end; + menu_tco(nbreTCO); + calcul_cellules(IndexTCOcourant); + affiche_TCO(indexTCOcourant); + dessine_icones(indexTCOCourant); + LabelErreur.caption:=''; + end; + end + else action:=tCloseAction(caNone); // si la config est nok, on ferme pas la fenetre +end; + +begin end. diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 802d638..7b6f42b 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -4,6 +4,7 @@ object FormDebug: TFormDebug Width = 884 Height = 732 VertScrollBar.Increment = 67 + VertScrollBar.Position = 17 VertScrollBar.Tracking = True Caption = 'Fen'#234'tre de d'#233'bug' Color = clWindow @@ -20,13 +21,13 @@ object FormDebug: TFormDebug OnCreate = FormCreate OnKeyPress = FormKeyPress DesignSize = ( - 851 - 693) + 859 + 701) PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 615 - Top = 4 + Top = -13 Width = 108 Height = 13 Anchors = [akTop, akRight] @@ -42,7 +43,7 @@ object FormDebug: TFormDebug end object LabelTitreDebug: TLabel Left = 463 - Top = 2 + Top = -15 Width = 131 Height = 18 Anchors = [akTop, akRight] @@ -56,7 +57,7 @@ object FormDebug: TFormDebug end object EditNivDebug: TEdit Left = 774 - Top = 2 + Top = -15 Width = 49 Height = 21 Anchors = [akTop, akRight] @@ -72,7 +73,7 @@ object FormDebug: TFormDebug end object ButtonEcrLog: TButton Left = 462 - Top = 328 + Top = 311 Width = 97 Height = 29 Anchors = [akTop, akRight] @@ -82,7 +83,7 @@ object FormDebug: TFormDebug end object ButtonRazTampon: TButton Left = 462 - Top = 360 + Top = 343 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -93,7 +94,7 @@ object FormDebug: TFormDebug end object ButtonCherche: TButton Left = 462 - Top = 296 + Top = 279 Width = 97 Height = 25 Hint = 'Cherche la cha'#238'ne "erreur"' @@ -106,7 +107,7 @@ object FormDebug: TFormDebug end object ButtonAffEvtChrono: TButton Left = 462 - Top = 256 + Top = 239 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -117,7 +118,7 @@ object FormDebug: TFormDebug end object ButtonCop: TButton Left = 462 - Top = 208 + Top = 191 Width = 97 Height = 41 Anchors = [akTop, akRight] @@ -134,7 +135,7 @@ object FormDebug: TFormDebug end object ButtonRazLog: TButton Left = 462 - Top = 400 + Top = 383 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -145,7 +146,7 @@ object FormDebug: TFormDebug end object GroupBox1: TGroupBox Left = 468 - Top = 600 + Top = 583 Width = 369 Height = 185 Anchors = [akTop, akRight] @@ -295,7 +296,7 @@ object FormDebug: TFormDebug end object GroupBox2: TGroupBox Left = 460 - Top = 20 + Top = 3 Width = 384 Height = 149 Anchors = [akTop, akRight] @@ -508,7 +509,7 @@ object FormDebug: TFormDebug end object RichDebug: TRichEdit Left = 8 - Top = 8 + Top = -9 Width = 445 Height = 685 Anchors = [akLeft, akTop, akRight, akBottom] @@ -521,7 +522,7 @@ object FormDebug: TFormDebug end object GroupBox5: TGroupBox Left = 468 - Top = 488 + Top = 471 Width = 372 Height = 57 Anchors = [akTop, akRight] @@ -588,7 +589,7 @@ object FormDebug: TFormDebug end object ButtonRazTout: TButton Left = 463 - Top = 176 + Top = 159 Width = 97 Height = 25 Hint = @@ -603,7 +604,7 @@ object FormDebug: TFormDebug end object GroupBox6: TGroupBox Left = 468 - Top = 552 + Top = 535 Width = 372 Height = 41 Anchors = [akTop, akRight] @@ -680,7 +681,7 @@ object FormDebug: TFormDebug end object MemoEvtDet: TRichEdit Left = 565 - Top = 174 + Top = 157 Width = 280 Height = 307 Anchors = [akTop, akRight] diff --git a/UnitDebug.pas b/UnitDebug.pas index d5dbc97..5a3fbfc 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -206,7 +206,10 @@ begin compt_erreur:=0; LigneErreur:=0; if debug=1 then Affiche('Fin création fenêtre debug',clLime); - + // && débug===================== + //CheckBoxEvtDetAig.Checked:=true; + //CheckTrame.checked:=true; + // fin debug==================== couleurs_debug; end; @@ -377,8 +380,7 @@ begin ancdebug:=NivDebug; NivDebug:=3; Val(EditSigSuiv.Text,adr,erreur); - if erreur<>0 then exit; - etat_signal_suivant(Adr,1,AdrSigSuivant) ; + if (erreur<>0) and (adr>0) then etat_signal_suivant(Adr,1,AdrSigSuivant) ; NivDebug:=AncDebug; end; @@ -394,8 +396,10 @@ begin if (s1='') or (s2='') then exit; if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det; if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det; - Val(s1,prec,erreur); if erreur<>0 then exit; - Val(s2,Actuel,erreur); if erreur<>0 then exit; + Val(s1,prec,erreur); + if (erreur<>0) or (prec<1) then exit; + Val(s2,Actuel,erreur); + if (erreur<>0) or (actuel<1) then exit; Adr:=detecteur_suivant_El(prec,type1,actuel,type2,1); if Adr<9996 then AfficheDebug('Le détecteur suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel)+' est '+IntToSTR(Adr),clyellow) else AfficheDebug('Pas trouvé de détecteur suvant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); @@ -407,7 +411,8 @@ var Adr,erreur,ancdebug : integer ; begin ancdebug:=NivDebug; NivDebug:=3; - Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit; + Val(EditSigSuiv.Text,Adr,erreur); + if (erreur=0) or (adr<1) then exit; if test_memoire_zones(Adr) then AfficheDebug('Présence train',clYellow) else AfficheDebug('Absence train',clyellow); NivDebug:=AncDebug; @@ -417,7 +422,8 @@ end; procedure TFormDebug.ButtonCPClick(Sender: TObject); var Adr,erreur,ancdebug,adrtrain,voie : integer ; begin - Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit; + Val(EditSigSuiv.Text,Adr,erreur); + if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; if PresTrainPrec(Adr,Nb_cantons_Sig,false,voie,adrtrain) then AfficheDebug('Présence train '+intToSTR(AdrTrain),clYellow) else @@ -429,7 +435,8 @@ procedure TFormDebug.Button2Click(Sender: TObject); var Adr,erreur,ancdebug,train : integer ; reservetraintiers : boolean; begin - Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit; + Val(EditSigSuiv.Text,Adr,erreur); + if (erreur<>0) or (Adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; Cond_Carre(Adr); @@ -454,28 +461,28 @@ procedure TFormDebug.ButtonSimuDet0Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); - if erreur=0 then Event_Detecteur(det,false,''); + if (erreur=0) and (det>0) then Event_Detecteur(det,false,''); end; procedure TFormDebug.ButtonSimuDet1Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); - if erreur=0 then Event_Detecteur(det,true,''); + if (erreur=0) and (det>0) then Event_Detecteur(det,true,''); end; procedure TFormDebug.ButtonSimuAct1Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); - if erreur=0 then Event_Act(det,0,1,''); + if (erreur=0) and (det>0) then Event_Act(det,0,1,''); end; procedure TFormDebug.ButtonSimuAct0Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); - if erreur=0 then Event_Act(det,0,0,''); + if (erreur=0) and (det>0) then Event_Act(det,0,0,''); end; procedure TFormDebug.ButtonRazToutClick(Sender: TObject); @@ -512,8 +519,10 @@ begin if (s1='') or (s2='') then exit; if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det; if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det; - Val(s1,prec,erreur); if erreur<>0 then exit; - Val(s2,Actuel,erreur); if erreur<>0 then exit; + Val(s1,prec,erreur); + if (erreur<>0) or (prec<1) then exit; + Val(s2,Actuel,erreur); + if (erreur<>0) or (actuel<1) then exit; Adr:=suivant_Alg3(prec,type1,actuel,type2,1); if Adr<9995 then begin diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index db6affb..aad98c0 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,10 +1,11 @@ object FormPrinc: TFormPrinc - Left = 114 - Top = 237 - Width = 1149 - Height = 699 + Left = 27 + Top = 202 Anchors = [akLeft, akTop, akRight] + BorderStyle = bsSingle Caption = 'Signaux complexes' + ClientHeight = 648 + ClientWidth = 1133 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -13,18 +14,20 @@ object FormPrinc: TFormPrinc Font.Style = [] Menu = MainMenu1 OldCreateOrder = False + Position = poDefault Scaled = False + Visible = True OnClose = FormClose OnCreate = FormCreate OnResize = FormResize DesignSize = ( - 1141 + 1133 648) PixelsPerInch = 96 TextHeight = 13 object LabelTitre: TLabel Left = 8 - Top = 2 + Top = 10 Width = 173 Height = 18 Caption = 'Signaux complexes GL' @@ -37,7 +40,7 @@ object FormPrinc: TFormPrinc end object Image9feux: TImage Left = 1064 - Top = 0 + Top = 8 Width = 57 Height = 105 Picture.Data = { @@ -227,7 +230,7 @@ object FormPrinc: TFormPrinc end object Image7feux: TImage Left = 440 - Top = 0 + Top = 8 Width = 57 Height = 105 Picture.Data = { @@ -395,7 +398,7 @@ object FormPrinc: TFormPrinc end object Image5feux: TImage Left = 728 - Top = -8 + Top = 0 Width = 41 Height = 89 Picture.Data = { @@ -495,7 +498,7 @@ object FormPrinc: TFormPrinc end object Image4feux: TImage Left = 704 - Top = 0 + Top = 8 Width = 41 Height = 97 Picture.Data = { @@ -587,7 +590,7 @@ object FormPrinc: TFormPrinc end object Image3feux: TImage Left = 600 - Top = 8 + Top = 16 Width = 33 Height = 57 Picture.Data = { @@ -668,7 +671,7 @@ object FormPrinc: TFormPrinc end object Image2feux: TImage Left = 1064 - Top = 104 + Top = 112 Width = 33 Height = 57 Picture.Data = { @@ -742,7 +745,7 @@ object FormPrinc: TFormPrinc end object Image2Dir: TImage Left = 656 - Top = 0 + Top = 8 Width = 41 Height = 25 Picture.Data = { @@ -817,7 +820,7 @@ object FormPrinc: TFormPrinc end object Image3Dir: TImage Left = 848 - Top = 0 + Top = 8 Width = 49 Height = 25 Picture.Data = { @@ -895,7 +898,7 @@ object FormPrinc: TFormPrinc end object Image4Dir: TImage Left = 792 - Top = 0 + Top = 8 Width = 57 Height = 25 Picture.Data = { @@ -983,7 +986,7 @@ object FormPrinc: TFormPrinc end object Image5Dir: TImage Left = 880 - Top = 0 + Top = 8 Width = 65 Height = 25 Picture.Data = { @@ -1081,7 +1084,7 @@ object FormPrinc: TFormPrinc end object Image6Dir: TImage Left = 960 - Top = 0 + Top = 8 Width = 81 Height = 25 Picture.Data = { @@ -1189,7 +1192,7 @@ object FormPrinc: TFormPrinc end object ImageSignal20: TImage Left = 1048 - Top = 416 + Top = 424 Width = 57 Height = 105 Picture.Data = { @@ -1429,7 +1432,7 @@ object FormPrinc: TFormPrinc object StatusBar1: TStatusBar Left = 0 Top = 626 - Width = 1141 + Width = 1133 Height = 22 Panels = < item @@ -1457,7 +1460,7 @@ object FormPrinc: TFormPrinc end object MSCommUSBInterface: TMSComm Left = 1064 - Top = 192 + Top = 200 Width = 32 Height = 32 OnComm = MSCommUSBInterfaceComm @@ -1467,7 +1470,7 @@ object FormPrinc: TFormPrinc end object Button1: TButton Left = 744 - Top = 8 + Top = 16 Width = 75 Height = 25 Anchors = [akTop, akRight] @@ -1478,7 +1481,7 @@ object FormPrinc: TFormPrinc end object GrandPanel: TPanel Left = 8 - Top = 48 + Top = 56 Width = 1057 Height = 476 TabOrder = 3 @@ -1518,7 +1521,7 @@ object FormPrinc: TFormPrinc OnChange = FenRichChange OnMouseDown = FenRichMouseDown end - object ScrollBox1: TScrollBox + object ScrollBoxSig: TScrollBox Left = 536 Top = 176 Width = 465 @@ -1532,7 +1535,7 @@ object FormPrinc: TFormPrinc ParentColor = False TabOrder = 1 end - object GroupBox1: TGroupBox + object GroupBoxAcc: TGroupBox Left = 497 Top = 21 Width = 265 @@ -1589,7 +1592,7 @@ object FormPrinc: TFormPrinc OnClick = ButtonDevieClick end end - object GroupBox3: TGroupBox + object GroupBoxTrains: TGroupBox Left = 497 Top = 64 Width = 265 @@ -1967,7 +1970,7 @@ object FormPrinc: TFormPrinc Text = '<1>' end object ButtonEnv: TButton - Left = 0 + Left = 8 Top = 88 Width = 88 Height = 33 @@ -1978,9 +1981,9 @@ object FormPrinc: TFormPrinc OnClick = ButtonEnvClick end end - object GroupBox2: TGroupBox - Left = 721 - Top = 56 + object GroupBoxCV: TGroupBox + Left = 481 + Top = -8 Width = 265 Height = 129 Anchors = [akTop, akRight] @@ -2043,7 +2046,7 @@ object FormPrinc: TFormPrinc end object MSCommCde1: TMSComm Left = 1064 - Top = 272 + Top = 280 Width = 32 Height = 32 OnComm = MSCommCde1Comm @@ -2053,7 +2056,7 @@ object FormPrinc: TFormPrinc end object MSCommCde2: TMSComm Left = 1064 - Top = 304 + Top = 312 Width = 32 Height = 32 OnComm = MSCommCde2Comm diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 054cd2e..2ff5669 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,5 +1,5 @@ Unit UnitPrinc; -// 09/2 10h +// 16/2 16h (******************************************** Programme signaux complexes Graphique Lenz Delphi 7 + activeX Tmscomm + clientSocket @@ -178,13 +178,13 @@ type GrandPanel: TPanel; FenRich: TRichEdit; SplitterV: TSplitter; - ScrollBox1: TScrollBox; - GroupBox1: TGroupBox; + ScrollBoxSig: TScrollBox; + GroupBoxAcc: TGroupBox; Label2: TLabel; EditAdresse: TEdit; ButtonDroit: TButton; ButtonDevie: TButton; - GroupBox3: TGroupBox; + GroupBoxTrains: TGroupBox; Label4: TLabel; Label5: TLabel; LabelFonction: TLabel; @@ -209,7 +209,7 @@ type BoutonRazTrains: TButton; ButtonAffAnalyseCDM: TButton; ButtonCDM: TButton; - GroupBox2: TGroupBox; + GroupBoxCV: TGroupBox; Label3: TLabel; LabelVCV: TLabel; ButtonEcrCV: TButton; @@ -430,6 +430,17 @@ EtatSign : array[0..13] of string[20] =('carr Aspects : array[0..11] of string[20]=('2 feux','3 feux','4 feux','5 feux','7 feux','9 feux','Directionnel 2 feux','Directionnel 3 feux','Directionnel 4 feux', 'Directionnel 5 feux','Directionnel 6 feux','Signal belge type 1'); +// combinaisons possibles des états français +Etats : array[0..20] of string[30]=('Non commandé', + 'carré','sémaphore','sémaphore cli','vert','vert cli','violet','blanc','blanc cli','jaune','jaune cli', + 'ralen 30','ralen 60','rappel 30','rappel 60','ralen 60 + jaune cli','rappel 30 + jaune','rappel 30 + jaune cli', + 'rappel 60 + jaune','rappel 60 + jaune cli','reserve'); + +// combinaisons possibles des états belges +EtatSignBelge: array[0..9] of string[30]= + ('Non commandé','vert jaune horizontal','rouge','vert','vert jaune vertical','rouge blanc', + 'deux jaunes','Chiffre','Chevron','Clignote'); + // conversion index et Signaux[aspect] // index aspect // 2feux 0 2 @@ -446,14 +457,7 @@ Aspects : array[0..11] of string[20]=('2 feux','3 feux','4 feux','5 feux','7 feu // belge 11 20 -Etats : array[0..20] of string[30]=('Non commandé', - 'carré','sémaphore','sémaphore cli','vert','vert cli','violet','blanc','blanc cli','jaune','jaune cli', - 'ralen 30','ralen 60','rappel 30','rappel 60','ralen 60 + jaune cli','rappel 30 + jaune','rappel 30 + jaune cli', - 'rappel 60 + jaune','rappel 60 + jaune cli','reserve'); -EtatSignBelge: array[0..9] of string[30]= - ('Non commandé','vert jaune horizontal','rouge','vert','vert jaune vertical','rouge blanc', - 'deux jaunes','Chiffre','Chevron','Clignote'); type Taccessoire = (aigP,signal); // aiguillage ou signal @@ -577,13 +581,13 @@ var ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc, Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO, Srvc_Pos,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif,Srvc_tdcc, - Hors_tension,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,doubleclic, + Hors_tension,traceSign,TraceZone,parSocketLenz,ackCdm,PremierFD,doubleclic, NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,AffTiers,AvecDemandeAiguillages, TraceListe,clignotant,nack,Maj_signaux_cours,configNulle,LanceCDM,AvecInitAiguillages, AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro, retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain, fichier_module_cdm,Diffusion,cdmDevant,avecRESA,serveurIPCDM_Touche, - Z21,sombre,serveur_ouvert,pasChgTBV : boolean; + sombre,serveur_ouvert,pasChgTBV : boolean; tick,Premier_tick : longint; @@ -740,15 +744,15 @@ var trains : array[1..Max_Trains] of record nom_train : string; adresse,vitmax,VitNominale,VitRalenti : integer; - vitesse : integer; // vitesse actuelle de pilotage + 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 + 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; index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train - SbitMap : TBitmap ; // pointeur sur tampon sous l'icone de déplacement du train en page CDM - ax,ay,x,y : integer; // coordonnées du train (anciennes et nouvelles) en points windows - x0,y0,x1,y1 : integer; // ancien contour du tampon + SbitMap : TBitmap ; // pointeur sur tampon sous l'icone de déplacement du train en page CDM + ax,ay,x,y : integer; // coordonnées du train (anciennes et nouvelles) en points windows + x0,y0,x1,y1 : integer; // ancien contour du tampon, pour l'animation dans la fenêtre cdm end; // éléments scannés et/ou verrouillés @@ -774,12 +778,13 @@ var end; event_det_train : array[0..Max_Trains] of record - NbEl,AdrTrain : integer; - signal_rouge : integer ; // adresse du signal si le train est arreté sur un signal au rouge - nom_train : string; // nom du train - suivant : integer; // suivant prévisionnel à det1 et det2 - Det : array[1..2] of record - adresse : integer; // tableau des evts détecteurs par train + NbEl : integer; // nombre d'éléments dans le tableau ci-dessous + AdrTrain : integer; + signal_rouge : integer ; // adresse du signal si le train est arreté sur un signal au rouge (carré sémaphore violet) + nom_train : string; // nom du train + suivant : integer; // suivant prévisionnel à det1 et det2 + Det : array[1..2] of record // tableau des evts détecteurs par train + adresse : integer; etat : boolean; end; end; @@ -874,6 +879,7 @@ procedure AffTexteIncliBordeTexture(c : TCanvas; x,y : integer; Fonte : tFont; Texture : tBitMap; texte : string; AngleDD : longint); procedure change_style; function isDirectionnel(index : integer) : boolean; +procedure stop_trains; implementation @@ -906,8 +912,8 @@ begin if Ancien_Style<>Style_Aff then begin TStyleManager.TrySetStyle(TStyleManager.StyleNames[0]); // repasse en windows (style 0) pour éviter exception - TStyleManager.TrySetStyle(TStyleManager.StyleNames[Style_Aff]); - // le style windows permet que le richedit affiche en couleurs + TStyleManager.TrySetStyle(TStyleManager.StyleNames[Style_Aff]); // passe dans le style demandé + // repasser certains composants dans le style windows permet que le composant affiche en couleurs Formprinc.FenRich.StyleName:='Windows'; if formDebug<>nil then begin @@ -935,6 +941,7 @@ begin inc(etape); end; +// renvoie vrai si le signal d'index index est directionnel function isDirectionnel(index : integer) : boolean; var a : integer; begin @@ -942,7 +949,7 @@ begin isDirectionnel:=(a>=12) and (a<=16); end; -procedure Tformprinc.DoHint(Sender : Tobject); // le sender est tApplication +procedure Tformprinc.DoHint(Sender : Tobject); // le sender est du type tApplication var s,nomForm: string; FormeTCO : boolean; begin @@ -2399,7 +2406,7 @@ begin TypeSignal:=Signaux[rang].aspect; if typeSignal<=0 then exit; adresse:=Signaux[rang].adresse; - Signaux[rang].Img:=Timage.create(Formprinc.ScrollBox1); + Signaux[rang].Img:=Timage.create(Formprinc.ScrollBoxSig); if Signaux[rang].Img=nil then begin affiche('Erreur 900 : impossible de créer une image',clred);exit;end; with Signaux[rang].Img do @@ -2408,15 +2415,15 @@ begin //canvas.Create; Autosize:=true; align:=alNone; - Parent:=Formprinc.ScrollBox1; // dire que l'image est dans la scrollBox1 + Parent:=Formprinc.ScrollBoxSig; // dire que l'image est dans la scrollBox1 //formprinc.ScrollBox1.Color:=ClGreen; - Name:='ImageFeu'+IntToSTR(rang); // nom de l'image - sert à identifier le composant si on fait clic droit. + Name:='ImageSignal'+IntToSTR(rang); // nom de l'image Top:=(HtImg+espY+20)*((rang-1) div NbreImagePLigne); // détermine les points d'origine Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); width:=LargImg; Height:=HtImg; - // hint + // hint - sert à identifier le composant si on fait clic droit. s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+decodeur[Signaux[rang].Decodeur]+#13+ ' Adresse détecteur associé='+intToSTR(Signaux[rang].Adr_det1)+#13+ ' Adresse élement suivant='+intToSTR(Signaux[rang].Adr_el_suiv1); @@ -2465,12 +2472,12 @@ begin end; // créée le label pour afficher son adresse - Signaux[rang].Lbl:=Tlabel.create(Formprinc.ScrollBox1); + Signaux[rang].Lbl:=Tlabel.create(Formprinc.ScrollBoxSig); with Signaux[rang].Lbl do begin Name:='LabelFeu'+intToSTR(Signaux[rang].adresse); caption:='@'+IntToSTR(Signaux[rang].adresse); - Parent:=Formprinc.ScrollBox1; + Parent:=Formprinc.ScrollBoxSig; font.color:=clBlack; width:=100;height:=20; Top:=HtImg+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); @@ -2482,7 +2489,7 @@ begin if Signaux[rang].FeuBlanc then begin if debug=1 then affiche('Création CheckBox feu blanc '+intToSTR(rang),clLime); - Signaux[rang].checkFB:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu + Signaux[rang].checkFB:=TCheckBox.create(Formprinc.ScrollBoxSig); // ranger l'adresse de la Checkbox dans la structure du feu with Signaux[rang].CheckFB do begin onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus @@ -2490,7 +2497,7 @@ begin Name:='CheckBoxFB'+intToSTR(adresse); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure caption:='dem FB'; font.color:=clBlack; - Parent:=Formprinc.ScrollBox1; + Parent:=Formprinc.ScrollBoxSig; width:=100;height:=15; Top:=HtImg+15+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); @@ -2504,7 +2511,7 @@ end; procedure Affiche_signaux; var i : integer; begin - i:=(Formprinc.ScrollBox1.Width div (largImg+5)) -1; + i:=(Formprinc.ScrollBoxSig.Width div (largImg+5)) -1; if i=NbreImagePLigne then exit; NbreImagePLigne:=i; for i:=1 to NbreSignaux do @@ -2586,11 +2593,13 @@ end; procedure envoi_ss_ack(s : string); var i,timeout,valto : integer; begin + // XpressNet if protocole=1 then begin s:=entete+s+suffixe; if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClLime); end; + // DCC++ if (protocole=2) and TraceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+s,ClLime); // par port com-usb @@ -2661,7 +2670,7 @@ begin repeat Application.processMessages; inc(tempo);Sleep(50); - until ferme or ack or nack or (tempo>(TimoutMaxInterface*3)); // l'interface répond < 5s en mode normal et 1,5 mn en mode programmation + until fermeSC or ack or nack or (tempo>(TimoutMaxInterface*3)); // l'interface répond < 5s en mode normal et 1,5 mn en mode programmation if not(ack) or nack then begin s:='Pas de réponse de l''interface'; @@ -4707,7 +4716,7 @@ begin begin if decodeur_pers[dp].nation<>1 then begin - Affiche('Erreur 380 : le signal '+IntToSTR(adresse)+' est français mais son décodeur est belge',clred); + Affiche('Erreur 381 : le signal '+IntToSTR(adresse)+' est français mais son décodeur est belge',clred); exit; end; @@ -5139,7 +5148,7 @@ begin for i:=1 to NbreSignaux do begin adr:=Signaux[i].adresse; - if not(ferme) and (adr<>0) then envoi_signal(adr); + if not(fermeSC) and (adr<>0) then envoi_signal(adr); end; end; @@ -5319,7 +5328,7 @@ begin s:=s+BTypeToChaine(TypeEl); s:=s+' non trouvé';Affiche(s,clred); branche_trouve:=0; IndexBranche_trouve:=0; - if NivDebug>=1 then AfficheDebug(s,clred); + AfficheDebug(s,clred); end; if debug=3 then formprinc.Caption:=''; @@ -5339,9 +5348,20 @@ begin if el>NbMaxDet then begin - Affiche('Erreur 78 : trouve_element el='+inttoStr(el),clred); + s:='Erreur 78 : trouve_element el='+inttoStr(el); + Affiche(s,clred); + AfficheDebug(s,clred); exit; end; + if el<1 then + begin + if TypeEL=buttoir then exit; + s:='Erreur 79 : trouve_element el='+inttoStr(el); + Affiche(s,clred); + AfficheDebug(s,clred); + exit; + end; + if typeEL=det then begin @@ -5370,7 +5390,7 @@ begin s:=s+BTypeToChaine(TypeEl); s:=s+' non trouvé';Affiche(s,clred); branche_trouve:=0; IndexBranche_trouve:=0; - if NivDebug>=1 then AfficheDebug(s,clred); + AfficheDebug(s,clred); end; if debug=3 then formprinc.Caption:=''; @@ -5415,7 +5435,7 @@ begin AfficheDebug(s,clred); Suivant_alg3:=9999;exit; end; - if NivDebug=3 then + if (NivDebug=3) then 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 @@ -6413,6 +6433,7 @@ end; // si det1 et det2 sont contigus sans aiguillages entre eux, çà renvoie det1 sinon renvoie l'aiguillage entre les 2 // s'ils ne sont pas contigus, renvoie 0 // Si un élément est inconnu, renvoie 9999 +// si le suivant est un buttoir 9995 // det_contigu(527,520: renvoie 7 dans suivant // det_contigu(514,522: renvoie 514 dans suivant // det_contigu(517,524: renvoie 30 @@ -6621,13 +6642,19 @@ begin tp:=det; if det1=0 then tp:=buttoir; trouve_element(det1,tp); // branche_trouve IndexBranche_trouve - if IndexBranche_trouve=0 then + if (IndexBranche_trouve=0) and (tp<>buttoir) then begin if NivDebug=3 then AfficheDebug('Element '+intToSTR(det1)+' non trouvé',clred); if debug=3 then formprinc.Caption:=''; suivant:=9999; exit; end; + if (IndexBranche_trouve=0) and (tp=buttoir) then + begin + suivant:=9995; + exit; + end; + indexBranche_det1:=IndexBranche_trouve; branche_det1:=branche_trouve; @@ -6744,11 +6771,14 @@ procedure Det_Adj(adresse : integer); var Adr,AdrFonc,Branche,AdrPrec,IndexBranche,i,Dir : integer; sortie : boolean; BtypeFonc,BtypePrec : TEquipement; + s : string; begin 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); + s:='Erreur 380 : élément '+IntToSTR(adresse)+' det non trouvé'; + Affiche(s,clred); + AfficheDebug(s,clred); exit; end; IndexBranche:=IndexBranche_trouve; @@ -7137,7 +7167,9 @@ end; // renvoie l'adresse du détecteur suivant les deux éléments // les aiguillages doivent être correctement positionnés entre El1 et el2 // El1 et El2 peuvent être séparés par des aiguillages, mais de pas plus de 3 détecteurs +// remplit aussi le tableau des éléments[idEl] rencontrés de el2 au suivant // en sortie : 9999= det1 ou det2 non trouvé +// 9995 : el2=0 buttoir // 9996 : non trouvé function detecteur_suivant_El(el1: integer;TypeDet1 : TEquipement;el2 : integer;TypeDet2 : TEquipement;alg : integer) : integer ; var IndexBranche_det1,IndexBranche_det2,branche_trouve_det1,branche_trouve_det2,i, @@ -7158,6 +7190,12 @@ begin exit; end; + if (el2=0) then + begin + detecteur_suivant_El:=9995; + exit; + end; + // trouver détecteur 1 trouve_element(el1,Typedet1); // branche_trouve IndexBranche_trouve if (IndexBranche_trouve=0) then @@ -7189,19 +7227,17 @@ begin IndexBranche_det2:=IndexBranche_trouve; branche_trouve_det2:=branche_trouve; j:=1; // J=1 test en incrément J=2 test en décrément - + idEl:=1; // étape 1 : trouver le sens de progression (en incrément ou en décrément) repeat //préparer les variables - IdEl:=1; AdrPrec:=el1;TypePrec:=typeDet1; if j=1 then i1:=IndexBranche_det1+1; if j=2 then i1:=IndexBranche_det1-1; // les suivants dansla branche sont: AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse; typeFonc:=BrancheN[branche_trouve_det1,i1].Btype; - IdEl:=1; elements[idEl].adresse:=adrFonc; elements[idEl].typ:=TypeFonc; @@ -7250,6 +7286,7 @@ begin adr:=el2;typeGen:=TypeDet2; end; + idel:=1; if (typeDet2=TypeGen) and (Adr=el2) and (N_Det<>Nb_det_dist) then begin if Nivdebug=3 then AfficheDebug('614 - Trouvé '+intToSTR(el2),clYellow); @@ -7272,7 +7309,7 @@ begin elements[idEl].adresse:=adr; elements[idEl].typ:=TypeGen; - AdrPrec:=AdrFonc;TypePrec:=TypeFonc; + ADrPrec:=AdrFonc;TypePrec:=TypeFonc; AdrFonc:=Adr;TypeFonc:=typeGen; inc(i); sortie:=(TypeGen=det) or (Adr=0) or (Adr>=9990) or (i=10); @@ -7301,6 +7338,185 @@ begin end; +// mode=0 = libère 1=réserve reserve_dereserve_det(detecteur1,detecteur2,adrTrain,i,1); +function reserve_dereserve_det(det1,det2,adrTrain,indexTrain,mode : integer) : integer; +var IndexBranche_det1,IndexBranche_det2,branche_trouve_det1,branche_trouve_det2,i, + j,k,AdrPrec,Adr,AdrFonc,i1,N_det : integer; + Sortie : boolean; + TypePrec,TypeFonc : Tequipement; + s : string; + label reprise; +begin + s:='Reserve_dereserve_det '+intToSTR(det1)+' '+intToSTR(det2)+' pour train '; + if roulage then s:=s+'@'+intToSTR(adrtrain) + else if avecResa then s:=s+intToSTR(IndexTrain); + if traceliste or ProcPrinc then afficheDebug(s,clorange); + Affiche(s,ClOrange); + + if NivDebug>=2 then + if (det1>9000) or (det2>9000) then + begin + if NivDebug=3 then AfficheDebug('Paramètres incorrects >9000',clred); + reserve_dereserve_det:=9999; + exit; + end; + + if (det2=0) then + begin + reserve_dereserve_det:=9995; + exit; + end; + + // trouver détecteur 1 + trouve_element(det1,det); // branche_trouve IndexBranche_trouve + if (IndexBranche_trouve=0) then + begin + if NivDebug=3 then + begin + s:='611. '+IntToSTR(det1)+' non trouvé'; + AfficheDebug(s,clOrange); + end; + reserve_dereserve_det:=9999; + exit; + end; + IndexBranche_det1:=IndexBranche_trouve; + branche_trouve_det1:=branche_trouve; + + // trouver détecteur 2 + trouve_element(det2,det); // branche_trouve IndexBranche_trouve + if (IndexBranche_trouve=0) then + begin + if NivDebug=3 then + begin + s:='612. '+IntToSTR(det2)+' non trouvé'; + AfficheDebug(s,clred); + AfficheDebug(s,clOrange); + end; + reserve_dereserve_det:=9999;exit; + end; + + IndexBranche_det2:=IndexBranche_trouve; + branche_trouve_det2:=branche_trouve; + j:=1; // J=1 test en incrément J=2 test en décrément + + // étape 1 : trouver le sens de progression (en incrément ou en décrément) + + repeat + //préparer les variables + AdrPrec:=det1;TypePrec:=det; + if j=1 then i1:=IndexBranche_det1+1; + if j=2 then i1:=IndexBranche_det1-1; + // les suivants dansla branche sont: + AdrFonc:=BrancheN[branche_trouve_det1,i1].adresse; + typeFonc:=BrancheN[branche_trouve_det1,i1].Btype; + + if NivDebug=3 then + begin + s:='------> Test en '; + if (j=1) then s:=s+'incrément ' else s:=s+'décrément '; + s:=s+'- départ depuis élément '+IntToSTR(det1)+' trouvé en index='+intToSTR(IndexBranche_det1)+' Branche='+intToSTR(branche_trouve_det1); + AfficheDebug(s,clyellow); + end; + + i:=0;N_Det:=0; + if AdrFonc<>det2 then // si pas déja trouvé le sens de progression + begin + repeat + //AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow); + if nivDebug=3 then AfficheDebug('i='+IntToSTR(i)+' NDet='+IntToSTR(N_det),clyellow); + if (AdrFonc<>0) or (TypeFonc<>rien) then Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,1) else + begin + Adr:=9999; + end; + //AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow); + if TypeGen=det then inc(N_Det); + if NivDebug=3 then + begin + s:='613 : trouvé='+intToSTR(Adr)+BTypeToChaine(typeGen); + AfficheDebug(s,clYellow); + end; + + AdrPrec:=AdrFonc;TypePrec:=TypeFonc; + AdrFonc:=Adr;TypeFonc:=typeGen; + inc(i); + sortie:=((TypeGen=det) and (Adr=det2)) or (Adr=0) or (Adr>=9990) or (i=15) or (N_Det=Nb_det_dist); + until sortie ; + if (i=15) and (Nivdebug=3) then afficheDebug('Pas trouvé',clyellow); + if (N_det=Nb_det_dist) and (Nivdebug=3) then + begin + s:='Elements trop distants '+intToStr(det1)+' '+intToSTR(det2); + afficheDebug(s,clorange); + end; + end + + else + begin + // déja trouvé + adr:=det2;typeGen:=det; + end; + + idel:=1; + elements[idEl].adresse:=adrPrec; + elements[idEl].typ:=TypePrec; + + if (TypeGen=det) and (Adr=det2) and (N_Det<>Nb_det_dist) then + begin + + i:=0; + repeat + //AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow); + Adr:=suivant_alg3(AdrFonc,TypeFonc,AdrPrec,TypePrec,1); + //AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow); + + if NivDebug=3 then + begin + s:='615 : trouvé='+intToSTR(Adr)+BTypeToChaine(typeGen); + AfficheDebug(s,clorange); + end; + inc(idEl); + elements[idEl].adresse:=adr; + elements[idEl].typ:=TypeGen; + + AdrFonc:=AdrPrec;TypeFonc:=TypePrec; + AdrPrec:=Adr;TypePrec:=TypeGen; + + inc(i); + sortie:=(TypeGen=det) or (Adr=0) or (Adr>=9990) or (i=10); + until sortie; + + if (TypeGen=det) or (TypeGen=buttoir) then + begin + for k:=1 to IdEl do + begin + j:=elements[k].adresse; + typePrec:=elements[k].typ; + if (typePrec=Aig) or (typePrec=tjd) or (typePrec=tjs) or (typePrec=crois) or (typePrec=triple) then + begin + if TraceListe then AfficheDebug_Suivi(intToSTR(k)+' ',clOrange); + if mode=0 then Aiguillage[index_aig(j)].AdrTrain:=0 + else + if (Aiguillage[index_aig(k)].AdrTrain=0) then + begin + if avecresa then Aiguillage[index_aig(j)].AdrTrain:=indexTrain; + if roulage then Aiguillage[index_aig(j)].AdrTrain:=AdrTrain; + end; + Texte_aig_fond(j); + end; + end; + reserve_dereserve_det:=0; + exit; + end; + end; + if (i=10) then if NivDebug=3 then AfficheDebug('201 : Itération trop longue',clred); + inc(j); + //AfficheDebug('j='+intToSTR(j),clyellow); + until j=3; // boucle incrément/décrément + + reserve_dereserve_det:=9996; + if NivDebug=3 then affichedebug('------------------',clyellow); + if debug=3 then formprinc.Caption:=''; +end; + // renvoie le nombre de croisements entre les détecteurs el1 et el2 // jamais utilisée ! function Test_croisement(el1,el2,alg: integer) : integer ; @@ -7544,7 +7760,7 @@ var begin AdrTrain:=0; ReserveTrainTiers:=false; - if (NivDebug>=1) then AfficheDebug('Proc carre_signal '+IntToSTR(adresse)+' -----------',clyellow); + if (NivDebug>=1) or ProcPrinc then AfficheDebug('Proc carre_signal '+IntToSTR(adresse)+' -----------',clyellow); i:=Index_Signal(adresse); if i=0 then @@ -7739,7 +7955,7 @@ var num_signal,AdrSignal,i,j,prec,AdrSuiv,index2,voie : integer; s : string; begin //traceDet:=true; - if NivDebug>=2 then AfficheDebug('Cherche signal suivant au détecteur '+IntToSTR(det1),clyellow); + if (NivDebug>=2) or ProcPrinc then AfficheDebug('Cherche signal suivant au détecteurs '+IntToSTR(det1)+' '+intToSTR(det2),clyellow); if (det1>NbMaxDet) or (det2>NbMaxDet) then begin @@ -7749,12 +7965,13 @@ begin // trouve l'élément suivant contigu det_contigu(det2,det1,i,Typ); - if i=0 then + if (i=0) or (i=9995) then // 9995:buttoir begin //affiche('Erreur 65 : Signal_suivant_det('+intToSTR(det1)+','+intToSTR(det2)+') ne sont pas liés ',clred); signal_suivant_det:=0; exit; end; + // si det1 et det2 sont contigus, i=det1 // sinon i contient l'adresse de l'aiguillage avant det2 @@ -7887,10 +8104,12 @@ begin 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 signal suivant, 2 pour signal suivant le 1, etc // retour dans AdrSignalsuivant : adresse du signal suivant +// remplit aussi les élements[] rencontrés // stocke les éléments trouvés dans Elements function etat_signal_suivant(Adresse,rang : integer;var AdrSignalsuivant : integer) : integer; var index,num_signal,etat,AdrSignal,i,j,prec,AdrSuiv,index2,voie : integer; @@ -7898,7 +8117,7 @@ var index,num_signal,etat,AdrSignal,i,j,prec,AdrSuiv,index2,voie : integer; TypePrec,TypeActuel,typ : TEquipement; s : string; begin - if NivDebug>=2 then AfficheDebug('Cherche état du signal suivant au '+IntToSTR(adresse),clyellow); + if ProcPrinc or (NivDebug>=2) then AfficheDebug('Cherche état du signal suivant au '+IntToSTR(adresse),clyellow); i:=Index_Signal(adresse); if (i=0) then begin @@ -8408,6 +8627,7 @@ begin end; // renvoie l'adresse du signal précédent au signal "adresse" +// remplit aussi les élements[] rencontrés function Signal_precedent(adresse : integer) : integer; var AdrSuiv,prec,ife,actuel,i,j,ifd,index, @@ -8551,6 +8771,54 @@ begin Signal_precedent:=0; 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) +Procedure libere_canton(detecteur1,detecteur2 : integer); +var sd2,i,j: integer; + typ : tEquipement; +begin + // mode_reserve 0 = par canton - 1=par détecteurs + if mode_reserve=1 then + begin + reserve_dereserve_det(detecteur1,detecteur2,0,0,0); + exit; + end; + + if not(roulage) and not(avecResa) then exit; + //if traceliste or ProcPrinc then + affiche('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); + if ProcPrinc or traceListe then AfficheDebug('Libère_Canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); + // est-on en limite de canton du detecteur 2 pour le libérer? + sd2:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2 + if sd2=0 then + begin + if traceliste then affiche('le détecteur '+intToSTR(detecteur2)+' n''est pas pas associé à un signal - pas de libération du canton',clorange); + exit; // pas de signal associé + end; + // ce signal sd2 est il dans le bon sens + i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal dans le bon sens associé au détecteur + //if i<>sd2 then exit; + if i=0 then exit; + + // trouver le signal précédent + i:=Signal_precedent(i); // trouve les éléments entre les deux signaux + + if traceListe then AfficheDebug('Libération canton det '+IntToSTR(detecteur1)+' '+intToSTR(detecteur2)+' : ',clLime); + for i:=1 to idEl-1 do + begin + 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('A'+intToSTR(j)+' ',clLime); + Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'aiguillage + end; + end; + Maj_Signaux(false); +end; + + + // présence train précédent les n (NbCtSig) cantons du signal Adresse, dans le sens d'avance vers le signal. // detect=true si on doit contrôler aussi sur les détecteurs // renvoie vrai si présence train @@ -8567,7 +8835,7 @@ var s : string; begin AdrTr:=0; - if debug=3 then formprinc.Caption:='PresTrainPrec '+IntToSTR(adresse); + if (debug=3) or ProcPrinc then formprinc.Caption:='PresTrainPrec '+IntToSTR(adresse); if NivDebug>=1 then begin s:='Proc PresTrainPrec('+intToSTR(adresse)+','+intToSTR(NbCtSig)+') '; @@ -8806,7 +9074,7 @@ end; // met à jour l'état du signel belge selon l'environnement des aiguillages et des trains procedure signal_belge(AdrSignal : integer;detect : boolean); -var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant,AdrTrainRes,detSuiv : integer; +var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant,AdrTrainRes : integer; Btype_el_suivant : TEquipement; car,presTrain,reserveTrainTiers,Aff_Semaphore : boolean; s: string; @@ -8921,6 +9189,7 @@ begin envoi_signal(AdrSignal); // si le signal n'est pas rouge, réserver les aiguillages en aval + { if (roulage or AvecResa) and (AdrTrainLoc<>0) then begin etat:=Signaux[index].EtatSignal; @@ -8938,7 +9207,7 @@ begin end; end; end; - end; + end; } if signalDebug=AdrSignal then begin AffSignal:=false;nivDebug:=0;end; if debug=3 then formprinc.Caption:=''; @@ -8949,7 +9218,7 @@ end; // AdrSignal: adresse du signal // detect: si true, tient compte de la présence des trains par détecteurs dans la fonction signalPrec procedure Maj_Signal(AdrSignal : integer;detect : boolean); -var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie,detSuiv,code,combine,AdrSignalsuivant,AdrTrainRes : integer ; +var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie,code,combine,AdrSignalsuivant,AdrTrainRes : integer ; PresTrain,Aff_semaphore,car,reserveTrainTiers : boolean; Btype_el_suivant : TEquipement; s : string; @@ -9180,6 +9449,7 @@ begin envoi_signal(AdrSignal); // 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:=Signaux[index].EtatSignal; @@ -9190,10 +9460,10 @@ begin 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, - } + //det1:=event_det_train[id].Det[2].adresse; + //det2:=event_det_train[id].suivant; + //det3:=suivant_alg3(det1, + // trouver le détecteur suivant if Signaux[index].Btype_suiv1<>det then detSuiv:=detecteur_suivant(Signaux[index].Adr_det1,det,Signaux[index].Adr_el_suiv1,Signaux[index].Btype_suiv1,1) else detSuiv:=Signaux[index].Adr_el_suiv1; @@ -9204,7 +9474,7 @@ begin end; end; end; - end; + end; } if signalDebug=AdrSignal then begin AffSignal:=false;nivDebug:=0;end; if debug=3 then formprinc.Caption:=''; @@ -9297,108 +9567,6 @@ begin signal_sens:=succ=det2; end; -// libère la portion de det1 à detecteur2 -Procedure libere_detecteur(detecteur1,detecteur2 : integer); -var i,j,det3 : integer; - typ : tEquipement; -begin - if not(roulage) and not(avecResa) then exit; - //if traceliste or ProcPrinc then - Affiche('Libère_Detecteur '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); - if ProcPrinc then AfficheDebug('Libère_Detecteur '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); - det3:=detecteur_suivant_El(detecteur1,det,detecteur2,det,1); // arret sur suivant - - if traceListe then AfficheDebug('Libération portion det '+IntToSTR(detecteur1)+' '+intToSTR(detecteur2)+' : ',clLime); - for i:=1 to idEl 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)+' ',clLime); - Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'aiguillage - end; - end; - Maj_Signaux(false); -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) -Procedure libere_canton(detecteur1,detecteur2 : integer); -var sd2,i,j: integer; - typ : tEquipement; -begin - // mode_reserve 0 = par canton - 1=par détecteurs - if mode_reserve=1 then - begin - libere_detecteur(detecteur1,detecteur2); - exit; - end; - - if not(roulage) and not(avecResa) then exit; - //if traceliste or ProcPrinc then - affiche('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); - if ProcPrinc then AfficheDebug('Libère_Canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); - // est-on en limite de canton du detecteur 2 pour le libérer? - sd2:=signal_detecteur(detecteur2); // trouve le signal associé au detecteur2 - if sd2=0 then - begin - if traceliste then affiche('le détecteur '+intToSTR(detecteur2)+' n''est pas pas associé à un signal - pas de libération du canton',clorange); - exit; // pas de signal associé - end; - // ce signal sd2 est il dans le bon sens - i:=signal_suivant_det(detecteur1,detecteur2); // adresse du signal dans le bon sens associé au détecteur - if i<>sd2 then exit; - - // trouver le signal précédent - i:=Signal_precedent(i); // trouve les éléments entre les deux signaux - - if traceListe then AfficheDebug('Libération canton det '+IntToSTR(detecteur1)+' '+intToSTR(detecteur2)+' : ',clLime); - for i:=1 to idEl-1 do - begin - 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)+' ',clLime); - Aiguillage[index_aig(j)].AdrTrain:=0; // libère l'aiguillage - end; - end; - Maj_Signaux(false); -end; - -// reserve les aiguillages du det1 au det2 et au suivant de det2 -procedure reserve_detecteur(det1,det2,adrTrain,NumTrain : integer); -var det3,i,j : integer; - typ : tEQuipement; -begin - det3:=detecteur_suivant_El(det1,det,det2,det,1); - Affiche('Réserve détecteur '+intToSTR(det1)+' '+intToSTR(det2)+' '+intToSTR(det3),clYellow); - for i:=1 to idEl do - begin - j:=elements[i].adresse; - //Affiche(intToSTR(j),clOrange); - 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; - Maj_Signaux(false); //sans_Maj -end; - - // 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 @@ -9451,13 +9619,8 @@ begin begin //Affiche('Absence de signal après '+intToSTR(detecteur2)+', réservation pour train @'+intToStr(AdrTrain)+' '+intToSTR(detecteur1)+' '+intToSTR(detecteur2)+' impossible',clred); i:=indexbrut_train_adresse(AdrTrain); // numéro de train - if i<>0 then - begin - reserve_detecteur(detecteur1,detecteur2,adrTrain,i); - end; - + if i<>0 then reserve_dereserve_det(detecteur1,detecteur2,adrTrain,i,1); exit; - end; etat:=Signaux[Index_Signal(AdrSig)].etatSignal; @@ -9996,17 +10159,17 @@ begin if detecteur[det2].train=train_ch then detecteur[det2].train:=''; // désaffectation du nom de train de l'ancien détecteur si le nom du train est égal if detecteur[det2].AdrTrain=AdrTrainLoc then detecteur[det2].AdrTrain:=0; // désaffectation du nom de train de l'ancien détecteur - libere_canton(det2,det3); - + //libere_canton(det2,det3); + reserve_dereserve_det(det2,det3,0,0,0); // libère reserve_canton(det3,AdrSuiv,adrTrainLoc,i,nCantonsRes); det4:=detecteur_suivant_EL(det3,det,AdrSuiv,det,1); if det4>9990 then begin if det4=9996 then affiche_evt('Erreur: 2-0 position inconnue aiguillage ',clred) - else Affiche_evt('Info: 2-0 '+intToSTR(Det4)+' : pas de suivant detecteur_suivant_el '+intToSTR(det3)+' '+intToSTR(AdrSuiv),clyellow); + else Affiche_evt('Info: 2-0 '+intToSTR(Det4)+' : pas de detecteur_suivant_el '+intToSTR(det3)+' '+intToSTR(AdrSuiv),clyellow); end else - reserve_canton(AdrSuiv,det4,adrTrainLoc,i,nCantonsRes); + reserve_canton(AdrSuiv,det4,adrTrainLoc,i,nCantonsRes); //Maj_Signaux(false); sans_maj // stockage dans historique de zones @@ -10142,7 +10305,7 @@ begin if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc,i,nCantonsRes) else begin - if det_suiv=9996 then affiche_evt('Erreur 2-0 position inconnue aiguillage ',clred) + if det_suiv=9996 then affiche_evt('Erreur 2-1 position inconnue aiguillage ',clred) else Affiche_evt('Erreur 2-1 '+intToSTR(Det_Suiv)+' : pas de suivant detecteur_suivant_el '+intToSTR(det2)+' '+intToSTR(det3),clred); end; // libère canton @@ -10207,7 +10370,7 @@ begin det[2].etat:=false; NbEl:=2; end; - + end else begin @@ -10912,8 +11075,8 @@ end; Procedure affiche_memoire; var s: string; begin - s:='Mémoire évènements '+IntToSTR(100*N_Event_tick div Max_Event_det_tick)+' %'; - FormPrinc.StatusBar1.Panels[1].text:=s; + s:='Mém evt: '+IntToSTR(100*N_Event_tick div Max_Event_det_tick)+' %'; + FormPrinc.StatusBar1.Panels[2].text:=s; end; procedure evalue; @@ -10935,6 +11098,11 @@ begin exit; end; + if index_adresse_detecteur(Adresse)=0 then + begin // si détecteur inexistant. Peut être renvoyé par la centrale dans un groupe de 4 détecteurs + exit; + end; + // vérifier si front descendant pour filtrage if filtrageDet0<>0 then begin @@ -11400,7 +11568,7 @@ begin end; -// le décodage de la rétro est appelé sur une réception d'une trame de la rétrosignalisation de la centrale. +// le décodage de la rétro XpressNet est appelé sur une réception d'une trame de la rétrosignalisation de la centrale. // On déclenche ensuite les évènements détecteurs ou aiguillages. // valeur = ITTN ZZZZ // var globale modeStkRetro=false = stockage sur changement d'état, et génère évènement détecteur @@ -11597,10 +11765,7 @@ begin ack:=chaineINT<>''; // Affiche(copy(chaineINT,i,j-i+1),clblue); - if affiche_retour_dcc then - begin - Affiche(copy(chaineINT,i,j-i+1),clOrange); - end; + if affiche_retour_dcc then Affiche(copy(chaineINT,i,j-i+1),clOrange); if pos('DCC',chaineINT)<>0 then begin @@ -11855,182 +12020,352 @@ begin end; // vérifie le checksum -procedure check(s : string;n : integer); +function check(s : string;n : integer): boolean; var x: byte; - i : integer; + i,l : 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); + i:=1; + l:=length(s); + if l>0 then + begin + repeat + x:=x xor ord(s[i]); + inc(i); + until (i>l) or (i>n); + end; + + result:=x=0; + end; -// décodage d'une chaine simple Xpressnet de la rétrosignalisation de la centrale +// décodage d'une chaine Xpressnet de la rétrosignalisation de la centrale +// la chaine peut être composée de plusieurs ordres, car on boucle, et être coupée. // en sortie, la chaine chaineINT est supprimée de la partie traitée function decode_chaine_retro_Xpress(chaineINT : string) : string ; -var msg : string; - i,cvLoc,AdrTrainLoc : integer; +var msg,s : string; + n,i,it,cvLoc,AdrTrainLoc,l,NOctets : integer; + traite,connu: boolean; begin - //affiche(chaine_hex(chaine),clyellow); + //affiche(chaine_hex(chaineINT),clOrange); msg:=''; ack:=true;nack:=false; - // décodage du 3eme octet de la chaîne - if chaineINT[1]=#$01 then - begin - case chaineINT[2] of // page 13 doc XpressNet - #$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); + it:=0; - check(chaineINT,3); - delete(chaineINT,1,3); - decode_chaine_retro_Xpress:=chaineINT; - - exit; - end; - - 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; - end; - - if chaineINT[1]=#$61 then - begin - 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 (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); - check(chaineINT,3); - delete(chaineINT,1,3); - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - - if ((chaineINT[1]=#$63) and (chaineINT[2]=#$14)) then // V3.6 uniquement - begin - // réception d'un CV. DocXpressNet p26 63 14 01 03 chk - - 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[4]); - inc(N_Cv); // nombre de CV recus - end; - recu_cv:=true; - check(chaineINT,5); - delete(chaineInt,1,5); - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - - if chaineINT[1]=#$42 then // accessory decodeur information response 4 octets - begin - check(chaineINT,4); - delete(chaineInt,1,1); - decode_retro_XpressNet(ord(chaineInt[1]),ord(chaineInt[2])); - delete(chaineInt,1,3); - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - - if chaineINT[1]=#$81 then // arrêt urgence 3 octets - begin - 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]=#$46 then // non doc - begin - //FF FD 46 43 40 41 40 40 49 4D non documentée - //FF FD 46 43 50 41 50 40 50 54 non documentée - // 46 43 40 41 40 40 48 4C - // 46 43 50 41 54 40 50 50 - - // supprimer jusque FF ou fin de chaine - check(chaineINT,8); - i:=0; - repeat - inc(i); - until (i>length(chaineINT)) or (chaineINT[i]=#$FF); - delete(chaineINT,1,i-1); - - Affiche('reprise puissance ',clLime); - Hors_tension:=false; - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - - if chaineInt[1]=#$81 then // non documentée - begin - check(chaineINT,2); - i:=0; - repeat - inc(i); - until (i>length(chaineINT)) or (chaineINT[i]=#$FF); - delete(chaineINT,1,i-1); - - Affiche('Court circuit msg 1',clRed); - Hors_tension:=true; - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - - // E3 40 ah al xor - 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; - end; - - // E4 id speed FcA FcB xor loco information - 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 - Fb:=ord(chaineInt[5]); // fonction B - delete(chaineInt,1,6); - decode_chaine_retro_Xpress:=chaineINT; - exit; - end; - - ack:=false; - nack:=true; - affiche('Erreur 7, chaîne rétrosig. inconnue recue:'+chaine_HEX(chaineINT),clred); - i:=0; + if length(chaineINT)>3 then repeat - inc(i); - until (i>length(chaineINT)) or (chaineINT[i]=#$FF); - delete(chaineINT,1,i-1); + inc(it); + //AfficheDebug('It='+IntToSTR(it),clLime); + connu:=false; + traite:=false; + + if length(chaineINT)>4 then + begin + // supprimer l'entete éventuelle FFFE ou FFFD + if (chaineINT[1]=#$ff) and ((chaineINT[2]=#$fe) or (chaineINT[2]=#$fd)) then Delete(chaineINT,1,2); + end; + + l:=length(chaineINT); + + if (chaineINT[1]=#$01) then + begin + nOctets:=3; + connu:=true; + if (l>=nOctets) then + begin + if check(chaineINT,nOctets) then + begin + case chaineINT[2] of // page 13 doc XpressNet + #$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); + + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineINT,1,nOctets); + end; + end + else + + if (chaineINT[1]=#$02) then + begin + connu:=true; + nOctets:=4; + if (l>=nOctets) then + begin + if check(chaineINT,nOctets) then + begin + msg:='Version matérielle '+intTohex(ord(chaineINT[2]),2)+' - Version soft '+intToHex(ord(chaineINT[3]),2); + Affiche(msg,clYellow); + version_Interface:=chaineInt; + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineINT,1,nOctets); + end; + end + else + + if (ord(chaineINT[1]) and $F0)=$40 then // accessory decodeur information response $40+N 40 N=1 à 14 + begin + connu:=true; + n:=ord(chaineINT[1]) and $0F; // nombre d'octets + nOctets:=n+2; + if (l>=nOctets) then + begin + if check(chaineINT,nOctets) then + begin + n:= n div 2; + for i:=1 to n do + begin + decode_retro_XpressNet(ord(chaineInt[i*2]),ord(chaineInt[i*2+1])); + end; + traite:=true; + end + else + begin + s:='ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)); + if TraceTrames then AfficheDebug(s,clred); + end; + delete(chaineINT,1,nOctets); + end; + end + else + + + // recu 61 01 60 + if (chaineINT[1]=#$61) then + begin + nOctets:=3; + connu:=true; + if l>nOctets then + begin + if check(chaineINT,nOctets) then + begin + 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; + + #$11 : begin nack:=true;msg:='Voie prog Station prête';end; + #$12 : begin ack:=true;msg:='Voie prog court-circuit';Hors_tension:=false;end; + #$13 : begin ack:=true;msg:='Voie prog octet non trouvé';end; + #$1F : begin nack:=true;msg:='Voie prog Station occupée - 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); + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineINT,1,nOctets); + end; + end + else + + if (chaineINT[1]=#$63) then // V3.6 uniquement + begin + connu:=true; + nOctets:=5; + if (l>=nOctets) then + begin + if check(chaineINT,nOctets) then + begin + if chaineINT[2]=#$14 then + begin + // réception d'un CV. DocXpressNet p26 63 14 01 03 chk + 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[4]); + inc(N_Cv); // nombre de CV recus + end; + recu_cv:=true; + traite:=true; + end; + if chaineINT[2]=#$10 then + begin + traite:=true; + end; + if chaineINT[2]=#$21 then + begin + traite:=true; + end; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineINT,1,nOctets); + end; + end + else + + + // 81 00 mise hors tension + if (chaineINT[1]=#$81) then // arrêt urgence 3 octets + begin + connu:=true; + nOctets:=3; + if (l>=3) then + begin + if check(chaineINT,nOctets) then + begin + Affiche('Voie hors tension msg1',clRed); + Hors_tension:=true; + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineINT,1,nOctets); + end; + end + else + + // id n + // 83 5 + // 84 6 + // C5 7 + // C6 8 + // A3 5 + // A4 6 + + if (chaineInt[1]=#$E1) then + begin + NOctets:=3; + connu:=true; + if (l>=NOctets) then + begin + if check(chaineINT,NOctets) then + begin + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,NOctets)),clred); + end; + delete(chaineInt,1,NOctets); + end; + end + else + + // E2 4 + + // E3 + if (chaineInt[1]=#$E3) then + begin + connu:=true; + nOctets:=5; + if (l>=nOctets) then + begin + // la loco ah al est pilotée par le PC + if check(chaineINT,nOctets) then + begin + if chaineInt[1]=#$40 then + begin + end; + if chaineInt[2]=#$50 then + begin + end; + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineInt,1,nOctets); + end; + end + else + + // E4 id speed FcA FcB xor loco information + if (chaineInt[1]=#$E4) then + begin + connu:=true; + nOctets:=6; + if (l>=nOctets) then + begin + if check(chaineINT,nOctets) then + begin + AdrTrainLoc:=ord(chaineInt[2]); // identification + i:=ord(chaineInt[3]); // vitesse + Fa:=ord(chaineInt[4]); // fonction A + Fb:=ord(chaineInt[5]); // fonction B + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineInt,1,nOctets); + end; + end + else + + // E5 7 + // E6 8 + + // spécifique Z21 : E7 0C 89 00 00 00 00 00 62 + if (chaineINT[1]=#$E7) then + begin + connu:=true; + nOctets:=9; + if (l>=nOctets) then + begin + if check(chaineINT,nOctets) then + begin + traite:=true; + end + else + begin + if TraceTrames then AfficheDebug('ErrCheck '+chaine_hex(copy(chaineINT,1,nOctets)),clred); + end; + delete(chaineINT,1,nOctets); + end; + end; + + // suppression du caractère inconnu car il n'a pas été traité + if not(connu) then + begin + if traceTrames then AfficheDebug('Suppression '+chaine_Hex(copy(chaineINT,1,1)),clred); + delete(chaineINT,1,1); + traite:=true; + end; + + until (length(chaineINT)<3) or not(traite) or (it>20); // conditions de sortie du repeat until + + if it>=20 then + begin + s:='Erreur 623 : itérations trames XpressNet'; + Affiche(s,clred); + AfficheDebug(s,clred); + chaineINT:=''; + end; decode_chaine_retro_Xpress:=chaineINT; end; @@ -12045,17 +12380,9 @@ begin chaineINT:=chaine; if protocole=1 then begin - while length(chaineINT)>=3 do - begin - if length(chaineINT)>4 then - begin - // supprimer l'entete éventuelle - if (chaineINT[1]=#$ff) and (chaineINT[2]=#$fe) then Delete(chaineINT,1,2); - if (chaineINT[1]=#$ff) and (chaineINT[2]=#$fd) then Delete(chaineINT,1,2); - end; - chaineINT:=decode_chaine_retro_Xpress(chaineINT); - end; + chaineINT:=decode_chaine_retro_Xpress(chaineINT); end; + if protocole=2 then begin i:=pos('<',chaineINT); @@ -12067,6 +12394,7 @@ begin j:=pos('>',chaineINT); end; end; + interprete_reponse:=chaineINT; end; @@ -12163,36 +12491,39 @@ function test_protocole : boolean; var s: string; temp : integer; begin + begin + if protocole=1 then // Xpressnet begin - if protocole=1 then // Xpressnet - begin - s:=#$f0; - s:=checksum(s); - end; - if protocole=2 then // dcc++ - s:=''; + s:=#$f0; + s:=checksum(s); + end; + if protocole=2 then s:=''; // dcc++ - envoi_ss_ack(s); - application.processMessages; + envoi_ss_ack(s); + application.processMessages; - temp:=0; - repeat - sleep(100); - inc(temp); - Application.processmessages; - until (version_Interface<>'') or (temp>15); + temp:=0; + repeat + sleep(100); + inc(temp); + Application.processmessages; + until (version_Interface<>'') or (temp>15); - if (temp>15) then - begin - s:=' mais l''interface n''a pas répondu '; - if protocole=1 then s:=s+' en XpressNet'; - if protocole=2 then s:=s+' en DCC++'; - Affiche_suivi(s,clyellow); - portCommOuvert:=false; // refermer le port - result:=false; - exit; - end - else + + if (temp>15) then + begin + s:=' mais l''interface n''a pas répondu '; + if protocole=1 then s:=s+' en XpressNet'; + if protocole=2 then s:=s+' en DCC++'; + Affiche_suivi(s,clyellow); + portCommOuvert:=false; // refermer le port + result:=false; + exit; + end + else + + begin + if length(version_interface)>0 then begin if (protocole=1) and (version_interface[1]=#2) then begin @@ -12206,11 +12537,11 @@ begin result:=true; exit; end; - - Affiche_suivi(s+' mais l''interface a répondu incorrectement',clyellow); - result:=false; end; - end + Affiche_suivi(s+' mais l''interface a répondu incorrectement',clyellow); + result:=false; + end; + end; end; // connecte un port usb pour la comm périphériques. Si le port n'est pas ouvert, renvoie false @@ -12255,7 +12586,7 @@ begin 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 + (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; @@ -12468,6 +12799,7 @@ end; procedure connecte_usb; var numport,erreur : integer; s : string; + unique: boolean; begin if debug=1 then affiche('Connexion interface USB',clLime); if portcommouvert then exit; @@ -12477,6 +12809,8 @@ begin val(copy(portcom,4,6),Numport,erreur); end; + unique:=numport<>0; + if numport=0 then // scan des ports begin @@ -12497,7 +12831,9 @@ begin s:='Pas d''interface '; if protocole=1 then s:=s+'XpressNet'; if protocole=2 then s:=s+'DCC++'; - Affiche(s+' trouvée sur les ports COM de 1 à '+intToSTR(MaxPortCom),clOrange); + if unique then s:=s+' trouvée sur le port COM'+intToSTR(numport) + else s:=s+' trouvée sur les ports COM de 1 à '+intToSTR(MaxPortCom); + Affiche(s,clOrange); Formprinc.StatusBar1.Panels[3].Text:=''; end else @@ -13050,16 +13386,15 @@ procedure positionne_elements(i : integer); begin with formprinc do begin - GroupBox1.Left:=i+12; - GroupBox2.Left:=i+12; - GroupBox3.Left:=i+12; - ScrollBox1.Left:=i+12; - ScrollBox1.width:=GrandPanel.Width-i-20; - Panel1.Left:=GroupBox1.Left+GroupBox1.Width+5; + GroupBoxAcc.Left:=i+12; + GroupBoxCV.Left:=i+12; + GroupBoxTrains.Left:=i+12; + ScrollBoxSig.Left:=i+12; + ScrollBoxSig.width:=GrandPanel.Width-i-20; + Panel1.Left:=GroupBoxAcc.Left+GroupBoxAcc.Width+5; Panel1.top:=9; - GroupBox1.Top:=5; + GroupBoxAcc.Top:=5; Affiche_signaux; - end; end; @@ -13178,10 +13513,10 @@ begin if assigned(cSc) then begin texte:=clBlack; - fond:=Formprinc.ScrollBox1.Color; - for i:=0 to formprinc.ScrollBox1.ComponentCount-1 do + fond:=Formprinc.ScrollBoxSig.Color; + for i:=0 to formprinc.ScrollBoxSig.ComponentCount-1 do begin - c:=formprinc.ScrollBox1.Components[i]; + c:=formprinc.ScrollBoxSig.Components[i]; //Affiche(c.Name,clLime); composant(c,fond,texte); end; @@ -13252,6 +13587,7 @@ begin filtrageDet0:=3; cdmHd:=0; CouleurFond:=$404040 ; + couleurAction:=$606060; // services commIP CDM par défaut Srvc_Aig:=true; @@ -13260,6 +13596,7 @@ begin Srvc_Pos:=false; Srvc_sig:=false; + Z21:=false; DebugAffiche:=false; ConfCellTCO:=false; confasauver:=false; @@ -13268,15 +13605,15 @@ begin Application.onHint:=doHint; // box2=CV - GroupBox2.Left:=633; - GroupBox2.Top:=60; - GroupBox2.Visible:=false; + GroupBoxCV.Left:=633; + GroupBoxCV.Top:=60; + GroupBoxCV.Visible:=false; // box3=vitesses et fonctions F - GroupBox3.Left:=633; - GroupBox3.Top:=60; - GroupBox1.Left:=633; - GroupBox3.visible:=true; - ScrollBox1.Left:=633; + GroupBoxTrains.Left:=633; + GroupBoxTrains.Top:=60; + GroupBoxAcc.Left:=633; + GroupBoxTrains.visible:=true; + ScrollBoxSig.Left:=633; procetape(''); //0 NbreTCO:=0; @@ -13309,9 +13646,10 @@ begin sombre:=false; AvecInit:=true; // &&&& avec initialisation des aiguillages ou pas Diffusion:=AvecInit; // mode diffusion publique + debug mise au point etc + Button1.Visible:=not(avecInit); roulage1.visible:=false; FenRich.MaxLength:=$7FFFFFF0; - NbDecodeur:= 11; + NbDecodeur:=11; NbDecodeurdeBase:=NbDecodeur; Decodeur[0]:='Rien';Decodeur[1]:='Digital Bahn';Decodeur[2]:='CDF';Decodeur[3]:='LS-DEC-SNCF';Decodeur[4]:='LEB'; Decodeur[5]:='Digikeijs 4018';Decodeur[6]:='Unisemaf Paco';Decodeur[7]:='Stéphane Ravaut';Decodeur[8]:='Arcomora'; @@ -13331,6 +13669,8 @@ begin cheminWin:=GetCurrentProcessEnvVar('windir')+'\System32'; end; + //s:=GetCurrentDir; + //Affiche(s,clLime); if FindFirst('*.*', faAnyFile, SR) = 0 then begin repeat @@ -13373,7 +13713,7 @@ begin if OsBits=64 then s:='OS 64 Bits' else s:='OS 32 Bits'; s:=DateToStr(date)+' '+TimeToStr(Time)+' '+s; Affiche(s,clLime); - With ScrollBox1 do + With ScrollBoxSig do begin HorzScrollBar.Tracking:=true; HorzScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si onclique sur la trackbar!! @@ -13381,7 +13721,7 @@ begin VertScrollBar.Smooth:=false; end; - ferme:=false; + fermeSC:=false; CDM_connecte:=false; pasreponse:=0; residuCDM:=''; @@ -13414,6 +13754,7 @@ begin procetape('Lecture de la configuration'); lit_config; + // identifier les écrans n:=Screen.MonitorCount-1; if n>9 then n:=9; for i:=0 to n do @@ -13432,7 +13773,7 @@ begin end; if ecran_sc<1 then ecran_SC:=1; - if Ecran_SC>Screen.MonitorCount then Ecran_SC:=1; + if Ecran_sc>Screen.MonitorCount then Ecran_SC:=1; serveur_ouvert:=true; serverSocket.Port:=PortServeur; @@ -13469,7 +13810,7 @@ begin Application.ProcessMessages; // Initialisation des images des signaux procetape('Création des signaux'); - NbreImagePLigne:=(Formprinc.ScrollBox1.Width div (largImg+5)) -1; + NbreImagePLigne:=(Formprinc.ScrollBoxSig.Width div (largImg+5)) -1; if NbreImagePLigne=0 then NbreImagePLigne:=1; // ajoute les images des signaux dynamiquement @@ -13481,7 +13822,7 @@ begin Tempo_init:=5; // démarre les initialisation des signaux et des aiguillages dans 0,5 s - if debug=1 then Affiche('Création TCO',clLime); + // il faut afficher la fenetre TCO pour l'init aiguillage sinon violation @@ -13513,7 +13854,7 @@ begin left:=5; Align:=AlLeft; // si on ne met pas AlignLeft, alors le splitter n'est pas accrochable top:=5; // par rapport au panel - Width:=GrandPanel.Width-Panel1.Width-GroupBox1.Width-25; + Width:=GrandPanel.Width-Panel1.Width-GroupBoxAcc.Width-25; //height:=formprinc.Height-StatusBar1.Height-StaticText.Height-LabelTitre.Height-90; Anchors:=[akLeft,akTop,akRight,akBottom]; end; @@ -13527,13 +13868,13 @@ begin Visible:=true; end; - with ScrollBox1 do + with ScrollBoxSig do begin Parent:=GrandPanel; Anchors:=[akTop,akRight,akBottom]; width:=GrandPanel.Width-SplitterV.Width-5; - height:=GrandPanel.Height-groupBox3.height-groupBox3.top-10; - top:=GroupBox3.Top+GroupBox3.Height+5; + height:=GrandPanel.Height-GroupBoxTrains.height-GroupBoxTrains.top-10; + top:=GroupBoxTrains.Top+GroupBoxTrains.Height+5; end; positionne_elements(splitterV.left); end; @@ -13552,6 +13893,7 @@ begin formPrinc.Top:=(Ecran[Ecran_sc].haut div 2)-(formprinc.height div 2)+Ecran[Ecran_sc].y0; if fenetre=1 then Formprinc.windowState:=wsMaximized ; + if debug=1 then Affiche('Création TCO',clLime); for index:=1 to nbreTCO do begin tcoCree:=false; @@ -13592,7 +13934,7 @@ begin couleurs_princ; if debug=1 then Affiche('Initialisations',clLime); - raz_tout; + procetape('Début des init'); I_Simule:=0; tick:=0; @@ -13655,7 +13997,7 @@ begin if AvecInit then begin - if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then + if not(ConfigNulle) and not(fermeSC) and (AvecInitAiguillages) then begin if maxaiguillage>0 then begin @@ -13664,7 +14006,7 @@ begin end; end; - if not(AvecInitAiguillages) and not(ferme) and (parSocketLenz or portCommOuvert) + if not(AvecInitAiguillages) and not(fermeSC) and (parSocketLenz or portCommOuvert) and AvecDemandeAiguillages then begin procetape('Demande etats accessoires'); @@ -13672,13 +14014,13 @@ begin end; //Menu_interface(valide); end; - - { + raz_tout; + { //DoubleBuffered:=true; aiguillage[index_aig(1)].position:=const_devie; aiguillage[index_aig(2)].position:=const_droit; aiguillage[index_aig(3)].position:=const_droit; - aiguillage[index_aig(4)].position:=const_devie; + aiguillage[index_aig(4)].position:=const_droit; aiguillage[index_aig(5)].position:=const_droit; aiguillage[index_aig(6)].position:=const_devie; aiguillage[index_aig(7)].position:=const_devie; @@ -13699,35 +14041,9 @@ begin aiguillage[index_aig(31)].position:=const_devie; aiguillage[index_aig(25)].position:=const_droit; aiguillage[index_aig(9)].position:=const_droit; - // zone_tco(1,519,527,1); - // zone_tco(1,521,527,2); - { - Event_Detecteur(524,true,'A'); - Event_Detecteur(524,false,'A'); - Event_Detecteur(521,true,'A'); - Event_Detecteur(521,false,'A'); + } - Event_Detecteur(527,true,'A'); - Event_Detecteur(527,false,'A'); - aiguillage[index_aig(7)].position:=const_devie; - } - //zone_TCO(1,560,562,1); - - //zone_TCO_V2(1,527,519,1); - - // Event_Detecteur(524,true,'B'); - //(524,false,'B'); - - // Event_Detecteur(521,true,'B'); - // Event_Detecteur(521,false,'B'); - // roulage:=true; - { formatY:=2; - ‹y 00001010000101000111010000> format 0 - // ‹y 0A0147405801CE..40› format 1 quartets renversés - // ‹y XXXXX......› (hexa pur) format 2 - - decode_chaine_retro_dcc(''); } procetape('Terminé !!'); if debug=1 then Affiche('Positionnement des signaux',clLime); Maj_Signaux(false); @@ -13796,7 +14112,6 @@ begin if protocole=1 then AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+chaine_Hex(chaine_recue),Clwhite); if protocole=2 then AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+chaine_recue,Clwhite); end; - //if terminal then Affiche(chaine_recue,clLime); chaine_recue:=interprete_reponse(chaine_recue); end; end; @@ -13804,7 +14119,23 @@ end; procedure TFormPrinc.FormClose(Sender: TObject; var Action: TCloseAction); var i,res : integer; begin - Ferme:=true; + if TCO_modifie then + begin + res:=MessageDlg('Un des TCO a été modifié. Voulez-vous les sauvegarder ?',mtConfirmation,[mbYes,mbNo,mbCancel],0); + if res=mrYes then sauve_fichiers_tco; + if res=mrCancel then abort; + end; + if config_modifie then + begin + res:=MessageDlg('La configuration a été modifiée. Voulez-vous la sauvegarder ?',mtConfirmation,[mbYes,mbNo,mbCancel],0); + if res=mrYes then sauve_config; + if res=mrCancel then abort; + end; + if confasauver then sauve_config; + if sauve_tco then sauve_fichiers_tco; + + timer1.Enabled:=false; + FermeSC:=true; if portCommOuvert then begin @@ -13820,28 +14151,12 @@ begin ServerSocket.Close; ClientSocketCDM.close; ClientSocketInterface.close; - timer1.Enabled:=false; - if TCO_modifie then - begin - res:=MessageDlg('Un des TCO a été modifié. Voulez-vous les sauvegarder ?',mtConfirmation,[mbYes,mbNo,mbCancel],0); - if res=mrYes then sauve_fichiers_tco; - if res=mrCancel then abort; - end; - if config_modifie then - begin - res:=MessageDlg('La configuration a été modifiée. Voulez-vous la sauvegarder ?',mtConfirmation,[mbYes,mbNo,mbCancel],0); - if res=mrYes then sauve_config; - if res=mrCancel then abort; - end; - if confasauver then sauve_config; - if sauve_tco then sauve_fichiers_tco; - //Application.ProcessMessages; end; // timer à 100 ms procedure TFormPrinc.Timer1Timer(Sender: TObject); var i,a,adresse,TailleX,TailleY,orientation,indexTCO,x,y,Bimage,aspect : integer; - imageFeu : Timage; + imageSignal : Timage; frx,fry : real; faire : boolean; s : string; @@ -13925,7 +14240,7 @@ begin end; end; - // signaux du TCO----------------------------------------------- + // signaux des TCO----------------------------------------------- if TCOActive then // évite d'accéder aux variables FormTCO si la form n'est pas encore ouverte begin for IndexTCO:=1 to NbreTCO do @@ -13956,17 +14271,17 @@ begin begin aspect:=Signaux[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; - else ImageFeu:=Formprinc.Image3feux; + 2 : ImageSignal:=Formprinc.Image2feux; + 3 : ImageSignal:=Formprinc.Image3feux; + 4 : ImageSignal:=Formprinc.Image4feux; + 5 : ImageSignal:=Formprinc.Image5feux; + 7 : ImageSignal:=Formprinc.Image7feux; + 9 : ImageSignal:=Formprinc.Image9feux; + else ImageSignal:=Formprinc.Image3feux; end; - TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) - TailleX:=ImageFeu.picture.BitMap.Width; + TailleY:=ImageSignal.picture.BitMap.Height; // taille du feu d'origine (verticale) + TailleX:=ImageSignal.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]); @@ -14229,13 +14544,13 @@ begin end; // lecture depuis socket interface -procedure TFormPrinc.ClientSocketInterfaceRead(Sender: TObject; - Socket: TCustomWinSocket); +procedure TFormPrinc.ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); var s : string; begin s:=ClientSocketInterface.Socket.ReceiveText; if traceTrames then afficheDebug(chaine_hex(s),clWhite); - interprete_reponse(s); + chaine_recue:=chaine_recue+s; + chaine_recue:=interprete_reponse(chaine_recue); end; // procédure Event appelée si on clique sur un checkbox de demande de feu blanc des images des feux @@ -14577,18 +14892,18 @@ begin demande_etat_det; if AvecInit then begin - if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then + if not(ConfigNulle) and not(fermeSC) and (AvecInitAiguillages) then begin Affiche('Positionnement des signaux',clYellow); init_aiguillages; // initialisation des aiguillages - envoi_signauxCplx; // initialisation des signaux end; - if not(AvecInitAiguillages) and not(ferme) and (parSocketLenz or portCommOuvert) + if not(AvecInitAiguillages) and not(fermeSC) and (parSocketLenz or portCommOuvert) and AvecDemandeAiguillages then begin procetape('demande etats accessoires'); demande_etat_acc; // demande l'état des accessoires (position des aiguillages) end; + envoi_signauxCplx; // initialisation des signaux end; end; if not(trouve) then ClientSocketInterface.Close; @@ -15065,8 +15380,7 @@ begin Delete(commandeCDM,i,l-i+1); end; - if AffAigDet then - AfficheDebug('Actionneur AD='+intToSTR(adr)+' Nom='+nom+' Train='+train+' Etat='+IntToSTR(etat),clyellow); + if AffAigDet then AfficheDebug('Actionneur AD='+intToSTR(adr)+' Nom='+nom+' Train='+train+' Etat='+IntToSTR(etat),clyellow); Event_act(adr,0,etat,train); // déclenche évent actionneur end; @@ -15320,7 +15634,7 @@ end; procedure TFormPrinc.ConnecterCDMrailClick(Sender: TObject); begin - connecte_CDM; + if not(connecte_CDM) then affiche('CDM Rail non connecté',clorange); end; procedure TFormPrinc.DeconnecterCDMRailClick(Sender: TObject); @@ -15341,14 +15655,13 @@ begin for i:=1 to NbreSignaux do begin - // signal de signalisation s:=IntToSTR(i)+' i='+intToSTR(tablo_index_signal[Signaux[i].Adresse])+' Adr='+IntToSTR(Signaux[i].Adresse); s:=s+' décodeur='+IntToStr(Signaux[i].decodeur); asp:=Signaux[i].aspect; if asp<>20 then nation:=1 else nation:=2; // non directionnel - if (asp<10) or (asp>=20) then + if not(isDirectionnel(i)) then begin l:=Signaux[i].aspect; if asp=20 then l:=5; @@ -15406,7 +15719,7 @@ begin s:=s+IntToSTR(d)+' '; end; inc(k); - until (d=0) or (k=Mtd); + until (d=0) or (k=Mtd); end @@ -15962,8 +16275,9 @@ procedure TFormPrinc.Proprits1Click(Sender: TObject); var s: string; begin clicliste:=false; - s:=((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; // nom du composant, pout récupérer l'index du signal (ex: ImageFeu2) - //Affiche(s,clOrange); // nom de l'image du signal (ex: ImageFeu2) + if affEvt then Affiche('Clic propriétés',clYellow); + s:=((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; // nom du composant, pour récupérer l'index du signal (ex: ImageSignal2) + //Affiche(s,clOrange); // nom de l'image du signal (ex: ImageSignal) IndexSignalClic:=extract_int(s); // extraire l'adresse (ex 2) formconfig.PageControl.ActivePage:=formconfig.TabSheetSig; clicproprietes:=true; @@ -16105,8 +16419,9 @@ procedure TFormPrinc.Informationsdusignal1Click(Sender: TObject); var s: string; i,adresse : integer; begin + if affEvt then Affiche('clic Informationsdusignal',clYellow); clicliste:=false; - s:=((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; // nom du composant, pout récupérer l'adresse du signal (ex: ImageFeu260) + s:=((Tpopupmenu(Tmenuitem(sender).GetParentMenu).PopupComponent) as TImage).name; // nom du composant, pout récupérer l'adresse du signal (ex: ImageSignal2) //Affiche(s,clOrange); // nom de l'image du signal (ex: ImageSignak2) i:=extract_int(s); // extraire l'index (ex 2) adresse:=Signaux[i].adresse; @@ -16150,8 +16465,8 @@ end; procedure TFormPrinc.ButtonLocCVClick(Sender: TObject); begin - if groupBox3.Visible then begin groupBox3.Visible:=false;groupBox2.Visible:=true;exit;end - else begin groupBox2.Visible:=false;groupBox3.Visible:=true;end; + if GroupBoxTrains.Visible then begin GroupBoxTrains.Visible:=false;GroupBoxCV.Visible:=true;exit;end + else begin GroupBoxCV.Visible:=false;GroupBoxTrains.Visible:=true;end; end; procedure TFormPrinc.ComboTrainsChange(Sender: TObject); @@ -16170,9 +16485,9 @@ var erreur,fonction,etat,loco : integer; s : string; begin val(editNumFonction.Text,fonction,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (fonction<1) then exit; val(editFonc01.Text,etat,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (etat<0) then exit; if not(portCommOuvert) and not(parSocketLenz) and not(CDM_connecte) then exit; val(editAdrTrain.Text,loco,erreur); s:=trains[combotrains.itemindex+1].nom_train; @@ -16378,11 +16693,14 @@ end; procedure TFormPrinc.Button1Click(Sender: TObject); var s : string; begin - s:=#$46+#$43+#$40+#$41+#$40+#$40+#$49+#$4D+#$FF; - decode_chaine_retro_Xpress(s); + debugTCO:=true; + zone_TCO(2,513,514,1,1); + Affiche('513-514',clYellow); + //reserve_dereserve_det(530,534,1,2,1); end; + procedure affiche_com(s : string;var n : integer); var i : integer; begin @@ -16398,6 +16716,7 @@ begin end; end; +// informations sur les ports série/usb disponibles procedure GetWin32_SerialPortInfo; const WbemUser=''; @@ -16416,8 +16735,8 @@ begin // 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 + // requete 1 pour les com natifs ------------------ + FWbemObjectSet:=FWMIService.ExecQuery('SELECT * FROM Win32_SerialPort','WQL',wbemFlagForwardOnly); oEnum:=IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant; while oEnum.Next(1,FWbemObject,iValue)=0 do @@ -16432,8 +16751,8 @@ begin end; 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 + // requete 2 pour les com sur usb ------------------- + FWbemObjectSet:=FWMIService.ExecQuery('SELECT * FROM Win32_PnPEntity WHERE ConfigManagerErrorCode = 0','WQL',wbemFlagForwardOnly); oEnum:=IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant; i:=0; @@ -16470,7 +16789,7 @@ procedure TFormPrinc.Evenementsdetecteurspartrain1Click(Sender: TObject); var i,j,train,pos : integer; s : string; begin - Affiche('Evenements tous détecteurs',clwhite); + Affiche('Evenements tous détecteurs et aiguillages',clwhite); Affiche(' ',clyellow); for i:=0 to n_trains do begin @@ -16494,6 +16813,7 @@ begin end; Affiche(s,couleur); end; + if event_det_tick[i].modele=aig then begin s:='Aiguillage '+intToSTR(event_det_tick[i].adresse)+' '; @@ -16519,8 +16839,8 @@ begin Affiche_tco(i); end; -procedure TFormPrinc.SBMarcheArretLocoClick(Sender: TObject); -var i,adr : integer; +procedure stop_trains; +var i,adr : integer; begin for i:=1 to Ntrains do begin @@ -16531,6 +16851,11 @@ begin vitesse_loco('',i,adr,0,not(placement[i].inverse),true); end; end; +end; + +procedure TFormPrinc.SBMarcheArretLocoClick(Sender: TObject); +begin + stop_trains; end; procedure TFormPrinc.EditAdrTrainChange(Sender: TObject); @@ -16539,7 +16864,7 @@ procedure TFormPrinc.EditAdrTrainChange(Sender: TObject); if clicComboTrain then exit; clicAdrTrain:=true; val(editAdrTrain.Text,adr,erreur); - if (erreur=0) then + if (erreur=0) and (adr>0) then begin i:=index_train_adresse(adr); comboTrains.ItemIndex:=i-1; @@ -16680,7 +17005,7 @@ begin for i:=1 to NbreTCO do begin e:=ECranTCO[i]; // écran du tco i - if (e>=1) and (e<=10) then inc(nbTCOE[e]); //nbTCOE[2]=3 signifie que l'écran 2 contient 3 TCO + if (e>=1) and (e<=10) then inc(nbTCOE[e]); //nbTCOE[2]=3 signifie que l'écran 2 contient 3 TCOs end; NombreEcrans:=Screen.MonitorCount; @@ -16708,13 +17033,16 @@ begin TopEcran:=ecran[e].y0; LeftEcran:=ecran[e].x0; largTCO:=largEcran ; - HautTCO:=HautEcran div NbTCOE[e];; + HautTCO:=(HautEcran div NbTCOE[e]); + + //Affiche(intToSTR(leftEcran),clred); with formtco[i] do begin Top:=((CeTCO[e]-1)*HautTCO)+Topecran; + //if i>1 then top:=formTCO[i-1].Top+formTCO[i-1].Height else top:=topEcran; Left:=leftECran; - width:=largTCO+8; + width:=largTCO; height:=HautTCO; windowState:=wsNormal; show; @@ -16966,6 +17294,7 @@ begin formTCO[i].show; // on est obligé d'afficher la fenetre TCO pour provoquer OnActivate pour valider les pointeurs + application.ProcessMessages; formTCO[i].Left:=Ecran[e].x0; formTCO[i].Top:=Ecran[e].y0; formTCO[i].BringToFront; @@ -17029,9 +17358,20 @@ end; // mise à jour des menus TCO en fonction du nombre i de TCO Procedure Menu_tco(i : integer); +var j : integer; begin with formprinc do begin + if i>=1 then AfficherTCO11.Caption:='Afficher TCO1 : '+NomfichierTCO[1]; + if i>=2 then AfficherTCO21.Caption:='Afficher TCO2 : '+NomfichierTCO[2]; + if i>=3 then AfficherTCO31.Caption:='Afficher TCO3 : '+NomfichierTCO[3]; + if i>=4 then AfficherTCO41.Caption:='Afficher TCO4 : '+NomfichierTCO[4]; + if i>=5 then AfficherTCO51.Caption:='Afficher TCO5 : '+NomfichierTCO[5]; + if i>=6 then AfficherTCO61.Caption:='Afficher TCO6 : '+NomfichierTCO[6]; + if i>=7 then AfficherTCO71.Caption:='Afficher TCO7 : '+NomfichierTCO[7]; + if i>=8 then AfficherTCO81.Caption:='Afficher TCO8 : '+NomfichierTCO[8]; + if i>=9 then AfficherTCO91.Caption:='Afficher TCO9 : '+NomfichierTCO[9]; + if i>=10 then AfficherTCO101.Caption:='Afficher TCO10 : '+NomfichierTCO[10]; if i=0 then begin AfficherTCO11.Enabled:=false; @@ -17444,7 +17784,7 @@ end; procedure TFormPrinc.Affichagenormal1Click(Sender: TObject); begin - FenRich.Width:=GrandPanel.Width-Panel1.Width-GroupBox1.Width-25; + FenRich.Width:=GrandPanel.Width-Panel1.Width-GroupBoxAcc.Width-25; splitterV.Left:=FenRich.left+FenRich.Width-5; positionne_elements(splitterV.Left); end; @@ -17585,8 +17925,7 @@ begin end; end; -procedure TFormPrinc.ClientSocketCde1Connect(Sender: TObject; - Socket: TCustomWinSocket); +procedure TFormPrinc.ClientSocketCde1Connect(Sender: TObject;Socket: TCustomWinSocket); begin Affiche('Socket '+ClientSocketCde1.Address+':'+intToSTR(ClientSocketCde1.port)+' connecté ',clYellow); end; @@ -17628,6 +17967,7 @@ procedure TFormPrinc.ClientSocketCde2Error(Sender: TObject; var s : string; begin s:='Erreur '+IntToSTR(ErrorCode)+' socket '+ClientSocketCde2.Address+':'+intToSTR(ClientSocketCde2.port); + case ErrorCode of 10053 : s:=s+': Connexion avortée - Timeout'; 10054 : s:=s+': Connexion avortée par un tiers'; @@ -17727,6 +18067,11 @@ end; begin + + + + + end. diff --git a/UnitSR.dfm b/UnitSR.dfm index ebae55a..4c9b9e0 100644 --- a/UnitSR.dfm +++ b/UnitSR.dfm @@ -3,7 +3,7 @@ object FormSR: TFormSR Top = 73 BorderStyle = bsDialog Caption = 'Configuration du d'#233'codeur du signal St'#233'phane Ravaut' - ClientHeight = 562 + ClientHeight = 540 ClientWidth = 475 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -18,21 +18,21 @@ object FormSR: TFormSR TextHeight = 13 object LabelAdrSR1: TLabel Left = 24 - Top = 64 + Top = 72 Width = 63 Height = 13 Caption = 'LabelAdrSR1' end object Label1: TLabel Left = 120 - Top = 48 + Top = 56 Width = 15 Height = 13 Caption = '+ 2' end object Label2: TLabel Left = 120 - Top = 72 + Top = 80 Width = 12 Height = 13 Caption = '- 1' @@ -78,33 +78,33 @@ object FormSR: TFormSR end object Shape1: TShape Left = 16 - Top = 96 + Top = 104 Width = 409 Height = 1 end object LabelAdrSR2: TLabel Left = 24 - Top = 120 + Top = 128 Width = 63 Height = 13 Caption = 'LabelAdrSR2' end object Label7: TLabel Left = 120 - Top = 104 + Top = 112 Width = 15 Height = 13 Caption = '+ 2' end object Label8: TLabel Left = 120 - Top = 128 + Top = 136 Width = 12 Height = 13 Caption = '- 1' end object Label6: TLabel - Left = 336 + Left = 344 Top = 24 Width = 21 Height = 16 @@ -118,56 +118,56 @@ object FormSR: TFormSR end object LabelCV1: TLabel Left = 320 - Top = 48 + Top = 56 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV2: TLabel Left = 384 - Top = 48 + Top = 56 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV3: TLabel Left = 320 - Top = 72 + Top = 80 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV4: TLabel Left = 384 - Top = 72 + Top = 80 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV5: TLabel Left = 320 - Top = 110 + Top = 118 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV6: TLabel Left = 384 - Top = 110 + Top = 118 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV7: TLabel Left = 320 - Top = 134 + Top = 142 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV8: TLabel Left = 384 - Top = 134 + Top = 142 Width = 20 Height = 13 Caption = 'CV=' @@ -449,55 +449,55 @@ object FormSR: TFormSR end object Shape7: TShape Left = 16 - Top = 448 + Top = 440 Width = 409 Height = 1 end object LabelAdrSR8: TLabel Left = 24 - Top = 472 + Top = 464 Width = 63 Height = 13 Caption = 'LabelAdrSR2' end object Label20: TLabel Left = 120 - Top = 456 + Top = 448 Width = 15 Height = 13 Caption = '+ 2' end object Label21: TLabel Left = 120 - Top = 480 + Top = 472 Width = 12 Height = 13 Caption = '- 1' end object LabelCV29: TLabel Left = 320 - Top = 460 + Top = 452 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV30: TLabel Left = 384 - Top = 460 + Top = 452 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV31: TLabel Left = 320 - Top = 484 + Top = 476 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV32: TLabel Left = 384 - Top = 484 + Top = 476 Width = 20 Height = 13 Caption = 'CV=' @@ -511,7 +511,7 @@ object FormSR: TFormSR end object ComboBoxAdr1: TComboBox Left = 160 - Top = 48 + Top = 56 Width = 145 Height = 21 Style = csDropDownList @@ -521,7 +521,7 @@ object FormSR: TFormSR end object ComboBoxAdr2: TComboBox Left = 160 - Top = 72 + Top = 80 Width = 145 Height = 21 Style = csDropDownList @@ -531,7 +531,7 @@ object FormSR: TFormSR end object ComboBoxAdr3: TComboBox Left = 160 - Top = 104 + Top = 112 Width = 145 Height = 21 Style = csDropDownList @@ -541,7 +541,7 @@ object FormSR: TFormSR end object ComboBoxAdr4: TComboBox Left = 160 - Top = 128 + Top = 136 Width = 145 Height = 21 Style = csDropDownList @@ -651,7 +651,7 @@ object FormSR: TFormSR end object ComboBoxAdr15: TComboBox Left = 160 - Top = 456 + Top = 448 Width = 145 Height = 21 Style = csDropDownList @@ -661,7 +661,7 @@ object FormSR: TFormSR end object ComboBoxAdr16: TComboBox Left = 160 - Top = 480 + Top = 472 Width = 145 Height = 21 Style = csDropDownList @@ -670,8 +670,8 @@ object FormSR: TFormSR OnChange = ComboBoxAdr16Change end object BitBtnok: TBitBtn - Left = 16 - Top = 520 + Left = 24 + Top = 504 Width = 75 Height = 25 TabOrder = 16 diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 55354d1..e8540b1 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,8 +1,8 @@ object FormTCO: TFormTCO - Left = 73 - Top = 79 - Width = 1212 - Height = 661 + Left = 114 + Top = 116 + Width = 1218 + Height = 594 VertScrollBar.Visible = False Caption = 'c' Color = clBtnFace @@ -24,13 +24,13 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1196 - 602) + 1210 + 543) PixelsPerInch = 96 TextHeight = 13 object LabelZoom: TLabel - Left = 1167 - Top = 3 + Left = 1168 + Top = 0 Width = 32 Height = 13 Anchors = [akTop, akRight] @@ -43,24 +43,24 @@ object FormTCO: TFormTCO ParentFont = False end object ImageTemp: TImage - Left = 1020 - Top = 3 + Left = 1021 + Top = 0 Width = 121 Height = 121 Anchors = [akTop, akRight] end object ImageTemp2: TImage - Left = 1019 - Top = 132 + Left = 1020 + Top = 129 Width = 121 Height = 121 Anchors = [akTop, akRight] end object ScrollBox: TScrollBox - Left = 10 - Top = 15 - Width = 687 - Height = 410 + Left = 8 + Top = 12 + Width = 690 + Height = 347 HorzScrollBar.Smooth = True HorzScrollBar.Tracking = True VertScrollBar.Smooth = True @@ -71,13 +71,13 @@ object FormTCO: TFormTCO ParentColor = False TabOrder = 1 DesignSize = ( - 683 - 406) + 686 + 343) object ImageTCO: TImage Left = 120 Top = 41 - Width = 486 - Height = 320 + Width = 489 + Height = 257 Anchors = [akLeft, akTop, akRight, akBottom] AutoSize = True ParentShowHint = False @@ -91,8 +91,8 @@ object FormTCO: TFormTCO end end object TrackBarZoom: TTrackBar - Left = 1157 - Top = 18 + Left = 1166 + Top = 15 Width = 41 Height = 311 Anchors = [akTop, akRight] @@ -108,9 +108,9 @@ object FormTCO: TFormTCO OnChange = TrackBarZoomChange end object PanelBas: TPanel - Left = 2 - Top = 461 - Width = 1199 + Left = 0 + Top = 395 + Width = 1202 Height = 140 Anchors = [akLeft, akRight, akBottom] Color = clActiveBorder @@ -123,7 +123,7 @@ object FormTCO: TFormTCO TabOrder = 2 OnDragOver = PanelBasDragOver DesignSize = ( - 1199 + 1202 140) object Label1: TLabel Left = 240 @@ -906,7 +906,7 @@ object FormTCO: TFormTCO ParentFont = False end object ButtonSauveTCO: TButton - Left = 1090 + Left = 1093 Top = 8 Width = 96 Height = 33 @@ -918,7 +918,7 @@ object FormTCO: TFormTCO OnClick = ButtonSauveTCOClick end object ButtonConfigTCO: TButton - Left = 1090 + Left = 1093 Top = 48 Width = 96 Height = 33 @@ -929,7 +929,7 @@ object FormTCO: TFormTCO OnClick = ButtonConfigTCOClick end object ButtonSimu: TButton - Left = 878 + Left = 881 Top = 80 Width = 113 Height = 25 @@ -939,18 +939,6 @@ object FormTCO: TFormTCO TabStop = False OnClick = ButtonSimuClick end - object ButtonMasquer: TButton - Left = 1090 - Top = 88 - Width = 96 - Height = 33 - Anchors = [akTop, akRight] - Caption = 'Masquer bandeau' - TabOrder = 3 - TabStop = False - WordWrap = True - OnClick = ButtonMasquerClick - end object GroupBox1: TGroupBox Left = 8 Top = 3 @@ -963,7 +951,7 @@ object FormTCO: TFormTCO Font.Name = 'Arial Narrow' Font.Style = [] ParentFont = False - TabOrder = 4 + TabOrder = 3 object Label41: TLabel Left = 72 Top = 18 @@ -1134,30 +1122,30 @@ object FormTCO: TFormTCO end end object buttonRaz: TButton - Left = 987 + Left = 1094 Top = 88 Width = 97 Height = 33 Anchors = [akTop, akRight] Caption = 'Raz des occupations' - TabOrder = 5 + TabOrder = 4 TabStop = False WordWrap = True OnClick = buttonRazClick end object ButtonCalibrage: TButton - Left = 918 + Left = 921 Top = 56 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = 'Calibrage' - TabOrder = 6 + TabOrder = 5 TabStop = False OnClick = ButtonCalibrageClick end object ButtonDessiner: TButton - Left = 987 + Left = 990 Top = 48 Width = 97 Height = 33 @@ -1168,24 +1156,24 @@ object FormTCO: TFormTCO Caption = 'Dessiner le TCO' ParentShowHint = False ShowHint = True - TabOrder = 7 + TabOrder = 6 TabStop = False OnClick = ButtonDessinerClick end object ButtonAffSC: TButton - Left = 987 + Left = 990 Top = 8 Width = 97 Height = 33 Anchors = [akTop, akRight] Caption = 'Afficher Signaux Complexes' - TabOrder = 8 + TabOrder = 7 TabStop = False WordWrap = True OnClick = ButtonAffSCClick end object RadioGroupSel: TRadioGroup - Left = 839 + Left = 842 Top = 8 Width = 138 Height = 49 @@ -1200,7 +1188,7 @@ object FormTCO: TFormTCO 'Cellules s'#233'lectionn'#233'es' 'fen'#234'tre d'#233'pla'#231'able') ParentFont = False - TabOrder = 9 + TabOrder = 8 OnClick = RadioGroupSelClick end end diff --git a/UnitTCO.pas b/UnitTCO.pas index 83c36c4..a246ac6 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -48,7 +48,6 @@ type Label18: TLabel; Label19: TLabel; Label20: TLabel; - ButtonMasquer: TButton; Label21: TLabel; Label22: TLabel; Label51: TLabel; @@ -489,7 +488,7 @@ type 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 + buttoir : integer; // définition des buttoirs : si le bit n°n est à 1 : buttoir sortie : integer; // si action sortie : état end; @@ -516,7 +515,8 @@ var AncienXClicCell,AncienYClicCell,TCODrag,epaisseur_voies,Ax,Ay,TpsBougeSouris, Epaisseur,oldX,oldY,offsetSourisY,offsetSourisX,AvecVerifIconesTCO,indexTrace,IndexTCOCourant, ancienTraceX,ancienTraceY,rangUndo,NbreTCO,IndexTCOCreate,deltaXrect,deltaYrect, - CellX,CellY,AncienXclic,AncienYclic,xCadre1,yCadre1,xCadre2,yCadre2,colonne_supprime : integer; + CellX,CellY,AncienXclic,AncienYclic,xCadre1,yCadre1,xCadre2,yCadre2,colonne_supprime, + couleurAction : integer; titre_Fonte,s90,s91,s93,s94,s100,s101 : string; @@ -617,7 +617,7 @@ var s : string; 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; @@ -1862,7 +1862,6 @@ begin y0:=(y-1)*hauteurCell[indexTCO]; //PCanvasTCO.Brush.Style:=bsSolid; s:=tco[indextco,x,y].Texte; -// if s='' then exit; c:=PcanvasTCO[indextco]; @@ -1885,7 +1884,7 @@ begin if taillefont=0 then taillefont:=8; tf:=(taillefont*LargeurCell[indexTCO]) div 40; c.font.Size:=tf; - if b=id_action then c.Brush.Color:=ClGray; + if b=id_action then c.Brush.Color:=couleurAction; //affiche(intToSTR(taillefont*LargeurCell[indexTCO] div 40),clyellow); // champ texte //Affiche(nf+' '+intToSTR(tf)+' '+s,clred); @@ -1894,7 +1893,7 @@ begin 2 : yt:=1; // haut 3 : yt:=hauteurCell[indexTCO]-round(2*TailleFont*fryGlob[indexTCO]); // bas 5 : begin // double centré XY - xt:=(largeurCell[indexTCO] div 2)-(round(length(s)*(taillefont)*frxGlob[indexTCO]) div 2); + xt:=(largeurCell[indexTCO] div 2)-(round(length(s)*(taillefont)*frxGlob[indexTCO]) div 2)-1; yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // texte centré end; end; @@ -5040,7 +5039,7 @@ begin end; // Element 51 (quai) -procedure dessin_51(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); +procedure dessin_Quai(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,x1,x2,jy1,jy2 : integer; r : Trect; begin @@ -5067,7 +5066,7 @@ begin end; // action -procedure dessin_52(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); +procedure dessin_Action(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xf,yf,act : integer; r : Trect; s : string; @@ -5081,7 +5080,7 @@ begin begin Pen.Width:=1; - Brush.Color:=clGray; + Brush.Color:=couleurAction; pen.color:=clwhite; r:=rect(x0,y0,xf,yf); @@ -5123,7 +5122,13 @@ begin tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; end; - + if act=5 then + begin + if s='' then s:='STOP'; + tco[indexTCO,x,y].texte:=s; + tco[indexTCO,x,y].TailleFonte:=8; + tco[indexTCO,x,y].FontStyle:='G'; + end; //tf:=(tco[indexTCO,x,y].TailleFonte*LargeurCell[indexTCO]) div 40; //tf:=(8*LargeurCell[indexTCO]) div 40;; @@ -8369,8 +8374,8 @@ begin 34 : dessin_34(indexTCO,PCanvasTCO,X,Y,mode); Id_signal : dessin_Signal(indexTCO,PCanvasTCO,X,Y); - Id_Quai : dessin_51(indexTCO,PCanvasTCO,X,Y,mode); - Id_action : dessin_52(indexTCO,PCanvasTCO,X,Y,mode); + Id_Quai : dessin_Quai(indexTCO,PCanvasTCO,X,Y,mode); + Id_action : dessin_Action(indexTCO,PCanvasTCO,X,Y,mode); end; end; @@ -8384,6 +8389,8 @@ var i,index,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied,AdrTr : inverse : boolean; s : string; begin + if indexTCO=0 then exit; + if PcanvasTCO[indexTCO]=nil then exit; if tco[indextco,x,y].BImage=0 then exit; //Affiche('Affiche_cellule',clLime); PcanvasTCO[indexTCO].pen.Mode:=PmCopy; @@ -8811,6 +8818,8 @@ var s : string; begin if affevt or (debug=1) then Affiche('FormTCO'+intToSTR(indexTCOCreate)+' create',clLime); //Screen.OnActiveControlChange := ActiveControlChanged; + visible:=false; // ne s'affiche pas par défaut et évite l'effet fenetre fantome. + offsetSourisY:=-10; // permet de tenir l'icone au milieu quand on fait un glisser offsetSourisX:=-10; RadioGroupSel.ItemIndex:=0; @@ -8828,7 +8837,6 @@ begin TrackBarZoom.Tabstop:=false; // permet d'avoir les evts curseurs ButtonSauveTCO.TabStop:=false; ButtonConfigTCO.TabStop:=false; - Buttonmasquer.TabStop:=false; ButtonRaz.TabStop:=false; ButtonDessiner.TabStop:=false; //TrackBarZoom.position:=78; @@ -8864,8 +8872,6 @@ begin ImagePalette7.Hint:=s;ImagePalette7.ShowHint:=true; ImagePalette8.Hint:=s;ImagePalette8.ShowHint:=true; ImagePalette9.Hint:=s;ImagePalette9.ShowHint:=true; - ImagePalette10.Hint:=s;ImagePalette10.ShowHint:=true; - ImagePalette11.Hint:=s;ImagePalette11.ShowHint:=true; ImagePalette16.Hint:=s;ImagePalette16.ShowHint:=true; ImagePalette17.Hint:=s;ImagePalette17.ShowHint:=true; ImagePalette18.Hint:=s;ImagePalette18.ShowHint:=true; @@ -8873,11 +8879,9 @@ begin s:='Voie pouvant porter un détecteur ou buttoir'; ImagePalette1.Hint:=s;ImagePalette1.ShowHint:=true; - ImagePalette20.Hint:=s;ImagePalette20.ShowHint:=true; - - s:='Voie ou buttoir'; ImagePalette10.Hint:=s;ImagePalette10.ShowHint:=true; ImagePalette11.Hint:=s;ImagePalette11.ShowHint:=true; + ImagePalette20.Hint:=s;ImagePalette20.ShowHint:=true; s:='Aiguillage'; ImagePalette2.Hint:=s;ImagePalette2.ShowHint:=true; @@ -9007,14 +9011,30 @@ 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 + if debugTCO then + begin + if ir<>0 then + begin + x:=Trace_Train[indexTCO].Train[train].route[1].x; + y:=Trace_Train[indexTCO].Train[train].route[1].y; + ax:=Trace_Train[indexTCO].Train[train].route[ir].x; + ay:=Trace_Train[indexTCO].Train[train].route[ir].y; + end; + //AfficheDebug('Affiche_trajet TCO'+intToSTR(indexTCO)+' '+intToSTR(x)+','+intToSTR(y)+' à '+intToSTR(ax)+','+intToSTR(ay)+' mode='+intToSTR(mode),clOrange); + end; for i:=1 to ir do begin x:=Trace_Train[indexTCO].Train[train].route[i].x; y:=Trace_Train[indexTCO].Train[train].route[i].y; + { if debugTCO then + begin + AfficheDebug('x='+intToSTR(x)+' y='+intToSTR(y),clYellow); + end; } + tco[Indextco,x,y].mode:=mode; //mode; // pour la couleur TCO[IndexTCO,x,y].train:=index_couleur; // = numéro du train - //Affiche(intToSTR(x)+' '+intToSTR(y),clorange); + //Affiche(intToSTR(x)+' '+intToSTR(y),clorange); bimage:=tco[indextco,x,y].BImage; adresse:=tco[indextco,x,y].Adresse; @@ -9100,16 +9120,16 @@ begin end; end; - // allume ou éteint (mode=0 ou 1) la voie du train "train", zone de det1 à det2 sur le TCO // det1 et det2 doivent être consécutifs sur le TCO, mais peuvent être séparés par des aiguillages // si mode=0 : éteint // =1 : couleur détecteur allumé -// =2 : couleur de l'index train +// =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 en pointe pour explorer les éléments opposés 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; +var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteration,indexIr, + sx,sy,position : integer; memtrouve,sortir,casok,indextrouve : boolean; s : string; @@ -9139,15 +9159,17 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio 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,train : integer; ir : integer); var mdl : Tequipement; - i,j :integer; - sortir : boolean; + i,j,index :integer; + posAig : boolean; begin + posAig:=true; // répète la route depuis un aiguillage inc(iteration); if DebugTCO then AfficheDebug('El_TCO',clorange); @@ -9156,6 +9178,16 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio repeat maj_route(indextco,x,y,train,ir); adresse:=tco[indextco,x,y].Adresse ; + index:=index_aig(adresse); + if index<>0 then + begin + position:=aiguillage[index].position; + if (tco[indexTCO,x,y].inverse) and (position<>const_inconnu) then + begin + if position=const_devie then position:=const_droit else position:=const_devie; + end; + end; + Bimage:=tco[indextco,x,y].Bimage; if debugTCO then begin @@ -9167,6 +9199,7 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio // vers case suivante: trouver le trajet pour rejoindre det1 à det2 case Bimage of + // voie 1 : begin if debugTCO then @@ -9179,47 +9212,48 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio end; // aiguillage 2 : begin - //if debugTCO then AfficheDebug('El 2',clyellow); yn:=y; if (ancienXy) then begin xn:=x+1;xn:=x+1;end; if (ancienX>x) and (ancienY=Y) then begin - //pris en pointe - ancienX:=x; - ancienY:=y; - x:=x-1; - el_tco(x,y,train,ir); // essaye droit - // essayer dévié - if not(memtrouve) then + if not(posAig) or (posAig and (position=const_droit)) then begin - AncienY:=y; - AncienX:=x+1; - y:=y+1; - x:=x; + ancienX:=x; + ancienY:=y; + dec(x); + el_tco(x,y,train,ir); // essaye droit + inc(x); + end; + // essayer dévié + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + AncienX:=x;AncienY:=y; + dec(x);inc(y); el_tco(x,y,train,ir); // nouvelle itération end; + if (position=const_inconnu) and posaig then sortir:=true; end; end; 3 : begin - //if debugTCO then AfficheDebug('El 3',clyellow); if (ancienX>x) and (ancienY<=Y) then begin xn:=x-1;end; if (ancienXx) and (ancienY>y) then begin xn:=x-1;end; if (ancienXx) and (ancienY=Y) then - begin - // pris en pointe pos droite - ancienx:=x;ancieny:=y; - 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; + AncienX:=x;AncienY:=y; + inc(x); el_tco(x,y,train,ir); end; + // essayer dévié + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + // essai dévié + AncienX:=x;AncienY:=y; + inc(x);inc(y); + el_tco(x,y,train,ir); // nouvelle itération + end; + if (position=const_inconnu) and posaig then sortir:=true; end; end; + + 5 : begin + if (ancienXx) and (ancienY=Y) then // on vient de E + begin + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienx:=x;ancieny:=y; + dec(x); + el_tco(x,y,train,ir); + inc(x); + end; + // essayer dévié + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + AncienX:=x;AncienY:=y; + dec(x);dec(y); + el_tco(x,y,train,ir); + end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; + 6 : if ancienXx) and (ancienYx) and (ancienY>y) then - begin - // pris en pointe droit - ancienX:=x;ancienY:=y; - x:=x-1;y:=y-1; - 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,train,ir); - end; - end; - end; - 15 : begin + inc(x);dec(y); + end; + // essayer dévié + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + ancienX:=x;ancienY:=y; + dec(x); + el_tco(x,y,train,ir); + end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; + 14 : begin + if (ancienXx) and (ancienY>y) then + begin + // pris en pointe droit + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienX:=x;ancienY:=y; + dec(x);dec(y); + el_tco(x,y,train,ir); + inc(x);inc(y); + end; + // essayer dévié + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + // essai dévié + ancienX:=x;ancienY:=y; + dec(x); + el_tco(x,y,train,ir); + end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; + 15 : begin if (ancienX>x) and (ancienY<=Y) then begin xn:=x-1;yn:=y+1;end; if (ancienXY) then begin - // aiguillage pris en pointe - ancienX:=x;ancienY:=y; - x:=x+1;y:=y-1; - // essayer droit - el_tco(x,y,train,ir); - // essayer dévié - if not(memtrouve) then + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienX:=x;ancienY:=y; + inc(x);dec(y); + el_tco(x,y,train,ir); + dec(x);inc(y); + end; + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then begin - AncienY:=y+1; - AncienX:=x-1; - y:=y+1; - x:=x; + ancienX:=x;ancienY:=y;; + inc(x); el_tco(x,y,train,ir); // nouvelle itération end; + if (position=const_inconnu) and posaig then sortir:=true; end; end; 16 : if ancienXy) and (ancienX=x) then - begin - ancienX:=x;ancienY:=y; - y:=y-1; - // essayer droit - 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,train,ir); // nouvelle itération - end; - end; - end; + 24 : begin + if debugTCO then AfficheDebug('El 24',clyellow); + // on vient d'en haut ou en haut à gauche + if (ancienYy) and (ancienX=x) then + begin + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienX:=x;ancienY:=y; + dec(y); + el_tco(x,y,train,ir); + inc(y); + end; + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + ancienX:=x;ancienY:=y; + dec(x);dec(y); + el_tco(x,y,train,ir); // nouvelle itération + end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; - // tjd ou croisement - 25 : begin - mdl:=rien; + // tjd ou croisement + 25 : begin + mdl:=rien; if adresse<>0 then begin j:=Index_Aig(adresse); @@ -9609,174 +9666,191 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio if (ancienX=x) and (ancienY>Y) then begin xn:=x;yn:=y-1;end; end; if (mdl=aig) then - begin - Affiche('Erreur 51 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); - Affiche('mais la cellule représente un croisement ou une TJD/S',clred); - exit; - end; - end; + begin + Affiche('Erreur 51 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); + Affiche('mais la cellule représente un croisement ou une TJD/S',clred); + exit; + end; + end; - 26 : begin - if debugTCO then AfficheDebug('El 26',clyellow); - if (ancienY=x) then begin yn:=y+1;xn:=x;end; - // on vient d'en bas - if (ancienY>y) and (ancienX=x) then - begin - ancienX:=x;ancienY:=y; - y:=y-1; - // essayer droit - 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,train,ir); // nouvelle itération - end; - end; + 26 : begin + if debugTCO then AfficheDebug('El 26',clyellow); + if (ancienY=x) then begin yn:=y+1;xn:=x;end; + if (ancienY>y) and (ancienX=x) then + begin + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienX:=x;ancienY:=y; + dec(y); + el_tco(x,y,train,ir); + inc(y); end; - 27 : begin - if debugTCO then AfficheDebug('El 27',clyellow); - // on vient d'en bas - if (ancienY>y) and (ancienX<=x) then begin yn:=y-1;xn:=x;end; - // on vient d'en haut: pris en pointe - if (ancienYy) and (ancienX>=x) then begin yn:=y-1;xn:=x; end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; - // on vient d'en haut - if (ancienY=x) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; - // on vient de NO - if (ancienXY) then begin xn:=x+1;yn:=y-1;end; - // on vient d'en haut à droite - if (ancienX>x) and (ancienYy) and (ancienX<=x) then begin yn:=y-1;xn:=x;end; + // on vient d'en haut: pris en pointe + if (ancienYy) and (ancienX>=x) then begin yn:=y-1;xn:=x; end; + // on vient d'en haut + if (ancienY=x) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; + // on vient de NO + if (ancienXY) then begin xn:=x+1;yn:=y-1;end; + // on vient d'en haut à droite + if (ancienX>x) and (ancienYx) and (ancienY>y) then begin - // on vient de SE - ancienX:=x;ancienY:=y; - y:=y-1;x:=x-1; - // essayer droit - 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,train,ir); // nouvelle itération - end; - end; - end; - 34 : begin - // on vient du N ou NE - if (ancienX>=x) and (ancienYy) then - begin - ancienX:=x;ancienY:=y; - y:=y-1;x:=x+1; - // essayer droit - 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,train,ir); // nouvelle itération - end; - end; - end; + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienX:=x;ancienY:=y; + y:=y-1;x:=x-1; + el_tco(x,y,train,ir); + inc(x);inc(y); + end; + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + ancienX:=x;ancienY:=y; + dec(y); + el_tco(x,y,train,ir); // nouvelle itération + end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; + 34 : begin + // on vient du N ou NE + if (ancienX>=x) and (ancienYy) then + begin + if not(posAig) or (posAig and (position=const_droit)) then + begin + ancienX:=x;ancienY:=y; + y:=y-1;x:=x+1; + el_tco(x,y,train,ir); + dec(x);inc(y); + end; + if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then + begin + ancienX:=x;ancienY:=y; + dec(y); + el_tco(x,y,train,ir); // nouvelle itération + end; + if (position=const_inconnu) and posaig then sortir:=true; + end; + end; else begin // fausse route, sortir if DebugTCO then - 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); + AfficheDebug('Sortie de calcul route TCO'+intToSTR(indexTCO)+' 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 (adresse=det2) and (adresse<>0) then memTrouve:=true; + if (adresse=0) and (det2=0) and (tco[indexTCO,x,y].buttoir<>0) 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); @@ -9786,17 +9860,18 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio //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 begin + if debugTCO then AfficheDebug('Trouvé '+intToSTR(det2),clLime); indexTrouve:=true; indexIr:=ir-1; end; - if i>200 then Affiche('Erreur 487 : limite d''itérations TCO',clred); - if iteration>200 then Affiche('Erreur 488 : limite de récursivité TCO',clred); + if i>200 then AfficheDebug('Erreur 487 : limite d''itérations TCO'+intToSTR(indexTCO)+' trajet de '+intToSTR(det1)+' à '+intToSTR(det2)+' x='+intToSTR(x)+' y='+intToSTR(y),clred); + if iteration>200 then AfficheDebug('Erreur 488 : limite de récursivité TCO'+intToSTR(indexTCO)+'trajet de '+intToSTR(det1)+' à '+intToSTR(det2)+' x='+intToSTR(x)+' y='+intToSTR(y),clred); end; // Début de la procédure zone_tco begin - if debugTCO then AfficheDebug('Zone_TCO det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' Train'+intToSTR(Train)+' mode='+intToSTR(mode),clyellow); + if debugTCO then AfficheDebug('Zone_TCO'+intToSTR(indexTCO)+' det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' Train'+intToSTR(Train)+' mode='+intToSTR(mode),clWhite); trouve_det(indexTCO,det1,Xdet1,Ydet1); if (Xdet1=0) or (Ydet1=0) then exit; @@ -9846,12 +9921,12 @@ begin iteration:=0; ir:=1; El_tco(x,y,train,ir); // trouve l'élément suivant, et explore les ports de l'aiguillage en récursif - + if debugTCO then AfficheDebug('retour',clWhite); 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>NbCellulesTCO[indexTCO]) then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); + if (i>NbCellulesTCO[indexTCO]) then AfficheDebug('Erreur 1000 TCO'+intToSTR(indexTCO)+' : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); inc(direction) until (direction=5) or memtrouve ; @@ -9862,652 +9937,6 @@ begin end; end; -// allume ou éteint (mode=0 ou 1) la voie, zone de det1 à det2 sur le TCO -// si mode=0 : éteint -// =1 : couleur détecteur allumé -// =2 : couleur de l'index train -// 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: integer; - memtrouve,sortir,casok : boolean; - mdl : Tequipement; - s : string; -begin - // trouver le détecteur det1 - if debugTCO then AfficheDebug('Zone_TCO det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' mode='+intToSTR(mode),clyellow); - trouve_det(indexTCO,det1,Xdet1,Ydet1); - if (Xdet1=0) or (Ydet1=0) then exit; - - trouve_det(indexTCO,det2,Xdet2,Ydet2); - if (Xdet2=0) or (Ydet2=0) then exit; - - if debugTCO then - begin - AfficheDebug('trouvé '+intToSTR(det1)+' en '+IntToSTR(xDet1)+'/'+intToSTR(ydet1),clyellow); - AfficheDebug('trouvé '+intToSTR(det2)+' en '+IntToSTR(xDet2)+'/'+intToSTR(ydet2),clyellow); - end; - - memtrouve:=false; - - Direction:=1; // on teste 4 directions: 1=SE 2=NO 3=SO 4=NE - repeat // boucle de test de direction - sortir:=false; - x:=xDet1;y:=Ydet1; - xn:=x;yn:=y; - ir:=1; // index de la route du tco - i:=0; // itérations - if debugTCO then afficheDebug('Direction '+intToSTR(direction),clOrange); - - // initialiser les points d'où l'on vient - if direction=1 then - begin - // vers SE - casok:=true; - ancieny:=ydet1+1; - ancienx:=xdet1+1; - end; - if direction=2 then - begin - // vers NO - casok:=true; - ancieny:=ydet1-1; - ancienx:=xdet1-1; - end; - if direction=3 then - begin - // SO - casok:=true; - ancieny:=ydet1+1; - ancienx:=xdet1-1; - end; - if direction=4 then - begin - // vers NE - casok:=true; - ancieny:=ydet1-1; - ancienx:=xdet1+1; - end; - - - // boucle de remplissage du tableau routeTCO de det1 à det2 - repeat -// 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); - - // Affiche la cellule en fonction du mode - - - adresse:=tco[indextco,x,y].Adresse ; - Bimage:=tco[indextco,x,y].Bimage; - casok:=false; - // vers case suivante: trouver le trajet pour rejoindre det1 à det2 - case Bimage of - // voie - 1 : begin - if debugTCO then - begin - s:='El 1';if adresse<>0 then s:=s+'adr='+intToStr(adresse); - AfficheDebug(s,clyellow); - end; - if ancienXx) and (ancienY=Y) then - begin - xn:=x-1; - if pos=const_devie then yn:=y+1; - end; - if (ancienXy) then begin xn:=x+1; end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 3 : begin - //if debugTCO then AfficheDebug('El 3',clyellow); - pos:=positionTCO(indexTCO,x,y); - if (ancienXx) and (ancienY=Y) then begin xn:=x-1;end; - if (ancienX>x) and (ancienYx) and (ancienY=Y) then begin xn:=x-1;end; - if (ancienX>x) and (ancienY>y) then begin xn:=x-1;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 5 : begin - //if debugTCO then AfficheDebug('El 5',clyellow); - pos:=positionTCO(indexTCO,x,y); - if (ancienXx) and (ancienY=Y) then begin xn:=x-1;if pos=const_devie then yn:=y-1;end; - if (ancienXx) and (ancienY=Y) then begin xn:=x-1;yn:=y-1;end; - if (ancienX>x) and (ancienY>y) then begin xn:=x-1;yn:=y-1;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 13 : begin - //if debugTCO then AfficheDebug('El 13',clyellow); - pos:=positionTCO(indexTCO,x,y); - if (ancienXx) and (ancienYy) then begin xn:=x+1;yn:=y-1;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 14 : begin - //if debugTCO then AfficheDebug('El 14',clyellow); - pos:=positionTCO(indexTCO,x,y); - if (ancienXx) and (ancienY>y) then begin xn:=x-1;if pos=const_droit then yn:=y-1;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 15 : begin - //if debugTCO then AfficheDebug('El 15',clyellow); - pos:=positionTCO(indexTCO,x,y); - if (ancienXY) then begin xn:=x+1;if pos=const_droit then yn:=y-1;end; - if (ancienX>x) and (ancienYx) and (ancienY=y) then begin xn:=x-1;yn:=y+1;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 16 : if ancienX0 then s:=s+'adr='+intToStr(adresse); - AfficheDebug(s,clyellow); - end; - xn:=x; - casok:=true; - if (ancienY0 then - begin - j:=Index_Aig(adresse); - mdl:=aiguillage[j].modele; - if (mdl=tjs) or (mdl=tjd) then - begin - // tjd ou tjs - pos:=aiguillage[j].position; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - - if ((mdl=tjd) or (mdl=tjs)) and (aiguillage[j].EtatTJD=4) then - begin - j:=Index_Aig(aiguillage[j].Ddroit); - pos2:=aiguillage[j].position; // 2eme adresse de la TJD - if (pos2=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - if (pos=const_droit) and (pos2=const_droit) then - begin - casok:=true; - if ancienXx) and (ancienY=Y) then begin xn:=x-1;end; - if (ancienXY) then begin xn:=x+1;yn:=y-1;end; - if (ancienX>x) and (ancienY0 then - begin - j:=Index_Aig(adresse); - mdl:=aiguillage[j].modele; - // tjd ou tjs - if (mdl=tjd) or (mdl=tjs) then - begin - pos:=aiguillage[j].position; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - - if ((mdl=tjd) or (mdl=tjs)) and (aiguillage[j].EtatTJD=4) then - begin - j:=Index_Aig(aiguillage[j].Ddroit); - pos2:=aiguillage[j].position; // 2eme adresse de la TJD - if (pos2=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - if (pos=const_droit) and (pos2=const_droit) then - begin - if ancienXx) and (ancienY=Y) then begin casok:=true;xn:=x-1;end; - if (ancienX>x) and (ancienY>Y) then begin casok:=true;xn:=x-1;yn:=y-1;end; - if (ancienX0 then - begin - j:=Index_Aig(adresse); - mdl:=aiguillage[j].modele; - // tjd ou tjs - if (mdl=tjd) or (mdl=tjs) then - begin - pos:=aiguillage[j].position; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - - if ((mdl=tjd) or (mdl=tjs)) and (aiguillage[j].EtatTJD=4) then - begin - j:=Index_Aig(aiguillage[j].Ddroit); - pos2:=aiguillage[j].position; // 2eme adresse de la TJD - if (pos2=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - if (pos=const_droit) and (pos2=const_droit) then - begin - if ancienXx) and (ancienYY) then begin xn:=x+1;yn:=yn-1;end; - if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; - end; - if (mdl=aig) then - begin - Affiche('Erreur 50 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); - Affiche('mais la cellule représente un croisement ou une TJD/S',clred); - exit; - end; - end; - - 24 : begin - if debugTCO then AfficheDebug('El 24',clyellow); - pos:=positionTCO(indexTCO,x,y); - // on vient d'en bas - if (ancienY>y) and (ancienX=x) then - begin - yn:=y-1;if pos=const_devie then xn:=x-1 else xn:=x; - end; - // on vient d'en haut - if (ancienY0 then - begin - j:=Index_Aig(adresse); - mdl:=aiguillage[j].modele; - // tjd ou tjs - if (mdl=tjd) or (mdl=tjs) then - begin - pos:=aiguillage[j].position; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - - if ((mdl=tjd) or (mdl=tjs)) and (aiguillage[j].EtatTJD=4) then - begin - j:=Index_Aig(aiguillage[j].Ddroit); - pos2:=aiguillage[j].position; // 2eme adresse de la TJD - if (pos2=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - if (pos=const_droit) and (pos2=const_droit) then - begin - if ancienXx) and (ancienY>Y) then begin casok:=true;xn:=x-1;yn:=yn-1;end; - if (ancienX=x) and (ancienYY) then begin casok:=true;xn:=x;yn:=y-1;end; - end; - if (mdl=aig) then - begin - Affiche('Erreur 51 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); - Affiche('mais la cellule représente un croisement ou une TJD/S',clred); - exit; - end; - end; - - 26 : begin - if debugTCO then AfficheDebug('El 26',clyellow); - pos:=positionTCO(indexTCO,x,y); - // on vient d'en bas - if (ancienY>y) and (ancienX=x) then - begin - yn:=y-1;if pos=const_devie then xn:=x+1 else xn:=x; - end; - // on vient d'en haut - if (ancienYx) then - begin - yn:=y+1;xn:=x; - end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 27 : begin - if debugTCO then AfficheDebug('El 27',clyellow); - pos:=positionTCO(indexTCO,x,y); - // on vient d'en bas - if (ancienY>y) and (ancienX=x) then - begin - yn:=y-1;xn:=x; - end; - // on vient d'en haut - if (ancienYy) and (ancienXy) and (ancienX=x) then - begin - yn:=y-1;xn:=x; - end; - // on vient d'en haut - if (ancienYy) and (ancienX>x) then - begin - yn:=y-1;xn:=x; - end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 29 : begin - //if debugTCO then AfficheDebug('El 12',clyellow); - pos:=positionTCO(indexTCO,x,y); - // on vient à de haut à gauche - if (ancienXx) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; - // on vient de bas - if (ancienX=x) and (ancienY>y) then begin xn:=x-1;yn:=y-1;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 32 : begin - if debugTCO then AfficheDebug('El 32',clyellow); - pos:=positionTCO(indexTCO,x,y); - // on vient d'en bas à gauche - if (ancienXY) then begin xn:=x+1;yn:=y-1;end; - // on vient d'en bas - if (ancienX=x) and (ancienY>Y) then begin xn:=x+1;yn:=y-1;end; - // on vient d'en haut à droite - if (ancienX>x) and (ancienYx) and (ancienY>y) then begin yn:=y-1;if pos=const_droit then xn:=x-1 else xn:=x;end; - if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; - end; - 34 : begin - pos:=positionTCO(indexTCO,x,y); - // on vient du SE - if (ancienXy) then begin yn:=y-1;if pos=const_droit then xn:=x+1 else xn:=x;end; - // on vient du N - if (ancienX=x) and (ancienYx) and (ancienYdet2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; - ancienX:=x; - ancienY:=y; - x:=xn; - y:=yn; - until (memTrouve) or (i>NbCellulesTCO[indexTCO]) or (x>NbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x=0) or (y=0) or sortir; // or not(casok) ; - - { if not(casok) then - begin - Affiche('Erreur TCO incohérence tracé cellule '+intToSTR(x)+','+intToSTR(y),clred); - exit; - end; } - if (i>NbCellulesTCO[indexTCO]) then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); - inc(direction) - until (direction=5) or memtrouve ; - - //Affiche(intToSTR(x),clLime); - if i>NbCellulesTCO[indexTCO] then - begin - // fausse route, sortir - if DebugTCO then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); - exit; - end; - if not(MemTrouve) then - begin - if DebugTCO then AfficheDebug('Pas de liaison entre '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); - exit; - end; - - if DebugTCO then AfficheDebug('trouvé liaison de '+IntToSTR(det1)+' à '+IntToSTR(det2),clLime); - - dec(ir); - Affiche_trajet(indexTCO,1,ir,mode); - -end; - // positionne l'icone du groupe G2 (signal, quai, action) procedure positionne_icone_G2(IndexTCO : integer;ip : timage;lbl : tlabel;i : integer); @@ -10685,8 +10114,8 @@ begin dessin_33(indexTCO,ImagePalette33.canvas,1,1,0); dessin_34(indexTCO,ImagePalette34.canvas,1,1,0); - dessin_51(indexTCO,ImagePalette51.canvas,1,1,0); //quai - dessin_52(indexTCO,ImagePalette52.canvas,1,1,0); //action + dessin_Quai(indexTCO,ImagePalette51.canvas,1,1,0); //quai + dessin_Action(indexTCO,ImagePalette52.canvas,1,1,0); //action LargeurCell[indexTCO]:=20; @@ -10704,7 +10133,6 @@ begin //Picture.Bitmap:=Formprinc.Image9feux.Picture.Bitmap; TransparentBlt(ImagePalette50.canvas.Handle,8,0,LargeurCell[indexTCO],hauteurCell[indexTCO], formprinc.Image9Feux.Canvas.Handle,0,0,50,90,clBlue); - // end; end; LargeurCell[indexTCO]:=ancW; hauteurCell[indexTCO]:=ancH; @@ -10726,15 +10154,16 @@ begin begin Width:=clLarge-55; // laisser 50 pixels pour la trackbarzoom + scrollBar //Width:=clLarge-300; // mode pour voir les imageTemp - top:=1; - left:=1; + top:=0; + left:=0; end; if MasqueBandeauTCO then begin BandeauMasque:=true; PanelBas.Hide; - ScrollBox.Height:=clientHeight; + //ScrollBox.Height:=clientHeight; + ScrollBox.Height:=ClHaut-ScrollBox.Top-10; end else begin @@ -10753,7 +10182,7 @@ begin IndexTCOCourant:=indexTCO; if affevt then Affiche('Form TCO'+intToSTR(indexTCO)+' activate',clyellow); Caption:='TCO'+intToSTR(indexTCO)+' : '+NomFichierTCO[indexTCO]; - + if indexTCO=0 then exit; {initalisation des dimensions du tco - à ne faire qu'une fois} if not(Forminit[indexTCO]) then begin @@ -11082,7 +10511,6 @@ begin traceXY[1].x:=0;traceXY[1].y:=0; traceXY[2].x:=0;traceXY[2].y:=0; affiche_tco(indexTCO); - if debugTCO then Affiche('------------',clYellow); FormTCO[indexTCO].Caption:='TCO'+intToSTR(indexTCO)+' : '+NomFichierTCO[indexTCO]; screen.cursor:=crDefault; end; @@ -11580,15 +11008,16 @@ begin 32 : dessin_32(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 33 : dessin_33(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 34 : dessin_34(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); - id_Quai : dessin_51(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); - id_action : dessin_52(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); + id_Quai : dessin_Quai(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); + id_action : dessin_Action(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); end; - + stocke_undo(indexTCO,1,XClic,YClic); maj_undo(1); tco[indextco,XClic,YClic].BImage:=icone; tco[indextco,XClic,YClic].liaisons:=liaisons[icone]; tco[indextco,xClic,YClic].CoulFonte:=clYellow; + tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Repr:=2; formTCO[indexTCO].EditAdrElement.Text:=IntToSTR( tco[indextco,XClic,YClic].Adresse); formTCO[indexTCO].EdittypeImage.Text:=IntToSTR(tco[indextco,XClic,YClic].BImage); end; @@ -12324,10 +11753,12 @@ begin Xclic:=position.X div LargeurCell[indexTCO] + 1; Yclic:=position.Y div hauteurCell[indexTCO] + 1; - + if button=mbLeft then begin - if affEvt then Affiche('TCO Souris clicG enfoncée',clYellow); + // zizi + //Affiche('TCO'+intToSTR(indexTCO)+' souris clicG enfoncée',clYellow); + if affEvt then Affiche('TCO'+intToSTR(i)+' souris clicG enfoncée',clYellow); if dbleClicTCO then begin dbleClicTCO:=false;exit;end; // coordonnées grille @@ -12346,6 +11777,7 @@ begin begin i:=tco[indextco,xclic,yclic].piedfeu; n:=tco[indextco,xclic,yclic].feuoriente; + //Affiche('Clic bouton action i='+intToSTR(i)+' n='+intToSTR(n),clYellow); if i=1 then Affiche_fenetre_TCO(n,true); // affiche le TCO n°n if i=2 then with formprinc do // afficher signaux complexes begin @@ -12364,6 +11796,10 @@ begin // pilotage impulsionnel pilote_acc(tco[indextco,xclic,yclic].Adresse,tco[indextco,xclic,yclic].sortie,AigP); end; + if i=5 then + begin + stop_trains; + end; end; TempoSouris:=2 ; // démarre la tempo souris @@ -12603,6 +12039,13 @@ begin if button=mbRight then begin if affEvt then Affiche('TCO Souris clicD enfoncée',clLime); + AncienXclic:=XclicCell[indexTCO]; + AncienYclic:=YclicCell[indexTCO]; + + XclicCell[indexTCO]:=Xclic; + YclicCell[indexTCO]:=Yclic; + + _entoure_cell_clic(indexTCO); auto_tcurs:=true; if modetrace[indexTCO] then begin @@ -12785,7 +12228,7 @@ begin end; Val(s,Adr,erreur); - if erreur<>0 then exit; + if erreur<>0 then begin clicTCO:=false;exit; end; if (Adr<0) or (Adr>2048) then Adr:=0; clicTCO:=false; @@ -13266,7 +12709,6 @@ begin PanelBas.Hide; ScrollBox.Height:=ClientHeight-32; BandeauMasque:=true; - defocusControl(ButtonMasquer,true); Bandeau.Caption:='Afficher le bandeau'; end; @@ -14437,8 +13879,7 @@ begin PanelBas.Hide; ScrollBox.Height:=ClientHeight; BandeauMasque:=true; - defocusControl(ButtonMasquer,true); - Bandeau.Caption:='Afficher le bandeau'; + Bandeau.Caption:='Afficher le bandeau'; end; end; diff --git a/Unitplace.pas b/Unitplace.pas index 0e84a16..dffc0df 100644 --- a/Unitplace.pas +++ b/Unitplace.pas @@ -239,7 +239,11 @@ procedure TFormPlace.Edit1Change(Sender: TObject); var i,erreur : integer; begin val(edit1.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then + begin + LabelTexte.caption:='Erreur détecteur 1'; + exit; + end; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -254,7 +258,11 @@ procedure TFormPlace.Edit2Change(Sender: TObject); var i,erreur : integer; begin val(edit2.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then + begin + LabelTexte.caption:='Erreur détecteur 2'; + exit; + end; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -269,7 +277,11 @@ procedure TFormPlace.Edit3Change(Sender: TObject); var i,erreur : integer; begin val(edit3.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then + begin + LabelTexte.caption:='Erreur détecteur 3'; + exit; + end; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -284,7 +296,11 @@ procedure TFormPlace.Edit4Change(Sender: TObject); var i,erreur : integer; begin val(edit4.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then + begin + LabelTexte.caption:='Erreur détecteur 4'; + exit; + end; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -299,7 +315,11 @@ procedure TFormPlace.Edit5Change(Sender: TObject); var i,erreur : integer; begin val(edit5.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then + begin + LabelTexte.caption:='Erreur détecteur 5'; + exit; + end; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -314,7 +334,11 @@ procedure TFormPlace.Edit6Change(Sender: TObject); var i,erreur : integer; begin val(edit6.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then + begin + LabelTexte.caption:='Erreur détecteur 6'; + exit; + end; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -449,7 +473,7 @@ procedure TFormPlace.EditDir1Change(Sender: TObject); var i,erreur : integer; begin val(editDir1.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then exit; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -463,7 +487,7 @@ procedure TFormPlace.EditDir2Change(Sender: TObject); var i,erreur : integer; begin val(editDir2.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then exit; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -477,7 +501,7 @@ procedure TFormPlace.EditDir3Change(Sender: TObject); var i,erreur : integer; begin val(editDir3.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then exit; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -487,13 +511,11 @@ begin placement[3].detdir:=i; end; - - procedure TFormPlace.EditDir4Change(Sender: TObject); var i,erreur : integer; begin val(editDir4.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then exit; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -507,7 +529,7 @@ procedure TFormPlace.EditDir5Change(Sender: TObject); var i,erreur : integer; begin val(editDir5.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then exit; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; @@ -521,7 +543,7 @@ procedure TFormPlace.EditDir6Change(Sender: TObject); var i,erreur : integer; begin val(editDir6.Text,i,erreur); - if erreur<>0 then exit; + if (erreur<>0) or (i<0) then exit; if index_adresse_detecteur(i)=0 then begin LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; diff --git a/verif_version.pas b/verif_version.pas index 82d6ea6..8dc9cf2 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -25,7 +25,7 @@ var verifVersion,notificationVersion,essai : boolean; chemin_Dest,chemin_src,date_creation,nombre_tel : string; -Const Version='8.43'; // sert à la comparaison de la version publiée +Const Version='8.5'; // sert à la comparaison de la version publiée SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace // pour unzip SHCONTCH_NOPROGRESSBOX = 4; diff --git a/versions.txt b/versions.txt index d8cee70..d21d48f 100644 --- a/versions.txt +++ b/versions.txt @@ -233,5 +233,15 @@ version 8.41 : Am version 8.42 : Création d'un onglet de paramètres avancés. Fichier d'aide affichable depuis le menu. version 8.43 : Correction d'un bug sur l'importation des détecteurs depuis CDM rail. +version 8.44 : Gestion de la centrale Z21 en mode autonome en Xpressnet. + Amélioration des réservations des aiguillages. + Amélioration affichages des trajets dans les TCOs. + Amélioration des réceptions des trames XpressNet. + Ajout d'une action "arrêt des trains" pour les TCOs + + + + +