diff --git a/MSCommLib_TLB.dcu b/MSCommLib_TLB.dcu index 4c6ccaa..9bdfdeb 100644 Binary files a/MSCommLib_TLB.dcu and b/MSCommLib_TLB.dcu differ diff --git a/Notice d'utilisation des signaux_complexes_GL_V9.3.pdf b/Notice d'utilisation des signaux_complexes_GL_V9.5.pdf similarity index 77% rename from Notice d'utilisation des signaux_complexes_GL_V9.3.pdf rename to Notice d'utilisation des signaux_complexes_GL_V9.5.pdf index 125c3d7..1a57fd7 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V9.3.pdf and b/Notice d'utilisation des signaux_complexes_GL_V9.5.pdf differ diff --git a/README.adoc b/README.adoc index 2b6f138..2dd5f79 100644 --- a/README.adoc +++ b/README.adoc @@ -22,5 +22,5 @@ Vous pouvez voir les nouveautés de chaque version dans le fichier versions.txt. image::Imtitre.jpg[] -image::tcon.png[] +image::tco.jpg[] image::sigpresentation.gif[] diff --git a/Signaux_complexes_GL.dpr b/Signaux_complexes_GL.dpr index 1b9c077..f216031 100644 --- a/Signaux_complexes_GL.dpr +++ b/Signaux_complexes_GL.dpr @@ -26,7 +26,8 @@ uses UnitRoute in 'UnitRoute.pas' {FormRoute}, UnitRouteTrains in 'UnitRouteTrains.pas' {FormRouteTrain}, UnitInfo in 'UnitInfo.pas' {FormInfo}, - UnitIntro in 'UnitIntro.pas' {FormIntro}; + UnitIntro in 'UnitIntro.pas' {FormIntro}, + UnitMesure in 'UnitMesure.pas' {FormMesure}; {$R *.res} @@ -56,6 +57,7 @@ begin Application.CreateForm(TFormRouteTrain, FormRouteTrain); Application.CreateForm(TFormInfo, FormInfo); Application.CreateForm(TFormIntro, FormIntro); + Application.CreateForm(TFormMesure, FormMesure); fin_preliminaire; Application.Run; end. diff --git a/Signaux_complexes_GL.map b/Signaux_complexes_GL.map index cd05fb8..03df473 100644 --- a/Signaux_complexes_GL.map +++ b/Signaux_complexes_GL.map @@ -1,254 +1,256 @@ Start Length Name Class - 0001:00000000 001FAE24H .text CODE - 0002:00000000 00002F38H .data DATA - 0002:00002F38 0F197EE5H .bss BSS + 0001:00000000 001C4204H .text CODE + 0002:00000000 00003018H .data DATA + 0002:00003018 28FB0E09H .bss BSS Detailed map of segments - 0001:00000000 00005F63 C=CODE S=.text G=(none) M=System ACBP=A9 - 0001:00005F64 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 - 0001:000060A4 00000108 C=CODE S=.text G=(none) M=Types ACBP=A9 - 0001:000061AC 00000F28 C=CODE S=.text G=(none) M=Windows ACBP=A9 - 0001:000070D4 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 - 0001:0000710C 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 - 0001:00007444 00006F90 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 - 0001:0000E3D4 00000823 C=CODE S=.text G=(none) M=VarUtils ACBP=A9 - 0001:0000EBF8 0000878A C=CODE S=.text G=(none) M=Variants ACBP=A9 - 0001:00017384 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 - 0001:00017524 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 - 0001:00017D60 00000368 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 - 0001:000180C8 0000A7FE C=CODE S=.text G=(none) M=Classes ACBP=A9 - 0001:000228C8 00000378 C=CODE S=.text G=(none) M=Consts ACBP=A9 - 0001:00022C40 00009DC7 C=CODE S=.text G=(none) M=Graphics ACBP=A9 - 0001:0002CA08 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 - 0001:0002CB2C 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 - 0001:0002CDE4 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 - 0001:0002CF7C 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 - 0001:0002D704 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 - 0001:0002D73C 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 - 0001:0002E734 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 - 0001:0002E78C 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 - 0001:0002F854 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 - 0001:0002FB74 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 - 0001:0002FF64 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 - 0001:00030920 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 - 0001:00030958 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 - 0001:00030990 00000040 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 - 0001:000309D0 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 - 0001:00030A08 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 - 0001:00030A60 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 - 0001:00030A98 000000EC C=CODE S=.text G=(none) M=ShlObj ACBP=A9 - 0001:00030B84 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 - 0001:00030BE4 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 - 0001:00030C1C 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 - 0001:000342F0 0000602A C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 - 0001:0003A31C 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 - 0001:0003A3AC 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 - 0001:0003AB4C 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 - 0001:0003AC74 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 - 0001:0003E498 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 - 0001:0003E4D0 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 - 0001:0003E538 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 - 0001:0003E5A0 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 - 0001:0003E60C 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 - 0001:0003E664 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 - 0001:0003E69C 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 - 0001:00047FE4 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 - 0001:00048E84 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 - 0001:0005551C 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 - 0001:00055684 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 - 0001:000563A4 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 - 0001:000677A8 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 - 0001:00068A3C 00001C04 C=CODE S=.text G=(none) M=ImgList ACBP=A9 - 0001:0006A640 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 - 0001:00070D24 0000CF8C C=CODE S=.text G=(none) M=Forms ACBP=A9 - 0001:0007DCB0 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 - 0001:0007DD00 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 - 0001:000910EC 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 - 0001:0009114C 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 - 0001:000923A8 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 - 0001:000923E0 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 - 0001:00093B74 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 - 0001:00093BD4 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 - 0001:000970F0 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 - 0001:00097404 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 - 0001:0009752C 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 - 0001:0009AFA4 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 - 0001:0009AFE4 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 - 0001:0009B01C 00000038 C=CODE S=.text G=(none) M=DateUtils ACBP=A9 - 0001:0009B054 00000038 C=CODE S=.text G=(none) M=PsAPI ACBP=A9 - 0001:0009B08C 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 - 0001:0009B978 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 - 0001:0009BF10 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 - 0001:0009C928 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 - 0001:0009EA30 000092A4 C=CODE S=.text G=(none) M=Grids ACBP=A9 - 0001:000A7CD4 00001BFC C=CODE S=.text G=(none) M=Spin ACBP=A9 - 0001:000A98D0 00003762 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 - 0001:000AD034 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 - 0001:000AD5B0 000196A8 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 - 0001:000C6C58 00002E8B C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 - 0001:000C9AE4 00000EB0 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 - 0001:000CA994 00001070 C=CODE S=.text G=(none) M=UnitFicheHoraire ACBP=A9 - 0001:000CBA04 00000038 C=CODE S=.text G=(none) M=ShellConsts ACBP=A9 - 0001:000CBA3C 000004E0 C=CODE S=.text G=(none) M=ShellCtrls ACBP=A9 - 0001:000CBF1C 00002D94 C=CODE S=.text G=(none) M=UnitRoute ACBP=A9 - 0001:000CECB0 00002C68 C=CODE S=.text G=(none) M=UnitRouteTrains ACBP=A9 - 0001:000D1918 0000028C C=CODE S=.text G=(none) M=UnitInfo ACBP=A9 - 0001:000D1BA4 00003438 C=CODE S=.text G=(none) M=selection_train ACBP=A9 - 0001:000D4FDC 00006808 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 - 0001:000DB7E4 00001634 C=CODE S=.text G=(none) M=UnitClock ACBP=A9 - 0001:000DCE18 00000274 C=CODE S=.text G=(none) M=UnitIntro ACBP=A9 - 0001:000DD08C 00059C48 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 - 0001:00136CD4 000039DC C=CODE S=.text G=(none) M=UnitSR ACBP=A9 - 0001:0013A6B0 00002BF8 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 - 0001:0013D2A8 00008C48 C=CODE S=.text G=(none) M=UnitModifAction ACBP=A9 - 0001:00145EF0 00000F84 C=CODE S=.text G=(none) M=UnitHorloge ACBP=A9 - 0001:00146E74 0000261B C=CODE S=.text G=(none) M=verif_version ACBP=A9 - 0001:00149490 00001190 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 - 0001:0014A620 00000F48 C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 - 0001:0014B568 0005D258 C=CODE S=.text G=(none) M=Unitprinc ACBP=A9 - 0001:001A87C0 0004F190 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 - 0001:001F7950 00002EE8 C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 - 0001:001FA838 000005EC C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 + 0001:00000000 00005EFF C=CODE S=.text G=(none) M=System ACBP=A9 + 0001:00005F00 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 + 0001:00006040 00000134 C=CODE S=.text G=(none) M=Types ACBP=A9 + 0001:00006174 00000F38 C=CODE S=.text G=(none) M=Windows ACBP=A9 + 0001:000070AC 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 + 0001:000070E4 00000340 C=CODE S=.text G=(none) M=SysConst ACBP=A9 + 0001:00007424 000079C0 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 + 0001:0000EDE4 00000823 C=CODE S=.text G=(none) M=VarUtils ACBP=A9 + 0001:0000F608 0000878A C=CODE S=.text G=(none) M=Variants ACBP=A9 + 0001:00017D94 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 + 0001:00017F34 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 + 0001:00018770 00000368 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 + 0001:00018AD8 0000AAE6 C=CODE S=.text G=(none) M=Classes ACBP=A9 + 0001:000235C0 00000380 C=CODE S=.text G=(none) M=Consts ACBP=A9 + 0001:00023940 00009DC7 C=CODE S=.text G=(none) M=Graphics ACBP=A9 + 0001:0002D708 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 + 0001:0002D82C 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 + 0001:0002DAE4 0000041C C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 + 0001:0002DF00 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 + 0001:0002E688 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 + 0001:0002E6C0 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 + 0001:0002F6B8 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 + 0001:0002F710 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 + 0001:000307D8 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 + 0001:00030AF8 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 + 0001:00030EE8 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 + 0001:000318A4 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 + 0001:000318DC 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 + 0001:00031914 00000040 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 + 0001:00031954 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 + 0001:0003198C 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 + 0001:000319E4 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 + 0001:00031A1C 000000EC C=CODE S=.text G=(none) M=ShlObj ACBP=A9 + 0001:00031B08 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 + 0001:00031B68 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 + 0001:00031BA0 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 + 0001:00035274 0000602A C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 + 0001:0003B2A0 000000A0 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 + 0001:0003B340 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 + 0001:0003BAE0 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 + 0001:0003BC08 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 + 0001:0003F42C 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 + 0001:0003F464 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 + 0001:0003F4CC 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 + 0001:0003F534 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 + 0001:0003F5A0 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 + 0001:0003F5F8 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 + 0001:0003F630 0000FD90 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 + 0001:0004F3C0 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 + 0001:00050260 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 + 0001:0005C8F8 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 + 0001:0005CA60 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 + 0001:0005D780 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 + 0001:0006EB84 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 + 0001:0006FE18 00001C04 C=CODE S=.text G=(none) M=ImgList ACBP=A9 + 0001:00071A1C 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 + 0001:00078100 0000CFC0 C=CODE S=.text G=(none) M=Forms ACBP=A9 + 0001:000850C0 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 + 0001:00085110 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 + 0001:000984FC 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 + 0001:0009855C 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 + 0001:000997B8 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 + 0001:000997F0 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 + 0001:0009AF84 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 + 0001:0009AFE4 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 + 0001:0009E500 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 + 0001:0009E814 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 + 0001:0009E93C 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 + 0001:000A23B4 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 + 0001:000A23F4 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 + 0001:000A242C 00000038 C=CODE S=.text G=(none) M=DateUtils ACBP=A9 + 0001:000A2464 00000038 C=CODE S=.text G=(none) M=PsAPI ACBP=A9 + 0001:000A249C 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 + 0001:000A2D88 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 + 0001:000A3320 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 + 0001:000A3D38 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 + 0001:000A5E40 000092A4 C=CODE S=.text G=(none) M=Grids ACBP=A9 + 0001:000AF0E4 00001BFC C=CODE S=.text G=(none) M=Spin ACBP=A9 + 0001:000B0CE0 00002EE8 C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 + 0001:000B3BC8 000039C2 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 + 0001:000B758C 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 + 0001:000B7B08 000147A0 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 + 0001:000CC2A8 00003248 C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 + 0001:000CF4F0 00000D98 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 + 0001:000D0288 000017A8 C=CODE S=.text G=(none) M=UnitFicheHoraire ACBP=A9 + 0001:000D1A30 00000038 C=CODE S=.text G=(none) M=ShellConsts ACBP=A9 + 0001:000D1A68 000004E0 C=CODE S=.text G=(none) M=ShellCtrls ACBP=A9 + 0001:000D1F48 000025E0 C=CODE S=.text G=(none) M=UnitRoute ACBP=A9 + 0001:000D4528 00003BA0 C=CODE S=.text G=(none) M=UnitRouteTrains ACBP=A9 + 0001:000D80C8 0000028C C=CODE S=.text G=(none) M=UnitInfo ACBP=A9 + 0001:000D8354 00002B6C C=CODE S=.text G=(none) M=selection_train ACBP=A9 + 0001:000DAEC0 000052A8 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 + 0001:000E0168 000015F4 C=CODE S=.text G=(none) M=UnitClock ACBP=A9 + 0001:000E175C 00000274 C=CODE S=.text G=(none) M=UnitIntro ACBP=A9 + 0001:000E19D0 0003F3DC C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 + 0001:00120DAC 00003410 C=CODE S=.text G=(none) M=UnitSR ACBP=A9 + 0001:001241BC 00002784 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 + 0001:00126940 0000872C C=CODE S=.text G=(none) M=UnitModifAction ACBP=A9 + 0001:0012F06C 00043150 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 + 0001:001721BC 00000F6C C=CODE S=.text G=(none) M=UnitHorloge ACBP=A9 + 0001:00173128 000023D7 C=CODE S=.text G=(none) M=verif_version ACBP=A9 + 0001:00175500 00001190 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 + 0001:00176690 00000D9C C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 + 0001:0017742C 00000BA8 C=CODE S=.text G=(none) M=UnitMesure ACBP=A9 + 0001:00177FD4 0004BC23 C=CODE S=.text G=(none) M=Unitprinc ACBP=A9 + 0001:001C3BF8 0000060C 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 - 0002:00000340 00000110 C=DATA S=.data G=DGROUP M=VarUtils ACBP=A9 - 0002:00000450 000001B2 C=DATA S=.data G=DGROUP M=Variants ACBP=A9 - 0002:00000604 0000000C C=DATA S=.data G=DGROUP M=TypInfo ACBP=A9 - 0002:00000610 00000010 C=DATA S=.data G=DGROUP M=ActiveX ACBP=A9 - 0002:00000620 00000080 C=DATA S=.data G=DGROUP M=Classes ACBP=A9 - 0002:000006A0 0000030C C=DATA S=.data G=DGROUP M=Graphics ACBP=A9 - 0002:000009AC 00000004 C=DATA S=.data G=DGROUP M=Printers ACBP=A9 - 0002:000009B0 00000180 C=DATA S=.data G=DGROUP M=Dialogs ACBP=A9 - 0002:00000B30 0000018C C=DATA S=.data G=DGROUP M=ExtCtrls ACBP=A9 - 0002:00000CBC 0000009E C=DATA S=.data G=DGROUP M=Buttons ACBP=A9 - 0002:00000D5C 00000008 C=DATA S=.data G=DGROUP M=IniFiles ACBP=A9 - 0002:00000D64 00000008 C=DATA S=.data G=DGROUP M=Registry ACBP=A9 - 0002:00000D6C 00000008 C=DATA S=.data G=DGROUP M=Mapi ACBP=A9 - 0002:00000D74 000000B9 C=DATA S=.data G=DGROUP M=ComCtrls ACBP=A9 - 0002:00000E30 00000068 C=DATA S=.data G=DGROUP M=Themes ACBP=A9 - 0002:00000E98 00000154 C=DATA S=.data G=DGROUP M=StdCtrls ACBP=A9 - 0002:00000FEC 0000013C C=DATA S=.data G=DGROUP M=Controls ACBP=A9 - 0002:00001128 00000020 C=DATA S=.data G=DGROUP M=ImgList ACBP=A9 - 0002:00001148 000000EC C=DATA S=.data G=DGROUP M=Menus ACBP=A9 - 0002:00001234 00000124 C=DATA S=.data G=DGROUP M=Forms ACBP=A9 - 0002:00001358 00000908 C=DATA S=.data G=DGROUP M=jpeg ACBP=A9 - 0002:00001C60 00000030 C=DATA S=.data G=DGROUP M=ComObj ACBP=A9 - 0002:00001C90 0000002C C=DATA S=.data G=DGROUP M=OleCtrls ACBP=A9 - 0002:00001CBC 00000080 C=DATA S=.data G=DGROUP M=MSCommLib_TLB ACBP=A9 - 0002:00001D3C 00000009 C=DATA S=.data G=DGROUP M=MaskUtils ACBP=A9 - 0002:00001D48 00000004 C=DATA S=.data G=DGROUP M=Mask ACBP=A9 - 0002:00001D4C 00000006 C=DATA S=.data G=DGROUP M=Grids ACBP=A9 - 0002:00001D54 00000068 C=DATA S=.data G=DGROUP M=ShellCtrls ACBP=A9 - 0002:00001DBC 000000D8 C=DATA S=.data G=DGROUP M=UnitTCO ACBP=A9 - 0002:00001E94 0000060D C=DATA S=.data G=DGROUP M=Unitprinc ACBP=A9 - 0002:00003000 00000664 C=BSS S=.bss G=DGROUP M=System ACBP=A9 - 0002:00003664 00000010 C=BSS S=.bss G=DGROUP M=SysInit ACBP=A9 - 0002:00003674 00000004 C=BSS S=.bss G=DGROUP M=Types ACBP=A9 - 0002:00003678 00000004 C=BSS S=.bss G=DGROUP M=Windows ACBP=A9 - 0002:0000367C 00000004 C=BSS S=.bss G=DGROUP M=Messages ACBP=A9 - 0002:00003680 00000004 C=BSS S=.bss G=DGROUP M=SysConst ACBP=A9 - 0002:00003684 00000120 C=BSS S=.bss G=DGROUP M=SysUtils ACBP=A9 - 0002:000037A4 0000005C C=BSS S=.bss G=DGROUP M=VarUtils ACBP=A9 - 0002:00003800 00000040 C=BSS S=.bss G=DGROUP M=Variants ACBP=A9 - 0002:00003840 00000004 C=BSS S=.bss G=DGROUP M=RTLConsts ACBP=A9 - 0002:00003844 00000004 C=BSS S=.bss G=DGROUP M=TypInfo ACBP=A9 - 0002:00003848 00000004 C=BSS S=.bss G=DGROUP M=ActiveX ACBP=A9 - 0002:0000384C 00000044 C=BSS S=.bss G=DGROUP M=Classes ACBP=A9 - 0002:00003890 00000004 C=BSS S=.bss G=DGROUP M=Consts ACBP=A9 - 0002:00003894 00000060 C=BSS S=.bss G=DGROUP M=Graphics ACBP=A9 - 0002:000038F4 00000004 C=BSS S=.bss G=DGROUP M=Math ACBP=A9 - 0002:000038F8 00000004 C=BSS S=.bss G=DGROUP M=Contnrs ACBP=A9 - 0002:000038FC 0000000C C=BSS S=.bss G=DGROUP M=CommCtrl ACBP=A9 - 0002:00003908 00000031 C=BSS S=.bss G=DGROUP M=MultiMon ACBP=A9 - 0002:0000393C 00000004 C=BSS S=.bss G=DGROUP M=Imm ACBP=A9 - 0002:00003940 00000008 C=BSS S=.bss G=DGROUP M=HelpIntfs ACBP=A9 - 0002:00003948 00000004 C=BSS S=.bss G=DGROUP M=WinSpool ACBP=A9 - 0002:0000394C 00000004 C=BSS S=.bss G=DGROUP M=Printers ACBP=A9 - 0002:00003950 00000034 C=BSS S=.bss G=DGROUP M=FlatSB ACBP=A9 - 0002:00003984 00000004 C=BSS S=.bss G=DGROUP M=SyncObjs ACBP=A9 - 0002:00003988 000000CC C=BSS S=.bss G=DGROUP M=UxTheme ACBP=A9 - 0002:00003A54 00000004 C=BSS S=.bss G=DGROUP M=RichEdit ACBP=A9 - 0002:00003A58 00000004 C=BSS S=.bss G=DGROUP M=ToolWin ACBP=A9 - 0002:00003A5C 00000004 C=BSS S=.bss G=DGROUP M=ShellAPI ACBP=A9 - 0002:00003A60 00000004 C=BSS S=.bss G=DGROUP M=RegStr ACBP=A9 - 0002:00003A64 00000004 C=BSS S=.bss G=DGROUP M=WinInet ACBP=A9 - 0002:00003A68 00000004 C=BSS S=.bss G=DGROUP M=UrlMon ACBP=A9 - 0002:00003A6C 00000004 C=BSS S=.bss G=DGROUP M=ShlObj ACBP=A9 - 0002:00003A70 00000004 C=BSS S=.bss G=DGROUP M=CommDlg ACBP=A9 - 0002:00003A74 00000004 C=BSS S=.bss G=DGROUP M=Dlgs ACBP=A9 - 0002:00003A78 0000003C C=BSS S=.bss G=DGROUP M=Dialogs ACBP=A9 - 0002:00003AB4 00000004 C=BSS S=.bss G=DGROUP M=ExtCtrls ACBP=A9 - 0002:00003AB8 00000004 C=BSS S=.bss G=DGROUP M=ComStrs ACBP=A9 - 0002:00003ABC 0000000C C=BSS S=.bss G=DGROUP M=Clipbrd ACBP=A9 - 0002:00003AC8 00000004 C=BSS S=.bss G=DGROUP M=StrUtils ACBP=A9 - 0002:00003ACC 00000030 C=BSS S=.bss G=DGROUP M=Buttons ACBP=A9 - 0002:00003AFC 00000004 C=BSS S=.bss G=DGROUP M=ExtDlgs ACBP=A9 - 0002:00003B00 00000004 C=BSS S=.bss G=DGROUP M=IniFiles ACBP=A9 - 0002:00003B04 00000004 C=BSS S=.bss G=DGROUP M=Registry ACBP=A9 - 0002:00003B08 00000004 C=BSS S=.bss G=DGROUP M=Mapi ACBP=A9 - 0002:00003B0C 00000009 C=BSS S=.bss G=DGROUP M=ExtActns ACBP=A9 - 0002:00003B18 00000004 C=BSS S=.bss G=DGROUP M=ListActns ACBP=A9 - 0002:00003B1C 00000010 C=BSS S=.bss G=DGROUP M=ComCtrls ACBP=A9 - 0002:00003B2C 00000008 C=BSS S=.bss G=DGROUP M=Themes ACBP=A9 - 0002:00003B34 00000004 C=BSS S=.bss G=DGROUP M=StdCtrls ACBP=A9 - 0002:00003B38 00000004 C=BSS S=.bss G=DGROUP M=StdActns ACBP=A9 - 0002:00003B3C 00000014 C=BSS S=.bss G=DGROUP M=WinHelpViewer ACBP=A9 - 0002:00003B50 00000080 C=BSS S=.bss G=DGROUP M=Controls ACBP=A9 - 0002:00003BD0 00000004 C=BSS S=.bss G=DGROUP M=ActnList ACBP=A9 - 0002:00003BD4 0000000C C=BSS S=.bss G=DGROUP M=ImgList ACBP=A9 - 0002:00003BE0 00000010 C=BSS S=.bss G=DGROUP M=Menus ACBP=A9 - 0002:00003BF0 00000020 C=BSS S=.bss G=DGROUP M=Forms ACBP=A9 - 0002:00003C10 00000004 C=BSS S=.bss G=DGROUP M=JConsts ACBP=A9 - 0002:00003C14 00000004 C=BSS S=.bss G=DGROUP M=jpeg ACBP=A9 - 0002:00003C18 00000004 C=BSS S=.bss G=DGROUP M=ComConst ACBP=A9 - 0002:00003C1C 00000011 C=BSS S=.bss G=DGROUP M=ComObj ACBP=A9 - 0002:00003C30 00000004 C=BSS S=.bss G=DGROUP M=StdVCL ACBP=A9 - 0002:00003C34 0000001C C=BSS S=.bss G=DGROUP M=AxCtrls ACBP=A9 - 0002:00003C50 00000004 C=BSS S=.bss G=DGROUP M=OleConst ACBP=A9 - 0002:00003C54 00000014 C=BSS S=.bss G=DGROUP M=OleCtrls ACBP=A9 - 0002:00003C68 00000048 C=BSS S=.bss G=DGROUP M=TlHelp32 ACBP=A9 - 0002:00003CB0 00000004 C=BSS S=.bss G=DGROUP M=WinSock ACBP=A9 - 0002:00003CB4 00000194 C=BSS S=.bss G=DGROUP M=ScktComp ACBP=A9 - 0002:00003E48 00000004 C=BSS S=.bss G=DGROUP M=MMSystem ACBP=A9 - 0002:00003E4C 00000004 C=BSS S=.bss G=DGROUP M=Nb30 ACBP=A9 - 0002:00003E50 00000004 C=BSS S=.bss G=DGROUP M=DateUtils ACBP=A9 - 0002:00003E54 00000004 C=BSS S=.bss G=DGROUP M=PsAPI ACBP=A9 - 0002:00003E58 00000004 C=BSS S=.bss G=DGROUP M=OleServer ACBP=A9 - 0002:00003E5C 00000004 C=BSS S=.bss G=DGROUP M=MSCommLib_TLB ACBP=A9 - 0002:00003E60 00000004 C=BSS S=.bss G=DGROUP M=MaskUtils ACBP=A9 - 0002:00003E64 00000004 C=BSS S=.bss G=DGROUP M=Mask ACBP=A9 - 0002:00003E68 00000004 C=BSS S=.bss G=DGROUP M=Grids ACBP=A9 - 0002:00003E6C 00000004 C=BSS S=.bss G=DGROUP M=Spin ACBP=A9 - 0002:00003E70 00002494 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 - 0002:00006304 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 - 0002:00006314 000148B0 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 - 0002:0001ABC4 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 - 0002:0001ABD8 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 - 0002:0001ABEC 0000190C C=BSS S=.bss G=DGROUP M=UnitFicheHoraire ACBP=A9 - 0002:0001C4F8 00000004 C=BSS S=.bss G=DGROUP M=ShellConsts ACBP=A9 - 0002:0001C4FC 0000001C C=BSS S=.bss G=DGROUP M=ShellCtrls ACBP=A9 - 0002:0001C518 00000DF4 C=BSS S=.bss G=DGROUP M=UnitRoute ACBP=A9 - 0002:0001D30C 00000008 C=BSS S=.bss G=DGROUP M=UnitRouteTrains ACBP=A9 - 0002:0001D314 0000000C C=BSS S=.bss G=DGROUP M=UnitInfo ACBP=A9 - 0002:0001D320 00000CB4 C=BSS S=.bss G=DGROUP M=selection_train ACBP=A9 - 0002:0001DFD4 00000020 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 - 0002:0001DFF4 00000034 C=BSS S=.bss G=DGROUP M=UnitClock ACBP=A9 - 0002:0001E028 0000000C C=BSS S=.bss G=DGROUP M=UnitIntro ACBP=A9 - 0002:0001E034 004CD3BC C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 - 0002:004EB3F0 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 - 0002:004EB400 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 - 0002:004EB414 00000018 C=BSS S=.bss G=DGROUP M=UnitModifAction ACBP=A9 - 0002:004EB42C 00000038 C=BSS S=.bss G=DGROUP M=UnitHorloge ACBP=A9 - 0002:004EB464 000001EC C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 - 0002:004EB650 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 - 0002:004EB654 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 - 0002:004EB660 0ECAF278 C=BSS S=.bss G=DGROUP M=Unitprinc ACBP=A9 - 0002:0F19A8D8 000005E0 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 - 0002:0F19AEB8 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 + 0002:000000EC 00000258 C=DATA S=.data G=DGROUP M=SysUtils ACBP=A9 + 0002:00000344 00000110 C=DATA S=.data G=DGROUP M=VarUtils ACBP=A9 + 0002:00000454 000001B2 C=DATA S=.data G=DGROUP M=Variants ACBP=A9 + 0002:00000608 0000000C C=DATA S=.data G=DGROUP M=TypInfo ACBP=A9 + 0002:00000614 00000010 C=DATA S=.data G=DGROUP M=ActiveX ACBP=A9 + 0002:00000624 00000080 C=DATA S=.data G=DGROUP M=Classes ACBP=A9 + 0002:000006A4 0000030C C=DATA S=.data G=DGROUP M=Graphics ACBP=A9 + 0002:000009B0 00000004 C=DATA S=.data G=DGROUP M=Printers ACBP=A9 + 0002:000009B4 00000180 C=DATA S=.data G=DGROUP M=Dialogs ACBP=A9 + 0002:00000B34 0000018C C=DATA S=.data G=DGROUP M=ExtCtrls ACBP=A9 + 0002:00000CC0 0000009E C=DATA S=.data G=DGROUP M=Buttons ACBP=A9 + 0002:00000D60 00000008 C=DATA S=.data G=DGROUP M=IniFiles ACBP=A9 + 0002:00000D68 00000008 C=DATA S=.data G=DGROUP M=Registry ACBP=A9 + 0002:00000D70 00000008 C=DATA S=.data G=DGROUP M=Mapi ACBP=A9 + 0002:00000D78 00000121 C=DATA S=.data G=DGROUP M=ComCtrls ACBP=A9 + 0002:00000E9C 00000068 C=DATA S=.data G=DGROUP M=Themes ACBP=A9 + 0002:00000F04 00000154 C=DATA S=.data G=DGROUP M=StdCtrls ACBP=A9 + 0002:00001058 0000013C C=DATA S=.data G=DGROUP M=Controls ACBP=A9 + 0002:00001194 00000020 C=DATA S=.data G=DGROUP M=ImgList ACBP=A9 + 0002:000011B4 000000EC C=DATA S=.data G=DGROUP M=Menus ACBP=A9 + 0002:000012A0 00000124 C=DATA S=.data G=DGROUP M=Forms ACBP=A9 + 0002:000013C4 00000908 C=DATA S=.data G=DGROUP M=jpeg ACBP=A9 + 0002:00001CCC 00000030 C=DATA S=.data G=DGROUP M=ComObj ACBP=A9 + 0002:00001CFC 0000002C C=DATA S=.data G=DGROUP M=OleCtrls ACBP=A9 + 0002:00001D28 00000080 C=DATA S=.data G=DGROUP M=MSCommLib_TLB ACBP=A9 + 0002:00001DA8 00000009 C=DATA S=.data G=DGROUP M=MaskUtils ACBP=A9 + 0002:00001DB4 00000004 C=DATA S=.data G=DGROUP M=Mask ACBP=A9 + 0002:00001DB8 00000006 C=DATA S=.data G=DGROUP M=Grids ACBP=A9 + 0002:00001DC0 00000068 C=DATA S=.data G=DGROUP M=ShellCtrls ACBP=A9 + 0002:00001E28 000000D8 C=DATA S=.data G=DGROUP M=UnitTCO ACBP=A9 + 0002:00001F00 0000060D C=DATA S=.data G=DGROUP M=Unitprinc ACBP=A9 + 0002:00004000 00000664 C=BSS S=.bss G=DGROUP M=System ACBP=A9 + 0002:00004664 00000010 C=BSS S=.bss G=DGROUP M=SysInit ACBP=A9 + 0002:00004674 00000004 C=BSS S=.bss G=DGROUP M=Types ACBP=A9 + 0002:00004678 00000004 C=BSS S=.bss G=DGROUP M=Windows ACBP=A9 + 0002:0000467C 00000004 C=BSS S=.bss G=DGROUP M=Messages ACBP=A9 + 0002:00004680 00000004 C=BSS S=.bss G=DGROUP M=SysConst ACBP=A9 + 0002:00004684 00000120 C=BSS S=.bss G=DGROUP M=SysUtils ACBP=A9 + 0002:000047A4 0000005C C=BSS S=.bss G=DGROUP M=VarUtils ACBP=A9 + 0002:00004800 00000040 C=BSS S=.bss G=DGROUP M=Variants ACBP=A9 + 0002:00004840 00000004 C=BSS S=.bss G=DGROUP M=RTLConsts ACBP=A9 + 0002:00004844 00000004 C=BSS S=.bss G=DGROUP M=TypInfo ACBP=A9 + 0002:00004848 00000004 C=BSS S=.bss G=DGROUP M=ActiveX ACBP=A9 + 0002:0000484C 00000044 C=BSS S=.bss G=DGROUP M=Classes ACBP=A9 + 0002:00004890 00000004 C=BSS S=.bss G=DGROUP M=Consts ACBP=A9 + 0002:00004894 00000060 C=BSS S=.bss G=DGROUP M=Graphics ACBP=A9 + 0002:000048F4 00000004 C=BSS S=.bss G=DGROUP M=Math ACBP=A9 + 0002:000048F8 00000004 C=BSS S=.bss G=DGROUP M=Contnrs ACBP=A9 + 0002:000048FC 0000000C C=BSS S=.bss G=DGROUP M=CommCtrl ACBP=A9 + 0002:00004908 00000031 C=BSS S=.bss G=DGROUP M=MultiMon ACBP=A9 + 0002:0000493C 00000004 C=BSS S=.bss G=DGROUP M=Imm ACBP=A9 + 0002:00004940 00000008 C=BSS S=.bss G=DGROUP M=HelpIntfs ACBP=A9 + 0002:00004948 00000004 C=BSS S=.bss G=DGROUP M=WinSpool ACBP=A9 + 0002:0000494C 00000004 C=BSS S=.bss G=DGROUP M=Printers ACBP=A9 + 0002:00004950 00000034 C=BSS S=.bss G=DGROUP M=FlatSB ACBP=A9 + 0002:00004984 00000004 C=BSS S=.bss G=DGROUP M=SyncObjs ACBP=A9 + 0002:00004988 000000CC C=BSS S=.bss G=DGROUP M=UxTheme ACBP=A9 + 0002:00004A54 00000004 C=BSS S=.bss G=DGROUP M=RichEdit ACBP=A9 + 0002:00004A58 00000004 C=BSS S=.bss G=DGROUP M=ToolWin ACBP=A9 + 0002:00004A5C 00000004 C=BSS S=.bss G=DGROUP M=ShellAPI ACBP=A9 + 0002:00004A60 00000004 C=BSS S=.bss G=DGROUP M=RegStr ACBP=A9 + 0002:00004A64 00000004 C=BSS S=.bss G=DGROUP M=WinInet ACBP=A9 + 0002:00004A68 00000004 C=BSS S=.bss G=DGROUP M=UrlMon ACBP=A9 + 0002:00004A6C 00000004 C=BSS S=.bss G=DGROUP M=ShlObj ACBP=A9 + 0002:00004A70 00000004 C=BSS S=.bss G=DGROUP M=CommDlg ACBP=A9 + 0002:00004A74 00000004 C=BSS S=.bss G=DGROUP M=Dlgs ACBP=A9 + 0002:00004A78 0000003C C=BSS S=.bss G=DGROUP M=Dialogs ACBP=A9 + 0002:00004AB4 00000004 C=BSS S=.bss G=DGROUP M=ExtCtrls ACBP=A9 + 0002:00004AB8 00000004 C=BSS S=.bss G=DGROUP M=ComStrs ACBP=A9 + 0002:00004ABC 0000000C C=BSS S=.bss G=DGROUP M=Clipbrd ACBP=A9 + 0002:00004AC8 00000004 C=BSS S=.bss G=DGROUP M=StrUtils ACBP=A9 + 0002:00004ACC 00000030 C=BSS S=.bss G=DGROUP M=Buttons ACBP=A9 + 0002:00004AFC 00000004 C=BSS S=.bss G=DGROUP M=ExtDlgs ACBP=A9 + 0002:00004B00 00000004 C=BSS S=.bss G=DGROUP M=IniFiles ACBP=A9 + 0002:00004B04 00000004 C=BSS S=.bss G=DGROUP M=Registry ACBP=A9 + 0002:00004B08 00000004 C=BSS S=.bss G=DGROUP M=Mapi ACBP=A9 + 0002:00004B0C 00000009 C=BSS S=.bss G=DGROUP M=ExtActns ACBP=A9 + 0002:00004B18 00000004 C=BSS S=.bss G=DGROUP M=ListActns ACBP=A9 + 0002:00004B1C 00000010 C=BSS S=.bss G=DGROUP M=ComCtrls ACBP=A9 + 0002:00004B2C 00000008 C=BSS S=.bss G=DGROUP M=Themes ACBP=A9 + 0002:00004B34 00000004 C=BSS S=.bss G=DGROUP M=StdCtrls ACBP=A9 + 0002:00004B38 00000004 C=BSS S=.bss G=DGROUP M=StdActns ACBP=A9 + 0002:00004B3C 00000014 C=BSS S=.bss G=DGROUP M=WinHelpViewer ACBP=A9 + 0002:00004B50 00000080 C=BSS S=.bss G=DGROUP M=Controls ACBP=A9 + 0002:00004BD0 00000004 C=BSS S=.bss G=DGROUP M=ActnList ACBP=A9 + 0002:00004BD4 0000000C C=BSS S=.bss G=DGROUP M=ImgList ACBP=A9 + 0002:00004BE0 00000010 C=BSS S=.bss G=DGROUP M=Menus ACBP=A9 + 0002:00004BF0 00000020 C=BSS S=.bss G=DGROUP M=Forms ACBP=A9 + 0002:00004C10 00000004 C=BSS S=.bss G=DGROUP M=JConsts ACBP=A9 + 0002:00004C14 00000004 C=BSS S=.bss G=DGROUP M=jpeg ACBP=A9 + 0002:00004C18 00000004 C=BSS S=.bss G=DGROUP M=ComConst ACBP=A9 + 0002:00004C1C 00000011 C=BSS S=.bss G=DGROUP M=ComObj ACBP=A9 + 0002:00004C30 00000004 C=BSS S=.bss G=DGROUP M=StdVCL ACBP=A9 + 0002:00004C34 0000001C C=BSS S=.bss G=DGROUP M=AxCtrls ACBP=A9 + 0002:00004C50 00000004 C=BSS S=.bss G=DGROUP M=OleConst ACBP=A9 + 0002:00004C54 00000014 C=BSS S=.bss G=DGROUP M=OleCtrls ACBP=A9 + 0002:00004C68 00000048 C=BSS S=.bss G=DGROUP M=TlHelp32 ACBP=A9 + 0002:00004CB0 00000004 C=BSS S=.bss G=DGROUP M=WinSock ACBP=A9 + 0002:00004CB4 00000194 C=BSS S=.bss G=DGROUP M=ScktComp ACBP=A9 + 0002:00004E48 00000004 C=BSS S=.bss G=DGROUP M=MMSystem ACBP=A9 + 0002:00004E4C 00000004 C=BSS S=.bss G=DGROUP M=Nb30 ACBP=A9 + 0002:00004E50 00000004 C=BSS S=.bss G=DGROUP M=DateUtils ACBP=A9 + 0002:00004E54 00000004 C=BSS S=.bss G=DGROUP M=PsAPI ACBP=A9 + 0002:00004E58 00000004 C=BSS S=.bss G=DGROUP M=OleServer ACBP=A9 + 0002:00004E5C 00000004 C=BSS S=.bss G=DGROUP M=MSCommLib_TLB ACBP=A9 + 0002:00004E60 00000004 C=BSS S=.bss G=DGROUP M=MaskUtils ACBP=A9 + 0002:00004E64 00000004 C=BSS S=.bss G=DGROUP M=Mask ACBP=A9 + 0002:00004E68 00000004 C=BSS S=.bss G=DGROUP M=Grids ACBP=A9 + 0002:00004E6C 00000004 C=BSS S=.bss G=DGROUP M=Spin ACBP=A9 + 0002:00004E70 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 + 0002:00004E9C 00002494 C=BSS S=.bss G=DGROUP M=UnitPilote ACBP=A9 + 0002:00007330 00000010 C=BSS S=.bss G=DGROUP M=Importation ACBP=A9 + 0002:00007340 000148A4 C=BSS S=.bss G=DGROUP M=UnitAnalyseSegCDM ACBP=A9 + 0002:0001BBE4 00000014 C=BSS S=.bss G=DGROUP M=UnitConfigTCO ACBP=A9 + 0002:0001BBF8 00000014 C=BSS S=.bss G=DGROUP M=Unit_Pilote_aig ACBP=A9 + 0002:0001BC0C 00001C2C C=BSS S=.bss G=DGROUP M=UnitFicheHoraire ACBP=A9 + 0002:0001D838 00000004 C=BSS S=.bss G=DGROUP M=ShellConsts ACBP=A9 + 0002:0001D83C 0000001C C=BSS S=.bss G=DGROUP M=ShellCtrls ACBP=A9 + 0002:0001D858 00000DF4 C=BSS S=.bss G=DGROUP M=UnitRoute ACBP=A9 + 0002:0001E64C 0000000C C=BSS S=.bss G=DGROUP M=UnitRouteTrains ACBP=A9 + 0002:0001E658 0000000C C=BSS S=.bss G=DGROUP M=UnitInfo ACBP=A9 + 0002:0001E664 00000CB4 C=BSS S=.bss G=DGROUP M=selection_train ACBP=A9 + 0002:0001F318 00000020 C=BSS S=.bss G=DGROUP M=UnitConfigCellTCO ACBP=A9 + 0002:0001F338 00000034 C=BSS S=.bss G=DGROUP M=UnitClock ACBP=A9 + 0002:0001F36C 0000000C C=BSS S=.bss G=DGROUP M=UnitIntro ACBP=A9 + 0002:0001F378 00533C6C C=BSS S=.bss G=DGROUP M=UnitTCO ACBP=A9 + 0002:00552FE4 00000010 C=BSS S=.bss G=DGROUP M=UnitSR ACBP=A9 + 0002:00552FF4 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 + 0002:00553008 00000018 C=BSS S=.bss G=DGROUP M=UnitModifAction ACBP=A9 + 0002:00553020 000005C0 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 + 0002:005535E0 00000038 C=BSS S=.bss G=DGROUP M=UnitHorloge ACBP=A9 + 0002:00553618 000001EC C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 + 0002:00553804 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 + 0002:00553808 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 + 0002:00553814 00000024 C=BSS S=.bss G=DGROUP M=UnitMesure ACBP=A9 + 0002:00553838 28A615D0 C=BSS S=.bss G=DGROUP M=Unitprinc ACBP=A9 Bound resource files @@ -256,6 +258,7 @@ 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 c:\program files (x86)\borland\delphi7\Lib\SPIN.RES +UnitDebug.dfm UnitPilote.dfm Importation.dfm UnitAnalyseSegCDM.dfm @@ -273,14 +276,14 @@ UnitTCO.dfm UnitSR.dfm UnitCDF.dfm UnitModifAction.dfm +UnitConfig.dfm UnitHorloge.dfm verif_version.dfm UnitSimule.dfm +UnitMesure.dfm Unitprinc.dfm -UnitConfig.dfm -UnitDebug.dfm Signaux_complexes_GL.res Signaux_complexes_GL.drf -Program entry point at 0001:001FABB0 +Program entry point at 0001:001C3F78 diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 2eb5441..893fd3b 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -165,7 +165,7 @@ var Segment : array of Tsegment; DernAdrAig,SeqAdrCroisement,nb_det,IndexClic,xAig,yAig,cadre,largeur_voie,dernierSeg, largeurTrain,HauteurTrain : integer; lignes : TStrings; - reducX,reducY,ArcTanHautLargTrain : double; + reducX,reducY,ArcTanHautLargTrain : single; FormAnalyseCDM: TFormAnalyseCDM; sBranche,NomModuleCDM : string; clic,premaff : boolean; @@ -178,7 +178,7 @@ procedure lit_fichier_segments_cdm; procedure affichage(imprime : boolean); procedure Aff_train(adr: integer;train:string;x1,y1,x2,y2 :integer); procedure D_Arc(Canvas: TCanvas; CenterX,CenterY: integer; - rayon: Integer; StartDegres, StopDegres: Double); + rayon: Integer; StartDegres, StopDegres: single); function point_Sur_Segment(x,y,x1,y1,x2,y2 : integer): Boolean; function explore_port_det(seg,port : integer) : integer; function index_segment_act(Adresse : integer;var TabloDetSeg : TdetSeg;var nombre : integer) : boolean; @@ -874,14 +874,14 @@ begin end; // degrés en radians -function degtoRad(angle : double) : double; +function degtoRad(angle : single) : single; begin degtoRad:=angle*pisur180; end; // dessine un arc dans le canvas, dont le centre est CenterX,Y de rayon , angle de départ et de stop en degrés procedure D_Arc(Canvas: TCanvas; CenterX,CenterY: integer; - rayon: Integer; StartDegres, StopDegres: Double); + rayon: Integer; StartDegres, StopDegres: single); var sinA,cosA : extended; x1,x2,x3,x4: Integer; @@ -909,7 +909,7 @@ end; // trouve si le point (x,y) est sur le segment (droit) x1,y1 x2,y2 // s*l = distance du point au segment function point_Sur_Segment(x,y,x1,y1,x2,y2 : integer): Boolean; -var l,r,s : Double; +var l,r,s : single; p : integer; begin Result:=False; @@ -925,8 +925,8 @@ begin end; // trouve si le point x,y est sur l'arc de centre CentreX,Y de rayon .. -function point_sur_arc(x,y,CentreX,centreY,rayon : integer;StartDegres,StopDegres :double;deb : boolean) : boolean; -var a : double; +function point_sur_arc(x,y,CentreX,centreY,rayon : integer;StartDegres,StopDegres : single;deb : boolean) : boolean; +var a : single; cosA,SinA : extended; xArc,yArc : integer; trouve,inverse : boolean; @@ -1007,7 +1007,7 @@ begin end; // trace un arc selon les coordonnées CDM -procedure angle_cdm(canvas : Tcanvas;centreX,centreY:integer;debut,fin : double ;rayon : integer); +procedure angle_cdm(canvas : Tcanvas;centreX,centreY:integer;debut,fin : single ;rayon : integer); begin coords(centreX,centreY); // transforme en coords windows rayon:=round(rayon*reducX) div 1000; @@ -1084,7 +1084,7 @@ end; procedure arc_xy_CDM(canvas : tcanvas;centreX,centreY,rayon,xa,ya,xb,yb : integer); var x1,y1,x2,y2 : integer ; arcXa,arcYa,arcxb,arcYb,angleA,angleB, - cosA,SinA,CosB,SinB: double; + cosA,SinA,CosB,SinB: single; inverse,maxA,maxB,deb : boolean; begin deb:=false; @@ -1206,7 +1206,7 @@ end; // dessine un aiguillage courbe - pas encore au point procedure dessine_aig_courbe(canvas : Tcanvas;i : integer); var numseg,milieuX,milieuY,centreX,centreY,x0,y0,x1,y1,x2,y2,rayon : integer; - b,pente,rayonD,alpha : double; + b,pente,rayonD,alpha : single; coul : Tcolor; s : string; begin @@ -1359,7 +1359,7 @@ procedure peindre(Indextrain,x,y : integer;Zoom : single); var XFormScale,XFormRot,XFormXLat,XForm,XFormOld : TXForm; // matrice GMode,x0,y0,x1,y1,x2,y2,x3,y3,larg,haut,ax,ay,l2,h2 : Integer; - d,alpha,angle,z : double; + d,alpha,angle,z : single; sinA,cosA : extended; tv : array[0..3] of integer; ACanvas : TCanvas; @@ -1486,7 +1486,7 @@ end; procedure Aff_train(adr: integer;train:string;x1,y1,x2,y2 :integer); -var zom : double; +var zom : single; i : integer; begin zom:=reducX/40; @@ -1503,7 +1503,7 @@ var r : Trect; i,j,x1,x2,y1,y2,largeur,hauteur,rayon,centreX,centreY,Numsegment,largeurCDM,hauteurCDM, maxiCDM,offset,ofs,CadreImp : integer; SegType,s,s2,ctyp : string; - Ech,Zoom,startAngle,StopAngle: double; + Ech,Zoom,startAngle,StopAngle: single; portsSeg : array[0..40] of record x,y : integer; end; coul : boolean; canvas : tCanvas; @@ -3840,10 +3840,11 @@ begin Affiche('Importation des aiguillages et des branches',clWhite); // recopier les aiguillages CDM dans signaux_complexes + // pour l'aiguillage triple, son homologue sera créé au tri for i:=1 to NAig_CDM do begin - Aiguillage[i].adresse:=Aig_CDM[i].adresse; tablo_index_aiguillage[aiguillage[i].Adresse]:=i; + Aiguillage[i].adresse:=Aig_CDM[i].adresse; Aiguillage[i].adrtriple:=Aig_CDM[i].adrtriple; Aiguillage[i].modele:=Aig_Cdm[i].modele; Aiguillage[i].temps:=Aig_cdm[i].temps; @@ -3862,13 +3863,12 @@ begin Aiguillage[i].Adevie2:=Aig_CDM[i].Adevie2; Aiguillage[i].Adevie2B:=Aig_CDM[i].Adevie2B; - Aiguillage[i].posInit:=9; aiguillage[i].InversionCDM:=0; aiguillage[i].vitesse:=0; end; MaxAiguillage:=NAig_CDM; - trier_aig; + trier_aig; // et crée les aiguillages triples homologues // remplit la list box les aiguillages formconfig.ListBoxAig.Clear; @@ -4482,7 +4482,7 @@ end; procedure clic_image; var pt : Tpoint; xSouris,ySouris,x1,y1,x2,y2,i,j,centreX,centrey,rayon,numero: integer; - StartAngle,StopAngle : double; + StartAngle,StopAngle : single; trouve : boolean; debug : boolean; ctype,s : string; @@ -4894,7 +4894,7 @@ end; procedure dessine_det(adresse : integer); var p,centreX,CentreY,rayon,i,index,x,y,x1,y1,x2,y2,x3,y3,x4,y4,np,NindexR,NumPort,IndexportSuiv,NumSeg,indexport, xs,ys,nombre,ind1,ind2,per1,per2,IndexSegBumper,PortBumper,port : integer; - StartAngle,stopangle,startDegres,StopDegres : double; + StartAngle,stopangle,startDegres,StopDegres : single; trouve,ts,tn,tp : boolean; ctyp,s : string; canvas : Tcanvas; diff --git a/UnitCDF.pas b/UnitCDF.pas index ead8b15..f704746 100644 --- a/UnitCDF.pas +++ b/UnitCDF.pas @@ -374,6 +374,7 @@ begin end; end; +// Ralen 30 procedure TFormCDF.Edit11Change(Sender: TObject); var erreur,i : integer; begin @@ -388,6 +389,7 @@ begin end; end; +// ralen 60 procedure TFormCDF.Edit12Change(Sender: TObject); var erreur,i: integer; begin @@ -402,6 +404,7 @@ begin end; end; +// rappel 30 procedure TFormCDF.Edit13Change(Sender: TObject); var erreur,i : integer; begin @@ -411,11 +414,12 @@ begin 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; + if label13.Caption=etats[13] then begin Maj_Etat_Signal(0,rappel_30);end; dessine_signal_CDF; end; end; +// rappel 60 procedure TFormCDF.Edit14Change(Sender: TObject); var erreur,i : integer; begin @@ -425,11 +429,12 @@ begin 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; + if label14.Caption=etats[14] then begin Maj_Etat_Signal(0,semaphore);Maj_Etat_Signal(0,rappel_60);end; dessine_signal_CDF; end; end; +// ralen60 jaune cli procedure TFormCDF.Edit15Change(Sender: TObject); var erreur,i : integer; begin @@ -439,11 +444,12 @@ begin 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; + if label15.Caption=etats[15] then begin Maj_Etat_Signal(0,jaune_cli);Maj_Etat_Signal(0,ral_60);end; dessine_signal_CDF; end; end; +// rappel 30 + avertissement procedure TFormCDF.Edit16Change(Sender: TObject); var erreur,i : integer; begin diff --git a/UnitClock.dfm b/UnitClock.dfm index 8f17dbb..d56f5fa 100644 --- a/UnitClock.dfm +++ b/UnitClock.dfm @@ -15,8 +15,8 @@ object FormClock: TFormClock OnCreate = FormCreate OnResize = FormResize DesignSize = ( - 242 - 219) + 234 + 211) PixelsPerInch = 96 TextHeight = 13 object BitBtnMarHor: TBitBtn @@ -226,7 +226,7 @@ object FormClock: TFormClock end object PopupMenuH: TPopupMenu OwnerDraw = True - Left = 216 + Left = 208 Top = 96 object TjsDev: TMenuItem Caption = ' Verrouiller devant' diff --git a/UnitClock.pas b/UnitClock.pas index 69b67e3..dad2db7 100644 --- a/UnitClock.pas +++ b/UnitClock.pas @@ -18,6 +18,7 @@ uses const pisur180=pi/180; pisur360=pi/360; + pisur30=pi/30; pisur6=pi/6; type TFormClock = class(TForm) @@ -49,7 +50,6 @@ type private Ticker : TTimer; - FPen: TPen; // couleur de crayon FBitMap : TBitMap; // arrière plan // Clock variables CenterPoint : TPoint; // Centre des aiguilles @@ -73,7 +73,7 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure tickercall; - procedure DrawArrows; // Draw clock arrows + procedure DrawArrows; // dessine les aiguilles published property Align; @@ -101,7 +101,7 @@ uses UnitConfigCellTCO, UnitPrinc, UnitFicheHoraire; const SecScale=1; // longueur de l'aiguille des secondes - MinScale=0.95; // longueur de l'aiguille des minutes + MinScale=0.93; // longueur de l'aiguille des minutes HouScale=0.60; // longueur de l'aiguille des heures offsetx=20; // décalage x du bitmap l'horloge par rapport à la fenetre offsety=60; // y @@ -118,8 +118,6 @@ begin FArrowColor:=clBlack; ShowSecond:=true; - // Crée le crayon horloge pour le bitmap - FPen:=TPen.Create; // Crée le bitmap d'arrière plan FBitMap:=TBitMap.Create; FBitMap.Width:=Width; @@ -147,7 +145,6 @@ end; destructor TClock.Destroy; begin - FPen.Free; FBitMap.Free; Ticker.Free; inherited Destroy; @@ -176,13 +173,13 @@ var sin,cos :extended; // Dessine les flèches dans le bitmap hors écran - procedure DrawArrow( Angle, Scale : real; AWidth : integer); + procedure DrawArrow(Angle, Scale : real;AWidth : integer); var SR : real; begin with ABitMap.Canvas do begin Pen.Width:=AWidth; - MoveTo(CenterPoint.X, CenterPoint.Y); + MoveTo(CenterPoint.X,CenterPoint.Y); SR:=Scale*Radius; sincos(Angle,sin,cos); LineTo(round(SR*sin)+ CenterPoint.X, @@ -193,32 +190,29 @@ var begin // Crée le bitmap AbitMap hors écran ABitMap:=TBitMap.Create; - FPen.Color:=ClkArrowColor; - try - // dessine les aiguilles sur l'image hors écran - // Attributs du bitmap hors écran - ABitMap.Width:=Width; - ABitMap.Height:=Height; - with ABitMap.Canvas do - begin - Pen:=FPen; - Brush.Color:=clred; - end; - // Copie l'image de fond du bitmap dans le bitmap hors écran - ABitMap.Canvas.CopyMode:=cmSrcCopy; - ABitMap.Canvas.CopyRect(ABitMap.Canvas.ClipRect,FBitMap.Canvas,FBitMap.Canvas.ClipRect); - // Dessine les nouvelles aiguilles dans le bitmap hors écran - if ShowSecond then DrawArrow( seconde*pi/30, SecScale, SecThick); // seconde - DrawArrow(minute*pi/30,MinScale, MinThick); // minute - DrawArrow(HourAngle(heure,minute),HouScale,HouThick); // heure + // dessine les aiguilles sur l'image hors écran + // Attributs du bitmap hors écran + ABitMap.Width:=Width; + ABitMap.Height:=Height; - // Dessine le bitmap hors écran dans l'horloge - Canvas.CopyMode:=cmSrcCopy; - Canvas.Draw(0,0,ABitMap); - formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] ); - finally - ABitMap.Free; + // Copie l'image de fond du bitmap dans le bitmap hors écran + ABitMap.Canvas.CopyMode:=cmSrcCopy; + ABitMap.Canvas.CopyRect(ABitMap.Canvas.ClipRect,FBitMap.Canvas,FBitMap.Canvas.ClipRect); + // Dessine les nouvelles aiguilles dans le bitmap hors écran + if ShowSecond then + begin + ABitMap.Canvas.pen.Color:=$600000; // bleu foncé + DrawArrow(seconde*pisur30, SecScale, SecThick); // seconde end; + ABitMap.Canvas.Pen.color:=ClkArrowColor; + DrawArrow(minute*pisur30,MinScale, MinThick); // minute + DrawArrow(HourAngle(heure,minute),HouScale,HouThick); // heure + + // copie le bitmap hors écran dans l'horloge + Canvas.CopyMode:=cmSrcCopy; + Canvas.Draw(0,0,ABitMap); + formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] ); + ABitMap.Free; end; procedure TClock.CalcClockSettings; @@ -338,6 +332,7 @@ end; procedure calcul_pos_horloge; begin + if not assigned(formclock) or (formclock=nil) or fermeSC then exit; if LargeurFC<150 then begin LargeurFC:=250; @@ -346,9 +341,9 @@ begin formclock.height:=HauteurFC; end; - OffsetYFC:=(formprinc.top+formPrinc.height)-FormClock.height-32; + OffsetYFC:=(formprinc.top+formPrinc.height)-FormClock.height-28; OffsetXFC:=(formprinc.left+formPrinc.width)-formClock.width; - + // écart entre fenetre principale et clock DeltaFPCY:=OffsetYFC-formprinc.top; DeltaFPCX:=OffsetXFC-formprinc.left; @@ -369,7 +364,6 @@ begin SetWindowPos(FormClock.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize); Verrouille:=true; - clock:=tClock.Create(formClock); clock.Parent:=formclock; @@ -473,7 +467,7 @@ end; procedure TFormClock.TjsVerClick(Sender: TObject); begin - SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize); + SetWindowPos(Handle,HWND_TOPMOST, 0, 0, 0, 0,SWP_NoMove or SWP_NoSize); // le checked ne fonctionne pas sous D7, fonctionne sous D12. TjsDev.Checked:=true; Dverrouiller1.Checked:=false; @@ -482,7 +476,7 @@ end; procedure TFormClock.Dverrouiller1Click(Sender: TObject); begin - SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize); + SetWindowPos(Handle,HWND_NOTOPMOST, 0, 0, 0, 0,SWP_NoMove or SWP_NoSize); TjsDev.Checked:=false; Dverrouiller1.Checked:=true; Verrouille:=false; @@ -499,12 +493,11 @@ begin end; - - procedure TFormClock.ButtonGHClick(Sender: TObject); begin formFicheHoraire.showModal; end; + end. diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 363a2ee..3f960c7 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,6 +1,6 @@ object FormConfig: TFormConfig - Left = 202 - Top = 143 + Left = 414 + Top = 95 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' @@ -682,7 +682,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetActionneurs + ActivePage = TabSheetSig Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -856,6 +856,22 @@ object FormConfig: TFormConfig ShowHint = True TabOrder = 7 end + object EditOuvreEcran: TLabeledEdit + Left = 205 + Top = 150 + Width = 28 + Height = 21 + Hint = #39'Num'#233'ro d'#39#39#233'cran sur lequel Signaux_Complexes s'#39'ouvrira' + EditLabel.Width = 173 + EditLabel.Height = 13 + EditLabel.Caption = 'Ouvrir Signaux_Complexes sur '#233'cran' + LabelPosition = lpLeft + LabelSpacing = 10 + ParentShowHint = False + ShowHint = True + TabOrder = 8 + OnChange = EditOuvreEcranChange + end end object GroupBox6: TGroupBox Left = 312 @@ -1361,7 +1377,7 @@ object FormConfig: TFormConfig Width = 257 Height = 25 Hint = 'Initialisation des aiguillages au d'#233'marrage' - Caption = 'Initialiser les aiguillages en position initiale' + Caption = 'Positionner les aiguillages en position initiale' ParentShowHint = False ShowHint = True TabOrder = 0 @@ -1668,7 +1684,7 @@ object FormConfig: TFormConfig end object Label18: TLabel Left = 212 - Top = 73 + Top = 71 Width = 16 Height = 16 Caption = 'S2' @@ -1687,7 +1703,7 @@ object FormConfig: TFormConfig Caption = 'LabelTJD1' end object LabelTJD2: TLabel - Left = 168 + Left = 160 Top = 76 Width = 52 Height = 13 @@ -1836,7 +1852,10 @@ object FormConfig: TFormConfig Top = 20 Width = 33 Height = 21 + Hint = '2'#232'me adresse de l'#39'aiguillage triple' Color = clLime + ParentShowHint = False + ShowHint = True TabOrder = 6 Visible = False OnKeyPress = EditAigTripleKeyPress @@ -2166,7 +2185,7 @@ object FormConfig: TFormConfig Caption = 'Temporisation entre deux commandes (ms)' end object GroupBox12: TGroupBox - Left = 336 + Left = 328 Top = 24 Width = 289 Height = 449 @@ -2584,7 +2603,7 @@ object FormConfig: TFormConfig object RadioGroupLEB: TRadioGroup Left = 8 Top = 224 - Width = 105 + Width = 113 Height = 41 Caption = 'Pilotage' Items.Strings = ( @@ -2597,32 +2616,32 @@ object FormConfig: TFormConfig OnClick = RadioGroupLEBClick end end - object ButtonNouvFeu: TButton + object ButtonNouvSig: TButton Left = 0 Top = 32 Width = 65 Height = 17 Caption = 'Nouveau' TabOrder = 1 - OnClick = ButtonNouvFeuClick + OnClick = ButtonNouvSigClick end - object ButtonSupFeu: TButton + object ButtonSupSig: TButton Left = 72 Top = 32 Width = 65 Height = 17 Caption = 'Supprime' TabOrder = 2 - OnClick = ButtonSupFeuClick + OnClick = ButtonSupSigClick end - object ButtonInsFeu: TButton + object ButtonInsSig: TButton Left = 144 Top = 32 Width = 153 Height = 17 Caption = 'Ajouter le signal supprim'#233 TabOrder = 3 - OnClick = ButtonInsFeuClick + OnClick = ButtonInsSigClick end object CheckBoxRazSignaux: TCheckBox Left = 24 @@ -2635,13 +2654,13 @@ object FormConfig: TFormConfig ShowHint = True TabOrder = 4 end - object EditTempoFeu: TEdit + object EditTempoSignal: TEdit Left = 16 Top = 432 Width = 33 Height = 21 TabOrder = 5 - OnChange = EditTempoFeuChange + OnChange = EditTempoSignalChange end object ListBoxSig: TListBox Left = 0 @@ -2782,7 +2801,7 @@ object FormConfig: TFormConfig Top = 56 Width = 193 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxDecodeurPersoChange end @@ -2801,7 +2820,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxNationChange end @@ -2847,7 +2866,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 6 OnChange = ComboBoxDecCdeChange end @@ -3084,6 +3103,40 @@ object FormConfig: TFormConfig TabOrder = 0 OnChange = LabeledEditAdrActionneurChange end + object Prox1: TLabeledEdit + Left = 200 + Top = 64 + Width = 30 + Height = 21 + Hint = 'Adresse du d'#233'tecteur 1 encadrant' + EditLabel.Width = 161 + EditLabel.Height = 13 + EditLabel.Caption = 'Adresse du d'#233'tecteur 1 encadrant' + EditLabel.Layout = tlBottom + LabelPosition = lpLeft + LabelSpacing = 27 + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnChange = Prox1Change + end + object Prox2: TLabeledEdit + Left = 200 + Top = 88 + Width = 30 + Height = 21 + Hint = 'Adresse du d'#233'tecteur 2 encadrant' + EditLabel.Width = 161 + EditLabel.Height = 13 + EditLabel.Caption = 'Adresse du d'#233'tecteur 2 encadrant' + EditLabel.Layout = tlBottom + LabelPosition = lpLeft + LabelSpacing = 27 + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnChange = Prox2Change + end end end object TabSheetDet: TTabSheet @@ -3092,12 +3145,12 @@ object FormConfig: TFormConfig object Label42: TLabel Left = 8 Top = 8 - Width = 63 - Height = 13 + Width = 76 + Height = 16 Caption = 'D'#233'tecteurs' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack - Font.Height = -11 + Font.Height = -13 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False @@ -3114,9 +3167,9 @@ object FormConfig: TFormConfig Font.Name = 'MS Sans Serif' Font.Style = [] ItemHeight = 13 - MultiSelect = True ParentFont = False TabOrder = 0 + OnKeyDown = ListBoxDetKeyDown OnMouseDown = ListBoxDetMouseDown end object Button4: TButton @@ -3126,6 +3179,7 @@ object FormConfig: TFormConfig Height = 17 Caption = 'Nouveau' TabOrder = 1 + Visible = False OnClick = Button4Click end object Button5: TButton @@ -3135,15 +3189,94 @@ object FormConfig: TFormConfig Height = 17 Caption = 'Supprime' TabOrder = 2 + Visible = False OnClick = Button5Click end object GroupBoxDet: TGroupBox Left = 336 Top = 56 Width = 265 - Height = 161 + Height = 97 Caption = 'Description' TabOrder = 3 + object LEAdrDet: TLabeledEdit + Left = 200 + Top = 32 + Width = 40 + Height = 21 + Hint = 'Adresse du d'#233'tecteur' + EditLabel.Width = 101 + EditLabel.Height = 13 + EditLabel.Caption = 'Adresse du d'#233'tecteur' + EditLabel.Layout = tlBottom + LabelPosition = lpLeft + LabelSpacing = 80 + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnChange = LEAdrDetChange + end + object LElongDet: TLabeledEdit + Left = 200 + Top = 64 + Width = 40 + Height = 21 + Hint = 'Longueur du d'#233'tecteir (cm)' + EditLabel.Width = 131 + EditLabel.Height = 13 + EditLabel.Caption = 'Longueur du d'#233'tecteur (cm)' + EditLabel.Layout = tlBottom + LabelPosition = lpLeft + LabelSpacing = 50 + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnChange = LElongDetChange + end + end + object GroupBox19: TGroupBox + Left = 336 + Top = 168 + Width = 265 + Height = 105 + Caption = 'Arr'#234't sur d'#233'tecteur' + TabOrder = 4 + object Label47: TLabel + Left = 176 + Top = 16 + Width = 67 + Height = 13 + Caption = 'd'#233'calage (cm)' + end + object RadioButtonArrFin: TRadioButton + Left = 8 + Top = 32 + Width = 145 + Height = 17 + Caption = 'Arr'#234't en fin de d'#233'tecteur' + TabOrder = 0 + OnClick = RadioButtonArrFinClick + end + object RadioButtonARMil: TRadioButton + Left = 8 + Top = 64 + Width = 169 + Height = 17 + Caption = 'Arr'#234't au milieu du d'#233'tecteur' + TabOrder = 1 + OnClick = RadioButtonARMilClick + end + object EditDecal: TEdit + Left = 200 + Top = 32 + Width = 40 + Height = 21 + Hint = 'Distance d'#39'arr'#234't avant la fin du d'#233'tecteur en cm' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnChange = EditDecalChange + end end end object TabSheetPN: TTabSheet @@ -3317,7 +3450,7 @@ object FormConfig: TFormConfig Height = 21 Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 10 @@ -3630,206 +3763,13 @@ object FormConfig: TFormConfig Width = 257 Height = 49 end - object GroupBox24: TGroupBox - Left = 296 - Top = 16 - Width = 321 - Height = 441 - Caption = 'Trains' - TabOrder = 0 - object Label51: TLabel - Left = 16 - Top = 50 - Width = 38 - Height = 13 - Caption = 'Adresse' - end - object Label52: TLabel - Left = 16 - Top = 122 - Width = 80 - Height = 13 - Caption = 'Vitesse maximale' - end - object Label53: TLabel - Left = 16 - Top = 26 - Width = 22 - Height = 13 - Caption = 'Nom' - end - object Label56: TLabel - Left = 16 - Top = 74 - Width = 215 - Height = 13 - Caption = 'Vitesse '#224' l'#39'avertissement ou au ralentissement' - end - object Label57: TLabel - Left = 16 - Top = 98 - Width = 79 - Height = 13 - Caption = 'Vitesse nominale' - end - object Label16: TLabel - Left = 16 - Top = 400 - Width = 27 - Height = 13 - Caption = 'Ic'#244'ne' - end - object SpeedButtonOuvre: TSpeedButton - Left = 120 - Top = 392 - Width = 23 - Height = 22 - Hint = 'Charger ic'#244'ne' - Caption = '...' - ParentShowHint = False - ShowHint = True - OnClick = SpeedButtonOuvreClick - end - object Label45: TLabel - Left = 10 - Top = 232 - Width = 111 - Height = 39 - Alignment = taRightJustify - Caption = - 'Arr'#234't temporis'#233' du train sur d'#233'tecteurs : (mode autonome seuleme' + - 'nt)' - WordWrap = True - end - object Label46: TLabel - Left = 24 - Top = 328 - Width = 34 - Height = 13 - Caption = 'Routes' - end - object EditNomTrain: TEdit - Left = 136 - Top = 24 - Width = 169 - Height = 21 - Hint = 'Nom du train' - ParentShowHint = False - ShowHint = True - TabOrder = 0 - OnChange = EditNomTrainChange - end - object EditAdresseTrain: TEdit - Left = 264 - Top = 48 - Width = 41 - Height = 21 - Hint = 'Adresse du d'#233'codeur du train' - ParentShowHint = False - ShowHint = True - TabOrder = 1 - OnChange = EditAdresseTrainChange - end - object EditVitesseMaxi: TEdit - Left = 264 - Top = 120 - Width = 41 - Height = 21 - Hint = 'Vitesse maximale autoris'#233'e par le d'#233'codeur' - ParentShowHint = False - ShowHint = True - TabOrder = 2 - OnChange = EditVitesseMaxiChange - end - object EditVitRalenti: TEdit - Left = 264 - Top = 72 - Width = 41 - Height = 21 - Hint = 'Vitesse apr'#232's l'#39'avertissement' - ParentShowHint = False - ShowHint = True - TabOrder = 3 - OnChange = EditVitRalentiChange - end - object EditVitNom: TEdit - Left = 264 - Top = 96 - Width = 41 - Height = 21 - Hint = 'Vitesse si voie libre' - ParentShowHint = False - ShowHint = True - TabOrder = 4 - OnChange = EditVitNomChange - end - object EditIcone: TEdit - Left = 168 - Top = 392 - Width = 121 - Height = 21 - TabOrder = 5 - OnChange = EditIconeChange - end - object LabeledEditTempoD: TLabeledEdit - Left = 264 - Top = 144 - Width = 41 - Height = 21 - EditLabel.Width = 146 - EditLabel.Height = 26 - EditLabel.Caption = 'Temporisation de d'#233'marrage '#224' l'#39'ouverture de signal (s)' - EditLabel.Layout = tlBottom - EditLabel.WordWrap = True - LabelPosition = lpLeft - LabelSpacing = 100 - TabOrder = 6 - OnChange = LabeledEditTempoDChange - end - object CheckBoxSens: TCheckBox - Left = 16 - Top = 176 - Width = 241 - Height = 17 - Hint = 'Inverse le sens de pilotage en mode roulage' - Caption = 'Sens de pilotage invers'#233 - ParentShowHint = False - ShowHint = True - TabOrder = 7 - OnClick = CheckBoxSensClick - end - object StringGridArr: TStringGrid - Left = 136 - Top = 192 - Width = 177 - Height = 113 - TabOrder = 8 - OnSelectCell = StringGridArrSelectCell - OnSetEditText = StringGridArrSetEditText - RowHeights = ( - 24 - 24 - 24 - 24 - 24) - end - object MemoRoutes: TMemo - Left = 120 - Top = 312 - Width = 185 - Height = 57 - ReadOnly = True - ScrollBars = ssBoth - TabOrder = 9 - end - end object ButtonNT: TButton Left = 8 Top = 48 Width = 73 Height = 17 Caption = 'Nouveau' - TabOrder = 1 + TabOrder = 0 OnClick = ButtonNTClick end object ButtonSupprime: TButton @@ -3838,7 +3778,7 @@ object FormConfig: TFormConfig Width = 75 Height = 17 Caption = 'Supprime' - TabOrder = 2 + TabOrder = 1 OnClick = ButtonSupprimeClick end object ListBoxTrains: TListBox @@ -3856,10 +3796,407 @@ object FormConfig: TFormConfig MultiSelect = True ParentFont = False PopupMenu = PopupMenuListes - TabOrder = 3 + TabOrder = 2 OnKeyDown = ListBoxTrainsKeyDown OnMouseDown = ListBoxTrainsMouseDown end + object PageControlTr: TPageControl + Left = 288 + Top = 16 + Width = 337 + Height = 457 + ActivePage = TtabSheetEt + TabOrder = 3 + object TabSheetTrGen: TTabSheet + Caption = 'G'#233'n'#233'ral' + object GroupBox24: TGroupBox + Left = 0 + Top = 8 + Width = 321 + Height = 417 + Caption = 'Trains' + TabOrder = 0 + object Label51: TLabel + Left = 16 + Top = 50 + Width = 38 + Height = 13 + Caption = 'Adresse' + end + object Label52: TLabel + Left = 16 + Top = 122 + Width = 80 + Height = 13 + Caption = 'Vitesse maximale' + end + object Label53: TLabel + Left = 16 + Top = 26 + Width = 22 + Height = 13 + Caption = 'Nom' + end + object Label56: TLabel + Left = 16 + Top = 74 + Width = 215 + Height = 13 + Caption = 'Vitesse '#224' l'#39'avertissement ou au ralentissement' + end + object Label57: TLabel + Left = 16 + Top = 98 + Width = 79 + Height = 13 + Caption = 'Vitesse nominale' + end + object Label16: TLabel + Left = 32 + Top = 352 + Width = 27 + Height = 13 + Caption = 'Ic'#244'ne' + end + object SpeedButtonOuvre: TSpeedButton + Left = 112 + Top = 344 + Width = 23 + Height = 22 + Hint = 'Charger ic'#244'ne' + Caption = '...' + ParentShowHint = False + ShowHint = True + OnClick = SpeedButtonOuvreClick + end + object Label46: TLabel + Left = 16 + Top = 170 + Width = 148 + Height = 13 + Caption = 'Longueur de la locomotive (cm)' + end + object EditNomTrain: TEdit + Left = 136 + Top = 24 + Width = 169 + Height = 21 + Hint = 'Nom du train' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnChange = EditNomTrainChange + end + object EditAdresseTrain: TEdit + Left = 264 + Top = 48 + Width = 41 + Height = 21 + Hint = 'Adresse du d'#233'codeur du train' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnChange = EditAdresseTrainChange + end + object EditVitesseMaxi: TEdit + Left = 264 + Top = 120 + Width = 41 + Height = 21 + Hint = 'Vitesse maximale autoris'#233'e par le d'#233'codeur' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnChange = EditVitesseMaxihange + end + object EditVitRalenti: TEdit + Left = 264 + Top = 72 + Width = 41 + Height = 21 + Hint = 'Vitesse apr'#232's l'#39'avertissement' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnChange = EditVitRalentiChange + end + object EditVitNom: TEdit + Left = 264 + Top = 96 + Width = 41 + Height = 21 + Hint = 'Vitesse si voie libre' + ParentShowHint = False + ShowHint = True + TabOrder = 4 + OnChange = EditVitNomChange + end + object EditIcone: TEdit + Left = 168 + Top = 344 + Width = 121 + Height = 21 + TabOrder = 5 + OnChange = EditIconeChange + end + object LabeledEditTempoD: TLabeledEdit + Left = 264 + Top = 144 + Width = 41 + Height = 21 + EditLabel.Width = 221 + EditLabel.Height = 13 + EditLabel.Caption = 'Tempo de d'#233'marrage '#224' l'#39'ouverture de signal (s)' + EditLabel.Layout = tlBottom + LabelPosition = lpLeft + LabelSpacing = 28 + TabOrder = 6 + OnChange = LabeledEditTempoDChange + end + object CheckBoxSens: TCheckBox + Left = 16 + Top = 200 + Width = 241 + Height = 17 + Hint = 'Inverse le sens de pilotage en mode roulage' + Caption = 'Sens de pilotage invers'#233 + ParentShowHint = False + ShowHint = True + TabOrder = 7 + OnClick = CheckBoxSensClick + end + object ButtonRdT: TButton + Left = 176 + Top = 288 + Width = 99 + Height = 33 + Hint = 'Fen'#234'tre des routes m'#233'moris'#233'es du train' + Caption = 'Routes du train' + ParentShowHint = False + ShowHint = True + TabOrder = 8 + WordWrap = True + OnClick = ButtonRdTClick + end + object EditLongLoco: TEdit + Left = 264 + Top = 168 + Width = 41 + Height = 21 + Hint = 'Longueur de la locomotive en cm' + ParentShowHint = False + ShowHint = True + TabOrder = 9 + OnChange = EditLongLocoChange + end + end + end + object TabSheet1: TTabSheet + Caption = 'Arr'#234't sur d'#233'tecteurs' + ImageIndex = 1 + object GroupBox14: TGroupBox + Left = 0 + Top = 8 + Width = 321 + Height = 401 + Caption = 'Arr'#234'ts temporis'#233's sur d'#233'tecteurs' + TabOrder = 0 + object Label45: TLabel + Left = 50 + Top = 40 + Width = 192 + Height = 26 + Alignment = taCenter + Caption = + 'Arr'#234't temporis'#233' du train sur routes sur d'#233'tecteurs : (mode auton' + + 'ome seulement)' + WordWrap = True + end + object StringGridArr: TStringGrid + Left = 40 + Top = 88 + Width = 225 + Height = 185 + TabOrder = 0 + OnSelectCell = StringGridArrSelectCell + OnSetEditText = StringGridArrSetEditText + RowHeights = ( + 24 + 24 + 24 + 24 + 24) + end + end + end + object TtabSheetEt: TTabSheet + Caption = 'Etalonnage vitesse' + ImageIndex = 2 + object GroupBox18: TGroupBox + Left = 0 + Top = 8 + Width = 321 + Height = 409 + Caption = 'Param'#232'tres de l'#39#233'talonnage ' + TabOrder = 0 + object LabelEt: TLabel + Left = 16 + Top = 24 + Width = 213 + Height = 26 + Caption = + 'Les 3 coefficients de vitesse sont issus de la proc'#233'dure d'#39#233'talo' + + 'nnage de la mesure du train' + WordWrap = True + end + object LabelErreur: TLabel + Left = 115 + Top = 360 + Width = 3 + Height = 13 + Caption = '.' + end + object LabelV2: TLabel + Left = 56 + Top = 248 + Width = 13 + Height = 13 + Caption = 'V2' + end + object LabelV3: TLabel + Left = 56 + Top = 272 + Width = 13 + Height = 13 + Caption = 'V3' + end + object LabelV1: TLabel + Left = 56 + Top = 224 + Width = 13 + Height = 13 + Caption = 'V1' + end + object Label49: TLabel + Left = 72 + Top = 330 + Width = 26 + Height = 13 + Caption = 'crans' + end + object LabeledEditV1: TLabeledEdit + Left = 224 + Top = 64 + Width = 41 + Height = 21 + EditLabel.Width = 119 + EditLabel.Height = 13 + EditLabel.Caption = 'Vitesse 1 - lente : 0 crans' + LabelPosition = lpLeft + LabelSpacing = 60 + TabOrder = 0 + OnChange = LabeledEditV1Change + end + object LabeledEditV2: TLabeledEdit + Left = 224 + Top = 88 + Width = 41 + Height = 21 + EditLabel.Width = 95 + EditLabel.Height = 13 + EditLabel.Caption = 'Vitesse 2 - moyenne' + LabelPosition = lpLeft + LabelSpacing = 60 + TabOrder = 1 + OnChange = LabeledEditV2Change + end + object LabeledEditV3: TLabeledEdit + Left = 224 + Top = 112 + Width = 41 + Height = 21 + EditLabel.Width = 81 + EditLabel.Height = 13 + EditLabel.Caption = 'Vitesse 3 - rapide' + LabelPosition = lpLeft + LabelSpacing = 60 + TabOrder = 2 + OnChange = LabeledEditV3Change + end + object LabeledEditCalcV: TLabeledEdit + Left = 16 + Top = 328 + Width = 49 + Height = 21 + Hint = 'Vitesse en crans' + EditLabel.Width = 119 + EditLabel.Height = 13 + EditLabel.Hint = 'Consigne en crans (1-120)' + EditLabel.Caption = 'Calcul de la vitesse r'#233'elle' + EditLabel.ParentShowHint = False + EditLabel.ShowHint = True + ParentShowHint = False + ShowHint = True + TabOrder = 3 + Text = '0' + OnChange = LabeledEditCalcVChange + end + object LabeledEditCV3: TLabeledEdit + Left = 224 + Top = 136 + Width = 41 + Height = 21 + EditLabel.Width = 135 + EditLabel.Height = 13 + EditLabel.Caption = 'Valeur du CV3 (acc'#233'l'#233'ration)' + LabelPosition = lpLeft + LabelSpacing = 60 + TabOrder = 4 + OnChange = LabeledEditCV3Change + end + object LabeledEditCV4: TLabeledEdit + Left = 224 + Top = 160 + Width = 41 + Height = 21 + EditLabel.Width = 135 + EditLabel.Height = 13 + EditLabel.Caption = 'Valeur du CV4 (d'#233'c'#233'l'#233'ration)' + LabelPosition = lpLeft + LabelSpacing = 60 + TabOrder = 5 + OnChange = LabeledEditCV4Change + end + object LabeledEditCrans: TLabeledEdit + Left = 224 + Top = 184 + Width = 41 + Height = 21 + EditLabel.Width = 144 + EditLabel.Height = 13 + EditLabel.Caption = 'Nombre de crans du d'#233'codeur' + LabelPosition = lpLeft + LabelSpacing = 60 + TabOrder = 6 + OnChange = LabeledEditCransChange + end + object MemoCalc: TMemo + Left = 112 + Top = 328 + Width = 177 + Height = 73 + Font.Charset = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -12 + Font.Name = 'Arial Narrow' + Font.Style = [] + ParentFont = False + ReadOnly = True + TabOrder = 7 + end + end + end + end end object TabSheetPeriph: TTabSheet Caption = 'P'#233'riph'#233'riques' @@ -3944,6 +4281,20 @@ object FormConfig: TFormConfig 's et actionneurs via les services.' WordWrap = True end + object LabelRC: TLabel + Left = 288 + Top = 312 + Width = 250 + Height = 13 + Caption = 'R'#233'f'#233'rences crois'#233'es de l'#39#39'utilisation des p'#233'riph'#233'riques' + end + object LabelNumeroP: TLabel + Left = 8 + Top = 384 + Width = 59 + Height = 13 + Caption = 'P'#233'riph'#233'rique' + end object ListBoxPeriph: TListBox Left = 8 Top = 96 @@ -4008,6 +4359,64 @@ object FormConfig: TFormConfig TabOrder = 0 OnChange = EditNomPeriphChange end + object EditPortCde: TLabeledEdit + Left = 168 + Top = 54 + Width = 153 + Height = 21 + EditLabel.Width = 134 + EditLabel.Height = 13 + EditLabel.Caption = 'Protocole de communication' + LabelPosition = lpLeft + LabelSpacing = 23 + TabOrder = 1 + OnChange = EditPortCdeChange + end + object CheckBoxCR: TCheckBox + Left = 16 + Top = 80 + Width = 153 + Height = 17 + Hint = 'Envoie un CR apr'#232's toute cha'#238'ne' + Caption = 'Envoyer CR (retour chariot)' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnClick = CheckBoxCRClick + end + object CbVis: TCheckBox + Left = 16 + Top = 104 + Width = 97 + Height = 17 + Hint = 'Affiche le texte '#224' l'#39#233'cran lors des envois' + Caption = 'Mode visible' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnClick = CbVisClick + end + object cbDTR: TCheckBox + Left = 200 + Top = 80 + Width = 97 + Height = 17 + Caption = 'DTR' + TabOrder = 4 + OnClick = cbDTRClick + end + object cbRTS: TCheckBox + Left = 200 + Top = 104 + Width = 97 + Height = 17 + Hint = 'COM/USB uniquement : mise '#224' 0 ou 1 de la ligne RTS' + Caption = 'RTS' + ParentShowHint = False + ShowHint = True + TabOrder = 5 + OnClick = cbRTSClick + end end object ButtonOuvreCom: TButton Left = 14 @@ -4022,10 +4431,393 @@ object FormConfig: TFormConfig WordWrap = True OnClick = ButtonOuvreComClick end + object gp1: TGroupBox + Left = 288 + Top = 208 + Width = 329 + Height = 90 + Caption = 'Services envoy'#233's au p'#233'riph'#233'rique' + TabOrder = 5 + object cbDet: TCheckBox + Left = 16 + Top = 24 + Width = 97 + Height = 17 + Hint = 'Envoie les '#233'v'#232'nements d'#233'tecteurs' + Caption = 'D'#233'tecteurs' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = cbDetClick + end + object CbAct: TCheckBox + Left = 16 + Top = 48 + Width = 97 + Height = 17 + Hint = 'Envoie les '#233'v'#232'nements actionneurs' + Caption = 'Actionneurs' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnClick = CbActClick + end + object CbAig: TCheckBox + Left = 168 + Top = 24 + Width = 97 + Height = 17 + Hint = 'Envoie les '#233'v'#232'nements aiguillages (accessoires)' + Caption = 'Aiguillages' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnClick = CbAigClick + end + end + object MemoPeriph: TMemo + Left = 288 + Top = 328 + Width = 329 + Height = 110 + Hint = 'R'#233'f'#233'rences crois'#233'es de l'#39#39'utilisation des p'#233'riph'#233'riques' + ParentShowHint = False + ReadOnly = True + ShowHint = True + TabOrder = 6 + end + object BoutonCom: TButton + Left = 144 + Top = 424 + Width = 75 + Height = 33 + Hint = 'Affiche les ports COM/USB disponibles' + Caption = 'Lister Coms' + ParentShowHint = False + ShowHint = True + TabOrder = 7 + WordWrap = True + OnClick = BoutonComClick + end end object TabAvance: TTabSheet Caption = 'Avanc'#233 ImageIndex = 10 + object Label50: TLabel + Left = 8 + Top = 8 + Width = 216 + Height = 16 + Caption = 'Param'#232'tres avanc'#233's et experts' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object GroupBoxAvance: TGroupBox + Left = 3 + Top = 32 + Width = 300 + Height = 241 + Caption = 'Jeu de param'#232'tres avanc'#233's' + TabOrder = 0 + object EditNbDetDist: TLabeledEdit + Left = 264 + Top = 22 + Width = 28 + Height = 21 + EditLabel.Width = 204 + EditLabel.Height = 13 + EditLabel.Caption = 'Seuil du nombre de d'#233'tecteurs trop distants' + LabelPosition = lpLeft + LabelSpacing = 53 + TabOrder = 0 + end + object EditNbCantons: TLabeledEdit + Left = 264 + Top = 46 + Width = 28 + Height = 21 + EditLabel.Width = 223 + EditLabel.Height = 13 + EditLabel.Caption = 'Nombre de cantons pr'#233'sence train avant signal' + LabelPosition = lpLeft + LabelSpacing = 33 + TabOrder = 1 + end + object EditFiltrDet: TLabeledEdit + Left = 264 + Top = 70 + Width = 28 + Height = 21 + Hint = + 'Temps de filtrage des d'#233'tecteurs qui passent '#224' 0'#39'+#13+'#39'Mode auto' + + 'nome uniquement'#39 + EditLabel.Width = 241 + EditLabel.Height = 13 + EditLabel.Caption = 'Filtrage des d'#233'tecteurs (x100 ms) - Mode autonome' + LabelPosition = lpLeft + LabelSpacing = 16 + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object EditnCantonsRes: TLabeledEdit + Left = 264 + Top = 94 + Width = 28 + Height = 21 + EditLabel.Width = 226 + EditLabel.Height = 13 + EditLabel.Caption = 'Nombre de cantons '#224' r'#233'server en avant du train' + LabelPosition = lpLeft + LabelSpacing = 30 + ParentShowHint = False + ShowHint = False + TabOrder = 3 + end + object EditAntiTO: TLabeledEdit + Left = 264 + Top = 118 + Width = 28 + Height = 21 + Hint = + 'Temps de filtrage des d'#233'tecteurs qui passent '#224' 0'#39'+#13+'#39'Mode auto' + + 'nome uniquement'#39 + EditLabel.Width = 192 + EditLabel.Height = 13 + EditLabel.Caption = 'Utilisation de l'#39#39'anti timeout Lenz Ethernet' + LabelPosition = lpLeft + LabelSpacing = 65 + ParentShowHint = False + ShowHint = True + TabOrder = 4 + end + object EditTempoTC: TLabeledEdit + Left = 264 + Top = 142 + Width = 28 + Height = 21 + Hint = + 'Temps de filtrage des d'#233'tecteurs qui passent '#224' 0'#39'+#13+'#39'Mode auto' + + 'nome uniquement'#39 + EditLabel.Width = 230 + EditLabel.Height = 13 + EditLabel.Caption = 'Facteur de temporisation de t'#233'l'#233'commande CDM' + LabelPosition = lpLeft + LabelSpacing = 28 + ParentShowHint = False + ShowHint = True + TabOrder = 5 + end + object EditMaxParcours: TLabeledEdit + Left = 264 + Top = 166 + Width = 28 + Height = 21 + Hint = + 'Temps de filtrage des d'#233'tecteurs qui passent '#224' 0'#39'+#13+'#39'Mode auto' + + 'nome uniquement'#39 + EditLabel.Width = 177 + EditLabel.Height = 13 + EditLabel.Caption = 'Nombre maximal d'#39#39#233'l'#233'ments par route' + LabelPosition = lpLeft + LabelSpacing = 80 + ParentShowHint = False + ShowHint = True + TabOrder = 6 + end + object EditMaxRoutes: TLabeledEdit + Left = 248 + Top = 190 + Width = 44 + Height = 21 + Hint = + 'Temps de filtrage des d'#233'tecteurs qui passent '#224' 0'#39'+#13+'#39'Mode auto' + + 'nome uniquement'#39 + EditLabel.Width = 124 + EditLabel.Height = 13 + EditLabel.Caption = 'Nombre maximal de routes' + LabelPosition = lpLeft + LabelSpacing = 117 + ParentShowHint = False + ShowHint = True + TabOrder = 7 + end + object CheckBoxOptionDemiTour: TCheckBox + Left = 8 + Top = 216 + Width = 161 + Height = 17 + Caption = 'Option demi tour des trains' + ParentShowHint = False + ShowHint = True + TabOrder = 8 + end + end + object GroupBoxExpert: TGroupBox + Left = 3 + Top = 280 + Width = 300 + Height = 97 + Caption = 'Jeu de param'#232'tres experts ' + TabOrder = 1 + object EditAlgo: TLabeledEdit + Left = 264 + Top = 17 + Width = 28 + Height = 21 + Hint = 'Algorithme de localisation des trains' + EditLabel.Width = 167 + EditLabel.Height = 13 + EditLabel.Caption = 'Algorithme de localisation des trains' + LabelPosition = lpLeft + LabelSpacing = 88 + ParentShowHint = False + ShowHint = False + TabOrder = 0 + end + object EditMaxSignalSens: TLabeledEdit + Left = 264 + Top = 41 + Width = 28 + Height = 21 + Hint = 'Algorithme de localisation des trains' + EditLabel.Width = 335 + EditLabel.Height = 13 + EditLabel.Caption = + 'Nombre maxi d'#39#233'l'#233'ments de recherche lors d'#39'un signal dans le bon' + + ' sens' + EditLabel.WordWrap = True + LabelPosition = lpLeft + LabelSpacing = 55 + ParentShowHint = False + ShowHint = False + TabOrder = 1 + end + object cbAck: TCheckBox + Left = 8 + Top = 72 + Width = 169 + Height = 17 + Hint = + 'Attendre l'#39'accus'#233' de r'#233'ception de la centrale lors du pilotage d' + + 'es accessoires' + Caption = 'Attendre ACK de la centrale' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + end + object rgPilTrains: TRadioGroup + Left = 315 + Top = 276 + Width = 300 + Height = 69 + Caption = 'M'#233'thode de pilotage des trains vers CDM Rail' + Items.Strings = ( + 'Par adresse de train' + 'Par nom de train') + TabOrder = 2 + end + object RadioServeurCDM: TRadioGroup + Left = 3 + Top = 392 + Width = 300 + Height = 65 + Caption = 'M'#233'thode de d'#233'marrage du serveur de CDM rail' + Items.Strings = ( + 'Par simulation de touches' + 'Par ligne de commande') + TabOrder = 3 + end + object GroupBoxChemin: TGroupBox + Left = 315 + Top = 32 + Width = 300 + Height = 89 + Caption = 'Chemin de fichiers' + TabOrder = 4 + object Label58: TLabel + Left = 64 + Top = 64 + Width = 175 + Height = 13 + Caption = 'Ce chemin sera suivi de "\CDM-Rail"' + end + object EditChemin: TLabeledEdit + Left = 128 + Top = 33 + Width = 164 + Height = 21 + Hint = 'Algorithme de localisation des trains' + EditLabel.Width = 99 + EditLabel.Height = 26 + EditLabel.Caption = 'Chemin Win de CDM (Sans \CDM-Rail)' + EditLabel.WordWrap = True + LabelPosition = lpLeft + LabelSpacing = 20 + ParentShowHint = False + ShowHint = False + TabOrder = 0 + end + end + object GroupBoxAff: TGroupBox + Left = 315 + Top = 136 + Width = 300 + Height = 129 + Caption = 'Affichages de la fen'#234'tre principale' + TabOrder = 5 + object cbAffSig: TCheckBox + Left = 16 + Top = 24 + Width = 169 + Height = 17 + Hint = 'Affiche l'#39#233'tat des signaux lors de leur changement' + Caption = 'Ev'#232'nements signaux' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + end + object cbres: TCheckBox + Left = 16 + Top = 48 + Width = 209 + Height = 17 + Hint = + 'Affiche les r'#233'servations/lib'#233'ration des cantons lors du roulage ' + + 'des trains' + Caption = 'R'#233'servation/lib'#233'ration des cantons' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object cbDebugRoulage: TCheckBox + Left = 16 + Top = 72 + Width = 217 + Height = 17 + Hint = 'Affiche des messages en mode roulage des trains en mode autonome' + Caption = 'Debug roulage' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object cbAffLoc: TCheckBox + Left = 16 + Top = 96 + Width = 145 + Height = 17 + Hint = 'Affiche des messages de localisation des trains' + Caption = 'Localisation trains' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + end + end end end object ButtonEnregistre: TButton diff --git a/UnitConfig.pas b/UnitConfig.pas index 3d3e756..276e939 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -150,9 +150,9 @@ type GroupBox17: TGroupBox; ButtonNouvPN: TButton; ButtonSupPN: TButton; - ButtonNouvFeu: TButton; - ButtonSupFeu: TButton; - ButtonInsFeu: TButton; + ButtonNouvSig: TButton; + ButtonSupSig: TButton; + ButtonInsSig: TButton; ButtonNouvAig: TButton; BoutSupAig: TButton; ButtonAjSup: TButton; @@ -180,7 +180,7 @@ type RadioButtonTJD2: TRadioButton; RadioButtonTJD4: TRadioButton; CheckBoxRazSignaux: TCheckBox; - EditTempoFeu: TEdit; + EditTempoSignal: TEdit; Label35: TLabel; Label36: TLabel; OpenDialogSon: TOpenDialog; @@ -204,13 +204,6 @@ type RichCdeDccpp: TRichEdit; Label10: TLabel; ListBoxTrains: TListBox; - GroupBox24: TGroupBox; - EditNomTrain: TEdit; - EditAdresseTrain: TEdit; - EditVitesseMaxi: TEdit; - Label51: TLabel; - Label52: TLabel; - Label53: TLabel; ButtonNT: TButton; ButtonSupprime: TButton; GroupBox23: TGroupBox; @@ -224,10 +217,6 @@ type Label54: TLabel; Label55: TLabel; EditDebug: TEdit; - Label56: TLabel; - EditVitRalenti: TEdit; - Label57: TLabel; - EditVitNom: TEdit; CheckBoxVerifXpressNet: TCheckBox; PopupMenuRichedit: TPopupMenu; Copier1: TMenuItem; @@ -327,11 +316,6 @@ type ButtonTestAction: TButton; PopupMenuActions: TPopupMenu; ModifAction: TMenuItem; - Label16: TLabel; - EditIcone: TEdit; - SpeedButtonOuvre: TSpeedButton; - LabeledEditTempoD: TLabeledEdit; - CheckBoxSens: TCheckBox; TabSheetActionneurs: TTabSheet; ListBoxActionneurs: TListBox; Label30: TLabel; @@ -348,11 +332,96 @@ type Button5: TButton; GroupBoxDet: TGroupBox; RadioGroupLEB: TRadioGroup; - Label45: TLabel; - StringGridArr: TStringGrid; ImageTrain: TImage; + PageControlTr: TPageControl; + TabSheetTrGen: TTabSheet; + GroupBox24: TGroupBox; + Label51: TLabel; + Label52: TLabel; + Label53: TLabel; + Label56: TLabel; + Label57: TLabel; + Label16: TLabel; + SpeedButtonOuvre: TSpeedButton; Label46: TLabel; - MemoRoutes: TMemo; + EditNomTrain: TEdit; + EditAdresseTrain: TEdit; + EditVitesseMaxi: TEdit; + EditVitRalenti: TEdit; + EditVitNom: TEdit; + EditIcone: TEdit; + LabeledEditTempoD: TLabeledEdit; + CheckBoxSens: TCheckBox; + ButtonRdT: TButton; + EditLongLoco: TEdit; + TabSheet1: TTabSheet; + GroupBox14: TGroupBox; + StringGridArr: TStringGrid; + Label45: TLabel; + TtabSheetEt: TTabSheet; + GroupBox18: TGroupBox; + LabeledEditV1: TLabeledEdit; + LabeledEditV2: TLabeledEdit; + LabeledEditV3: TLabeledEdit; + LabelEt: TLabel; + LabelErreur: TLabel; + GroupBox19: TGroupBox; + RadioButtonArrFin: TRadioButton; + RadioButtonARMil: TRadioButton; + Label47: TLabel; + EditDecal: TEdit; + LabelV2: TLabel; + LabelV3: TLabel; + LabelV1: TLabel; + LabeledEditCalcV: TLabeledEdit; + Label49: TLabel; + LabeledEditCV3: TLabeledEdit; + LabeledEditCV4: TLabeledEdit; + LabeledEditCrans: TLabeledEdit; + MemoCalc: TMemo; + GroupBoxAvance: TGroupBox; + Label50: TLabel; + GroupBoxExpert: TGroupBox; + rgPilTrains: TRadioGroup; + RadioServeurCDM: TRadioGroup; + GroupBoxChemin: TGroupBox; + GroupBoxAff: TGroupBox; + gp1: TGroupBox; + LabelRC: TLabel; + MemoPeriph: TMemo; + LEAdrDet: TLabeledEdit; + LElongDet: TLabeledEdit; + EditPortCde: TLabeledEdit; + BoutonCom: TButton; + EditNbDetDist: TLabeledEdit; + EditNbCantons: TLabeledEdit; + EditFiltrDet: TLabeledEdit; + EditnCantonsRes: TLabeledEdit; + EditAntiTO: TLabeledEdit; + EditTempoTC: TLabeledEdit; + EditMaxParcours: TLabeledEdit; + EditMaxRoutes: TLabeledEdit; + CheckBoxOptionDemiTour: TCheckBox; + EditOuvreEcran: TLabeledEdit; + EditAlgo: TLabeledEdit; + EditMaxSignalSens: TLabeledEdit; + cbAck: TCheckBox; + EditChemin: TLabeledEdit; + Label58: TLabel; + cbAffSig: TCheckBox; + cbres: TCheckBox; + cbDebugRoulage: TCheckBox; + cbAffLoc: TCheckBox; + CheckBoxCR: TCheckBox; + CbVis: TCheckBox; + cbDTR: TCheckBox; + cbRTS: TCheckBox; + cbDet: TCheckBox; + CbAct: TCheckBox; + CbAig: TCheckBox; + LabelNumeroP: TLabel; + Prox1: TLabeledEdit; + Prox2: TLabeledEdit; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton; @@ -373,9 +442,9 @@ type procedure ButtonNouvPNClick(Sender: TObject); procedure ButtonSupAccClick(Sender: TObject); procedure ButtonSupPNClick(Sender: TObject); - procedure ButtonNouvFeuClick(Sender: TObject); - procedure ButtonSupFeuClick(Sender: TObject); - procedure ButtonInsFeuClick(Sender: TObject); + procedure ButtonNouvSigClick(Sender: TObject); + procedure ButtonSupSigClick(Sender: TObject); + procedure ButtonInsSigClick(Sender: TObject); procedure ButtonNouvAigClick(Sender: TObject); procedure BoutSupAigClick(Sender: TObject); procedure ButtonAjSupClick(Sender: TObject); @@ -414,7 +483,7 @@ type procedure PageControlChange(Sender: TObject); procedure RadioButtonTJD2Click(Sender: TObject); procedure RadioButtonTJD4Click(Sender: TObject); - procedure EditTempoFeuChange(Sender: TObject); + procedure EditTempoSignalChange(Sender: TObject); procedure RichBrancheKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ListBoxAigKeyDown(Sender: TObject; var Key: Word; @@ -434,7 +503,7 @@ type procedure ButtonSupprimeClick(Sender: TObject); procedure EditNomTrainChange(Sender: TObject); procedure EditAdresseTrainChange(Sender: TObject); - procedure EditVitesseMaxiChange(Sender: TObject); + procedure EditVitesseMaxihange(Sender: TObject); procedure ButtonNTClick(Sender: TObject); procedure EditVitNomChange(Sender: TObject); procedure EditVitRalentiChange(Sender: TObject); @@ -539,6 +608,34 @@ type procedure StringGridArrSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure EditAigTripleKeyPress(Sender: TObject; var Key: Char); + procedure ButtonRdTClick(Sender: TObject); + procedure EditLongLocoChange(Sender: TObject); + procedure LabeledEditV1Change(Sender: TObject); + procedure LabeledEditV2Change(Sender: TObject); + procedure LabeledEditV3Change(Sender: TObject); + procedure EditDecalChange(Sender: TObject); + procedure RadioButtonArrFinClick(Sender: TObject); + procedure RadioButtonARMilClick(Sender: TObject); + procedure LabeledEditCalcVChange(Sender: TObject); + procedure LabeledEditCV3Change(Sender: TObject); + procedure LabeledEditCV4Change(Sender: TObject); + procedure LabeledEditCransChange(Sender: TObject); + procedure ListBoxDetKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure LEAdrDetChange(Sender: TObject); + procedure LElongDetChange(Sender: TObject); + procedure EditPortCdeChange(Sender: TObject); + procedure BoutonComClick(Sender: TObject); + procedure EditOuvreEcranChange(Sender: TObject); + procedure CheckBoxCRClick(Sender: TObject); + procedure CbVisClick(Sender: TObject); + procedure cbDTRClick(Sender: TObject); + procedure cbRTSClick(Sender: TObject); + procedure cbDetClick(Sender: TObject); + procedure CbActClick(Sender: TObject); + procedure CbAigClick(Sender: TObject); + procedure Prox1Change(Sender: TObject); + procedure Prox2Change(Sender: TObject); private { Déclarations privées } @@ -547,11 +644,7 @@ type procedure modif_editT(Sender : TObject); procedure modif_ComboTS(Sender : TObject); procedure modif_ComboL(Sender : TObject); - procedure cb_onclick(Sender : Tobject); - procedure tb_onChange(sender : TObject); - procedure Bt_onclick(sender : Tobject); procedure tbCde_onchange(Sender : Tobject); - procedure modif_Labeled(Sender : Tobject); {$IF CompilerVersion >= 28.0} procedure modif_ComboStyle(Sender : Tobject); {$IFEND} @@ -569,6 +662,7 @@ AntiTimeoutEthLenz_ch='AntiTimeoutEthLenz'; TempoTC_ch='TempoTC'; Verif_AdrXpressNet_ch='Verif_AdrXpressNet'; debugRoulage_ch='debugRoulage'; +AffLoc_ch='AffLoc'; Filtrage_det_ch='Filtrage_det'; nCantons_Res_ch='nCantonsRes'; MaxSignalSens_ch='Max_Signal_Sens'; @@ -677,54 +771,39 @@ var compt_Ligne,Style_aff,Ancien_Style,Ecran_SC,Max_Signal_Sens,nCantonsRes,ligneClicActionneur, TempoTC,Nbuttoirs,AncLigneClicActionneur,AncligneclicDet,ligneclicDet : integer; - ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort,fermeSC, + ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort, modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains,trouve_section_acccomusb, trouveAvecVerifIconesTCO,Affiche_avert,activ,trouve_section_dec_pers,Z21,AffAigND, - PilotageTrainsCDMNom,LanceHorl,AffSig,AffRes,avecAck : boolean; + PilotageTrainsCDMNom,LanceHorl,AffSig,AffRes,avecAck,affLoc : boolean; fichier : text; - // composants dynamiques - Gp1,GroupBoxAvance,GroupBoxExpert,GroupBoxChemin,GroupBoxAff : TGroupBox; + FormatSettings : TFormatSettings; - CheckBoxCR,Cb1,Cb2,Cb3,CbVis,cbDTR,cbRTS,cbAffSig,cbres,cbAck,CheckBoxOptionDemiTour, - cbDebugRoulage : TCheckBox; - - MemoPeriph : Tmemo; - - EditPortCde,EditV1F,EditV1O,EditV2F,EditV2O,EditV3F,EditV3O,EditV4F,EditV4O,EditV5F,EditV5O, + // composants dynamiques voies PN + EditV1F,EditV1O,EditV2F,EditV2O,EditV3F,EditV3O,EditV4F,EditV4O,EditV5F,EditV5O, EditZdet1V1F,EditZdet2V1F,EditZdet1V1O,EditZdet2V1O, EditZdet1V2F,EditZdet2V2F,EditZdet1V2O,EditZdet2V2O, EditZdet1V3F,EditZdet2V3F,EditZdet1V3O,EditZdet2V3O, EditZdet1V4F,EditZdet2V4F,EditZdet1V4O,EditZdet2V4O, - EditZdet1V5F,EditZdet2V5F,EditZdet1V5O,EditZdet2V5O,EditOuvreEcran, - EditNbDetDist,EditNbCantons,EditFiltrDet,EditAlgo,EditChemin,EditMaxParcours, - EditMaxSignalSens,EditnCantonsRes,EditAntiTO,EditRep,EditTempoTC, - EditMaxRoutes : Tedit; + EditZdet1V5F,EditZdet2V5F,EditZdet1V5O,EditZdet2V5O : tEdit; + // composants dynamiques décodeurs personnalisés EditT : Array[1..10] of Tedit; TextBoxCde : array[1..19] of Tedit; - LabelPortCde,LbPnVoie1,LbAPnVoie1,LbAPnVoie2,LbAPnVoie3,LbAPnVoie4,LbAPnVoie5,LbATitre, - LbZTitre,LbZPnVoie1,LbZPnVoie2,LbZPnVoie3,LbZPnVoie4,LbZPnVoie5,LabelMP,LabelNumeroP, - LabelStyle,LabelOuvreEcran,LabelAvance1,LabelAvance2,LabelAntiTO,LabelCDM, - LabelTD,LabelNC,LabelFiltre,LabelAlgo,LabelNbSignBS,LabelnCantonsRes,LabelTempoTC, - LabelChemin,LabelMaxParcours,LabelRoutes : Tlabel; - - RadioReserve,RadioServeurCDM,rgPilTrains : TradioGroup; + LbPnVoie1,LbAPnVoie1,LbAPnVoie2,LbAPnVoie3,LbAPnVoie4,LbAPnVoie5,LbATitre, + LbZTitre,LbZPnVoie1,LbZPnVoie2,LbZPnVoie3,LbZPnVoie4,LbZPnVoie5, + LabelStyle,LabelAvance1,LabelAvance2 : Tlabel; LabelDecCde : array[1..19] of TLabel; shape1,ShapeZ : Tshape; ShapeT : array[1..10] of TShape; - BoutonCom : Tbutton; - ComboL1,ComboL2,ComboTS1,ComboTS2 : Array[1..10] of TComboBox; ComboStyle : TcomboBox; - Prox1,prox2,LEAdrDet,LElongDet : TlabeledEdit; - function config_com(s : string) : boolean; function connecte_CDM : boolean; procedure decodeAig(s : string;var adr : integer;var B : char); @@ -753,11 +832,10 @@ procedure Maj_icone_train(IImage : Timage;index :integer); implementation uses UnitDebug,UnitTCO, UnitSR, UnitCDF,UnitAnalyseSegCDM, unitPilote, unitclock, - UnitModifAction,UnitConfigCellTCO; + UnitModifAction,UnitConfigCellTCO, UnitRouteTrains; {$R *.dfm} - procedure Maj_Hint_Signal(indexSignal : integer); var s : string; begin @@ -786,7 +864,6 @@ begin if Srvc_Sig then begin s:=s+'SRV=ASIG;';inc(i);end; // service signaux if Srvc_tdcc then begin s:=s+'SRV=TDCC;';inc(i);end; // service info train (si chgt vitesse) - // insère le nombre de paramètres ss:=format('%.*d',[2,i]) ; delete(s,30,2); @@ -919,6 +996,7 @@ function config_com(s : string) : boolean; var sa : string; i,erreur,vitesse : integer; begin + s:=Uppercase(s); sa:=s; prot_serie:=-1; // trouver la vitesse @@ -1174,7 +1252,7 @@ begin // si unisemaf ou LEB, paramètre supplémentaire if (decod=4) or (decod=6) then s:=s+',U'+intToSTR(Signaux[i].unisemaf); - if decod=4 then s:=s+',L'+intToSTR(signaux[i].BinLin); + if (decod=4) then s:=s+',L'+intToSTR(signaux[i].BinLin); // conditions supplémentaires pour le carré for nc:=1 to 6 do @@ -1559,7 +1637,6 @@ begin signaux[i].BinLin:=k; end; - // voir si conditions supplémentaires de carré l:=1; // nombre de parenthèses repeat @@ -1687,9 +1764,12 @@ end; // transforme le détecteur en chaine function encode_detecteur(i : integer) : string; var adr : integer; + s : string; begin adr:=Adresse_detecteur[i]; - result:=intToSTR(adr)+','+intToSTR(detecteur[adr].longueur); + s:=intToSTR(adr)+','+intToSTR(detecteur[adr].longueur)+','; + s:=s+intToSTR(detecteur[adr].ModeArret)+','+intToSTR(detecteur[adr].DistArret); + result:=s; end; // transforme l'actionneur en chaine @@ -1763,7 +1843,7 @@ begin ActionVitesse : s:=s+','+intToSTR(Tablo_Action[i].tabloOp[j].vitesse)+','+Tablo_Action[i].tabloOp[j].train; ActionCdePeriph : s:=s+','+intToSTR(Tablo_Action[i].tabloOp[j].periph)+','+Tablo_Action[i].tabloOp[j].chaine; - ActionFonctionF : s:=s+','+intToSTR(Tablo_Action[i].tabloOp[j].fonctionF)+','+intToSTR(Tablo_Action[i].tabloOp[j].TempoF)+','+Tablo_Action[i].tabloOp[j].train; + ActionFonctionF : s:=s+','+intToSTR(Tablo_Action[i].tabloOp[j].fonctionF)+','+intToSTR(Tablo_Action[i].tabloOp[j].etat)+','+intToSTR(Tablo_Action[i].tabloOp[j].TempoF)+','+Tablo_Action[i].tabloOp[j].train; ActionSon : s:=s+','+Tablo_Action[i].tabloOp[j].train; // nom du fichier ActionTempo : s:=s+','+intToSTR(Tablo_Action[i].tabloOp[j].TempoF); end; @@ -1880,7 +1960,7 @@ begin encode_act_pn:=s; end; - +// encode une entrée de train function Train_tablo(index : integer) : string; var s: string; nc,i : integer; @@ -1889,8 +1969,11 @@ begin begin s:=nom_train+','+inttostr(adresse)+','+ intToSTR(vitmax)+','+intToSTR(vitnominale)+','+ - intToSTR(vitRalenti)+','+NomIcone+','+intToSTR(TempsDemarreSig)+','; - if inverse then s:=s+'1' else s:=s+'0'; + intToSTR(vitRalenti)+','+NomIcone+','+intToSTR(TempsDemarreSig)+','; + if inverse then s:=s+'1,' else s:=s+'0,'; + s:=s+intToSTR(longueur)+','+IntToSTR(ConsV1)+','+IntToSTR(ConsV2)+','+IntToSTR(ConsV3)+','; + s:=s+FloatToSTRF(coeffV1,ffFixed,5,2,FormatSettings)+','+FloatToSTRF(coeffV2,ffFixed,5,2,FormatSettings)+','+FloatToSTRF(coeffV3,ffFixed,5,2,FormatSettings)+','; + s:=s+intToSTR(CV3)+','+intToSTR(CV4)+','+intToSTR(crans); // arrêts sur cantons for i:=1 to ncantons do begin @@ -1942,6 +2025,9 @@ begin writeln(fichierN,sombre_ch+'=',s); if debugRoulage then s:='1' else s:='0'; writeln(fichierN,debugRoulage_ch+'=',s); + if AffLoc then s:='1' else s:='0'; + writeln(fichierN,AffLoc_ch+'=',s); + writeln(fichierN,couleur_fond_ch+'='+IntToHex(couleurFond,6)); if serveurIPCDM_Touche then s:='1' else s:='0'; writeln(fichierN,serveurIPCDM_Touche_ch+'='+s); @@ -2226,13 +2312,19 @@ begin writeln(fichierN,section_trains_ch); for i:=1 to ntrains do begin - // route du train : writeln(fichierN,Train_tablo(i)); - if trains[i].route[0].adresse<>0 then Writeln(fichierN,'{'+route_totale_to_string(trains[i].routePref)+'}'); + // route du train + for j:=1 to trains[i].routePref[0][0].adresse do + begin + s:='['+trains[i].NomRoute[j]+']'+','; + if trains[i].routePref[j][0].talon then s:=s+'1' else s:=s+'0'; + writeln(fichierN,s); + if trains[i].routePref[j][0].adresse<>0 then Writeln(fichierN,'{'+route_totale_to_string(trains[i].routePref[j])+'}'); + end; end; writeln(fichierN,'0'); - // placement des trains + // placement des trains dans les cantons writeln(fichierN,'/------------'); writeln(fichierN,section_placement_ch); for i:=1 to ntrains do @@ -2367,11 +2459,41 @@ begin end; // trier les aiguillages par adresses croissantes +// et complète les aiguillages triples procedure trier_aig; var i,j,adr : integer; temp : TAiguillage; s : string; begin + // trouve les aig triple + // attribue les index + i:=1; + while (inil then begin @@ -2420,9 +2529,10 @@ begin end; // trie les signaux par adresses croissantes -procedure trier_sig; +procedure trier_signaux; var i,j,l,longestLength,pixelLength : integer; s,LongestString : string; + tabloDet : TTabloDet; temp : TSignal; begin for i:=1 to NbreSignaux-1 do @@ -2444,6 +2554,14 @@ begin tablo_index_signal[Signaux[i].adresse]:=i; end; + // trouver les détecteurs amont des signaux et les range dans la structure des signaux + for i:=1 to NbreSignaux do + begin + adr:=Signaux[i].adresse; + det_prec_signal(adr,TabloDet); + Signaux[i].DetAmont:=TabloDet; + end; + if formconfig<>nil then begin formconfig.ListBoxSig.Clear; @@ -2495,9 +2613,8 @@ var train,s,sa,SOrigine: string; virgule,i_detect,erreur,aig2,detect,offset,j,position,i, ComptEl,Compt_IT,Num_Element,adr,Nligne,postriple,itl,vers, postjd,postjs,nv,it,Num_Champ,asp,adraig,poscroi,idtrain : integer; - tabloDet : TTabloDet; - - versR : double; + + versR : single; function lit_ligne : string ; var esp,l1,l2 : integer; @@ -2849,14 +2966,6 @@ var train,s,sa,SOrigine: string; Tablo_Action[maxTablo_act].TabloOp[1].chaine:=s; - - { - i:=pos(',',sOrigine); - i:=posEx(',',sOrigine,i+1); - i:=posEx(',',sOrigine,i+1); - i:=posEx(',',sOrigine,i+1); - Delete(sOrigine,1,i); - Tablo_Action[maxTablo_act].trainDest:=sOrigine;} inc(maxTablo_act); // incrémenter index de stockage du tableau des actionneurs s:=''; end @@ -2899,115 +3008,112 @@ var train,s,sa,SOrigine: string; inc(Nligne); end; // Passage à niveau----------------------------------------- - if (pos('PN',s)<>0) then - begin - s:=sOrigine; - inc(NbrePN); - NbreVoies:=0; - repeat - inc(NbreVoies); - Delete(s,1,1); // supprime ( - // déterminer si il y a un - avant le ) - j:=pos(')',s); - i:=pos('-',s); - if (i0) then - begin - // zone de détection - Tablo_PN[NbrePN].actionneur:=false; - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].detZ1F:=j; - delete(s,1,erreur); - - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].detZ2F:=j; - delete(s,1,erreur); - - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].detZ1O:=j; - delete(s,1,erreur); - - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].detZ2O:=j; - end - else - begin - // actionneurs - Tablo_PN[NbrePN].actionneur:=true; - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].ActFerme:=j; - // Affiche('Ferme='+intToSTR(j),clyellow); - i:=pos(',',s); - Delete(S,1,i); - val(s,j,erreur); - Tablo_PN[NbrePN].voie[NbreVoies].ActOuvre:=j; - // Affiche('Ouvre='+intToSTR(j),clyellow); - end; - - i:=pos(')',s);Delete(S,1,i); - i:=pos(',',s);Delete(S,1,i); - Tablo_PN[NbrePN].compteur:=0; - until (uppercase(copy(s,1,2))='PN') or (NbreVoies=5); - - Tablo_PN[NbrePN].NbVoies:=NbreVoies; - Delete(s,1,3); // Supprime PN( - val(s,j,erreur); - Tablo_PN[NbrePN].Adresseferme:=j; // adresse ferme ou numéro accessoire - Delete(s,1,erreur); - // prendre le 4 paramètre (commande ACC ou COMUSB - i:=pos(',',s); - i:=posEx(',',s,i+1); - i:=posEx(',',s,i+1); - i:=posEx(',',s,i+1); - val(copy(s,i+1,1),asp,erreur); - if asp=0 then // S peut peut être un nombre ou une chaine + if (pos('PN',s)<>0) then + begin + s:=sOrigine; + inc(NbrePN); + NbreVoies:=0; + repeat + inc(NbreVoies); + Delete(s,1,1); // supprime ( + // déterminer si il y a un - avant le ) + j:=pos(')',s); + i:=pos('-',s); + if (i0) then begin + // zone de détection + Tablo_PN[NbrePN].actionneur:=false; val(s,j,erreur); - Tablo_PN[NbrePN].CommandeFerme:=j; - j:=pos(',',s); - Delete(s,1,j); // supprime séparateurs + Tablo_PN[NbrePN].voie[NbreVoies].detZ1F:=j; + delete(s,1,erreur); val(s,j,erreur); - Tablo_PN[NbrePN].AdresseOuvre:=j; - Delete(s,1,erreur); + Tablo_PN[NbrePN].voie[NbreVoies].detZ2F:=j; + delete(s,1,erreur); + val(s,j,erreur); - Tablo_PN[NbrePN].CommandeOuvre:=j; + Tablo_PN[NbrePN].voie[NbreVoies].detZ1O:=j; + delete(s,1,erreur); + + val(s,j,erreur); + Tablo_PN[NbrePN].voie[NbreVoies].detZ2O:=j; end else begin - // commande usb + // actionneurs + Tablo_PN[NbrePN].actionneur:=true; + val(s,j,erreur); + Tablo_PN[NbrePN].voie[NbreVoies].ActFerme:=j; + // Affiche('Ferme='+intToSTR(j),clyellow); i:=pos(',',s); - Tablo_PN[NbrePN].CommandeF:=copy(s,1,i-1); - delete(s,1,i); - i:=pos(',',s); - Tablo_PN[NbrePN].CommandeO:=copy(s,1,i-1); - delete(s,1,i); - + Delete(S,1,i); + val(s,j,erreur); + Tablo_PN[NbrePN].voie[NbreVoies].ActOuvre:=j; + // Affiche('Ouvre='+intToSTR(j),clyellow); end; - j:=pos(')',s); + + i:=pos(')',s);Delete(S,1,i); + i:=pos(',',s);Delete(S,1,i); + Tablo_PN[NbrePN].compteur:=0; + until (uppercase(copy(s,1,2))='PN') or (NbreVoies=5); + + Tablo_PN[NbrePN].NbVoies:=NbreVoies; + Delete(s,1,3); // Supprime PN( + val(s,j,erreur); + Tablo_PN[NbrePN].Adresseferme:=j; // adresse ferme ou numéro accessoire + Delete(s,1,erreur); + // prendre le 4 paramètre (commande ACC ou COMUSB + i:=pos(',',s); + i:=posEx(',',s,i+1); + i:=posEx(',',s,i+1); + i:=posEx(',',s,i+1); + val(copy(s,i+1,1),asp,erreur); + if asp=0 then // S peut peut être un nombre ou une chaine + begin + val(s,j,erreur); + Tablo_PN[NbrePN].CommandeFerme:=j; + j:=pos(',',s); Delete(s,1,j); // supprime séparateurs - if length(s)>0 then - begin - // champ impulsion nouvelle syntaxe - if s[1]=',' then delete(s,1,1); - val(s,i,erreur); - Tablo_PN[NbrePN].Pulse:=i; - if erreur<>0 then - begin - delete(s,1,erreur); - val(s,i,erreur); - Tablo_PN[NbrePN].TypeCde:=i; - end; - s:=''; + val(s,j,erreur); + Tablo_PN[NbrePN].AdresseOuvre:=j; + Delete(s,1,erreur); + val(s,j,erreur); + Tablo_PN[NbrePN].CommandeOuvre:=j; + end + else + begin + // commande usb + i:=pos(',',s); + Tablo_PN[NbrePN].CommandeF:=copy(s,1,i-1); + delete(s,1,i); + i:=pos(',',s); + Tablo_PN[NbrePN].CommandeO:=copy(s,1,i-1); + delete(s,1,i); end; + j:=pos(')',s); + Delete(s,1,j); // supprime séparateurs + if length(s)>0 then + begin + // champ impulsion nouvelle syntaxe + if s[1]=',' then delete(s,1,1); + val(s,i,erreur); + Tablo_PN[NbrePN].Pulse:=i; + if erreur<>0 then + begin + delete(s,1,erreur); + val(s,i,erreur); + Tablo_PN[NbrePN].TypeCde:=i; + end; + s:=''; end; end; + end; until (s='0') or eof(fichier) ; dec(maxTablo_act); end; - // nouveaux procedure compile_actions; var n,k,l : integer; begin @@ -3262,6 +3368,12 @@ var train,s,sa,SOrigine: string; Val(s,i,erreur);Delete(s,1,erreur); Tablo_Action[maxtablo_act].tabloOp[k].fonctionF:=i; Val(s,i,erreur);Delete(s,1,erreur); + // si version >9.4, champ supplémentaire + if versR>=9.41 then + begin + Tablo_Action[maxtablo_act].tabloOp[k].Etat:=i; + Val(s,i,erreur);Delete(s,1,erreur); + end; Tablo_Action[maxtablo_act].tabloOp[k].TempoF:=i; i:=pos(',',s); if i<>0 then @@ -3552,7 +3664,6 @@ var train,s,sa,SOrigine: string; delete(enregistrement,1,virgule); end; - inc(itl); until (enregistrement='') or (itl>3); if itl>4 then begin Affiche('Erreur 400 ligne '+sOrigine,clred);exit;end; @@ -3730,51 +3841,64 @@ var train,s,sa,SOrigine: string; end; procedure compile_route(s : string); - var v,i,erreur,n : integer; + var v,i,j,erreur,n : integer; + bug : boolean; begin + j:=trains[ntrains].routePref[0][0].adresse; // index de la route s:=lowercase(s); - if s[1]='{' then delete(s,1,1); - n:=0;i:=1; - with trains[ntrains] do - repeat - val(s,v,erreur); //{540->91 dev->92 droit->105 droit->106 droit->566} - routePref[i].adresse:=v; - delete(s,1,erreur-1); - if (s[1]='-') or (s[1]='}') then begin routePref[i].typ:=det;routePref[i].pos:=0;end - else - begin - if s[1]=' ' then delete(s,1,1); - routePref[i].typ:=aiguillage[index_aig(v)].modele; // type de l'aiguillage; - if copy(s,1,3)='dev' then begin delete(s,1,3);routePref[i].pos:=const_devie;end; - if copy(s,1,5)='droit' then begin delete(s,1,5);routePref[i].pos:=const_droit;end; - end; - delete(s,1,2); - inc(i); - - until length(s)<2; - trains[ntrains].routePref[0].adresse:=i-1; + if s<>'' then + if s[1]='{' then + begin + delete(s,1,1); + n:=0;i:=1; // i est l'index de l'élément dans la routePref + with trains[ntrains] do + repeat + val(s,v,erreur); //{540->91 dev->92 droit->105 droit->106 droit->566} + // détection bug ancien croisement codé en 1030 + bug:=v>1000; + if bug then + begin + v:=v div 10; + routePref[j][i].pos:=0; + end; + routePref[j][i].adresse:=v; + delete(s,1,erreur-1); + while s[1]=' ' do + begin + delete(s,1,1); + end; + if ((s[1]='-') or (s[1]='}')) and not bug then begin routePref[j][i].typ:=det;routePref[j][i].pos:=0;end + else + begin + if s[1]=' ' then delete(s,1,1); + routePref[j][i].typ:=aiguillage[index_aig(v)].modele; // type de l'aiguillage; + if copy(s,1,3)='dev' then begin delete(s,1,3);routePref[j][i].pos:=const_devie;end; + if copy(s,1,5)='droit' then begin delete(s,1,5);routePref[j][i].pos:=const_droit;end; + if copy(s,1,5)='crois' then begin delete(s,1,5);routePref[j][i].pos:=0;end; + end; + delete(s,1,2); + inc(i); + until length(s)<2; + trains[ntrains].routePref[j][0].adresse:=i-1; + end; end; procedure compile_trains; - var i,erreur : integer; + var i,j,erreur,n : integer; + r : single; + ss : string; + lire,trouveNom,sens : boolean; begin ntrains:=0; + + lire:=true; repeat - lit_ligne; - - if length(s)>0 then - if s[1]='{' then - begin - compile_route(s); - while (pos('}',s)<>0) do - begin - lit_ligne; - end; - end; - + if lire then s:=lit_ligne; + lire:=true; if s<>'0' then begin - inc(ntrains); + inc(nTrains); + sa:=sOrigine; i:=pos(',',s); if i<>0 then @@ -3846,7 +3970,120 @@ var train,s,sa,SOrigine: string; delete(s,1,erreur-1); end; - // détecteurs d'arret + if versR>9.41 then + begin + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].longueur:=i; + delete(s,1,erreur-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].ConsV1:=i; + delete(s,1,erreur-1); + end; + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].ConsV2:=i; + delete(s,1,erreur-1); + end; + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].ConsV3:=i; + delete(s,1,erreur-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + i:=pos(',',s); + ss:=copy(s,1,i-1); + try + r:=StrToFloat(ss,FormatSettings); + except + r:=0; + Affiche('Erreur 93 : Format flottant incorrect : '+ss+' dans '+sOrigine,clred); + end; + trains[ntrains].CoeffV1:=r; + delete(s,1,i-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + i:=pos(',',s); + ss:=copy(s,1,i-1); + try + r:=StrToFloat(ss,FormatSettings); + except + r:=0; + Affiche('Erreur 94 : Format flottant incorrect : '+ss+' dans '+sOrigine,clred); + end; + trains[ntrains].CoeffV2:=r; + delete(s,1,i-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + i:=pos(',',s); + if i<>0 then ss:=copy(s,1,i-1) else ss:=s; + try + r:=StrToFloat(ss,FormatSettings); + except + r:=0; + Affiche('Erreur 95 : Format flottant incorrect : '+ss+' dans '+sOrigine,clred); + end; + trains[ntrains].CoeffV3:=r; + if i<>0 then delete(s,1,i-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].CV3:=i; + delete(s,1,erreur-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].CV4:=i; + delete(s,1,erreur-1); + end; + + i:=pos(',',s); + if i<>0 then + begin + delete(s,i,1); + val(s,i,erreur); + trains[ntrains].crans:=i; + delete(s,1,erreur-1); + end; + + end; + + // détecteurs d'arret i:=pos(',',s); if i<>0 then begin @@ -3856,7 +4093,7 @@ var train,s,sa,SOrigine: string; if s[1]='P' then begin delete(s,1,1); - if s[1]='A' then + if s[1]='A' then begin trains[ntrains].DetecteurArret[j].TPrec:=aig; delete(s,1,1); @@ -3882,9 +4119,52 @@ var train,s,sa,SOrigine: string; delete(s,1,erreur); end; inc(j); - until s=''; + until (s='') or (j>10); + end; + end; + + // y a t-il une route + lit_ligne; + lire:=false; + if length(s)>0 then + while (s[1]='{') or (s[1]='[') do + begin + sens:=false; + trouveNom:=false; + if s[1]='[' then + begin + s:=sOrigine; + trouveNom:=true; + j:=trains[ntrains].RoutePref[0][0].adresse; + inc(j); + trains[ntrains].RoutePref[0][0].Adresse:=j; + delete(s,1,1); + i:=pos(']',s); + trains[ntrains].nomRoute[j]:=copy(s,1,i-1); + delete(s,1,i); + // + i:=pos(',',s); + if i<>0 then + begin + // sens de la consigne de la route + delete(s,1,1); + sens:=s[1]='1'; + end; + lit_ligne; end; + if s[1]='{' then + begin + if not trouveNom then + begin + inc(trains[ntrains].RoutePref[0][0].adresse); // si route sans nom, incrémeter l'index de route + end; + n:=trains[ntrains].RoutePref[0][0].adresse; + trains[ntrains].routePref[n,0].talon:=sens; + compile_route(s); + lit_ligne; + lire:=false; + end; end; until (sOrigine='0') or (ntrains>=Max_Trains); @@ -3893,6 +4173,7 @@ var train,s,sa,SOrigine: string; trains[i].canton:=0; trains[i].x:=-999999; trains[i].y:=-999999; + calcul_equations_coeff(i); end; if ntrains>1 then with Formprinc do @@ -3900,7 +4181,6 @@ var train,s,sa,SOrigine: string; ComboTrains.ItemIndex:=0; editadrtrain.Text:=inttostr(trains[1].adresse); end; - end; procedure compile_periph; @@ -4010,6 +4290,19 @@ var train,s,sa,SOrigine: string; delete(s,1,erreur); val(s,i,erreur); detecteur[j].longueur:=i; + if erreur<>0 then + begin + delete(s,1,erreur); + val(s,i,erreur); + detecteur[j].ModeArret:=i; + end; + if erreur<>0 then + begin + delete(s,1,erreur); + val(s,i,erreur); + detecteur[j].distArret:=i; + end; + end; until (sOrigine='0') or (s=''); end; @@ -4487,6 +4780,15 @@ var train,s,sa,SOrigine: string; debugRoulage:=s='1'; end; + sa:=uppercase(AffLoc_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + inc(nv); + delete(s,i,length(sa)); + AffLoc:=s='1'; + end; + // avec demande de position des aiguillages en mode autonome au démarrage sa:=uppercase(Init_dem_aig_ch)+'='; i:=pos(sa,s); @@ -4850,7 +5152,7 @@ var train,s,sa,SOrigine: string; begin trouve_section_sig:=true; compile_signaux; - trier_sig; + trier_signaux; end; // section anciens actionneurs @@ -4907,6 +5209,7 @@ var train,s,sa,SOrigine: string; i:=1; repeat lit_ligne; + s:=sOrigine; if s<>'0' then begin j:=pos(',',s); @@ -5095,6 +5398,7 @@ begin reset(fichier); end; readln(fichier,s); + // trouver la version avec laquelle le fichier de config a été créé i:=pos('version',s); if i<>0 then begin @@ -5160,16 +5464,18 @@ begin {$IF CompilerVersion >= 28.0} sombre:=false; {$IFEND} - - // trouver les détecteurs amont des signaux et les range dans la structure des signaux - for i:=1 to NbreSignaux do - begin - adr:=Signaux[i].adresse; - det_prec_signal(adr,TabloDet); - Signaux[i].DetAmont:=TabloDet; - end; end; +// génère les informations calculées +procedure genere_informations_BD; +var tabloDet : TTabloDet; +begin + renseigne_TJDs_TCO; + trier_aig; + renseigne_tous_cantons; + trier_cantons; + trier_signaux; +end; // sauvegarder la config dans le fichier cfg function Sauve_config : boolean; @@ -5305,13 +5611,7 @@ begin begin if (AdresseIP<>'0') and (adresseIP<>'') then begin - Affiche('demande connexion à la centrale Lenz par Ethernet',clyellow); - With Formprinc do - begin - ClientSocketInterface.port:=portInterface; - ClientSocketInterface.Address:=AdresseIP; - ClientSocketInterface.Open; - end; + connecte_interface_ethernet; end end; @@ -5370,6 +5670,7 @@ begin AffSig:=cbAffSig.Checked; AffRes:=cbRes.checked; DebugRoulage:=cbDebugRoulage.Checked; + AffLoc:=cbAffLoc.checked; AvecAck:=cbAck.Checked; Option_DemiTour:=CheckBoxOptionDemiTour.checked; sombre:=CheckBoxSombre.Checked; @@ -5630,31 +5931,6 @@ begin if typ=1 then Champs_dec_Periph; end; -procedure TformConfig.Bt_onclick(sender : TObject); -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; - if pos('Aig',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvAig:=cb.Checked; - if pos('Det',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvDet:=cb.Checked; - if pos('Act',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvAct:=cb.Checked; - if pos('Vis',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].ScvVis:=cb.Checked; - if pos('DTR',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].dtr:=cb.Checked;; - if pos('RTS',s)<>0 then Tablo_periph[ligneClicAccPeriph+1].rts:=cb.Checked; - - if s='CheckBoxCR' then Tablo_periph[ligneClicAccPeriph+1].CR:=cb.Checked; - s:=encode_Periph(ligneClicAccPeriph+1); - ListBoxPeriph.Items[ligneClicAccPeriph]:=s; - ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; -end; // ajoute les champs des périphériques dans les combos procedure ajoute_champs_combos(i : integer); @@ -5827,51 +6103,6 @@ begin end; {$IFEND} -// textbox du protocole -procedure TformConfig.tb_onChange(sender : TObject); -var s,te : string; - tb : Tedit; - i,v : integer; -begin - if clicliste or (ligneClicAccPeriph<0) then exit; - tb:=sender as Tedit; - s:=tb.Name; - te:=tb.text; - if s='EditPortCde' then Tablo_periph[ligneClicAccPeriph+1].Protocole:=te; - s:=encode_Periph(ligneClicAccPeriph+1); - ListBoxPeriph.Items[ligneClicAccPeriph]:=s; - i:=pos(':',te);if i=0 then begin LabelInfo.caption:='Syntaxe incorrecte';exit;end; - te:=copy(te,1,i); - i:=extract_int(te); - if i=0 then begin LabelInfo.caption:='Erreur COM nul';exit;end; - LabelInfo.caption:=''; - - Tablo_periph[ligneClicAccPeriph+1].NumCom:=i; - ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; - - maj_champs_combos(ligneClicAccPeriph+1); - - // recalculer le nombre de sockets et de comusb - // et réaffecter les numéros de composants - NbPeriph_COMUSB:=0; - NbPeriph_Socket:=0; - for i:=1 to NbMaxi_Periph do - begin - v:=com_socket(i); - if v=1 then - begin - inc(NbPeriph_COMUSB); - if NbPeriph_COMUSB>MaxComUSBPeriph then labelInfo.Caption:='Nombre maxi de périphériques COM/USB atteint'; - Tablo_periph[i].numComposant:=NbPeriph_COMUSB; - end; - if v=2 then - begin - inc(NbPeriph_Socket); - if NbPeriph_Socket>MaxComSocketPeriph then labelInfo.Caption:='Nombre maxi de périphériques socket atteint'; - Tablo_periph[NbPeriph].numComposant:=NbPeriph_socket; - end; - end; -end; procedure couleurs_config; var i : integer; @@ -6068,6 +6299,7 @@ begin Affiche_avert:=false; if affevt then affiche('FormConfig create',clLime); PageControl.ActivePage:=Formconfig.TabSheetCDM; // force le premier onglet sur la page + PageControlTR.ActivePage:=FormConfig.TabSheetTrGen; ButtonImRCDM.Hint:='Importation des actionneurs depuis le fichier '+#13+NomModuleCDM; Aig_supprime.Adresse:=0; Signal_Supprime.Adresse:=0; @@ -6115,42 +6347,18 @@ begin RowCount:=NbDetArret+1; Options := StringGridArr.Options + [goEditing]; ColWidths[0]:=0; // colonne grise invisible - ColWidths[1]:=55; // Précédent - ColWidths[2]:=55; // détecteur - ColWidths[3]:=38; // temps + ColWidths[1]:=70; // Précédent + ColWidths[2]:=70; // détecteur + ColWidths[3]:=55; // temps Cells[1,0]:='Précédent'; Cells[2,0]:='Détecteur'; Cells[3,0]:='Temps (s)'; - for i:=0 to RowCount-1 do - RowHeights[i]:=15; + for i:=0 to RowCount-1 do + RowHeights[i]:=18; end; - // création des champs dynamiques de l'onglet CDM Rail - EditOuvreEcran:=TEdit.create(GroupBox5); - with EditOuvreEcran do - begin - Name:='EditOuvreEcran'; - left:=220;Top:=152;Width:=20;Height:=21; - text:=''; - parent:=GroupBox5; - visible:=true; - Text:='1'; - Hint:='Numéro d''écran sur lequel Signaux_Complexes s''ouvrira'; - showHint:=true; - onChange:=formConfig.modif_editT; - end; - LabelOuvreEcran:=Tlabel.Create(GroupBox5); - with LabelOuvreEcran do - begin - Name:='LabelOuvreEcran'; - left:=20;Top:=156;Width:=110;Height:=13; - caption:='Ouvrir Signaux_Complexes sur écran'; - parent:=GroupBox5; - ShowHint:=false; - visible:=true; - end; - {$IFDEF CompilerVersion < 28.0}} //- Delphi7 ----------------------------------------- + {$IFDEF CompilerVersion < 28.0} //- Delphi7 ----------------------------------------- labelD12.Visible:=true; {$ENDIF} {$IFDEF WIN64} // si compilé en 64 bits @@ -6158,21 +6366,10 @@ begin LabelD12.Left:=730; {$ENDIF} - rgPilTrains:=TRadioGroup.Create(FormConfig.TabSheetPeriph); - with rgPilTrains do - begin - Left:=GroupBoxDivers.Left;Top:=GroupBoxDivers.top+GroupBoxDivers.Height+10;width:=GroupBoxDivers.width;Height:=55; - caption:='Méthode de pilotage des trains vers CDM Rail'; - name:='gbPilTrains'; - parent:=TabSheetCDM; - hint:='Choix du mode de pilotage des trains'+#13+ + rgPilTrains.hint:='Choix du mode de pilotage des trains'+#13+ 'par adresse ou par nom'; - ShowHint:=true; - items.Add('par adresse de train'); - items.Add('par nom de train'); - end; - // création des champs dynamiques de l'onglet décodeurs + // création des champs dynamiques de l'onglet décodeurs personnalisés for i:=1 to 10 do begin y:=i*40+20; @@ -6770,72 +6967,6 @@ begin onChange:=formConfig.modif_editT; end; - // actionneurs - Prox1:=TlabeledEdit.Create(FormConfig.GroupBoxAct); - with Prox1 do - begin - Name:='Prox1'; - left:=190;Top:=68;Width:=40;Height:=21; - text:=''; - parent:=GroupBoxAct; - hint:='Adresse du détecteur 1 encadrant'; - showhint:=true; - onChange:=formConfig.modif_Labeled; - LabelSpacing:=20; - editLabel.Caption:='Adresse du détecteur 1 encadrant'; - editLabel.Layout:=tlBottom; - LabelPosition:=lpLeft; - end; - // actionneurs - Prox2:=TlabeledEdit.Create(FormConfig.GroupBoxAct); - with Prox2 do - begin - Name:='Prox2'; - left:=190;Top:=90;Width:=40;Height:=21; - text:=''; - parent:=GroupBoxAct; - hint:='Adresse du détecteur 2 encadrant'; - showhint:=true; - onChange:=formConfig.modif_Labeled; - LabelSpacing:=20; - editLabel.Caption:='Adresse du détecteur 2 encadrant'; - editLabel.Layout:=tlBottom; - LabelPosition:=lpLeft; - end; - - // onglet détecteurs - LEAdrDet:=TlabeledEdit.Create(FormConfig.GroupBoxAct); - with LEAdrDet do - begin - Name:='LEAdrDet'; - left:=200;Top:=40;Width:=40;Height:=21; - text:=''; - parent:=GroupBoxDet; - hint:='Adresse du détecteur'; - showhint:=true; - onChange:=formConfig.modif_Labeled; - LabelSpacing:=80; - editLabel.Caption:='Adresse du détecteur'; - editLabel.Layout:=tlBottom; - LabelPosition:=lpLeft; - end; - LElongDet:=TlabeledEdit.Create(FormConfig.GroupBoxAct); - with LElongDet do - begin - Name:='LElongDet'; - left:=200;Top:=70;Width:=40;Height:=21; - text:=''; - parent:=GroupBoxDet; - hint:='Longueur du détecteur (cm)'; - showhint:=true; - onChange:=formConfig.modif_Labeled; - LabelSpacing:=50; - editLabel.Caption:='Longueur du détecteur (cm)'; - editLabel.Layout:=tlBottom; - LabelPosition:=lpLeft; - end; - - // remplit les 5 fenêtres de config des aiguillages branches signaux, actionneurs, accessoires comusb formconfig.ComboBoxDecodeurPerso.AutoComplete:=false; // mettre absolument à false sinon remplissage auto quand on tape et l'index sélec peut changer!!! for i:=1 to NbreDecPers do @@ -6918,8 +7049,6 @@ begin comboBoxNation.Items.add('Française'); comboBoxNation.Items.add('Belge'); - - // actionneurs actions ListBoxActions.Clear; longestLength:=0; @@ -6983,12 +7112,32 @@ begin CheckEnvAigDccpp.Checked:=EnvAigDccpp=1; EditBase.Text:=intToSTR(AdrBaseDetDccpp); + longestLength:=0; with ListBoxTrains do begin clear; - for i:=1 to ntrains do items.Add(Train_tablo(i)); + + for i:=1 to ntrains do + begin + s:=Train_tablo(i); + items.Add(s); + l:=Length(s); + if l>LongestLength then + begin + LongestString:=s; + LongestLength:=l; + end; + end; end; + PixelLength:=ListboxTrains.Canvas.TextWidth(LongestString)+8; + // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength + SendMessage(ListBoxTrains.Handle,LB_SETHORIZONTALEXTENT,PixelLength,0); + + LabeledEditCrans.Hint:='Nombre de crans du décodeur, 128 par défaut.'+#13+ + 'Le nombre de crans est configué dans le CV29 du décodeur'; + LabeledEditCrans.ShowHint:=true; + // actionneurs with ListBoxActionneurs do begin @@ -7003,178 +7152,18 @@ begin for i:=1 to NDetecteurs do items.add(encode_detecteur(i)); end; - // composants dynamiques car on ne peut plus ajouter de composants en mode conception! - // onglet périphériques COM/USB/Socket - //--------- groupbox - gp1:=TgroupBox.Create(FormConfig.TabSheetPeriph); - with gp1 do - begin - Left:=GroupBoxDesc.Left; - Top:=groupBoxDesc.top+groupBoxDesc.Height+10; - Width:=groupBoxDesc.Width; - Height:=90; - parent:=TabSheetPeriph; - caption:='Services envoyés au périphérique'; - Name:='Gp1'; - end; - - cb2:=TCheckBox.Create(FormConfig.TabSheetPeriph); - with cb2 do - begin - Left:=10;Top:=25;Width:=100;Height:=17; - caption:='Détecteurs'; - name:='cbDet'; - parent:=gp1; - hint:='Envoie les évènements détecteurs'; - ShowHint:=true; - onclick:=formconfig.cb_onclick; - end; - cb3:=TCheckBox.Create(FormConfig.TabSheetPeriph); - with cb3 do - begin - Left:=10;Top:=45;Width:=100;Height:=17; - caption:='Actionneurs'; - name:='cbAct'; - parent:=gp1; - hint:='Envoie les évènements actionneurs'; - ShowHint:=true; - onclick:=formconfig.cb_onclick; - end; - - cb1:=TCheckBox.Create(FormConfig.TabSheetPeriph); - with cb1 do - begin - Left:=10;Top:=65;Width:=170;Height:=17; - caption:='Aiguillages et accessoires'; - name:='cbAig'; - parent:=gp1; - hint:='Envoie les évènements aiguillages (accessoires)'; - ShowHint:=true; - onclick:=formconfig.cb_onclick; - end; - - LabelMP:=Tlabel.Create(Formconfig.TabSheetPeriph); - with LabelMP do - begin - left:=gp1.Left-20; - top:=gp1.Top+gp1.Height+10; - height:=10; - width:=40; - caption:='Références croisées de l''utilisation des périphériques'; - Name:='LabelMP'; - parent:=TabSheetPeriph; - end; - - MemoPeriph:=Tmemo.Create(Formconfig.TabSheetPeriph); - with MemoPeriph do - begin - left:=gp1.Left-20; - top:=LabelMP.Top+15; - width:=gp1.Width+20; - height:=110; - parent:=TabSheetPeriph; - Name:='MemoPeriph'; - readOnly:=true; - color:=clBtnFace; - //Font.Color:=clAqua; - clear; - Hint:='Références croisées de l''utilisation des périphériques'; - ShowHint:=true; - end; - - BoutonCom:=Tbutton.Create(FormConfig.TabSheetPeriph); - with BoutonCom do - begin - Left:=100;Top:=ButtonOuvreCom.top;Width:=75;Height:=36; - caption:='Lister COMs'; - name:='BoutonCom'; - parent:=FormConfig.TabSheetPeriph; - hint:='Affiche les ports COM/USB disponibles'; - ShowHint:=true; - wordwrap:=true; - onclick:=formconfig.Bt_onclick; - end; - - LabelNumeroP:=Tlabel.Create(Formconfig.TabSheetPeriph); - with LabelNumeroP do - begin - Left:=12;Top:=ListBoxPeriph.top+ListBoxPeriph.Height+8;Width:=200;Height:=12; - caption:='Périphérique'; - parent:=FormConfig.TabSheetPeriph; - name:='LabelNumeroP'; - end; - - EditPortCde:=TEdit.Create(FormConfig.TabSheetPeriph); with EditPortCde do begin - Left:=150;Top:=EditNomPeriph.top+30;Width:=170;Height:=12; - name:='EditPortCde'; - text:=''; - parent:=GroupBoxDesc; hint:='Port COM/USB : COMX:vitesse,parité,nombre de bits de données, nombre de bits de stop '+#13+ 'ou'+#13+ 'Socket : AdresseIPV4:port'; ShowHint:=true; - OnChange:=formconfig.tb_onChange; end; - LabelPortCde:=TLabel.Create(FormConfig.TabSheetPeriph); - with LabelPortCde do - begin - Left:=10;Top:=EditNomPeriph.top+32;Width:=170;Height:=12; - caption:='Protocole de communication'; - name:='LabelPortCde'; - parent:=GroupBoxDesc; - hint:='Protocole de communication'; - ShowHint:=true; - end; - - CheckBoxCR:=TCheckBox.Create(FormConfig.TabSheetPeriph); - with CheckBoxCR do - begin - Left:=10;Top:=LabelPortCde.Top+30;width:=150;Height:=17; - caption:='Envoyer CR (retour chariot)'; - name:='CheckBoxCR'; - parent:=GroupBoxDesc; - hint:='Envoie un CR après toute chaîne'; - ShowHint:=true; - onclick:=formconfig.cb_onclick; - end; - - cbVis:=TCheckBox.Create(FormConfig.TabSheetPeriph); - with cbVis do - begin - parent:=groupBoxDesc; - Left:=10;Top:=CheckBoxCR.top+20;Width:=100;Height:=17; - caption:='Mode visible'; - name:='cbVis'; - hint:='Affiche le texte à l''écran lors des envois'; - ShowHint:=true; - onclick:=formconfig.cb_onclick; - end; - - cbDTR:=TCheckBox.Create(FormConfig.TabSheetPeriph); with cbDTR do begin - parent:=groupBoxDesc; - Left:=200;Top:=LabelPortCde.Top+30;Width:=100;Height:=17; - caption:='DTR'; - name:='cbDTR'; hint:='COM/USB uniquement.'+#13+'Décoché: mise à 0 de ligne DTR et évite le reset de la plupart des arduinos,'+#13+'ou peut bloquer la transmission sur d''autres.'; ShowHint:=true; - onclick:=formconfig.cb_onclick; - end; - - cbRTS:=TCheckBox.Create(FormConfig.TabSheetPeriph); - with cbRTS do - begin - parent:=groupBoxDesc; - Left:=200;Top:=cbDTR.top+20;Width:=100;Height:=17; - caption:='RTS'; - name:='cbRTS'; - hint:='COM/USB uniquement : mise à 0 ou 1 de la ligne RTS'; - ShowHint:=true; - onclick:=formconfig.cb_onclick; end; // compilation avec D12---------------------------------------- @@ -7225,366 +7214,65 @@ begin ButtonCouleur.Visible:=false; {$IFEND} - - // onglet avancé - LabelAvance1:=TLabel.Create(FormConfig.TabAvance); - with LabelAvance1 do - begin - Left:=10;Top:=10;Width:=208;Height:=12; - caption:='Paramètres avancés et experts'; - name:='LabelAvance1'; - Font.Style:=[fsBold]; - Font.Size:=10; - parent:=TabAvance; - end; - - GroupBoxAvance:=TGroupBox.Create(FormConfig.TabAvance); - with GroupBoxAvance do - begin - Left:=3;Top:=40;Width:=300;Height:=220; // maxi=580 - caption:='Jeu de paramètres avancés'; - name:='GroupBoxAvance'; - parent:=TabAvance; - end; - x:=GroupBoxAvance.width-40; - LabelTD:=TLabel.Create(FormConfig.TabAvance); - with LabelTD do - begin - Left:=10;Top:=30;Width:=170;Height:=12; - caption:='Seuil du nombre de détecteurs trop distants'; - name:='LabelTD'; - Font.Size:=9; - parent:=GroupBoxAvance; - end; - EditNbDetDist:=TEdit.Create(FormConfig.TabAvance); with EditNbDetDist do begin - Left:=x;Top:=28;Width:=30;Height:=15; - name:='EditNbDetDist'; - 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:'+#13+ '3 pour les petits réseaux jusque 5 ou 6 pour les grands'; ShowHint:=true; end; - LabelNC:=TLabel.Create(FormConfig.TabAvance); - with LabelNC do - begin - Left:=10;Top:=50;Width:=170;Height:=12; - caption:='Nombre de cantons présence train avant signal'; - name:='LabelNC'; - parent:=GroupBoxAvance; - end; - EditNbCantons:=TEdit.Create(TabAvance); - with EditNbCantons do - begin - Left:=x;Top:=48;Width:=30;Height:=15; - name:='EditNbCantons'; - text:=''; - parent:=GroupBoxAvance; - hint:='Nombre de cantons présence train avant un signal pour le déclarer verrouillé'; - ShowHint:=true; - end; - - LabelFiltre:=TLabel.Create(FormConfig.TabAvance); - with LabelFiltre do - begin - Left:=10;Top:=70;Width:=170;Height:=12; - caption:='Filtrage des détecteurs (x100 ms) - Mode autonome'; - name:='LabelFiltre'; - parent:=GroupBoxAvance; - end; - EditFiltrDet:=TEdit.Create(TabAvance); - with EditFiltrDet do - begin - Left:=x;Top:=68;Width:=30;Height:=15; - name:='EditFiltrDet'; - text:=''; - parent:=GroupBoxAvance; - hint:='Temps de filtrage des détecteurs qui passent à 0'+#13+'Mode autonome uniquement'; - ShowHint:=true; - end; - - LabelnCantonsRes:=TLabel.Create(FormConfig.TabAvance); - with LabelnCantonsRes do - begin - Left:=10;Top:=90;Width:=170;Height:=12; - caption:='Nombre de cantons à réserver en avant du train'; - name:='LabelnCantonsRes'; - parent:=GroupBoxAvance; - end; - EditnCantonsRes:=TEdit.Create(TabAvance); - with EditnCantonsRes do - begin - Left:=x;Top:=88;Width:=30;Height:=15; - name:='EditnCantonsRes'; - text:=''; - parent:=GroupBoxAvance; - hint:='Nombre de cantons à réserver (1 à 5) en avant du train.'+#13+ + EditnCantonsRes.hint:='Nombre de cantons à réserver (1 à 5) en avant du train.'+#13+ 'Utilisé en mode roulage.'+#13+ 'Cette valeur dépend de la taille du réseau.'; - ShowHint:=true; - end; + EditnCantonsRes.ShowHint:=true; - LabelAntiTO:=TLabel.Create(FormConfig.TabAvance); - with LabelAntiTO do - begin - Left:=10;Top:=110;Width:=170;Height:=12; - caption:='Utilisation de l''anti timeout Lenz Ethernet'; - name:='LabelAntiTO'; - parent:=GroupBoxAvance; - end; - EditAntiTO:=TEdit.Create(TabAvance); with EditAntiTO do begin - Left:=x;Top:=108;Width:=30;Height:=15; - name:='EditAntiTO'; - text:=''; - parent:=GroupBoxAvance; hint:='Si 1, envoie un caractère chaque minute à la centrale '+#13+ 'pour éviter sa déconnexion (uniquement en Ethernet)'; ShowHint:=true; end; - LabelTempoTC:=TLabel.Create(FormConfig.TabAvance); - with LabelTempoTC do - begin - Left:=10;Top:=130;Width:=170;Height:=12; - caption:='Facteur de temporisation de télécommande CDM'; - name:='LabelTempoTC'; - parent:=GroupBoxAvance; - end; - EditTempoTC:=TEdit.Create(TabAvance); with EditTempoTC do begin - Left:=x;Top:=130;Width:=30;Height:=15; - name:='EditTempoTC'; - text:=''; - parent:=GroupBoxAvance; - s:='Facteur multiplicateur de 1 à 10 pour la temporisation'+#13+ + hint:='Facteur multiplicateur de 1 à 10 pour la temporisation'+#13+ 'de la télécommande du démarrage de CDM'; - hint:=s; ShowHint:=true; end; - LabelMaxParcours:=TLabel.Create(FormConfig.TabAvance); - with LabelMaxParcours do - begin - Left:=10;Top:=152;Width:=170;Height:=12; - caption:='Nombre maximal d''éléments par route'; - name:='LabelMaxParcours'; - parent:=GroupBoxAvance; - end; - EditMaxParcours:=TEdit.Create(FormConfig.TabAvance); with EditMaxParcours do begin - Left:=x;Top:=152;Width:=30;Height:=15; - name:='EditMaxParcours'; - text:=''; - parent:=GroupBoxAvance; - s:='Nombre maximal d''éléments par route lors de la proposition du calcul des routes'+#13+'Maxi='+IntToSTR(MaxParcoursTablo); - hint:=s; + hint:='Nombre maximal d''éléments par route lors de la proposition du calcul des routes'+#13+'Maxi='+IntToSTR(MaxParcoursTablo); ShowHint:=true; end; - LabelRoutes:=TLabel.Create(FormConfig.TabAvance); - with LabelRoutes do - begin - Left:=10;Top:=173;Width:=170;Height:=12; - caption:='Nombre maximal de routes'; - name:='LabelRoutes'; - parent:=GroupBoxAvance; - end; - EditMaxRoutes:=TEdit.Create(FormConfig.TabAvance); with EditMaxRoutes do begin - Left:=x-10;Top:=173;Width:=40;Height:=15; - name:='EditMaxRoutes'; - text:=''; - parent:=GroupBoxAvance; - s:='Nombre maximal de routes lors de la proposition du calcul des routes'+#13+'Maxi='+intToSTR(MaxRoutesCte); - hint:=s; + hint:='Nombre maximal de routes lors de la proposition du calcul des routes'+#13+'Maxi='+intToSTR(MaxRoutesCte); ShowHint:=true; end; - CheckBoxOptionDemiTour:=TCheckBox.Create(FormConfig.TabAvance); with CheckBoxOptionDemiTour do begin - Left:=10;Top:=194;Width:=170;Height:=17; - caption:='Option demi tour des trains'; - name:='CheckBoxOptionDemiTour'; - parent:=GroupBoxAvance; Hint:='Détecte le demi-tour des trains durant un parcours'; end; - { - RadioReserve:=TRadioGroup.Create(TabAvance); - with RadioReserve do - begin - Left:=5;Top:=GroupBoxAvance.top+GroupBoxAvance.Height+10;Width:=GroupBoxAvance.width;Height:=60; - name:='RadioReserve'; - Caption:='Réservation des aiguillages'; - parent:=TabAvance; - hint:='Choix du mode de réservation des aiguillages par les trains.'+#13+ - 'La réservation des aiguillages est fonctionnelle en mode roulage (mode autonome) ou en mode réservation'; - ShowHint:=true; - items.Add('Réservation par canton'); - items.Add('Réservation par détecteurs'); - end;} - - GroupBoxExpert:=TGroupBox.Create(FormConfig.TabAvance); - with GroupBoxExpert do - begin - Left:=GroupBoxAvance.Left;Width:=GroupBoxAvance.width;Height:=110; // maxi=580 - Top:=GroupBoxAvance.top+GroupBoxAvance.Height+10 ; - caption:='Jeu de paramètres experts'; - name:='GroupBoxExpert'; - parent:=TabAvance; - end; - LabelAlgo:=TLabel.Create(FormConfig.TabAvance); - with LabelAlgo do - begin - Left:=10;Top:=30;Width:=170;Height:=12; - caption:='Algorithme de localisation des trains'; - name:='LabelAlgo'; - Font.Size:=9; - parent:=GroupBoxExpert; - end; - EditAlgo:=TEdit.Create(FormConfig.TabAvance); - with EditAlgo do - begin - Left:=x;Top:=28;Width:=30;Height:=15; - name:='EditAlgo'; - text:=''; - parent:=GroupBoxExpert; - hint:='Algorithme de localisation des trains'; - ShowHint:=true; - end; - - LabelNbSignBS:=TLabel.Create(FormConfig.TabAvance); - with LabelNbSignBS do - begin - Left:=10;Top:=50;Width:=100;Height:=30; - caption:='Nombre maxi d''éléments de recherche lors'+#13+'d''un signal dans le bon sens'; - name:='LabelNbSignBS'; - Font.Size:=9; - wordwrap:=true; - parent:=GroupBoxExpert; - end; - EditMaxSignalSens:=TEdit.Create(FormConfig.TabAvance); with EditMaxSignalSens do begin - Left:=x;Top:=48;Width:=30;Height:=15; + editLabel.caption:='Nombre maxi d''éléments de recherche lors'+#13+'d''un signal dans le bon sens'; name:='EditMaxSignalSens'; text:=''; - parent:=GroupBoxExpert; hint:='Nombre maxi d''éléments de recherche lors d''un signal dans le bon sens'; ShowHint:=true; end; - cbAck:=tCheckBox.Create(FormConfig.TabAvance); - with cbAck do - begin - Left:=10;Top:=85;Width:=200;Height:=17; - name:='cbAck'; - caption:='Attendre ACK de la centrale'; - parent:=GroupBoxExpert; - hint:='Attendre l''accusé de réception de la centrale lors du pilotage des accessoires'; - ShowHint:=true; - end; - - RadioServeurCDM:=TRadioGroup.Create(TabAvance); - with RadioServeurCDM do - begin - Left:=GroupBoxAvance.Left;Top:=GroupBoxExpert.top+GroupBoxExpert.Height+10;Width:=GroupBoxAvance.width;Height:=60; - name:='RadioServeurCDM'; - Caption:='Méthode de démarrage du serveur de CDM rail'; - parent:=TabAvance; - hint:='Démarrage du serveur COM-IP de CDMRail'; - ShowHint:=true; - items.Add('Par simulation de touches'); - items.Add('Par ligne de commande'); - end; - - GroupBoxChemin:=TGroupBox.Create(FormConfig.TabAvance); - with GroupBoxChemin do - begin - Left:=310;Top:=40;Width:=300;Height:=100; - caption:='Chemins de fichiers'; - name:='GroupBoxChemin'; - parent:=TabAvance; - end; - LabelChemin:=TLabel.Create(FormConfig.TabAvance); - with LabelChemin do - begin - Left:=10;Top:=25;Width:=120;Height:=12; - caption:='Chemin Win de CDM'+#13+'(Sans \CDM-Rail)'; - name:='LabelChemin'; - Font.Size:=9; - parent:=GroupBoxChemin; - end; - EditChemin:=TEdit.Create(FormConfig.TabAvance); with EditChemin do begin - Left:=140;Top:=28;Width:=150;Height:=15; - name:='EditChemin'; - text:=''; - parent:=GroupBoxChemin; hint:='Chemin windows d''installation de CDM'; ShowHint:=true; end; - LabelCDM:=TLabel.Create(FormConfig.TabAvance); - with LabelCDM do - begin - Left:=10;Top:=60;Width:=90;Height:=12; - caption:='Ce chemin sera suivi de "\CDM-Rail"'; - name:='LabelCDM'; - Font.Size:=9; - parent:=GroupBoxChemin; - end; - - // groupBox affichages - GroupBoxAff:=TGroupBox.Create(FormConfig.TabAvance); - with GroupBoxAff do - begin - Left:=310;Top:=GroupBoxChemin.top+GroupBoxChemin.height+8;Width:=300;Height:=160; - caption:='Affichages de la fenêtre principale'; - name:='GroupBoxAff'; - parent:=TabAvance; - end; - cbAffSig:=TcheckBox.Create(formconfig.TabAvance); - with cbAffSig do - begin - Left:=15;Top:=30;Width:=200;Height:=17; - caption:='Evènements signaux'; - name:='cbAffSig'; - hint:='Affiche l''état des signaux lors de leur changement'; - showHint:=true; - parent:=GroupBoxAff; - end; - cbres:=TcheckBox.Create(formconfig.TabAvance); - with cbres do - begin - Left:=15;Top:=50;Width:=200;Height:=17; - caption:='Réservation/libération des cantons'; - name:='cbRes'; - hint:='Affiche les réservations/libération des cantons lors du roulage des trains'; - showHint:=true; - parent:=GroupBoxAff; - end; - cbDebugRoulage:=TcheckBox.Create(formconfig.TabAvance); - with cbDebugRoulage do - begin - Left:=15;Top:=70;Width:=200;Height:=17; - caption:='Debug roulage'; - name:='cbDebugRoulage'; - hint:='Affiche des messages en mode roulage des trains en mode autonome'; - showHint:=true; - parent:=GroupBoxAff; - end; ImageSignaux.picture.Assign(formpilote.ImageSignaux.Picture); @@ -7720,17 +7408,17 @@ begin if (index<1) or (index>NbPeriph) then exit; clicliste:=true; formConfig.EditNomPeriph.Text:=Tablo_periph[index].nom; - cb1.Checked:=Tablo_periph[index].ScvAig; - cb2.Checked:=Tablo_periph[index].ScvDet; - cb3.Checked:=Tablo_periph[index].ScvAct; - cbVis.Checked:=Tablo_periph[index].ScvVis; - cbDTR.Checked:=Tablo_periph[index].dtr; - cbRTS.Checked:=Tablo_periph[index].rts; + formconfig.cbAig.Checked:=Tablo_periph[index].ScvAig; + formconfig.cbDet.Checked:=Tablo_periph[index].ScvDet; + formconfig.cbAct.Checked:=Tablo_periph[index].ScvAct; + formConfig.cbVis.Checked:=Tablo_periph[index].ScvVis; + formConfig.cbDTR.Checked:=Tablo_periph[index].dtr; + formConfig.cbRTS.Checked:=Tablo_periph[index].rts; - CheckBoxCR.Checked:=Tablo_periph[index].cr; + formConfig.CheckBoxCR.Checked:=Tablo_periph[index].cr; - EditPortCde.text:=Tablo_periph[index].protocole; - MemoPeriph.Clear; + formConfig.EditPortCde.text:=Tablo_periph[index].protocole; + formconfig.MemoPeriph.Clear; clicliste:=false; end; @@ -8052,7 +7740,10 @@ begin ButtonConfigSR.Visible:=false; case decodeur of - 2 : if not(isDirectionnel(index)) then ButtonConfigSR.Visible:=true; //cdf + 2 : if not(isDirectionnel(index)) then + begin + ButtonConfigSR.Visible:=true; //cdf + end; 4 : begin EditSpecUni.Visible:=true; LabelUni.Caption:='Cible LEB'; @@ -8242,7 +7933,7 @@ begin end else begin // directionnel - Label17.Caption:='Conditions d''affichage du feu directionnel :'; + Label17.Caption:='Conditions d''affichage du signal directionnel :'; label17.Width:=131; label43.Visible:=false; LabelDetAss.visible:=false; @@ -8501,7 +8192,7 @@ begin if b=#0 then b:='Z'; Aiguillage[index].ADroit:=adr; Aiguillage[index].ADroitB:=B; - EditDroit_BD.Hint:=TypeElAIg_to_char(adr,B); + EditDroit_BD.Hint:=TypeElAIg_to_char(adr,B); // réencoder la ligne s:=encode_aig(Index); formconfig.ListBoxAig.items[ligneclicAig]:=s; @@ -8517,20 +8208,20 @@ begin begin // TJD4/TJS if aiguillage[index].EtatTJD=4 then - begin + begin adr2:=aiguillage[index].DDroit; // adresse homologue index:=Index_aig(adr2); if index=0 then exit; aiguillage[index].Adroit:=adr; aiguillage[index].AdroitB:=B; LabelInfo.caption:='Modification de la TJD homologe ('+IntToSTR(adr2)+')'; - end; + end; // TJD2 if aiguillage[index].EtatTJD=2 then - begin + begin aiguillage[index].Ddroit:=adr; aiguillage[index].DdroitB:=B; - end; + end; s:=encode_aig(index); formconfig.ListBoxAig.items[index-1]:=s; //RE_ColorLine(Formconfig.ListBoxAig,index-1,ClWhite); @@ -8543,7 +8234,16 @@ begin s:=encode_aig(index); formconfig.ListBoxAig.items[index-1]:=s; end; - + if modele=triple then + begin + index:=index_aig(Aiguillage[index].Adrtriple); + aiguillage[index].APointe:=adr; + aiguillage[index].APointeB:=B; + aiguillage[index].ADroit:=adr; + aiguillage[index].ADroitB:=B; + // s:=encode_aig(Index); + // formconfig.ListBoxAig.items[ligneclicAig]:=s; + end; end; end; @@ -8564,25 +8264,25 @@ begin begin s:=formconfig.ListBoxAig.items[ligneclicAig]; Val(s,adrAig,erreur); + Index:=Index_Aig(AdrAig); + normal:=aiguillage[index].modele=aig; + tjdC:=aiguillage[index].modele=tjd; + tjsC:=aiguillage[index].modele=tjs; + triC:=aiguillage[index].modele=triple; + croi:=aiguillage[index].modele=crois; + //vérifier la syntaxe de P s:=Editpointe_BG.text; decodeAig(s,adr,B); if ((B='S') or (B='P') or (B='D') or (B=#0) or (b='Z')) and (s<>'') then begin - Index:=Index_Aig(AdrAig); LabelInfo.caption:=''; if (B='S') or (b='P') or (b='D') then begin if adr=AdrAig then LabelInfo.caption:='Un aiguillage ne peut pointer sur lui même '; end; - normal:=aiguillage[index].modele=aig; - tjdC:=aiguillage[index].modele=tjd; - tjsC:=aiguillage[index].modele=tjs; - triC:=aiguillage[index].modele=triple; - croi:=aiguillage[index].modele=crois; - Aiguillage[index].modifie:=true; // modifier la base de données de l'aiguillage @@ -8607,7 +8307,7 @@ begin EditPointe_BG.Hint:=TypeElAIg_to_char(adr,B); end else LabelInfo.caption:='Erreur pointe aiguillage '+intToSTR(AdrAig); - end; + end; end; procedure TFormConfig.EditDevieS2Change(Sender: TObject); @@ -8645,6 +8345,14 @@ begin s:=encode_aig(index); formconfig.ListBoxAig.items[ligneclicAig]:=s; formconfig.ListBoxAig.selected[ligneclicAig]:=true; + + index:=index_aig(Aiguillage[index].Adrtriple); + aiguillage[index].ADevie:=adr; + aiguillage[index].ADevieB:=B; + // s:=encode_aig(Index); + // formconfig.ListBoxAig.items[ligneclicAig]:=s; + + end else begin @@ -8898,6 +8606,7 @@ var s: string; begin // Affiche(IntToStr(ComboBoxDec.ItemIndex),clyellow); if clicListe then exit; + labelInfo.caption:=''; if NbreSignaux0) or (i<0) then begin LabelInfo.caption:='Erreur temporisation décodeurs ';exit;end; LabelInfo.caption:=' '; @@ -9308,6 +9017,7 @@ begin if clicListe then exit; if affevt then Affiche('Evt aspect',clOrange); + labelInfo.Caption:=''; i:=ComboBoxAsp.ItemIndex; //Affiche(IntToSTR(i),clyellow); case i of @@ -9570,63 +9280,6 @@ begin clicliste:=false; config_modifie:=true; end; -{ -procedure ajoute_actionneur; -var s: string; - i : integer; -begin - if affevt then affiche('Evt bouton nouveau acc',clyellow); - if maxtablo_act>=Max_actionneurs then - begin - Affiche('Nombre maximal d''actionneurs atteint',clred); - exit; - end; - clicliste:=true; - inc(maxTablo_act); - - with formconfig.ListBoxAct do - for i:=0 to items.Count-1 do Selected[i]:=false; - with formconfig.ListBoxPN do - for i:=0 to items.Count-1 do Selected[i]:=false; - - // désactiver la ligne PN - lignecliqueePN:=-1; - - formconfig.radioButtonLoc.Checked:=true; - Tablo_Action[maxtablo_act].act:=false; - Tablo_Action[maxtablo_act].loco:=true; - - SetLength(Tablo_Action[maxtablo_act].TabloOp,2); - - Tablo_Action[maxtablo_act].NbOperations:=1; - - // ajouter et scroller en fin - s:=encode_act_loc_son(MaxTablo_act); - with formconfig.listBoxActions do - begin - items.add(s); - Selected[maxTablo_act-1]:=true; - SetFocus; - perform(WM_VSCROLL,SB_BOTTOM,0); - end; - - s:=encode_actions(MaxTablo_act); - with formconfig.listBoxAct do - begin - items.add(s); - Selected[maxTablo_act-1]:=true; - perform(WM_VSCROLL,SB_BOTTOM,0); - end; - - formconfig.GroupBoxRadio.Visible:=true; - formconfig.LabelInfo.caption:=''; - LigneClicAct:=MaxTablo_act-1; - AncligneClicAct:=ligneClicAct; - Aff_champs_Act(maxTablo_act); - clicliste:=false; - config_modifie:=true; -end; } - procedure TFormConfig.ButtonNouvAccClick(Sender: TObject); begin @@ -9870,7 +9523,6 @@ begin repeat if formconfig.ListBoxActions.selected[i-1] then begin - for j:=i to maxTablo_act-1 do begin formconfig.ListBoxActions.selected[j-1]:=formconfig.ListBoxActions.selected[j]; @@ -10110,7 +9762,7 @@ begin tablo_index_signal[Signaux[i].Adresse]:=i; end; -procedure TFormConfig.ButtonNouvFeuClick(Sender: TObject); +procedure TFormConfig.ButtonNouvSigClick(Sender: TObject); begin ajoute_signal; end; @@ -10149,7 +9801,7 @@ begin Signal_supprime:=Signaux[i]; // sauvegarde le signal supprimé Signal_sauve.adresse:=0; // dévalider sa définition - FormConfig.ButtonInsFeu.Caption:='Ajouter le signal '+intToSTR(Signaux[i].adresse)+' supprimé'; + FormConfig.ButtonInsSig.Caption:='Ajouter le signal '+intToSTR(Signaux[i].adresse)+' supprimé'; // supprimer le signal i Affiche('Supprime signal '+intToSTR(Signaux[i].adresse),clOrange); @@ -10227,13 +9879,13 @@ begin end; -procedure TFormConfig.ButtonSupFeuClick(Sender: TObject); +procedure TFormConfig.ButtonSupSigClick(Sender: TObject); begin Supprime_sig; end; // Ajouter le signal supprimé -procedure TFormConfig.ButtonInsFeuClick(Sender: TObject); +procedure TFormConfig.ButtonInsSigClick(Sender: TObject); var s : string; begin if Signal_supprime.adresse<>0 then @@ -10252,7 +9904,7 @@ begin begin with ListBoxSig.Items do begin - ButtonInsFeu.Caption:='Ajouter le signal supprimé'; + ButtonInsSig.Caption:='Ajouter le signal supprimé'; Add(s); ligneClicSig:=NbreSignaux-1; AncligneClicSig:=-1; @@ -10553,17 +10205,29 @@ begin end; // cohérence 3 : vérifie si aiguillage triple ok et si doublon aiguillage + // si on rencontre un aiguilage triple vérifier que c'est son adresse de base en branches for Indexaig:=1 to maxaiguillage do begin adr:=aiguillage[Indexaig].Adresse; if aiguillage[Indexaig].modele=triple then begin + adr2:=aiguillage[Indexaig].AdrTriple; + trouve_element(adr2,aig,0,false); // pas d'affichage d'erreur si non trouvé + if branche_trouve<>0 then + begin + Affiche('Erreur 6.0: La designation de l''aiguillage triple '+intToSTR(adr)+' doit se faire par son adresse de base',clred); + Affiche('et non par son adresse secondaire ('+intToSTR(adr2)+') en branche '+intToSTR(branche_trouve),clred); + ok:=false; + end; + if aiguillage[Indexaig].AdrTriple=0 then begin Affiche('Erreur 6.1: 2ème adresse de l''aiguillage triple '+intToSTR(adr)+' non définie',clred); ok:=false; end; end; + + for i:=Indexaig+1 to maxaiguillage do begin if adr=aiguillage[i].Adresse then @@ -11540,7 +11204,7 @@ begin end; clicliste:=true; - // désélectionne tout + // désélectionne tous les éléments de la list box with formconfig.ListBoxAig do for i:=0 to items.Count-1 do Selected[i]:=false; @@ -11560,6 +11224,7 @@ begin aiguillage[i].position:=const_inconnu; aiguillage[i].InversionCDM:=0; aiguillage[i].vitesse:=0; + aiguillage[i].visible:=true; // encoder l'index tablo_index_aiguillage[aiguillage[i].Adresse]:=i; @@ -11611,15 +11276,19 @@ begin if trouve then begin formconfig.ListBoxAig.selected[j]:=true; - ss:=ss+intToSTR(adrTri)+' '; + //ss:=ss+intToSTR(adrTri)+' '; end; inc(j); until (j>MaxAiguillage-1) or trouve; - ss:=ss+ intToSTR(aiguillage[i+1].adresse)+' '; end; inc(n); end; end; + + for i:=0 to MaxAiguillage-1 do + begin + if formconfig.ListBoxAig.selected[i] then ss:=ss+ intToSTR(aiguillage[i+1].adresse)+' '; + end; if ss='' then exit; s:='Voulez-vous supprimer '; @@ -13034,7 +12703,7 @@ end; // Icanvas: canvas de destination ; index: index du train procedure Maj_icone_train(IImage : Timage;index :integer); var h,l,HautDest,LargDest,y : integer; - rd : double; + rd : single; begin if (index<1) or (index>Ntrains) then exit; begin @@ -13069,14 +12738,25 @@ end; procedure clicListeTrains(index : integer); var s : string; i,t : integer; + r : single; begin if index<1 then exit; if Trains[index].nom_train='' then exit; with formconfig do begin + i:=trains[index].routePref[0][0].adresse; + s:=''; + case i of + 0 : s:='Pas de route'; + 1 : s:='1 route'; + else s:=intToSTR(i)+' routes'; + end; + ButtonRdt.Caption:=s; + editNomTrain.text:=Trains[index].nom_train; editAdresseTrain.Text:=intToSTR(trains[index].adresse); editVitesseMaxi.Text:=intToSTR(trains[index].vitmax); + editLongLoco.text:=IntToSTR(trains[index].longueur); LabeledEditTempoD.Text:=intToSTR(trains[index].TempsDemarreSig); editVitRalenti.Text:=IntToSTR(trains[index].Vitralenti); editvitnom.text:=IntToSTR(trains[index].VitNominale); @@ -13109,8 +12789,49 @@ begin end; end; - // routepref - MemoRoutes.Lines.Add(route_restreinte_to_string(trains[index].routePref)); + With LabeledEditV1 do + begin + EditLabel.Caption:='Vitesse 1 - Lente '+intToSTR(Trains[index].ConsV1)+' crans :'; + Text:=FloatToSTRF(Trains[index].coeffV1,ffFixed,5,2,FormatSettings); + end; + With LabeledEditV2 do + begin + EditLabel.Caption:='Vitesse 2 - Moyenne '+intToSTR(Trains[index].ConsV2)+' crans :'; + Text:=FloatToSTRF(Trains[index].coeffV2,ffFixed,5,2,FormatSettings); + end; + With LabeledEditV3 do + begin + EditLabel.Caption:='Vitesse 3 - Rapide '+intToSTR(Trains[index].ConsV3)+' crans :'; + Text:=FloatToSTRF(Trains[index].coeffV3,ffFixed,5,2,FormatSettings); + end; + + if Trains[index].coeffV1<>0 then + begin + r:=Trains[index].consV1/Trains[index].coeffV1; + LabelV1.Caption:='Vr1 (cm/s) = '+intToSTR(trains[index].consV1)+' (crans) / '+FloatToSTRF(Trains[index].coeffV1,ffFixed,5,2)+ + ' = '+FloatToSTRF(r,ffFixed,5,2)+' cm/s'; + end + else LabelV1.Caption:='Vr1'; + + if Trains[index].coeffV2<>0 then + begin + r:=Trains[index].consV2/Trains[index].coeffV2; + LabelV2.Caption:='Vr2 (cm/s) = '+intToSTR(trains[index].consV2)+' (crans) / '+FloatToSTRF(Trains[index].coeffV2,ffFixed,5,2)+ + ' = '+FloatToSTRF(r,ffFixed,5,2)+' cm/s'; + end + else LabelV2.Caption:='Vr2'; + + if Trains[index].coeffV3<>0 then + begin + r:=Trains[index].consV3/Trains[index].coeffV3; + LabelV3.Caption:='Vr3 (cm/s) = '+intToSTR(trains[index].consV3)+' (crans) / '+FloatToSTRF(Trains[index].coeffV3,ffFixed,5,2)+ + ' = '+FloatToSTRF(r,ffFixed,5,2)+' cm/s'; + end + else LabelV3.Caption:='Vr3'; + + LabeledEditCV3.Text:=intToSTR(Trains[index].CV3); + LabeledEditCV4.Text:=intToSTR(Trains[index].CV4); + LabeledEditCrans.Text:=intToSTR(Trains[index].crans); end; end; @@ -13171,7 +12892,7 @@ begin ListBoxTrains.selected[ligneclicTrain]:=true; end; -procedure TFormConfig.EditVitesseMaxiChange(Sender: TObject); +procedure TFormConfig.EditVitesseMaxihange(Sender: TObject); var erreur,i :integer; begin if clicliste then exit; @@ -13184,6 +12905,19 @@ begin formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; end; +procedure TFormConfig.EditLongLocoChange(Sender: TObject); +var erreur,i :integer; +begin + if clicliste then exit; + if affevt then affiche('Evt change longueur train',clyellow); + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; + val(EditLongLoco.text,i,erreur); + if i<1 then exit; + trains[ligneclicTrain+1].longueur:=i; + formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; +end; + procedure TFormConfig.EditVitNomChange(Sender: TObject); var erreur,i : integer; begin @@ -13283,6 +13017,7 @@ begin editVitRalenti.Text:=''; editVitNom.Text:=''; editVitesseMaxi.text:=''; + editLongLoco.text:=''; end; // suppression @@ -13567,18 +13302,6 @@ begin s:=lowercase(te.Name); sb:=te.Text; - if pos('editouvreecran',s)<>0 then - begin - val(sb,i,erreur); - if (erreur<>0) or (i<1) then - begin - labelInfo.caption:='Erreur écran'; - exit; - end; - labelInfo.caption:=''; - Ecran_SC:=i; - exit; - end; if pos('editdecalt',s)<>0 then begin @@ -13732,74 +13455,6 @@ begin end; -procedure TformConfig.modif_Labeled(Sender : Tobject); -var te : tLabeledEdit; - s,sb : string; - i,r,erreur : integer; -begin - // actionneurs - if clicListe then exit; - - te:=Sender as TLabelededit; - s:=lowercase(te.Name); - sb:=te.Text; - - if pos('prox',s)<>0 then - begin - val(sb,i,erreur); - if (erreur<>0) or (i<1) then - begin - labelInfo.caption:='Erreur'; - exit; - end; - labelInfo.caption:=''; - r:=extract_int(s); - case r of - 1 : actionneur[ligneclicActionneur+1].prox1:=i; - 2 : actionneur[ligneclicActionneur+1].prox2:=i; - end; - s:=encode_actionneur(ligneclicActionneur+1); - formconfig.ListBoxActionneurs.items[ligneclicActionneur]:=s; - formconfig.ListBoxActionneurs.selected[ligneclicActionneur]:=true; - - exit; - end; - - if pos('leadrdet',s)<>0 then - begin - val(sb,i,erreur); - if (erreur<>0) or (i<1) then - begin - labelInfo.caption:='Erreur'; - exit; - end; - labelInfo.caption:=''; - Adresse_detecteur[ligneclicDet+1]:=i; - s:=encode_detecteur(ligneclicDet+1); - formconfig.ListBoxDet.items[ligneclicDet]:=s; - formconfig.ListBoxDet.selected[ligneclicDet]:=true; - exit; - end; - - if pos('lelongdet',s)<>0 then - begin - val(sb,i,erreur); - if (erreur<>0) or (i<1) then - begin - labelInfo.caption:='Erreur'; - exit; - end; - labelInfo.caption:=''; - r:=adresse_detecteur[ligneclicDet+1]; - detecteur[r].longueur:=i; - s:=encode_detecteur(ligneclicDet+1); - formconfig.ListBoxDet.items[ligneclicDet]:=s; - formconfig.ListBoxDet.selected[ligneclicDet]:=true; - exit; - end; -end; - - // changement combobox choix sorties 1 ou 2 procedure Tformconfig.modif_ComboTS(Sender : TObject); var co : tComboBox; @@ -14329,7 +13984,7 @@ begin clicliste:=true; formConfig.EditNomPeriph.text:=''; - LabelNumeroP.Caption:='Périphérique '; + FormConfig.LabelNumeroP.Caption:='Périphérique '; // suppression n:=0; @@ -14368,7 +14023,7 @@ begin ajoute_champs_combos(i); end; end; - MemoPeriph.Clear; + FormConfig.MemoPeriph.Clear; ligneClicAccPeriph:=-1; AncligneClicAccPeriph:=-1; clicliste:=false; @@ -14393,7 +14048,7 @@ begin if NbPeriph>10 then formConfig.LabelInfoAcc.caption:='Nombre maxi de périphériques atteint : '+intToStr(NbPeriph); i:=NbPeriph; - LabelNumeroP.Caption:='Périphérique '+intToSTR(NbPeriph); + FormConfig.LabelNumeroP.Caption:='Périphérique '+intToSTR(NbPeriph); Tablo_periph[i].nom:=''; Tablo_periph[i].NumCom:=0; @@ -14735,9 +14390,9 @@ begin EditPortCde.text:=''; CheckBoxCR.checked:=false; CbVis.checked:=false; - cb1.checked:=false; - cb2.checked:=false; - cb3.checked:=false; + cbAig.checked:=false; + cbDet.checked:=false; + cbAct.checked:=false; end; end; @@ -15241,7 +14896,7 @@ begin CheckBoxAffMemo.Checked:=AffMemoFenetre=1; EditNbCantons.text:=intToSTR(Nb_cantons_Sig); - EditTempoFeu.Text:=IntToSTR(Tempo_Signal); + EditTempoSignal.Text:=IntToSTR(Tempo_Signal); EditNbDetDist.text:=IntToSTR(Nb_Det_dist); EditAdrIPCDM.text:=adresseIPCDM; EditPortCDM.Text:=IntToSTR(portCDM); @@ -15254,7 +14909,6 @@ begin EditTempoTC.Text:=intToSTR(TempoTC); EditMaxParcours.Text:=intToSTR(MaxParcours); EditMaxRoutes.Text:=intToSTR(MaxRoutes); - EditRep.Text:=RepConfig; {$IF CompilerVersion >= 28.0} ComboStyle.itemIndex:=Style_Aff; @@ -15282,20 +14936,20 @@ begin CheckBandeauTCO.Checked:=MasqueBandeauTCO; RadioButtonSS.Checked:=ServeurInterfaceCDM=0; - RadioButtonXN.Checked:=ServeurInterfaceCDM=1; + RadioButtonXN.Checked:=ServeurInterfaceCDM=1; // Xpressnet RadioButtonP50.Checked:=ServeurInterfaceCDM=2; RadioButtonSP.Checked:=ServeurInterfaceCDM=3; RadioButtonFIS.Checked:=ServeurInterfaceCDM=4; - RadioButtonRS.Checked:=ServeurInterfaceCDM=5; + RadioButtonRS.Checked:=ServeurInterfaceCDM=5; // RS RadioButtonDCCpp.Checked:=ServeurInterfaceCDM=6; RadioButtonECOS.Checked:=ServeurInterfaceCDM=7; RadioButtonDCCpl.Checked:=ServeurInterfaceCDM=8; - RadioButton13.Checked:=ServeurRetroCDM=1; - RadioButton14.Checked:=ServeurRetroCDM=2; - RadioButton15.Checked:=ServeurRetroCDM=3; - RadioButton16.Checked:=ServeurRetroCDM=4; - RadioButton17.Checked:=ServeurRetroCDM=5; - RadioButton18.Checked:=ServeurRetroCDM=6; + RadioButton13.Checked:=ServeurRetroCDM=1; // automatique + RadioButton14.Checked:=ServeurRetroCDM=2; // LI USB + RadioButton15.Checked:=ServeurRetroCDM=3; // Li101F + RadioButton16.Checked:=ServeurRetroCDM=4; // Li100F + RadioButton17.Checked:=ServeurRetroCDM=5; // Li100 + RadioButton18.Checked:=ServeurRetroCDM=6; // Genli checkBoxZ21.Checked:=Z21; CheckBoxServAig.checked:=Srvc_Aig; @@ -15315,6 +14969,7 @@ begin cbRes.Checked:=affRes; cbAck.Checked:=avecAck; cbDebugRoulage.checked:=DebugRoulage; + cbAffLoc.checked:=AffLoc; CheckBoxOptionDemiTour.checked:=option_demitour; CheckBoxSombre.Checked:=sombre; @@ -15770,6 +15425,9 @@ begin adr:=Adresse_detecteur[i]; LEAdrDet.text:=intToSTR(adr); LELongDet.Text:=IntToSTR(detecteur[adr].longueur); + EditDecal.Text:=IntToSTR(detecteur[adr].distArret); + RadioButtonArrFin.Checked:=detecteur[adr].ModeArret=1; + RadioButtonARMil.Checked:=detecteur[adr].ModeArret=2; end; end; @@ -15859,26 +15517,7 @@ begin for i:=0 to items.Count-1 do Selected[i]:=false; inc(nDetecteurs); - { - i:=nDetecteurs; - Detecteur[i].Adresse:=0; - Detecteur[i].longueur:=0; - Detecteur[i].Etat:=false; - Detecteur[i].Train:=''; - Detecteur[i].AdrTrain:=0; - Detecteur[i].AdrTrainRes:=0; - Detecteur[i].IndexTrainRoulant:=0; - Detecteur[i].Tempo0:=0; - Detecteur[i].NumBranche:=0; - Detecteur[i].IndexBranche:=0; - Detecteur[i].index:=0; - Detecteur[i].temps:=0; - Detecteur[i].distanceTr:=0; - Detecteur[i].suivant:=0; - Detecteur[i].precedent:=0; - Detecteur[i].TypSuivant:=rien; - Detecteur[i].TypPrecedent:=rien;} - + i:=formConfig.ListBoxDet.items.Count+1; s:=encode_Detecteur(0); // scroller à la fin et sélectionner with formconfig.ListBoxDet do @@ -15973,11 +15612,13 @@ begin end; procedure TFormConfig.Button4Click(Sender: TObject); -begin Ajoute_detecteur; +begin + Ajoute_detecteur; end; procedure TFormConfig.Button5Click(Sender: TObject); -begin supprime_detecteur; +begin + supprime_detecteur; end; procedure TFormConfig.RadioGroupLEBClick(Sender: TObject); @@ -16036,16 +15677,19 @@ begin if ligneclicTrain<0 then exit; i:=ligneclicTrain+1; s:=value; - if length(s)=0 then exit; - if s[1]='A' then + tprec:=rien; + if length(s)>0 then begin - tprec:=aig; - delete(s,1,1); - end - else tprec:=det; - + if s[1]='A' then + begin + tprec:=aig; + delete(s,1,1); + end + else tprec:=det; + end; + val(s,v,erreur); - if erreur<>0 then exit; + if v<0 then exit; config_modifie:=true; if aCol=1 then @@ -16061,10 +15705,10 @@ begin begin trains[i].DetecteurArret[Arow].temps:=v; end; + ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; end; - - procedure TFormConfig.EditAigTripleKeyPress(Sender: TObject; var Key: Char); var s : string; @@ -16140,6 +15784,469 @@ begin end; end; +procedure TFormConfig.ButtonRdTClick(Sender: TObject); +begin + if ligneclicTrain>-1 then + begin + if trains[ligneclicTrain+1].routePref[0][0].adresse>0 then + with FormRouteTrain do + begin + PageControlRoutes.ActivePageIndex:=1; + TabSheetRA.Enabled:=false; + IndexTrainFR:=ligneclicTrain+1; + irPref:=1; + ShowModal; + end; + end; +end; + +procedure TFormConfig.LabeledEditV1Change(Sender: TObject); +var r : single; + erreur: boolean; +begin + if (ligneClicTrain<0) or (clicliste) then exit; + Erreur:=false; + try + r:=StrToFloat(labelededitV1.Text,FormatSettings); + except + erreur:=true; + LabelErreur.caption:='Erreur'; + exit; + end; + if not(erreur) then + begin + LabelErreur.caption:=''; + if (r>=0) and (r<10) then trains[ligneclicTrain+1].CoeffV1:=r + else + begin + LabelErreur.caption:='Hors limites'; + exit; + end; + end; + + ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; +end; + +procedure TFormConfig.LabeledEditV2Change(Sender: TObject); +var r : single; + erreur: boolean; +begin + if (ligneClicTrain<0) or (clicliste) then exit; + Erreur:=false; + try + r:=StrToFloat(labelededitV2.Text,FormatSettings); + except + erreur:=true; + LabelErreur.caption:='Erreur'; + exit; + end; + if not(erreur) then + begin + LabelErreur.caption:=''; + if (r>=0) and (r<10) then trains[ligneclicTrain+1].CoeffV2:=r + else + begin + LabelErreur.caption:='Hors limites'; + exit; + end; + end; + ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; +end; + +procedure TFormConfig.LabeledEditV3Change(Sender: TObject); +var r : single; + erreur: boolean; +begin + if (ligneClicTrain<0) or (clicliste) then exit; + Erreur:=false; + try + r:=StrToFloat(labelededitV3.Text,FormatSettings); + except + erreur:=true; + LabelErreur.caption:='Erreur'; + exit; + end; + if not(erreur) then + begin + LabelErreur.caption:=''; + if (r>=0) and (r<10) then trains[ligneclicTrain+1].CoeffV3:=r + else + begin + LabelErreur.caption:='Hors limites'; + exit; + end; + end; + ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; +end; + + + +procedure TFormConfig.EditDecalChange(Sender: TObject); +var r,i,erreur : integer; +begin + if clicListe then exit; + val(editDecal.Text,i,erreur); + if (erreur<>0) or (i<1) then + begin + labelInfo.caption:='Erreur'; + exit; + end; + labelInfo.caption:=''; + r:=adresse_detecteur[ligneclicDet+1]; + detecteur[r].distArret:=i; + ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1); + ListBoxDet.selected[ligneclicDet]:=true; +end; + +procedure TFormConfig.RadioButtonArrFinClick(Sender: TObject); +var r : integer; +begin + if clicListe then exit; + r:=adresse_detecteur[ligneclicDet+1]; + detecteur[r].ModeArret:=1; + ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1); + ListBoxDet.selected[ligneclicDet]:=true; +end; + +procedure TFormConfig.RadioButtonARMilClick(Sender: TObject); +var r : integer; +begin + if clicListe then exit; + r:=adresse_detecteur[ligneclicDet+1]; + detecteur[r].ModeArret:=2; + ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1); + ListBoxDet.selected[ligneclicDet]:=true; +end; + +procedure calculs; +var vitesse,erreur,distArret : integer; + coeff,vitR,TempsArret : single; +begin + val(FormConfig.LabeledEditCalcV.text,vitesse,erreur); + vitesse:=abs(vitesse); + if vitesse>127 then exit; + + with trains[ligneclicTrain+1] do + begin + if vitesse0 then vitR:=vitesse/coeff; + with formconfig.MemoCalc do + begin + Lines.Clear; + lines.add('Vitesse='+FloatToSTRF(vitR,ffFixed,5,2)+' cm/s'); + + TempsArret:=0.896*cv4*Vitesse/128; + Lines.Add('Temps d''arrêt='+FloatToSTRF(TempsArret,ffFixed,5,2)+' s'); + + distArret:=round(TempsArret*vitR/2.2); // en cm + Lines.Add('Distance approx d''arrêt='+IntToSTR(distArret)+' cm'); + end; + end; +end; + +procedure TFormConfig.LabeledEditCalcVChange(Sender: TObject); +var vitesse,erreur : integer; +begin + if clicListe Then exit; + val(LabeledEditCalcV.text,vitesse,erreur); + if vitesse>127 then + begin + LabeledEditCalcV.text:='127'; + exit; + end; + calculs; +end; + +procedure TFormConfig.LabeledEditCV3Change(Sender: TObject); +var erreur,i :integer; +begin + if clicliste then exit; + if affevt then affiche('Evt change CV3',clyellow); + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; + val(LabeledEditCV3.text,i,erreur); + if i<0 then exit; + trains[ligneclicTrain+1].cv3:=i; + formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; +end; + +procedure TFormConfig.LabeledEditCV4Change(Sender: TObject); +var erreur,i :integer; +begin + if clicliste then exit; + if affevt then affiche('Evt change CV4',clyellow); + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; + val(LabeledEditCV4.text,i,erreur); + if i<0 then exit; + trains[ligneclicTrain+1].cv4:=i; + formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; + calculs; +end; + +procedure TFormConfig.LabeledEditCransChange(Sender: TObject); +var erreur,i :integer; +begin + if clicliste then exit; + if affevt then affiche('Evt change Crans',clyellow); + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; + val(LabeledEditCrans.text,i,erreur); + if i<0 then exit; + trains[ligneclicTrain+1].Crans:=i; + formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.selected[ligneclicTrain]:=true; +end; + +procedure TFormConfig.ListBoxDetKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if nDetecteurs<1 then exit; + //if key=VK_delete then supprime_detecteur; + + if ord(Key)=VK_UP then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt ListBoxSig.Items keydown',clyellow); + with Formconfig.ListBoxDet.Items do + begin + if ligneClicDet>0 then + begin + dec(ligneClicDet); + if AncligneClicDet<>ligneClicDet then + begin + AncligneClicDet:=ligneClicDet; + aff_champs_Detecteurs(LigneClicDet); + end; + end; + end; + end; + + if ord(Key)=VK_DOWN then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt ListBoxSig.Items keydown',clyellow); + with Formconfig.ListBoxDet.Items do + begin + if ligneClicDetligneClicDet then + begin + AncligneClicDet:=ligneClicDet; + aff_champs_Detecteurs(ligneClicDet); + end; + end; + end; + end; + + if (Shift = [ssCtrl]) and (key = ord('A')) then + begin + ListBoxSig.SelectAll; + end; + + clicListe:=false; +end; + +procedure TFormConfig.LEAdrDetChange(Sender: TObject); +var i,erreur : integer; + s : string; +begin + val(LEAdrDet.text,i,erreur); + if (erreur<>0) or (i<1) then + begin + labelInfo.caption:='Erreur'; + exit; + end; + labelInfo.caption:=''; + Adresse_detecteur[ligneclicDet+1]:=i; + s:=encode_detecteur(ligneclicDet+1); + formconfig.ListBoxDet.items[ligneclicDet]:=s; + formconfig.ListBoxDet.selected[ligneclicDet]:=true; +end; + +procedure TFormConfig.LElongDetChange(Sender: TObject); +var r,i,erreur :integer; + s : string; +begin + val(LElongDet.Text,i,erreur); + if (erreur<>0) or (i<1) then + begin + labelInfo.caption:='Erreur'; + exit; + end; + labelInfo.caption:=''; + r:=adresse_detecteur[ligneclicDet+1]; + detecteur[r].longueur:=i; + s:=encode_detecteur(ligneclicDet+1); + formconfig.ListBoxDet.items[ligneclicDet]:=s; + formconfig.ListBoxDet.selected[ligneclicDet]:=true; +end; + +procedure TFormConfig.EditPortCdeChange(Sender: TObject); +var s,te : string; + i,v : integer; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + te:=EditPortCde.Text; + Tablo_periph[ligneClicAccPeriph+1].Protocole:=te; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + i:=pos(':',te);if i=0 then begin LabelInfo.caption:='Syntaxe incorrecte';exit;end; + te:=copy(te,1,i); + i:=extract_int(te); + if i=0 then begin LabelInfo.caption:='Erreur COM nul';exit;end; + LabelInfo.caption:=''; + + Tablo_periph[ligneClicAccPeriph+1].NumCom:=i; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; + + maj_champs_combos(ligneClicAccPeriph+1); + + // recalculer le nombre de sockets et de comusb + // et réaffecter les numéros de composants + NbPeriph_COMUSB:=0; + NbPeriph_Socket:=0; + for i:=1 to NbMaxi_Periph do + begin + v:=com_socket(i); + if v=1 then + begin + inc(NbPeriph_COMUSB); + if NbPeriph_COMUSB>MaxComUSBPeriph then labelInfo.Caption:='Nombre maxi de périphériques COM/USB atteint'; + Tablo_periph[i].numComposant:=NbPeriph_COMUSB; + end; + if v=2 then + begin + inc(NbPeriph_Socket); + if NbPeriph_Socket>MaxComSocketPeriph then labelInfo.Caption:='Nombre maxi de périphériques socket atteint'; + Tablo_periph[NbPeriph].numComposant:=NbPeriph_socket; + end; + end; +end; + +procedure TFormConfig.BoutonComClick(Sender: TObject); +begin + liste_portcom; +end; + +procedure TFormConfig.EditOuvreEcranChange(Sender: TObject); +var i, erreur : integer; +begin + begin + val(EditOuvreEcran.text,i,erreur); + if (erreur<>0) or (i<1) then + begin + labelInfo.caption:='Erreur écran'; + exit; + end; + labelInfo.caption:=''; + Ecran_SC:=i; + end; +end; + +procedure TFormConfig.CheckBoxCRClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].CR:=CheckBoxCR.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + +procedure TFormConfig.CbVisClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].ScvVis:=cbVis.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + +procedure TFormConfig.cbDTRClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].DTR:=cbDTR.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + +procedure TFormConfig.cbRTSClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].RTS:=cbRTS.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + +procedure TFormConfig.cbDetClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].ScvDet:=cbDet.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + +procedure TFormConfig.CbActClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].ScvAct:=cbAct.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + +procedure TFormConfig.CbAigClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicAccPeriph<0) then exit; + Tablo_periph[ligneClicAccPeriph+1].ScvAig:=cbAig.Checked; + s:=encode_Periph(ligneClicAccPeriph+1); + ListBoxPeriph.Items[ligneClicAccPeriph]:=s; + ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; +end; + + +procedure TFormConfig.Prox1Change(Sender: TObject); +var i,erreur : integer; + s : string; +begin + labelInfo.caption:=''; + val(Prox1.Text,i,erreur); + actionneur[ligneclicActionneur+1].prox1:=i; + s:=encode_actionneur(ligneclicActionneur+1); + formconfig.ListBoxActionneurs.items[ligneclicActionneur]:=s; + formconfig.ListBoxActionneurs.selected[ligneclicActionneur]:=true; +end; + +procedure TFormConfig.Prox2Change(Sender: TObject); +var i,erreur : integer; + s : string; +begin + labelInfo.caption:=''; + val(Prox2.Text,i,erreur); + actionneur[ligneclicActionneur+1].prox2:=i; + s:=encode_actionneur(ligneclicActionneur+1); + formconfig.ListBoxActionneurs.items[ligneclicActionneur]:=s; + formconfig.ListBoxActionneurs.selected[ligneclicActionneur]:=true; +end; + + + end. diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index bdcac7d..4831098 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -485,8 +485,8 @@ object FormConfCellTCO: TFormConfCellTCO OnClick = CheckPinvClick end object GroupBoxAction: TGroupBox - Left = 48 - Top = 248 + Left = 112 + Top = 72 Width = 273 Height = 145 Caption = 'Actions' @@ -559,7 +559,7 @@ object FormConfCellTCO: TFormConfCellTCO end object GroupBoxCanton: TGroupBox Left = 16 - Top = 240 + Top = 152 Width = 281 Height = 129 Caption = 'Canton' @@ -636,8 +636,8 @@ object FormConfCellTCO: TFormConfCellTCO end end object GroupBoxDet: TGroupBox - Left = 16 - Top = 168 + Left = 32 + Top = 152 Width = 281 Height = 121 Caption = 'Options d'#39'arr'#234't des trains sur le d'#233'tecteur' @@ -659,7 +659,7 @@ object FormConfCellTCO: TFormConfCellTCO object ImageListIcones: TImageList Left = 160 Bitmap = { - 494C010119001D00040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01011A001D00040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000008000000001002000000000000080 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -800,35 +800,47 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000008080000000000000000000000000008080000000000000C0C0 + C000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 0000008080008000000000000000000000000000000000008000000000000000 + 0000800000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000C0C0 + C00000000000C0C0C000000000000000000000000000C0C0C000000000008000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000C0C0 + C00000000000C0C0C00000000000000000000000000000008000000000000000 + 0000C0C0C0000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 0000000080008080000000000000000000000000800000000000C0C0C0000000 + 8000808000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 0000C0C0C00000000000800000000080800000000000C0C0C000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -836,6 +848,7 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000808000000000008000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -843,6 +856,7 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000C0C0C00000000000800000000000800000000000C0C0C0000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -850,6 +864,7 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800080000000000000000000000000008000808000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -857,6 +872,7 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800080800000000000000000000000808000800000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -864,6 +880,7 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000C0C0C00080000000000000000000000000008000808000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -871,24 +888,7 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000808000000000000000000080000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -1691,11 +1691,11 @@ object FormConfCellTCO: TFormConfCellTCO 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000FFFF000000000000FFFF000000000000 - FFFF000000000000FFFF000000000000FFBF000000000000FF9F000000000000 - C007000000000000C003000000000000C001000000000000C003000000000000 - C007000000000000FF9F000000000000FFBF000000000000FFFF000000000000 - FFFF000000000000FFFF0000000000000000F81FFFFF00000000E007FC3F0000 + 00000000000000000000000000000000FFFFFFFF00000000FFFFF82700000000 + FFFFF38700000000FFFFE38F00000000FFBFE38700000000FF9FF30700000000 + C007F03F00000000C003FC7F00000000C001F81F00000000C003F99F00000000 + C007F99F00000000FF9FF99F00000000FFBFFC3F00000000FFFFFFFF00000000 + FFFFFFFF00000000FFFFFFFF000000000000F81FFFFF00000000E007FC3F0000 0000C003F81F00000000C001F00F000000008001F00F000000000180F00F0000 000003C0F00F0000000007E0F00F0000000007E0F00F0000000003C0F00F0000 00000180F00F000000008001F00F00000000C001F00F00000000C003F00F0000 @@ -1719,7 +1719,6 @@ object FormConfCellTCO: TFormConfCellTCO 0000FFFFFFFFF56F0000FFFFFFFFF56F0000C1C1FFFFF54F0000988C8866FB6F 0000F81F39A6FFFF0000F81F39A600000000C11F39A200000000871F39A40000 00008F1F886E000000008C8CFFFF00000000C1C1FFFF00000000FFFFFFFF0000 - 0000FFFFFFFF00000000FFFFFFFF000000000000000000000000000000000000 - 000000000000} + 0000FFFFFFFF00000000FFFFFFFF0000} end end diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index e883085..d522c34 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -205,7 +205,7 @@ end; // actualise le contenu de la fenetre et de la zone tco par rapport à la cellule cliquée procedure actualise(indexTCO : integer); -var i,j,ligne,Adr,Bimage,oriente,piedFeu,act,sens : integer; +var i,j,ligne,Adr,Bimage,oriente,piedFeu,act,sens,IdCanton : integer; s : string; ip : Timage; r : trect; @@ -261,6 +261,8 @@ begin XclicCell[indexTCO]:=XclicC; YclicCell[indexTCO]:=YclicC; + idCanton:=index_canton(indexTCO,xclicC,yclicC); + GroupBoxOrientation.visible:=false; GroupBoxImplantation.visible:=false; GroupBoxAction.Visible:=false; @@ -621,7 +623,8 @@ begin with formConfCellTCO do begin - EditTexteCCTCO.Text:=tco[indexTCO,xclicC,yclicC].Texte; + if isCanton(Bimage) then EditTexteCCTCO.Text:=canton[idcanton].nom + else EditTexteCCTCO.Text:=tco[indexTCO,xclicC,yclicC].Texte; EditAdrElement.Text:=IntToSTR(tco[indexTCO,XclicCellInserer,YclicCellInserer].Adresse); ComboRepr.ItemIndex:=tco[indexTCO,XclicC,YclicC].repr; end; @@ -712,7 +715,7 @@ begin tco[indexTCOCourant,x,y].CoulFonte:=clTexte; tco[indexTCOCourant,x,y].TailleFonte:=8; end; - tco[indexTCOCourant,x,y].Texte:=EditTexteCCTCO.Text; + if not(clicTCO) then TCO_modifie:=true; if not(selectionaffichee[indexTCOcourant]) then efface_entoure(indexTCOCourant); @@ -725,7 +728,10 @@ begin Dessin_canton(indexTCOCourant,PcanvasTCO[indexTCOCourant],x,y,0); end else + begin + tco[indexTCOCourant,x,y].Texte:=EditTexteCCTCO.Text; affiche_texte(indexTCOCourant,x,y); + end; formTCO[indexTCOCourant].EditTexte.Text:=EditTexteCCTCO.text; if not(selectionaffichee[indexTCOcourant]) then _entoure_cell_clic(indexTCOCourant); diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index 3483d60..55bdf0d 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -1,9 +1,9 @@ object FormConfigTCO: TFormConfigTCO - Left = 296 - Top = 201 + Left = 319 + Top = 137 BorderStyle = bsDialog Caption = 'Configuration du TCO' - ClientHeight = 420 + ClientHeight = 443 ClientWidth = 665 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -49,20 +49,20 @@ object FormConfigTCO: TFormConfigTCO object ImageAig: TImage Left = 128 Top = 16 - Width = 41 - Height = 41 + Width = 32 + Height = 32 OnClick = ImageAigClick end object ImageFond: TImage Left = 128 - Top = 64 - Width = 41 - Height = 41 + Top = 56 + Width = 32 + Height = 32 OnClick = ImageFondClick end object Label6: TLabel Left = 33 - Top = 72 + Top = 56 Width = 75 Height = 26 Alignment = taRightJustify @@ -71,44 +71,44 @@ object FormConfigTCO: TFormConfigTCO end object ImageGrille: TImage Left = 128 - Top = 112 - Width = 41 - Height = 41 + Top = 96 + Width = 32 + Height = 32 OnClick = ImageGrilleClick end object Label7: TLabel Left = 31 - Top = 128 + Top = 104 Width = 74 Height = 13 Caption = 'couleur de grille' end object ImageDetAct: TImage Left = 128 - Top = 160 - Width = 41 - Height = 41 - OnClick = ImageDetActClick + Top = 136 + Width = 32 + Height = 32 + OnClick = ImageDetAtlick end object Label8: TLabel Left = 26 - Top = 176 + Top = 144 Width = 79 Height = 13 Caption = 'D'#233'tecteur activ'#233 end object Label9: TLabel Left = 218 - Top = 176 + Top = 144 Width = 66 Height = 13 Caption = 'Canton activ'#233 end object Imagecanton: TImage Left = 296 - Top = 160 - Width = 41 - Height = 41 + Top = 136 + Width = 32 + Height = 32 OnClick = ImagecantonClick end object Label10: TLabel @@ -121,41 +121,41 @@ object FormConfigTCO: TFormConfigTCO object ImageTexte: TImage Left = 296 Top = 16 - Width = 41 - Height = 41 + Width = 32 + Height = 32 OnClick = ImageTexteClick end object Label11: TLabel Left = 197 - Top = 24 + Top = 16 Width = 87 Height = 13 Caption = 'Couleur des textes' end object Label12: TLabel Left = 192 - Top = 40 + Top = 32 Width = 93 Height = 13 Caption = 'statiques par d'#233'faut' end object ImageQuai: TImage Left = 296 - Top = 64 - Width = 41 - Height = 41 + Top = 56 + Width = 32 + Height = 32 OnClick = ImageQuaiClick end object Label13: TLabel Left = 214 - Top = 80 + Top = 64 Width = 74 Height = 13 Caption = 'Couleur de quai' end object Label1: TLabel Left = 184 - Top = 120 + Top = 96 Width = 102 Height = 26 Alignment = taRightJustify @@ -164,11 +164,39 @@ object FormConfigTCO: TFormConfigTCO end object ImagePiedFeu: TImage Left = 296 - Top = 112 - Width = 41 - Height = 41 + Top = 96 + Width = 32 + Height = 32 OnClick = ImagePiedFeuClick end + object ImageCantonLibre: TImage + Left = 128 + Top = 176 + Width = 32 + Height = 32 + OnClick = ImageCantonLibreClick + end + object ImageCantonOccupe: TImage + Left = 296 + Top = 176 + Width = 32 + Height = 32 + OnClick = ImageCantonOccupeClick + end + object Label19: TLabel + Left = 58 + Top = 184 + Width = 56 + Height = 13 + Caption = 'Canton libre' + end + object Label20: TLabel + Left = 210 + Top = 184 + Width = 73 + Height = 13 + Caption = 'Canton occup'#233 + end object CheckCouleur: TCheckBox Left = 48 Top = 248 @@ -181,7 +209,7 @@ object FormConfigTCO: TFormConfigTCO end object Memo1: TMemo Left = 304 - Top = 360 + Top = 392 Width = 353 Height = 49 BevelInner = bvLowered @@ -230,7 +258,7 @@ object FormConfigTCO: TFormConfigTCO Left = 304 Top = 296 Width = 353 - Height = 57 + Height = 89 Caption = 'Graphisme de tous les TCOs' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -240,22 +268,13 @@ object FormConfigTCO: TFormConfigTCO ParentFont = False TabOrder = 4 end - object RadioButtonCourbes: TRadioButton - Left = 320 - Top = 328 - Width = 113 - Height = 17 - Caption = 'Lignes courbes' - TabOrder = 5 - OnClick = RadioButtonCourbesClick - end object GroupBox3: TGroupBox Left = 8 Top = 8 Width = 289 Height = 89 Caption = 'Configuration du TCO ' - TabOrder = 6 + TabOrder = 5 object Label3: TLabel Left = 16 Top = 20 @@ -335,7 +354,7 @@ object FormConfigTCO: TFormConfigTCO Width = 289 Height = 273 Caption = 'Configuration de tous les TCOs' - TabOrder = 7 + TabOrder = 6 object Ratio: TLabel Left = 8 Top = 208 @@ -444,32 +463,30 @@ object FormConfigTCO: TFormConfigTCO OnChange = TrackBarEpaisseurChange end end - object RadioButtonLignes: TRadioButton - Left = 320 + object RadioGroupStyle: TRadioGroup + Left = 480 Top = 312 - Width = 113 - Height = 17 - Caption = 'Lignes bris'#233'es' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 8 - OnClick = RadioButtonLignesClick + Width = 169 + Height = 65 + Caption = 'Mode d'#39'affichage' + Items.Strings = ( + 'Mode sombre' + 'Mode clair' + 'Mode noir et blanc') + TabOrder = 7 + OnClick = RadioGroupStyleClick end - object CheckNB: TCheckBox - Left = 488 + object RadioGroupVoies: TRadioGroup + Left = 312 Top = 312 - Width = 137 - Height = 17 - Hint = 'Affichage du TCO en noir et blanc pour impression' - Caption = 'Mode noir et blanc' - ParentShowHint = False - ShowHint = True - TabOrder = 9 - OnClick = CheckNBClick + Width = 153 + Height = 49 + Caption = 'Style de voies' + Items.Strings = ( + 'Lignes bris'#233'es' + 'Lignes courbes') + TabOrder = 8 + OnClick = RadioGroupVoiesClick end object ColorDialog1: TColorDialog OnShow = ColorDialog1Show diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index 03a9071..f27de99 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -36,7 +36,6 @@ type ImagePiedFeu: TImage; BitBtnOk: TBitBtn; RadioGroup1: TRadioGroup; - RadioButtonCourbes: TRadioButton; GroupBox3: TGroupBox; Label3: TLabel; Label4: TLabel; @@ -58,14 +57,18 @@ type TrackBarEpaisseur: TTrackBar; Label17: TLabel; Label18: TLabel; - RadioButtonLignes: TRadioButton; - CheckNB: TCheckBox; + RadioGroupStyle: TRadioGroup; + RadioGroupVoies: TRadioGroup; + ImageCantonLibre: TImage; + ImageCantonOccupe: TImage; + Label19: TLabel; + Label20: TLabel; procedure ButtonDessineClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ImageAigClick(Sender: TObject); procedure ImageFondClick(Sender: TObject); procedure ImageGrilleClick(Sender: TObject); - procedure ImageDetActClick(Sender: TObject); + procedure ImageDetAtlick(Sender: TObject); procedure ImagecantonClick(Sender: TObject); procedure ColorDialog1Show(Sender: TObject); procedure ImageTexteClick(Sender: TObject); @@ -77,12 +80,13 @@ type procedure EditNbCellYChange(Sender: TObject); procedure CheckDessineGrilleClick(Sender: TObject); procedure CheckCouleurClick(Sender: TObject); - procedure RadioButtonLignesClick(Sender: TObject); - procedure RadioButtonCourbesClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TrackBarEpaisseurChange(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure CheckNBClick(Sender: TObject); + procedure RadioGroupVoiesClick(Sender: TObject); + procedure RadioGroupStyleClick(Sender: TObject); + procedure ImageCantonLibreClick(Sender: TObject); + procedure ImageCantonOccupeClick(Sender: TObject); private { Déclarations privées } public @@ -94,6 +98,10 @@ var FormConfigTCO: TFormConfigTCO; titre_couleur : string; graphisme : integer; +procedure sauve_styles_tco(indexTCO: integer); +procedure restitue_styles(indexTCO: integer); +procedure jeu_clair(indexTCO: integer); + implementation uses UnitPrinc,unitconfig ; @@ -103,8 +111,6 @@ uses UnitPrinc,unitconfig ; // icone exemple procedure icone_aig; -var r : Trect; - x1,y1,x2,y2,x3,y3,x4,y4 : integer; begin with FormConfigTCO.ImageAig do begin @@ -114,15 +120,58 @@ begin canvas.pen.color:=clVoies[indexTCOCourant]; canvas.brush.color:=clvoies[indexTCOCourant]; - // bande horizontale - r:=Rect(0,(height div 2)-3,width,(height div 2)+3); - canvas.FillRect(r); - x1:=(width div 2); y1:=(height div 2)-3; - x2:=3; y2:=0; - x3:=0; y3:=3; - x4:=0+(width div 2)-1; y4:=(height div 2)+3-1; - canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + Canvas.Pen.Width:=4; + canvas.MoveTo(0,height div 2);Canvas.LineTo(width,height div 2); + + canvas.MoveTo(width div 2,height div 2);Canvas.LineTo(0,0); + + end; +end; + +procedure icone_canton_libre; +var haut,larg,yc1,yc2 : integer; +begin + haut:=FormConfigTCO.ImageCantonLibre.Height; + larg:=FormConfigTCO.ImageCantonLibre.Width; + yc1:=haut div 4; + yc2:=larg-(haut div 4); + + with FormConfigTCO.ImageCantonLibre.Canvas do + begin + Pen.color:=clfond[indexTCOCourant]; + Brush.Color:=clfond[indexTCOCourant]; + Rectangle(0,0,larg,Haut); + + Pen.Width:=1; + + Brush.Color:=CoulCantonLibre[indexTCOCourant]; + pen.color:=clwhite; + + Roundrect(0,yc1,larg,yc2,larg div 2,(yc2-yc1) div 2); + end; +end; + +procedure icone_canton_occupe; +var haut,larg,yc1,yc2 : integer; +begin + haut:=FormConfigTCO.ImageCantonLibre.Height; + larg:=FormConfigTCO.ImageCantonLibre.Width; + yc1:=haut div 4; + yc2:=larg-(haut div 4); + + with FormConfigTCO.ImageCantonOccupe.Canvas do + begin + Pen.color:=clfond[indexTCOCourant]; + Brush.Color:=clfond[indexTCOCourant]; + Rectangle(0,0,larg,Haut); + + Pen.Width:=1; + + Brush.Color:=CoulCantonOccupe[indexTCOCourant]; + pen.color:=clwhite; + + Roundrect(0,yc1,larg,yc2,larg div 2,(yc2-yc1) div 2); end; end; @@ -149,7 +198,7 @@ begin canvas.Rectangle(0,0,Width,Height); canvas.Pen.color:=ClGrille[IndexTCO]; canvas.moveto(0,5); canvas.LineTo(width,5); - canvas.moveto(27,0); canvas.LineTo(27,Height); + canvas.moveto(8,0); canvas.LineTo(8,Height); end; // 4 détecteur with formConfigTCO.ImageDetAct do @@ -227,6 +276,10 @@ begin canvas.LineTo(x1,y2); canvas.LineTo(x1-10,y2); end; + + icone_canton_libre; + icone_canton_occupe; + end; function verif_config_TCO(indexTCO : integer) : boolean; // renvoie true si ok @@ -311,8 +364,8 @@ begin EditNbCellY.Text:=IntToSTR(NbreCellY[indexTCOcourant]); EditRatio.text:=IntToSTR(RatioC); EditEcran.Text:=intToSTR(EcranTCO[indexTCOcourant]); - RadioButtonCourbes.checked:=graphisme=2; - RadioButtonLignes.checked:=graphisme=1; + RadioGroupVoies.ItemIndex:=graphisme-1; + RadioGroupStyle.itemIndex:=JeuCouleurs-1; checkDessineGrille.Checked:=AvecGrille[IndexTCOCourant]; checkCouleur.Checked:=ModeCouleurCanton=1; trackbarEpaisseur.Position:=Epaisseur_voies; @@ -355,6 +408,7 @@ begin clVoies[indexTCOCourant]:=ColorDialog1.Color; TCO_modifie:=true; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -371,6 +425,7 @@ begin clfond[indexTCOCourant]:=ColorDialog1.Color; TCO_modifie:=true; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -388,10 +443,11 @@ begin ClGrille[IndexTCOCourant]:=ColorDialog1.Color; TCO_modifie:=true; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; -procedure TFormConfigTCO.ImageDetActClick(Sender: TObject); +procedure TFormConfigTCO.ImageDetAtlick(Sender: TObject); var s: string; begin titre_couleur:='Changer la couleur de détecteur activé'; @@ -404,6 +460,7 @@ begin ClAllume[indexTCOCourant]:=ColorDialog1.Color; TCO_modifie:=true; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -416,6 +473,7 @@ begin begin ClCanton[indexTCOCourant]:=ColorDialog1.Color; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -428,6 +486,7 @@ begin begin ClTexte:=ColorDialog1.Color; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -440,6 +499,7 @@ begin begin ClQuai[indexTCOCourant]:=ColorDialog1.Color; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -452,6 +512,7 @@ begin begin clPiedSignal[indexTCOCourant]:=ColorDialog1.Color; dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); end; end; @@ -494,17 +555,6 @@ begin if not(clicConf) then TCO_modifie:=true; end; -procedure TFormConfigTCO.RadioButtonLignesClick(Sender: TObject); -begin - if not(clicConf) then TCO_modifie:=true; - graphisme:=1; -end; - -procedure TFormConfigTCO.RadioButtonCourbesClick(Sender: TObject); -begin - if not(clicConf) then TCO_modifie:=true; - graphisme:=2; -end; procedure TFormConfigTCO.FormCreate(Sender: TObject); var i : integer; @@ -540,6 +590,48 @@ begin composant(c,couleurFond,couleurTexte); end; end; + + With ImageAig do + begin + Height:=32; + Width:=32; + end; + With ImageFond do + begin + Height:=32; + Width:=32; + end; + With ImageGrille do + begin + Height:=32; + Width:=32; + end; + With ImageDetAct do + begin + Height:=32; + Width:=32; + end; + With ImageTexte do + begin + Height:=32; + Width:=32; + end; + With ImageQuai do + begin + Height:=32; + Width:=32; + end; + With ImagePiedFeu do + begin + Height:=32; + Width:=32; + end; + With ImageCanton do + begin + Height:=32; + Width:=32; + end; + if debug=1 then Affiche('Fin création fenetre configTCO',clLime); end; @@ -573,17 +665,6 @@ 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); @@ -616,10 +697,126 @@ begin else action:=tCloseAction(caNone); // si la config est nok, on ferme pas la fenetre end; -procedure TFormConfigTCO.CheckNBClick(Sender: TObject); + + +procedure TFormConfigTCO.RadioGroupVoiesClick(Sender: TObject); begin - NB:=CheckNB.checked; + if not(clicConf) then TCO_modifie:=true; + if RadioGroupVoies.itemIndex<0 then exit; + tco_Modifie:=graphisme<>RadioGroupVoies.itemIndex+1; + graphisme:=RadioGroupVoies.itemIndex+1; end; +procedure sauve_styles_tco(indexTCO: integer); +var x,y : integer; begin + clvoiesSV:=clVoies[indexTCO]; + clFoncSV:=ClFond[indexTCO]; + clGrilleSV:=ClGrille[IndexTCO]; + clCoulCantonLibreSV:=CoulCantonLibre[IndexTco]; + clCoulCantonOccupeSV:=CoulCantonOccupe[IndexTCO]; + for y:=1 to NbreCellY[indexTCO] do + for x:=1 to NbreCellX[indexTCO] do + clCoulFondSV[IndexTCO,x,y]:=TCO[indexTCO,x,y].CouleurFond; +end; + +procedure restitue_styles(indexTCO: integer); +var x,y : integer; +begin + clVoies[indexTCO]:=clVoiesSV; + ClFond[indexTCO]:=clFoncSV; + ClGrille[IndexTCO]:=ClGrilleSV; + CoulCantonLibre[IndexTco]:=ClCoulCantonLibreSV; + CoulCantonOccupe[IndexTCO]:=ClCoulCantonOccupeSV; + for y:=1 to NbreCellY[indexTCO] do + for x:=1 to NbreCellX[indexTCO] do + begin + TCO[indexTCO,x,y].CouleurFond:=ClCoulFondSV[IndexTCO,x,y]; + end; +end; + +procedure jeu_clair(indexTCO: integer); +var x,y : integer; +begin + for indexTCO:=1 to NbreTco do + begin + clVoies[indexTCO]:=$A00000; + ClFond[indexTCO]:=$A00000; + ClGrille[IndexTCO]:=$FFC0C0; + CoulCantonLibre[IndexTco]:=$A0A0A0; + CoulCantonOccupe[IndexTCO]:=$A0A0FF; + for y:=1 to NbreCellY[indexTCO] do + for x:=1 to NbreCellX[indexTCO] do + TCO[indexTCO,x,y].CouleurFond:=$FFFFFF; + end; +end; + +procedure TFormConfigTCO.RadioGroupStyleClick(Sender: TObject); +var indexTCO,AncienJeuCouleurs : integer; +begin + AncienJeuCouleurs:=JeuCouleurs; + if ancienJeuCouleurs=1 then sauve_styles_tco(1); + JeuCouleurs:=RadioGroupStyle.itemIndex+1; + + if (JeuCouleurs<0) or (AncienJeuCouleurs=JeuCouleurs) then exit; + + // mode sombre + if JeuCouleurs=1 then + begin + for indexTCO:=1 to NbreTco do + begin + restitue_styles(indexTCO); + Affiche_tco(indexTCO); + end; + end; + + // mode clair + if JeuCouleurs=2 then + begin + for indexTCO:=1 to NbreTco do + begin + jeu_clair(indexTCO); + Affiche_tco(indexTCO); + end; + end; + + NB:=JeuCouleurs=3; +end; + +procedure TFormConfigTCO.ImageCantonLibreClick(Sender: TObject); +var s : string; +begin + titre_couleur:='Changer la couleur du canton libre'; + ColorDialog1.Color:=clAllume[indexTCOCourant]; + + s:='ColorA='+IntToHex(clfond[indexTCOCourant],6); // ajouter aux couleurs personnalisées + colorDialog1.CustomColors.Add(s); + if ColorDialog1.execute then + begin + CoulCantonLibre[indexTCOCourant]:=ColorDialog1.Color; + TCO_modifie:=true; + dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCourant); + end; +end; + +procedure TFormConfigTCO.ImageCantonOccupeClick(Sender: TObject); +var s : string; +begin + titre_couleur:='Changer la couleur du canton occupé'; + ColorDialog1.Color:=clAllume[indexTCOCourant]; + + s:='ColorA='+IntToHex(clfond[indexTCOCourant],6); // ajouter aux couleurs personnalisées + colorDialog1.CustomColors.Add(s); + if ColorDialog1.execute then + begin + CoulCantonOccupe[indexTCOCourant]:=ColorDialog1.Color; + TCO_modifie:=true; + dessine_icones_config(indexTCOCourant); + sauve_styles_tco(indexTCOCOurant); + end; +end; + + + end. diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 24267f5..a1c7af3 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -32,7 +32,6 @@ object FormDebug: TFormDebug Width = 872 Height = 677 HorzScrollBar.Visible = False - VertScrollBar.Position = 69 Anchors = [akLeft, akTop, akRight, akBottom] Color = clBtnFace ParentColor = False @@ -42,7 +41,7 @@ object FormDebug: TFormDebug 673) object LabelTitreDebug: TLabel Left = 475 - Top = -61 + Top = 8 Width = 131 Height = 18 Anchors = [akTop, akRight] @@ -56,7 +55,7 @@ object FormDebug: TFormDebug end object Label1: TLabel Left = 627 - Top = -59 + Top = 10 Width = 108 Height = 13 Anchors = [akTop, akRight] @@ -72,7 +71,7 @@ object FormDebug: TFormDebug end object RichDebug: TRichEdit Left = 0 - Top = -69 + Top = 0 Width = 454 Height = 753 Anchors = [akLeft, akTop, akRight] @@ -86,7 +85,7 @@ object FormDebug: TFormDebug end object ButtonRazTout: TButton Left = 465 - Top = 147 + Top = 216 Width = 97 Height = 25 Hint = @@ -101,7 +100,7 @@ object FormDebug: TFormDebug end object ButtonCop: TButton Left = 465 - Top = 179 + Top = 248 Width = 97 Height = 41 Anchors = [akTop, akRight] @@ -118,7 +117,7 @@ object FormDebug: TFormDebug end object ButtonAffEvtChrono: TButton Left = 465 - Top = 227 + Top = 296 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -129,7 +128,7 @@ object FormDebug: TFormDebug end object ButtonCherche: TButton Left = 465 - Top = 267 + Top = 336 Width = 97 Height = 25 Hint = 'Cherche la cha'#238'ne "erreur"' @@ -142,7 +141,7 @@ object FormDebug: TFormDebug end object ButtonEcrLog: TButton Left = 465 - Top = 115 + Top = 184 Width = 97 Height = 29 Anchors = [akTop, akRight] @@ -152,7 +151,7 @@ object FormDebug: TFormDebug end object ButtonRazTampon: TButton Left = 465 - Top = 299 + Top = 368 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -163,7 +162,7 @@ object FormDebug: TFormDebug end object ButtonRazLog: TButton Left = 465 - Top = 339 + Top = 408 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -174,7 +173,7 @@ object FormDebug: TFormDebug end object MemoEvtDet: TRichEdit Left = 570 - Top = 117 + Top = 186 Width = 272 Height = 263 Anchors = [akTop, akRight] @@ -185,7 +184,7 @@ object FormDebug: TFormDebug end object GroupBox5: TGroupBox Left = 462 - Top = 387 + Top = 456 Width = 380 Height = 57 Anchors = [akTop, akRight] @@ -252,7 +251,7 @@ object FormDebug: TFormDebug end object GroupBox6: TGroupBox Left = 462 - Top = 451 + Top = 520 Width = 380 Height = 52 Anchors = [akTop, akRight] @@ -319,7 +318,7 @@ object FormDebug: TFormDebug Top = 16 Width = 49 Height = 25 - Hint = 'Mise '#224' 0 de la sortie' + Hint = 'Mise '#224' 0 des deux sorties' Caption = 'Mise '#224' 0' ParentShowHint = False ShowHint = True @@ -329,7 +328,7 @@ object FormDebug: TFormDebug end object GroupBoxPrim: TGroupBox Left = 464 - Top = 515 + Top = 584 Width = 378 Height = 185 Anchors = [akTop, akRight] @@ -500,7 +499,7 @@ object FormDebug: TFormDebug end object GroupBox2: TGroupBox Left = 466 - Top = -41 + Top = 28 Width = 376 Height = 149 Anchors = [akTop, akRight] @@ -713,7 +712,7 @@ object FormDebug: TFormDebug end object EditNivDebug: TEdit Left = 751 - Top = -61 + Top = 8 Width = 49 Height = 21 Anchors = [akTop, akRight] diff --git a/UnitDebug.pas b/UnitDebug.pas index d1541f1..16d82e5 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -701,10 +701,6 @@ begin ProcPrinc:=checkBoxPrinc.checked; end; - - - - procedure TFormDebug.Button3Click(Sender: TObject); begin ScrollBoxDebug.VertScrollBar.Position:=0; diff --git a/UnitFicheHoraire.dfm b/UnitFicheHoraire.dfm index ee84533..bc76610 100644 --- a/UnitFicheHoraire.dfm +++ b/UnitFicheHoraire.dfm @@ -1,10 +1,9 @@ object FormFicheHoraire: TFormFicheHoraire Left = 358 Top = 169 - BorderStyle = bsDialog + Width = 617 + Height = 377 Caption = 'Fiche horaire' - ClientHeight = 346 - ClientWidth = 527 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -15,6 +14,9 @@ object FormFicheHoraire: TFormFicheHoraire Position = poScreenCenter OnActivate = FormActivate OnCreate = FormCreate + DesignSize = ( + 609 + 346) PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel @@ -22,21 +24,24 @@ object FormFicheHoraire: TFormFicheHoraire Top = 272 Width = 310 Height = 13 + Anchors = [akLeft, akBottom] Caption = 'Le nom des trains doit respecter l'#39#233'criture d'#233'clar'#233'e dans CDM Ra' + 'il' end object LabelErreur: TLabel - Left = 136 - Top = 304 + Left = 280 + Top = 296 Width = 3 Height = 13 + Anchors = [akLeft, akBottom] end object Label2: TLabel - Left = 208 - Top = 328 + Left = 288 + Top = 320 Width = 296 Height = 13 + Anchors = [akLeft, akBottom] Caption = 'Les horaires sont sauvegard'#233's dans le fichier '#39'FicheHoraire.txt"' end object ButtonOk: TButton @@ -45,6 +50,7 @@ object FormFicheHoraire: TFormFicheHoraire Width = 75 Height = 25 Hint = 'Sauvegarde la fiche et ferme la fen'#234'tre' + Anchors = [akLeft, akBottom] Caption = 'Ok' ParentShowHint = False ShowHint = True @@ -54,11 +60,12 @@ object FormFicheHoraire: TFormFicheHoraire object StringGridFO: TStringGrid Left = 8 Top = 16 - Width = 505 + Width = 593 Height = 233 ColCount = 4 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing] TabOrder = 1 OnDrawCell = StringGridFODrawCell + OnSetEditText = StringGridFOSetEditText end end diff --git a/UnitFicheHoraire.pas b/UnitFicheHoraire.pas index cb55dc5..e7cf809 100644 --- a/UnitFicheHoraire.pas +++ b/UnitFicheHoraire.pas @@ -18,6 +18,8 @@ type procedure FormActivate(Sender: TObject); procedure StringGridFODrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); + procedure StringGridFOSetEditText(Sender: TObject; ACol, ARow: Integer; + const Value: String); private { Déclarations privées } public @@ -26,23 +28,34 @@ type const MaxHoraire=200; - + colLigne=0; + ColTrain=1; + ColRoute=2; + ColHDep=3; + ColVitDem=4; + ColSens=5; + ColArret=6; var FormFicheHoraire: TFormFicheHoraire; Nombre_horaires : integer; GrilleHoraire : Array[1..MaxHoraire] of record NomTrain : string ; - Adresse : integer; + route : string; + Adresse : integer; // adresse du train vitesse : integer; - sens : boolean; + sens : boolean; //Normal=true inverse=false arretDepart : boolean; // arret du train au démarrage de l'horloge heure,minute : integer; detecteur,actionneur : integer; end; +Bouton : Tbutton; + implementation +uses verif_version; + {$R *.dfm} procedure TFormFicheHoraire.ButtonOkClick(Sender: TObject); @@ -52,14 +65,17 @@ var f : textfile; begin assignFile(f,'FicheHoraire.txt'); rewrite(f); - writeln(f,'/ Fichier horaire'); + writeln(f,'/ Fichier horaire Version '+VersionSC); n:=stringGridFO.RowCount-1; if n>MaxHoraire then n:=MaxHoraire; for ligne:=1 to n do begin + // nomtrain,Nomroute,départ,vitesse démarre,sens,inverse + + // recopier le composant grille dans le tableau grilleHoraire[] grilleHoraire[ligne].NomTrain:=stringGridFO.Cells[1,ligne]; - s:=stringGridFO.Cells[2,ligne]; // heure de démarrage + s:=stringGridFO.Cells[ColHDep,ligne]; // heure de démarrage val(s,i,erreur); grilleHoraire[ligne].heure:=i; delete(s,1,erreur); @@ -97,35 +113,47 @@ begin end; end; + procedure TFormFicheHoraire.FormCreate(Sender: TObject); var i,champ,ligne,col,erreur : integer; f : textFile ; - s,ss : string; + s,ss,v : string; + ver : single; + MRect : Trect; begin // cells[colonne,ligne] with stringGridFO do begin + Anchors:=[]; + Anchors:=[AkTop,AkLeft,akright,akBottom]; + Options:=options + // édition pas multiselect trackbar dynamique autoriz le dimensionnement des colonnes + + [goEditing] - [goRangeSelect] + [goThumbTracking]+ [goColSizing] + + [goAlwaysShowEditor]; // autorise l'édition Hint:='Grille horaire'; ShowHint:=true; - ColCount:=6; + ColCount:=7; RowCount:=MaxHoraire+1; Options := stringGridFO.Options + [goEditing]; - ColWidths[0]:=30; - ColWidths[1]:=200; - ColWidths[2]:=60; - ColWidths[3]:=60; - ColWidths[4]:=50; - ColWidths[5]:=60; + ColWidths[ColLigne]:=30; + ColWidths[ColTrain]:=200; + ColWidths[ColRoute]:=100; + ColWidths[ColHDep]:=60; + ColWidths[ColVitDem]:=60; + ColWidths[ColSens]:=50; + ColWidths[ColArret]:=60; - Cells[0,0]:='Ligne'; - Cells[1,0]:='Nom du train'; - Cells[2,0]:='Départ'; - Cells[3,0]:='Vitesse'+#13+'démarrage'; - Cells[4,0]:='Sens'+#13+'(N/R)'; - Cells[5,0]:='Forcer arrêt'+#13+'O/N'; + Cells[ColLigne,0]:='Ligne'; + Cells[ColTrain,0]:='Nom du train'; + Cells[ColRoute,0]:='Nom de la route'; + Cells[ColHDep,0]:='Départ'; + Cells[ColVitDem,0]:='Vitesse'+#13+'démarrage'; + Cells[ColSens,0]:='Sens'+#13+'(N/R)'; + Cells[ColArret,0]:='Forcer arrêt'+#13+'O/N'; RowHeights[0]:=22; + // numéroter les lignes et fixer la hauteur des lignes for i:=1 to RowCount-1 do begin if i>0 then Cells[0,i]:=intToSTR(i); @@ -142,6 +170,18 @@ begin exit; end; + readln(f,s); // version + s:=lowercase(s); + i:=pos('version ',s); + v:=''; + if i<>0 then + begin + delete(s,1,i+7); + v:=s; + end; + + val(v,ver,erreur); + ligne:=1; repeat readln(f,s); @@ -153,7 +193,7 @@ begin col:=1; repeat // lecture de la ligne champ:=pos(',',s); - if col=1 then // nom du train + if col=ColTrain then // nom du train begin if champ=0 then begin affiche('Erreur 17',clred);closefile(f);end; ss:=copy(s,1,champ-1); @@ -162,11 +202,20 @@ begin if champ<>0 then delete(s,1,champ); end; - if col=2 then // heure + if (col=ColRoute) then // route + begin + ss:=s; + ss:=copy(s,1,champ-1); + stringGridFO.Cells[colRoute,ligne]:=ss; + grilleHoraire[ligne].route:=ss; + if champ<>0 then delete(s,1,champ); + end; + + if col=3 then // heure begin ss:=s; if champ<>0 then ss:=copy(s,1,champ-1); - stringGridFO.Cells[col,ligne]:=ss; + stringGridFO.Cells[ColHDep,ligne]:=ss; val(ss,i,erreur); grilleHoraire[ligne].heure:=i; delete(ss,1,erreur); @@ -175,30 +224,30 @@ begin if champ<>0 then delete(s,1,champ); end; - if col=3 then // vitesse + if (col=4) then // vitesse begin ss:=copy(s,1,champ-1); val(ss,i,erreur); grilleHoraire[ligne].vitesse:=i; - stringGridFO.Cells[col,ligne]:=ss; + stringGridFO.Cells[colVitDem,ligne]:=ss; if champ<>0 then delete(s,1,champ); end; - if col=4 then // sens + if (col=5) then // sens begin ss:=copy(s,1,champ-1); grilleHoraire[ligne].sens:=ss='N'; if grilleHoraire[ligne].sens then ss:='N' else ss:='R'; - stringGridFO.Cells[col,ligne]:=ss; + stringGridFO.Cells[colSens,ligne]:=ss; if champ<>0 then delete(s,1,champ); end; - if col=5 then // arret du train au démarrage de l'horloge + if (col=6) then // arret du train au démarrage de l'horloge begin ss:=copy(s,1,champ-1); grilleHoraire[ligne].arretDepart:=ss='O'; if grilleHoraire[ligne].arretDepart then ss:='O' else ss:='N'; - stringGridFO.Cells[col,ligne]:=ss; + stringGridFO.Cells[colArret,ligne]:=ss; if champ<>0 then delete(s,1,champ); end; @@ -239,33 +288,31 @@ begin s:=Grid.Cells[ACol,ARow]; sM:=uppercase(s); - if (Acol=2) and (Arow>0) and (s<>'') then + if (Acol=ColHdep) and (Arow>0) and (s<>'') then begin if pos('H',sM)=0 then LabelErreur.caption:='Erreur : l''heure doit être au format HHhMM' else labelErreur.Caption:=''; end; - if (Acol=3) and (Arow>0) and (s<>'') then + if (Acol=ColVitDem) and (Arow>0) and (s<>'') then begin val(s,i,erreur); if (i<0) or (i>120) or (erreur<>0) then LabelErreur.caption:='Erreur : la vitesse doit être comprise entre 0 et 120' else labelErreur.Caption:=''; end; - - if (Acol=4) and (Arow>0) and (s<>'') then + if (Acol=colSens) and (Arow>0) and (s<>'') then begin if (sM<>'N') and (sM<>'R') then LabelErreur.caption:='Erreur : le sens doit être N(direct) ou R(recul)' else labelErreur.Caption:=''; end; - if (Acol=5) and (Arow>0) and (s<>'') then + if (Acol=ColArret) and (Arow>0) and (s<>'') then begin if (sM<>'O') and (sM<>'N') then LabelErreur.caption:='Erreur : la demande d''arrêt doit être N(non) ou O(oui)' else labelErreur.Caption:=''; end; - // pour écrire sur 2 lignes dans une stringGrid { if Length(s)>0 then @@ -288,26 +335,92 @@ begin d12:=true; {$IFEND} + // couleur de fond couleur:=$E0E0E0; if d12 then couleur:=$505050; with grid.canvas do begin Brush.Color := couleur; FillRect(Rect); + font.Color:=clBlack; // couleur de la fonte end; - DRect:=Rect; - // calcule, ajuste et positionne la ligne de l'espace vertical nécessaire - DrawText(Grid.Canvas.Handle,Pchar(S),Length(S),DRect,DT_CALCRECT or DT_CENTER); - // if the text height is greater than the row height, increase the row height - if (DRect.Bottom - DRect.Top) > Grid.RowHeights[ARow] then Grid.RowHeights[ARow]:=DRect.Bottom - DRect.Top - // changer la hauteur de la cellule provoque son redessinage - else + DRect:=Rect; + // calcule, ajuste et positionne la ligne de l'espace vertical nécessaire + DrawText(Grid.Canvas.Handle,Pchar(S),Length(S),DRect,DT_CALCRECT or DT_CENTER); + // if the text height is greater than the row height, increase the row height + + if (DRect.Bottom - DRect.Top) > Grid.RowHeights[ARow] then Grid.RowHeights[ARow]:=DRect.Bottom - DRect.Top + // changer la hauteur de la cellule provoque son redessinage + else + begin + DRect.Right:=Rect.Right; + Grid.Canvas.FillRect(DRect); + DrawText(Grid.Canvas.Handle, Pchar(S), Length(S), DRect, DT_CENTER); + end; +end; + + +procedure TFormFicheHoraire.StringGridFOSetEditText(Sender: TObject; ACol, + ARow: Integer; const Value: String); +var s : string; + i,erreur : integer; +begin + case Acol of + ColTrain : begin - DRect.Right:=Rect.Right; - Grid.Canvas.FillRect(DRect); - DrawText(Grid.Canvas.Handle, Pchar(S), Length(S), DRect, DT_CENTER); + GrilleHoraire[ARow].NomTrain:=StringGridFO.Cells[Acol,ARow]; + application.CancelHint; + FormFicheHoraire.Caption:='Nom du train'; end; + Colroute : + begin + GrilleHoraire[ARow].Route:=StringGridFO.Cells[Acol,ARow]; + application.CancelHint; + FormFicheHoraire.Caption:='Nom de la route mémorisée du train'; + end; + ColHDep : + begin + FormFicheHoraire.Caption:='Heure au format XXhXX'; + s:=stringGridFO.Cells[Acol,Arow]; // heure de démarrage + val(s,i,erreur); + grilleHoraire[Arow].heure:=i; + if erreur<>0 then + begin + delete(s,1,erreur); + val(s,i,erreur); + grilleHoraire[Arow].minute:=i; + LabelErreur.caption:=''; + end + else + LabelErreur.caption:='Erreur : l''heure doit être au format HHhMM'; + end; + ColVitDem : + begin + FormFicheHoraire.Caption:='Vitesse entre 0 et 120'; + s:=stringGridFO.Cells[Acol,Arow]; + val(s,i,erreur); + if (i<0) or (i>120) or (erreur<>0) then LabelErreur.caption:='Erreur : la vitesse doit être comprise entre 0 et 120' + else labelErreur.Caption:=''; + grilleHoraire[Arow].vitesse:=i; + end; + ColSens : + begin + FormFicheHoraire.Caption:='Sens N(direct) ou R(recul)'; + s:=stringGridFO.Cells[Acol,Arow]; + if (s<>'N') and (s<>'R') then LabelErreur.caption:='Erreur : le sens doit être N(direct) ou R(recul)' + else labelErreur.Caption:=''; + grilleHoraire[Arow].sens:=s='N'; + end; + ColArret : + begin + FormFicheHoraire.Caption:='N(non) ou O(oui)'; + s:=stringGridFO.Cells[Acol,Arow]; + grilleHoraire[Arow].arretDepart:=s='O'; + if (s<>'O') and (s<>'N') then LabelErreur.caption:='Erreur : la demande d''arrêt doit être N(non) ou O(oui)' + else labelErreur.Caption:=''; + end; + end; end; end. diff --git a/UnitHorloge.pas b/UnitHorloge.pas index 59698f2..46b6f8e 100644 --- a/UnitHorloge.pas +++ b/UnitHorloge.pas @@ -115,8 +115,8 @@ procedure Demarre_horloge; var h,m,sec,ms : word; begin decodeTime(GetTime,h,m,sec,ms); - //Affiche(intToSTR(ms),clwhite); comptSec:=ms div 100; + if comptsec>9 then comptsec:=0; horloge:=true; end; diff --git a/UnitInfo.dfm b/UnitInfo.dfm index f10ca64..93da830 100644 --- a/UnitInfo.dfm +++ b/UnitInfo.dfm @@ -5,7 +5,7 @@ object FormInfo: TFormInfo BorderStyle = bsNone Caption = 'FormInfo' ClientHeight = 50 - ClientWidth = 575 + ClientWidth = 615 Color = clBackground Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText diff --git a/UnitMesure.dfm b/UnitMesure.dfm new file mode 100644 index 0000000..741d48d --- /dev/null +++ b/UnitMesure.dfm @@ -0,0 +1,177 @@ +object FormMesure: TFormMesure + Left = 717 + Top = 117 + Width = 393 + Height = 357 + Caption = 'Mesure de la vitesse des trains' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 56 + Top = 16 + Width = 272 + Height = 13 + Caption = 'S'#233'lection d'#39'un train plac'#233' sur le TCO pour son '#233'talonnage' + end + object LabelEtat: TLabel + Left = 24 + Top = 40 + Width = 12 + Height = 13 + Caption = '. ' + end + object Label2: TLabel + Left = 64 + Top = 122 + Width = 168 + Height = 13 + Caption = 'Nombre de passages sur d'#233'tecteur ' + end + object LabelP: TLabel + Left = 32 + Top = 154 + Width = 180 + Height = 13 + Caption = 'Progression du nombre de passages :' + end + object LabelProg: TLabel + Left = 224 + Top = 152 + Width = 9 + Height = 16 + Caption = '. ' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object LabelMesC: TLabel + Left = 256 + Top = 202 + Width = 96 + Height = 15 + Alignment = taCenter + Caption = 'Mesure en cours' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + WordWrap = True + end + object ButtonOk: TButton + Left = 272 + Top = 272 + Width = 75 + Height = 33 + Caption = 'Fermer' + TabOrder = 0 + OnClick = ButtonOkClick + end + object ComboBoxTrains: TComboBox + Left = 72 + Top = 64 + Width = 217 + Height = 28 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 20 + ParentFont = False + TabOrder = 1 + Text = 'ComboBoxTrains' + OnChange = ComboBoxTrainsChange + OnDrawItem = ComboBoxTrainsDrawItem + end + object ButtonLanceMes: TButton + Left = 40 + Top = 272 + Width = 75 + Height = 33 + Caption = 'Lancer la mesure' + TabOrder = 2 + WordWrap = True + OnClick = ButtonLanceMesClick + end + object EditNbrePassages: TEdit + Left = 248 + Top = 120 + Width = 49 + Height = 21 + Hint = 'Condition d'#39'arr'#234't de la mesure par vitesse' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnChange = EditNbrePassagesChange + end + object ButtonArret: TButton + Left = 160 + Top = 272 + Width = 75 + Height = 33 + Caption = 'Arreter' + TabOrder = 4 + OnClick = ButtonArretClick + end + object LabeledEditV1: TLabeledEdit + Left = 216 + Top = 176 + Width = 33 + Height = 21 + EditLabel.Width = 92 + EditLabel.Height = 13 + EditLabel.Hint = 'vitesse en crans (1-120)' + EditLabel.Caption = 'Crans vitesse lente ' + EditLabel.ParentShowHint = False + EditLabel.ShowHint = True + LabelPosition = lpLeft + LabelSpacing = 70 + TabOrder = 5 + OnChange = LabeledEditV1Change + end + object LabeledEditV2: TLabeledEdit + Left = 216 + Top = 200 + Width = 33 + Height = 21 + EditLabel.Width = 109 + EditLabel.Height = 13 + EditLabel.Hint = 'vitesse en crans (1-120)' + EditLabel.Caption = 'Crans vitesse moyenne' + EditLabel.ParentShowHint = False + EditLabel.ShowHint = True + LabelPosition = lpLeft + LabelSpacing = 70 + TabOrder = 6 + OnChange = LabeledEditV2Change + end + object LabeledEditV3: TLabeledEdit + Left = 216 + Top = 224 + Width = 33 + Height = 21 + EditLabel.Width = 95 + EditLabel.Height = 13 + EditLabel.Hint = 'vitesse en crans (1-120)' + EditLabel.Caption = 'Crans vitesse rapide' + EditLabel.ParentShowHint = False + EditLabel.ShowHint = True + LabelPosition = lpLeft + LabelSpacing = 70 + TabOrder = 7 + OnChange = LabeledEditV3Change + end +end diff --git a/UnitMesure.pas b/UnitMesure.pas new file mode 100644 index 0000000..afcc8de --- /dev/null +++ b/UnitMesure.pas @@ -0,0 +1,211 @@ +unit UnitMesure; + +// mesure de la vitesse des trains + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls; + +type + TFormMesure = class(TForm) + ButtonOk: TButton; + ComboBoxTrains: TComboBox; + Label1: TLabel; + LabelEtat: TLabel; + ButtonLanceMes: TButton; + Label2: TLabel; + EditNbrePassages: TEdit; + ButtonArret: TButton; + LabelP: TLabel; + LabelProg: TLabel; + LabeledEditV1: TLabeledEdit; + LabeledEditV2: TLabeledEdit; + LabeledEditV3: TLabeledEdit; + LabelMesC: TLabel; + procedure ButtonOkClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ComboBoxTrainsDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure ComboBoxTrainsChange(Sender: TObject); + procedure ButtonLanceMesClick(Sender: TObject); + procedure EditNbrePassagesChange(Sender: TObject); + procedure ButtonArretClick(Sender: TObject); + procedure LabeledEditV1Change(Sender: TObject); + procedure LabeledEditV2Change(Sender: TObject); + procedure LabeledEditV3Change(Sender: TObject); + private + { Déclarations privées } + public + { Déclarations publiques } + end; + +var + FormMesure: TFormMesure; + IndexTrainMes,NbreArret,PhaseVitesse,v1,v2,v3,detecteurREF : integer; + +implementation + +uses UnitPrinc,unitTCO; + +{$R *.dfm} + +procedure arret_mesure ; +begin + mesureTrains:=false; + vitesse_loco('',0,trains[indexTrainMes].adresse,0,10); + with formMesure do + begin + ComboBoxTrains.Enabled:=true; + ButtonLanceMes.Enabled:=true; + end; +end; + +procedure TFormMesure.ButtonOkClick(Sender: TObject); +begin + arret_mesure; + close; +end; + +procedure TFormMesure.FormCreate(Sender: TObject); +var i : integer; +begin + with comboBoxTrains do + begin + Font.size:=12; // détermine la hauteur de la combobox + Style:=csOwnerDrawFixed; // csOwnerDrawVariable; + items.clear; + for i:=1 to Ntrains do + begin + items.AddObject(Trains[i].nom_train, Trains[i].icone.Picture.graphic); + end; + ItemIndex:=-1; + end; + IndexTrainMes:=0; + EditNbrePassages.Text:='3'; + LabeledEditV1.Text:='40'; + LabeledEditV2.Text:='60'; + LabeledEditV3.Text:='80'; + LabelMesC.Visible:=false; +end; + + +procedure TFormMesure.ComboBoxTrainsDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +var LargDest,HautDest,l,h : integer; + cv : TCanvas; +begin + Cv:=ComboBoxTrains.canvas; + LargDest:=70; + HautDest:=18; + l:=Trains[index+1].Icone.width; + h:=Trains[index+1].Icone.Height; + + if index mod 2<>1 then + begin + cv.brush.color:=clWindow; + cv.fillrect(rect); + end + else + begin + cv.brush.color:=clWindow; + cv.fillrect(rect); + end; + // Affichage du texte + cv.font.style:=canvas.font.style+[fsbold]; + cv.textout(rect.left+largDest+5,rect.top,ComboBoxTrains.items[index]); + if (odSelected in state) then + begin + cv.brush.color:=clWindowFrame; + cv.fillrect(rect); + //cv.font.color:=clblue; + cv.textout(rect.left+largDest+5,rect.top,ComboBoxTrains.items[index]); + end; + + TransparentBlt(cv.Handle,rect.Left+2,rect.Top,largDest,hautDest, + Trains[index+1].Icone.canvas.Handle,0,0,l,h,clWhite); + +end; + +procedure TFormMesure.ComboBoxTrainsChange(Sender: TObject); +var i,idc : integer; + trouve : boolean; +begin + i:=ComboBoxTrains.itemindex+1; + if i<1 then exit; + idc:=1; + repeat + trouve:=canton[idc].adresseTrain=trains[i].adresse; + inc(idc); + until (idc>ncantons) or trouve; + dec(idc); + if not trouve then + begin + LabelEtat.Caption:='Le train '+trains[i].nom_train+' n''est déposé sur aucun canton'; + IndexTrainMes:=0; + ButtonLanceMes.Enabled:=false; + end + else + begin + IndexTrainMes:=i; + LabelEtat.caption:=''; + ButtonLanceMes.Enabled:=true; + end; +end; + +procedure TFormMesure.ButtonLanceMesClick(Sender: TObject); +begin + if (IndexTrainMes<1) or mesureTrains then exit; + ComboBoxTrains.Enabled:=false; + ButtonLanceMes.Enabled:=false; + Affiche('Mesure vitesse 1',clYellow); + PhaseVitesse:=1; // vitesse 1 2 ou 3 + DetecteurREF:=0; + mesureTrains:=true; + vitesse_loco('',0,trains[indexTrainMes].adresse,v1,10); + LabelMesC.Visible:=true; + LabelMesC.top:=178; +end; + +procedure TFormMesure.EditNbrePassagesChange(Sender: TObject); +var i,erreur : integer; +begin + val(editNbrePassages.Text,i,erreur); + if (erreur<>0) or (i<2) or (i>6) then + begin + editNbrePassages.Text:='3'; + exit; + end; + NbreArret:=i; +end; + +procedure TFormMesure.ButtonArretClick(Sender: TObject); +begin + arret_mesure; + Affiche('Arret',clYellow); +end; + +procedure TFormMesure.LabeledEditV1Change(Sender: TObject); +var erreur : integer; +begin + val(LabeledEditV1.Text,v1,erreur); + if IndexTrainMes<1 then exit; +end; + +procedure TFormMesure.LabeledEditV2Change(Sender: TObject); +var erreur : integer; +begin + val(LabeledEditV2.Text,v2,erreur); + if IndexTrainMes<1 then exit; +end; + +procedure TFormMesure.LabeledEditV3Change(Sender: TObject); +var erreur : integer; +begin + val(LabeledEditV3.Text,v3,erreur); + if IndexTrainMes<1 then exit; +end; + + +end. diff --git a/UnitModifAction.dfm b/UnitModifAction.dfm index 8b43b63..309a3e7 100644 --- a/UnitModifAction.dfm +++ b/UnitModifAction.dfm @@ -1,6 +1,6 @@ object FormModifAction: TFormModifAction - Left = 448 - Top = 165 + Left = 395 + Top = 166 BorderStyle = bsDialog Caption = 'Modifier une action' ClientHeight = 443 @@ -61,13 +61,13 @@ object FormModifAction: TFormModifAction Top = 64 Width = 729 Height = 337 - ActivePage = TabSheet1 + ActivePage = TabSheetDecl MultiLine = True TabOrder = 2 object TabSheetDecl: TTabSheet Caption = 'D'#233'clencheur' object LabelDecl: TLabel - Left = 16 + Left = 8 Top = 24 Width = 193 Height = 13 @@ -212,6 +212,114 @@ object FormModifAction: TFormModifAction TabOrder = 3 OnClick = ButtonApplDeclClick end + object GroupBoxLogique: TGroupBox + Left = 224 + Top = 8 + Width = 489 + Height = 193 + Caption = 'D'#233'clencheur logique' + TabOrder = 4 + Visible = False + object Label7: TLabel + Left = 280 + Top = 16 + Width = 78 + Height = 13 + Caption = 'Fonction logique' + end + object TreeViewL: TTreeView + Left = 16 + Top = 24 + Width = 241 + Height = 145 + Images = ImageListLogic + Indent = 19 + PopupMenu = PopupMenuL + TabOrder = 0 + OnChange = TreeViewLChange + Items.Data = { + 040000001C0000000000000000000000FFFFFFFFFFFFFFFF0000000000000000 + 03456C311C0000000000000000000000FFFFFFFFFFFFFFFF0000000002000000 + 03456C321F0000000000000000000000FFFFFFFFFFFFFFFF0000000000000000 + 06536F7573656C190000000000000000000000FFFFFFFFFFFFFFFF0000000000 + 000000001C0000000000000000000000FFFFFFFFFFFFFFFF0000000000000000 + 03456C33190000000000000000000000FFFFFFFFFFFFFFFF0000000003000000 + 00200000000000000000000000FFFFFFFFFFFFFFFF000000000000000007536F + 7573456C31200000000000000000000000FFFFFFFFFFFFFFFF00000000000000 + 0007536F7573456C32190000000000000000000000FFFFFFFFFFFFFFFF000000 + 000200000000240000000000000000000000FFFFFFFFFFFFFFFF000000000000 + 00000B536F7573536F7573456C31190000000000000000000000FFFFFFFFFFFF + FFFF000000000000000000} + end + object ButtonCreer: TButton + Left = 280 + Top = 56 + Width = 49 + Height = 25 + Caption = 'Cr'#233'er' + TabOrder = 1 + OnClick = ButtonCreerClick + end + object ButtonAjouteVar: TButton + Left = 280 + Top = 120 + Width = 105 + Height = 25 + Caption = 'Ajouter variable' + TabOrder = 2 + OnClick = ButtonAjouteVarClick + end + object BoutonSupprime: TButton + Left = 408 + Top = 120 + Width = 75 + Height = 25 + Hint = 'Supprime la s'#233'lection' + Caption = 'Supprime' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnClick = BoutonSupprimeClick + end + object ComboBoxFonction: TComboBox + Left = 280 + Top = 32 + Width = 145 + Height = 21 + ItemHeight = 13 + TabOrder = 4 + OnChange = ComboBoxFonctionChange + OnDrawItem = ComboBoxFonctionDrawItem + end + object ButtonAjouteFonc: TButton + Left = 280 + Top = 88 + Width = 105 + Height = 25 + Caption = 'Ajouter fonction' + TabOrder = 5 + OnClick = ButtonAjouteFoncClick + end + object ButtonVoir: TButton + Left = 336 + Top = 56 + Width = 49 + Height = 25 + Caption = 'Affiche structure' + TabOrder = 6 + WordWrap = True + OnClick = ButtonVoirClick + end + object ButtonSupTout: TButton + Left = 408 + Top = 80 + Width = 75 + Height = 25 + Caption = 'Supprime tout' + TabOrder = 7 + OnClick = ButtonSupToutClick + end + end end object TabSheet1: TTabSheet Caption = 'Conditions' @@ -219,9 +327,9 @@ object FormModifAction: TFormModifAction object Label4: TLabel Left = 16 Top = 24 - Width = 169 + Width = 175 Height = 13 - Caption = 'Liste de conditions diponibles' + Caption = 'Liste de conditions disponibles' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 @@ -644,7 +752,7 @@ object FormModifAction: TFormModifAction OnChange = LabeledEditTrainChange end object LabeledEditAdresse: TLabeledEdit - Left = 64 + Left = 72 Top = 32 Width = 41 Height = 21 @@ -657,7 +765,7 @@ object FormModifAction: TFormModifAction OnChange = LabeledEditAdresseChange end object LabeledEditFonctionF: TLabeledEdit - Left = 144 + Left = 72 Top = 56 Width = 41 Height = 21 @@ -666,6 +774,8 @@ object FormModifAction: TFormModifAction EditLabel.Caption = 'FonctionF' LabelPosition = lpLeft LabelSpacing = 10 + ParentShowHint = False + ShowHint = True TabOrder = 2 OnChange = LabeledEditFonctionFChange end @@ -799,4 +909,440 @@ object FormModifAction: TFormModifAction object OpenDialogSon: TOpenDialog Left = 680 end + object ImageListLogic: TImageList + Left = 456 + Top = 48 + Bitmap = { + 494C010106000900040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000800000000000000000000000800000000000000080000000 + 8000000080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000080000000000000008000000000000000800000000000000000000000 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000080000000000000008000000000000000800000000000000000000000 + 80000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000080000000000000008000000000000000800000000000000080000000 + 80000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000800000000000000000000000800000000000000000000000 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000080800000808000008080 + 0000808000008080000080800000808000008080000080800000808000008080 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000080800000808000008080 + 0000808000008080000080800000808000008080000080800000808000008080 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000000000000000000000000 + 0000808000008080000080800000000000000000000000000000808000008080 + 0000000000000000000000000000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000000000000808000008080 + 0000000000008080000000000000808000008080000080800000808000000000 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000000000000808000008080 + 0000000000008080000000000000808000008080000080800000808000000000 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000000000000808000008080 + 0000000000008080000000000000808000008080000080800000808000000000 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000000000000000000000000 + 0000808000008080000080800000000000000000000000000000808000008080 + 0000000000000000000000000000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000080800000808000008080 + 0000808000008080000080800000808000008080000080800000808000008080 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008080000080800000808000008080 + 0000808000008080000080800000808000008080000080800000808000008080 + 0000808000008080000080800000808000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000008000000000000000000000000000000000000000000000000000 + 0000800000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF000000000000FF + FF0000FFFF000000000000FFFF0000FFFF00000000000000000000FFFF000000 + 000000FFFF000000000000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF00000000000000 + 000000FFFF000000000000FFFF0000FFFF000000000000FFFF0000FFFF000000 + 0000000000000000000000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000080000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000000000000000000000 + 000000FFFF0000FFFF0000000000000000000000000000FFFF0000FFFF000000 + 0000000000000000000000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000008000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF000000000000FFFF000000 + 00000000000000FFFF00000000000000000000FFFF0000FFFF0000FFFF000000 + 000000FFFF000000000000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF0000FF + FF000000000000FFFF00000000000000000000FFFF0000FFFF0000FFFF000000 + 0000000000000000000000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000080000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000080000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFFFFFF00000000FB47FFFF00000000 + F56FFFFF00000000F56FC0FF00000000F54FC0FF00000000FB6FFFFF00000000 + FFFFFFFF000000000000B6DB0000000000000000000000000000B6DB00000000 + 00000000000000000000B6DB000000000000FFFF000000000000FFFF00000000 + 0000FFFF000000000000FFFF000000000000FFFFFFFFFFFF0000F837F9FFFFFF + 0000F387FCFFFC3F0000E7CFF27FF00F0000E78FF93FE3870000F327FC9FE7E7 + 0000F87FFE7FCFF30000FE7FFF3FCFF30000FC3FFE7FCFF30000F99FFCFFCFF3 + 0000F99FF9FFE7E70000F99FF3FFE3C70000FC3FFFFFF00F0000FFFFFFFFFC3F + 0000FFFFFFFFFFFF0000FFFFFFFFFFFF} + end + object PopupMenuL: TPopupMenu + Left = 684 + Top = 120 + object Monter1: TMenuItem + Caption = 'Monter' + OnClick = Monter1Click + end + object Descendre1: TMenuItem + Caption = 'Descendre' + OnClick = Descendre1Click + end + object N1: TMenuItem + Caption = '-' + end + object Supprimer1: TMenuItem + Caption = 'Supprimer' + OnClick = Supprimer1Click + end + object N2: TMenuItem + Caption = '-' + end + object outdployer1: TMenuItem + Caption = 'Tout d'#233'ployer' + OnClick = outdployer1Click + end + object outcontracter1: TMenuItem + Caption = 'Tout contracter' + OnClick = outcontracter1Click + end + end end diff --git a/UnitModifAction.pas b/UnitModifAction.pas index 83ddb8b..29babb7 100644 --- a/UnitModifAction.pas +++ b/UnitModifAction.pas @@ -4,7 +4,8 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls, Spin , MMSystem; + Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls, Spin , MMSystem, ImgList, + Menus; type TFormModifAction = class(TForm) @@ -74,6 +75,25 @@ type RadioEtatSignal: TRadioGroup; SpinEditEtatop: TSpinEdit; LabelEtatOp: TLabel; + GroupBoxLogique: TGroupBox; + TreeViewL: TTreeView; + Label7: TLabel; + ButtonCreer: TButton; + ButtonAjouteVar: TButton; + BoutonSupprime: TButton; + ImageListLogic: TImageList; + ComboBoxFonction: TComboBox; + ButtonAjouteFonc: TButton; + ButtonVoir: TButton; + ButtonSupTout: TButton; + PopupMenuL: TPopupMenu; + Monter1: TMenuItem; + Descendre1: TMenuItem; + N1: TMenuItem; + Supprimer1: TMenuItem; + N2: TMenuItem; + outdployer1: TMenuItem; + outcontracter1: TMenuItem; procedure ButtonOkClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListBoxOperDrawItem(Control: TWinControl; Index: Integer; @@ -127,12 +147,45 @@ type procedure ListBoxOperationsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure ButtonCreerClick(Sender: TObject); + procedure BoutonSupprimeClick(Sender: TObject); + procedure ComboBoxFonctionDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); + procedure ButtonAjouteVarClick(Sender: TObject); + procedure ButtonAjouteFoncClick(Sender: TObject); + procedure ButtonVoirClick(Sender: TObject); + procedure ButtonSupToutClick(Sender: TObject); + procedure Monter1Click(Sender: TObject); + procedure Descendre1Click(Sender: TObject); + procedure Supprimer1Click(Sender: TObject); + procedure TreeViewLChange(Sender: TObject; Node: TTreeNode); + procedure outdployer1Click(Sender: TObject); + procedure outcontracter1Click(Sender: TObject); + procedure ComboBoxFonctionChange(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; +const +// indice des icones donc des fonctions +FoncVAR=0; +//-------- +foncET=1; +foncOU=2; +foncNON=3; +//------- +EtatDCC=4; +EtatDet=5; +NomVAR='Variables'; +NomFoncET='Fonction ET'; +NomFoncOU='Fonction OU'; +NomFoncNON='Fonction NON'; +NomEtatDCC='Etat DCC'; +NomEtatDet='Etat détecteur'; + + var FormModifAction: TFormModifAction; AffParam : boolean; @@ -195,11 +248,43 @@ end; procedure TFormModifAction.FormCreate(Sender: TObject); var i,icone : integer; begin + GroupBoxLogique.Visible:=AvecLogique; + TreeViewL.HideSelection:=false; + ListBoxOper.Style:=lbOwnerDrawVariable; // pour afficher des icones ListBoxDeclench.Style:=lbOwnerDrawVariable; ListBoxOperations.Style:=lbOwnerDrawVariable; ListBoxCondTot.Style:=lbOwnerDrawVariable; ListBoxConditions.Style:=lbOwnerDrawVariable; + with ComboBoxFonction do + begin + Style:=csOwnerDrawFixed; + clear; + itemHeight:=18; // hauteur des icones + items.add(nomFoncET); + items.add(NomFoncOU); + items.add(NomFoncNON); + items.add(NomEtatDCC); + items.add(NomEtatDet); + end; + + for i:=1 to NbreDeclencheurs do + begin + icone:=0; + case i of + DeclHorloge : icone:=iconeHorloge; + DeclPeriph : icone:=iconePeriph; + DeclAccessoire: icone:=IconeAccessoire; + DeclDetAct: icone:=IconeDet; + DeclZoneDet: icone:=IconeZoneDet; + DeclDemarTrain : icone:=IconeDemarTrain; + DeclArretTrain : icone:=IconeArretTrain; + DeclSignal : icone:=IconeSignal; + DeclLogique : icone:=IconeLogique; + end; + ListBoxDeclench.Items.Add(Format('%d%s', [icone, declencheurs[i].nom])); // valeur d'index de l'icone dans la ImagelistIcones + ListBoxDeclench.itemHeight:=17; + end; for i:=1 to NbreOperations do begin @@ -222,22 +307,6 @@ begin ListBoxCondTot.itemHeight:=17; // 16 mini taille des éléments pour l'icone end; - for i:=1 to NbreDeclencheurs do - begin - icone:=0; - case i of - DeclHorloge : icone:=iconeHorloge; - DeclPeriph : icone:=iconePeriph; - DeclAccessoire: icone:=IconeAccessoire; - DeclDetAct: icone:=IconeDet; - DeclZoneDet: icone:=IconeZoneDet; - DeclDemarTrain : icone:=IconeDemarTrain; - DeclArretTrain : icone:=IconeArretTrain; - DeclSignal : icone:=IconeSignal; - end; - ListBoxDeclench.Items.Add(Format('%d%s', [icone, declencheurs[i].nom])); // valeur d'index de l'icone dans la ImagelistIcones - ListBoxDeclench.itemHeight:=17; - end; with ComboBoxFamille do begin @@ -250,6 +319,7 @@ begin ListBoxOperations.Hint:='Liste chronologique des opérations à effectuer'+#13+ 'Double clic pour valider/dévalider une opération'; + LabeledEditFonctionF.Hint:='Fonction F de 0 à 28'; Efface_tous_parametres; PageControlAct.ActivePage:=TabSheetDecl; @@ -270,7 +340,6 @@ begin formConfCellTCO.ImageListIcones.Draw(Canvas, Rect.Left, Rect.Top, i); Canvas.Textout(Rect.Left + formConfCellTCO.ImageListIcones.Width + 2, Rect.Top, ItemText); end; - end; procedure TFormModifAction.ListBoxDeclenchDrawItem(Control: TWinControl; @@ -278,7 +347,7 @@ procedure TFormModifAction.ListBoxDeclenchDrawItem(Control: TWinControl; var larg,i,erreur : integer; itemText : string; begin - with FormModifAction.ListBoxDeclench do + with FormModifAction.ListBoxDeclench do begin larg:=formConfCellTCO.ImageListIcones.Width; ItemText:=Items[index]; @@ -336,7 +405,7 @@ end; function Info_action(i : integer) : string; var nop,op,top,decl : integer; - r : double; + r : single; s :string; begin decl:=Tablo_Action[i].declencheur; @@ -419,7 +488,8 @@ begin ActionAffHorl : s:=s+'Affiche l''horloge'+#13; ActionVitesse : s:=s+'Modifie la vitesse du train '+Tablo_Action[i].tabloop[op].train+' à '+intToSTR(Tablo_Action[i].tabloop[op].vitesse)+#13; ActionCdePeriph : s:=s+'Pilote le périphérique '+intToSTR(Tablo_Action[i].tabloop[op].periph)+' chaîne : '+Tablo_Action[i].tabloop[op].chaine+#13; - ActionFonctionF : s:=s+'Fonction F'+intToSTR(Tablo_Action[i].tabloop[op].fonctionF)+' train dest='+Tablo_Action[i].tabloop[op].train+#13; + ActionFonctionF : s:=s+'Fonction F'+intToSTR(Tablo_Action[i].tabloop[op].fonctionF)+' à '+IntToSTR(Tablo_action[i].tabloOp[op].etat)+ + ' train dest='+Tablo_Action[i].tabloop[op].train+#13; ActionSon : s:=s+'Son '+Tablo_Action[i].tabloop[op].train+#13; ActionTempo : begin @@ -531,6 +601,7 @@ begin case decl of DeclHorloge : begin + GroupBoxLogique.Visible:=false; EditAdr.text:=intToSTR(Tablo_Action[index].heure); EditAdr2.text:=intToSTR(Tablo_Action[index].minute); LabelHeure.visible:=true; @@ -551,6 +622,7 @@ begin end; DeclPeriph : begin + GroupBoxLogique.Visible:=false; EditTrainDecl.Text:=Tablo_Action[index].ordrePeriph; LabelHeure.visible:=false; LabelAdresse.visible:=false; @@ -574,6 +646,7 @@ begin end; DeclAccessoire : begin + GroupBoxLogique.Visible:=false; EditAdr.text:=intToSTR(Tablo_Action[index].adresse); with SpinEditEtat do @@ -607,6 +680,7 @@ begin DeclDetAct : begin + GroupBoxLogique.Visible:=false; EditAdr.text:=intToSTR(Tablo_Action[index].adresse); EditTrainDecl.Visible:=true; EditTrainDecl.Text:=Tablo_Action[index].trainDecl; @@ -645,6 +719,7 @@ begin DeclZoneDet : begin + GroupBoxLogique.Visible:=false; EditAdr.text:=intToSTR(Tablo_Action[index].adresse); EditAdr2.text:=intToSTR(Tablo_Action[index].adresse2); @@ -683,6 +758,7 @@ begin DeclDemarTrain : begin + GroupBoxLogique.Visible:=false; LabelTrain.visible:=true; EditTrainDecl.Visible:=true; LabelAdresse.Visible:=true; @@ -702,6 +778,7 @@ begin DeclArretTrain : begin + GroupBoxLogique.Visible:=false; LabelTrain.visible:=true; EditTrainDecl.Visible:=true; LabelAdresse.Visible:=true; @@ -720,6 +797,7 @@ begin DeclSignal : begin + GroupBoxLogique.Visible:=false; LabelAdresse.Visible:=true; EditAdr.text:=intToSTR(Tablo_Action[index].adresse); RadioEtatSignal.ItemIndex:=Tablo_Action[index].Etat; @@ -734,6 +812,11 @@ begin formConfCellTCO.ImageListIcones.GetBitmap(IconeSignal,ImageIcone.Picture.Bitmap); ImageIcone.repaint; end; + + DeclLogique : + begin + GroupBoxLogique.Visible:=true; + end; end; // conditions @@ -865,12 +948,18 @@ begin end; ActionFonctionF : begin + SpinEditEtatop.Visible:=true; + SpinEditEtatop.MinValue:=0; + SpinEditEtatop.MaxValue:=1; + + labelEtatOp.Visible:=true; LabeledEditFonctionF.Visible:=true; LabeledEditTempoF.Visible:=true; LabeledEditTrain.EditLabel.Caption:='Train destinataire'; LabeledEditFonctionF.EditLabel.Caption:='Fonction F'; LabeledEditTrain.Visible:=true; LabeledEditTrain.hint:='Nom unique du train'; + SpinEditEtatOp.Text:=IntToSTR(Tablo_Action[index].tabloop[indexAction].etat); LabeledEditFonctionF.Text:=intToSTR(Tablo_Action[index].tabloop[indexAction].fonctionF); LabeledEditTempoF.Text:=intToSTR(Tablo_Action[index].tabloop[indexAction].TempoF); LabeledEditTrain.Text:=Tablo_Action[index].tabloop[indexAction].train; @@ -1706,6 +1795,7 @@ begin op:=Tablo_Action[ligneclicact+1].tabloOp[clicaction+1].numoperation; case op of ActionAccessoire : Tablo_Action[ligneclicact+1].tabloOp[clicaction+1].etat:=i; + ActionFonctionF : Tablo_Action[ligneclicact+1].tabloOp[clicaction+1].etat:=i; end; maj_combocactions(ligneclicAct); end; @@ -1764,6 +1854,258 @@ begin Aff_champs(ligneclicAct+1,1,1); end; +procedure TFormModifAction.ButtonCreerClick(Sender: TObject); +var MyTreeNode1, MyTreeNode2: TTreeNode; + i : integer; +begin + with TreeViewL.Items do + begin + Clear; { Remove any existing nodes. } + mytreenode1:=Add(nil, 'R1'); { Add a root node. } + { Add a child node to the node just added. } + AddChild(MyTreeNode1,NomFoncET); + {Add another root node} + MyTreeNode2 := Add(MyTreeNode1,NomFoncOU); + {Give MyTreeNode2 to a child. } + AddChild(MyTreeNode2,NomFoncOU); + + {Change MyTreeNode2 to ChildNode2 } + { Add a child node to it. } + MyTreeNode2 := TreeViewL.Items[3]; + AddChild(MyTreeNode2,NomEtatDCC); + + { Add another child to ChildNode2, after ChildNode2a. } + AddChild(MyTreeNode2,NomEtatDet); + + { Add another root node. } + Add(MyTreeNode1, NomFoncOU); + + //AddChild(ParentNode,'Nom'.AsString); + + end; + + TreeViewL.Items[1].ImageIndex:=FoncET; // index de l'image si non sélectionné + TreeViewL.Items[1].SelectedIndex:=FoncET; // index de l'image si sélectionné + + + TreeViewL.Items[2].ImageIndex:=FoncOU; + TreeViewL.Items[2].SelectedIndex:=FoncOU; + + TreeViewL.Items[3].ImageIndex:=FoncNon; + TreeViewL.Items[3].SelectedIndex:=FoncNON; + + TreeViewL.Items[4].ImageIndex:=EtatDCC; + TreeViewL.Items[4].SelectedIndex:=EtatDCC; + + TreeViewL.Items[5].ImageIndex:=EtatDet; + TreeViewL.Items[5].SelectedIndex:=EtatDet; + + + //TreeviewL.Items[1].Item[0].ImageIndex:=2; + //TreeViewL.Items[4].SelectedIndex:=1; +end; + +procedure Supprime_node; + // A procedure to recursively delete nodes + procedure DeleteNode(ANode: TTreeNode); + begin + while ANode.HasChildren do + DeleteNode(ANode.GetLastChild); + formModifAction.TreeViewL.Items.Delete(ANode); + end; + +begin + if formModifAction.TreeViewL.Selected = nil then exit; + + // If the selected node has child nodes, first ask for confirmation + if formModifAction.TreeviewL.Selected.HasChildren then + if MessageDlg('Delete node and all children?', mtConfirmation, [mbYes,mbNo], 0 ) <> mrYes then + exit; + DeleteNode(formModifAction.TreeViewL.Selected); +end; + +procedure TFormModifAction.BoutonSupprimeClick(Sender: TObject); +var node : TtreeNode; +begin + node:=TreeViewL.Selected; + if Assigned(Node) then node.Delete; +end; + +procedure TFormModifAction.ComboBoxFonctionDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + comboboxFonction.canvas.fillrect(rect); + + (* This line draws the actual bitmap*) + imagelistLogic.Draw(comboBoxFonction.Canvas,rect.left,rect.top,Index+1); //+1 car on commence à 1 + + (* This line writes the text after the bitmap*) + comboboxFonction.canvas.textout(rect.left+imagelistLogic.width+2,rect.top, + comboboxFonction.items[index]); +end; + +procedure TFormModifAction.ButtonAjouteVarClick(Sender: TObject); +var NodeOrigine,node : Ttreenode; +begin + if TreeViewL.Items.Count=0 then exit; + + nodeOrigine:=TreeViewL.Selected; + if nodeOrigine=nil then exit; + if (nodeOrigine.ImageIndex>=foncET) and (nodeOrigine.ImageIndex<=FoncNon) then // on ne peut pas rajouter une variable sur une variable ou surle 1er élément + begin + node:=TreeViewL.items.AddChild(nodeOrigine,NomEtatDCC); + Node.ImageIndex:=EtatDCC; + Node.SelectedIndex:=EtatDCC; + NodeOrigine.Expand(true); + end; +end; + +// https://wiki.freepascal.org/TTreeView + +procedure TFormModifAction.ButtonAjouteFoncClick(Sender: TObject); +var node,NodeOrigine : Ttreenode; + n : integer; +begin + // ajoute en fin + n:=TreeViewL.Items.Count; + if n=0 then + begin + Node:=TreeviewL.Items.Add(nil,NomVar); + Node.ImageIndex:=FoncVar; + Node.SelectedIndex:=FoncVar; + exit; + end; + + nodeOrigine:=TreeViewL.Selected; + if nodeOrigine=nil + then exit; + +{ if NodeOrigine.Index=0 then + begin + node:=TreeViewL.items.Add(nodeOrigine,NomFoncET); + end + else } + node:=TreeViewL.items.AddChild(nodeOrigine,NomFoncET); + + Node.ImageIndex:=FoncET; + Node.SelectedIndex:=FoncET; + NodeOrigine.Expand(true); + +end; + +procedure TFormModifAction.ButtonVoirClick(Sender: TObject); +var i : integer; + s : string; +begin + + for i:=0 to TreeViewL.Items.Count-1 do + begin + s:=inttoSTR(i)+' '+TreeViewL.Items[i].Text; + if TreeViewL.Items[i].IsFirstNode then s:=s+' *'; + if TreeViewL.Items[i].HasChildren then s:=s+' ->'; + Affiche(s,clYellow); + TreeViewL.Items[i].Expand(true); + end; + + +end; + +procedure TFormModifAction.ButtonSupToutClick(Sender: TObject); +begin + TreeViewL.Items.clear; +end; + +procedure TFormModifAction.Monter1Click(Sender: TObject); +begin + // Ensure a node is selected + if(TreeviewL.Selected <> nil) then + // Ensure there is a previous sibling node + if TreeviewL.Selected.GetPrevSibling <> nil then + // If we have made it this far, move it UP + TreeviewL.Selected.MoveTo(TreeviewL.Selected.GetPrevSibling, naInsert); +end; + +procedure TFormModifAction.Descendre1Click(Sender: TObject); +begin + // Ensure a node is selected + if(TreeviewL.Selected <> nil) then + // Ensure there is a next sibling node + if TreeviewL.Selected.GetNextSibling <> nil then + // If we have made it this far, move it DOWN + // naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert + // naAdd The new or relocated node becomes the last sibling of the other node. + // naAddFirst The new or relocated node becomes the first sibling of the other node. + // naInsert The new or relocated node becomes the sibling immediately before the other node. + // naAddChild The new or relocated node becomes the last child of the other node. + // naAddChildFirst The new or relocated node becomes the first child of the other node. + TreeviewL.Selected.MoveTo(TreeviewL.Selected.GetNextSibling, naAdd); +end; + + +procedure TFormModifAction.Supprimer1Click(Sender: TObject); +begin + TreeViewL.Selected.Delete; +end; + + +procedure TFormModifAction.TreeViewLChange(Sender: TObject; + Node: TTreeNode); +begin + if Assigned(Node) then + // if Node.AbsoluteIndex = 1 then + begin + Affiche('Le node est '+node.Text+' id='+intToSTR(node.ImageIndex),clYellow); + ComboBoxFonction.ItemIndex:=node.ImageIndex-1; + end; +end; + +procedure TFormModifAction.outdployer1Click(Sender: TObject); +var i : integer; +begin + for i:=0 to TreeViewL.Items.Count-1 do + begin + Affiche(inttoSTR(i)+' '+TreeViewL.Items[i].Text,clYellow); + TreeViewL.Items[i].Expand(true); + end; +end; + +procedure TFormModifAction.outcontracter1Click(Sender: TObject); +var i : integer; +begin + for i:=0 to TreeViewL.Items.Count-1 do + begin + Affiche(inttoSTR(i)+' '+TreeViewL.Items[i].Text,clYellow); + TreeViewL.Items[i].Collapse(true); + end; +end; + +procedure TFormModifAction.ComboBoxFonctionChange(Sender: TObject); +var node : tTreenode; + i,Fnode : integer; +begin + node:=TreeViewL.Selected; + if assigned(node) then + begin + i:=ComboBoxFonction.ItemIndex+1; + Fnode:=node.ImageIndex; + // si le node est une fonction logique ET OU NON + //if (node.HasChildren) and (i=FoncET) and (Fnode<=FoncNON) and (i>=FoncET) and (i<=FoncNON) then + begin + node.Text:=ComboBoxFonction.Items[i-1]; + node.ImageIndex:=i; + node.SelectedIndex:=i; + end; + { + // si le node n'a pas d'enfant, c'est une variable + if not(node.HasChildren) and (i>=EtatDCC) then + begin + node.Text:=ComboBoxFonction.Items[i]; + node.ImageIndex:=i; + node.SelectedIndex:=i; + end; } + end; +end; end. diff --git a/UnitPilote.pas b/UnitPilote.pas index 84446a2..76ab844 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -190,11 +190,38 @@ begin if decodeur_pers[dec-NbDecodeurdeBase+1].nation=2 then i:=2; end; result:=i; - end; +procedure Raz_combine; +begin + with FormPilote do + begin + RadioRalen30.checked:=false; + RadioRappel30.checked:=false; + RadioRalen60.checked:=false; + RadioRappel60.checked:=false; + end; +end; + +procedure Raz_Base; +begin + with FormPilote do + begin + RadioVert.checked:=false; + RadioVertCli.checked:=false; + RadioRouge.checked:=false; + RadioRougeCli.checked:=false; + RadioCarre.checked:=false; + RadioBlanc.checked:=false; + RadioBlancCli.checked:=false; + RadioViolet.checked:=false; + end; +end; + + procedure TFormPilote.RadioVertClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; if nation=1 then Maj_Etat_Signal(0,vert) else Maj_Etat_Signal(0,vertB) ; dessine_signal_pilote; @@ -202,6 +229,7 @@ end; procedure TFormPilote.RadioVertCliClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; Maj_Etat_Signal(0,vert_cli); dessine_signal_pilote; @@ -209,7 +237,9 @@ end; procedure TFormPilote.RadioJauneClick(Sender: TObject); begin - Signaux[0].AncienEtat:=Signaux[0].EtatSignal; + Signaux[0].AncienEtat:=Signaux[0].EtatSignal; + RadioRalen30.Checked:=false; + RadioRalen60.Checked:=false; if nation=1 then Maj_Etat_Signal(0,jaune) else Maj_Etat_Signal(0,deux_jaunes); dessine_signal_pilote; end; @@ -217,12 +247,14 @@ end; procedure TFormPilote.RadioJaunecliClick(Sender: TObject); begin Signaux[0].AncienEtat:=Signaux[0].EtatSignal; + RadioRalen30.Checked:=false; Maj_Etat_Signal(0,jaune_cli); dessine_signal_pilote; end; procedure TFormPilote.RadioRougeClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; Maj_Etat_Signal(0,semaphore); dessine_signal_pilote; @@ -230,6 +262,7 @@ end; procedure TFormPilote.RadioRougeCliClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; Maj_Etat_Signal(0,semaphore_cli); dessine_signal_pilote; @@ -237,6 +270,7 @@ end; procedure TFormPilote.RadioCarreClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; if nation=1 then Maj_Etat_Signal(0,carre) else Maj_Etat_Signal(0,vert_jaune_H); dessine_signal_pilote; @@ -244,6 +278,7 @@ end; procedure TFormPilote.RadioBlancClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; if nation=1 then Maj_Etat_Signal(0,blanc) else Maj_Etat_Signal(0,rouge_blanc); dessine_signal_pilote; @@ -251,6 +286,7 @@ end; procedure TFormPilote.RadioVioletClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; if nation=1 then Maj_Etat_Signal(0,violet) else Maj_Etat_Signal(0,vert_jaune_V); dessine_signal_pilote; @@ -258,6 +294,7 @@ end; procedure TFormPilote.RadioBlancCliClick(Sender: TObject); begin + Raz_combine; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; Maj_Etat_Signal(0,blanc_cli); dessine_signal_pilote; @@ -271,6 +308,16 @@ end; procedure TFormPilote.RadioRalen30Click(Sender: TObject); begin + Raz_Base; + RadioJaune.Checked:=false; + RadioJauneCli.Checked:=false; + RadioBlanc.checked:=false; + RadioBlancCli.checked:=false; + RadioViolet.checked:=false; + RadioRouge.checked:=false; + RadioRougeCli.checked:=false; + RadioVert.Checked:=false; + RadioVertCli.Checked:=false; Signaux[0].AncienEtat:=Signaux[0].EtatSignal; Maj_Etat_Signal(0,ral_30); dessine_signal_pilote; @@ -280,14 +327,28 @@ end; procedure TFormPilote.RadioRappel60Click(Sender: TObject); begin Signaux[0].AncienEtat:=Signaux[0].EtatSignal; + RadioBlanc.checked:=false; + RadioBlancCli.checked:=false; + RadioViolet.checked:=false; + RadioRouge.checked:=false; + RadioRougeCli.checked:=false; + RadioVert.Checked:=false; + RadioVertCli.Checked:=false; Maj_Etat_Signal(0,rappel_60); dessine_signal_pilote; end; - procedure TFormPilote.RadioRalen60Click(Sender: TObject); begin Signaux[0].AncienEtat:=Signaux[0].EtatSignal; + RadioJaune.Checked:=false; + RadioBlanc.checked:=false; + RadioBlancCli.checked:=false; + RadioViolet.checked:=false; + RadioRouge.checked:=false; + RadioRougeCli.checked:=false; + RadioVert.Checked:=false; + RadioVertCli.Checked:=false; Maj_Etat_Signal(0,ral_60); dessine_signal_pilote; end; @@ -295,6 +356,13 @@ end; procedure TFormPilote.RadioRappel30Click(Sender: TObject); begin Signaux[0].AncienEtat:=Signaux[0].EtatSignal; + RadioBlanc.checked:=false; + RadioBlancCli.checked:=false; + RadioViolet.checked:=false; + RadioRouge.checked:=false; + RadioRougeCli.checked:=false; + RadioVert.Checked:=false; + RadioVertCli.Checked:=false; Maj_Etat_Signal(0,rappel_30); dessine_signal_pilote; end; diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 94bc4f3..fe891ac 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,6 +1,6 @@ object FormPrinc: TFormPrinc - Left = 132 - Top = 172 + Left = 73 + Top = 187 Width = 1148 Height = 625 Anchors = [akLeft, akTop, akRight] @@ -21,7 +21,7 @@ object FormPrinc: TFormPrinc OnResize = FormResize DesignSize = ( 1132 - 566) + 567) PixelsPerInch = 96 TextHeight = 13 object LabelTitre: TLabel @@ -1445,7 +1445,7 @@ object FormPrinc: TFormPrinc end object StatusBar1: TStatusBar Left = 0 - Top = 544 + Top = 545 Width = 1132 Height = 22 Panels = < @@ -1529,7 +1529,7 @@ object FormPrinc: TFormPrinc end object GroupBoxAcc: TGroupBox Left = 497 - Top = 21 + Top = 5 Width = 265 Height = 52 Anchors = [akTop, akRight] @@ -1602,19 +1602,19 @@ object FormPrinc: TFormPrinc object Label5: TLabel Left = 8 Top = 44 - Width = 74 + Width = 76 Height = 13 - Caption = 'Vitesse train % :' + Caption = 'Vitesse train Cr :' end object LabelFonction: TLabel - Left = 144 + Left = 148 Top = 44 Width = 47 Height = 13 Caption = 'Fonction: ' end object Label6: TLabel - Left = 224 + Left = 228 Top = 44 Width = 9 Height = 13 @@ -1772,6 +1772,9 @@ object FormPrinc: TFormPrinc Top = 40 Width = 33 Height = 21 + Hint = 'Vitesse du train en crans' + ParentShowHint = False + ShowHint = True TabOrder = 2 Text = '0' OnChange = EditVitesseChange @@ -1786,7 +1789,7 @@ object FormPrinc: TFormPrinc OnChange = ComboTrainsChange end object EditNumFonction: TEdit - Left = 192 + Left = 196 Top = 40 Width = 25 Height = 21 @@ -1817,14 +1820,23 @@ object FormPrinc: TFormPrinc Height = 21 Hint = 'Vitesse loco en %' Ctl3D = False - Max = 100 - Min = -100 + Max = 127 + Min = -127 ParentCtl3D = False ParentShowHint = False ShowHint = True TabOrder = 7 OnChange = TrackBarVitChange end + object Button0: TButton + Left = 124 + Top = 48 + Width = 17 + Height = 17 + Caption = '0' + TabOrder = 8 + OnClick = Button0Click + end end object Panel1: TPanel Left = 768 @@ -1974,12 +1986,14 @@ object FormPrinc: TFormPrinc end end object GroupBoxCV: TGroupBox - Left = 713 - Top = 32 + Left = 681 + Top = 40 Width = 265 Height = 129 Anchors = [akTop, akRight] Caption = 'Variables CV' + Color = clBtnFace + ParentColor = False TabOrder = 5 object Label3: TLabel Left = 208 @@ -2041,7 +2055,7 @@ object FormPrinc: TFormPrinc Top = 8 Width = 75 Height = 25 - Caption = 'Route' + Caption = 'Essai' TabOrder = 2 OnClick = Button3Click end @@ -2051,16 +2065,6 @@ object FormPrinc: TFormPrinc Left = 1064 Top = 232 end - object ClientSocketInterface: TClientSocket - Active = False - ClientType = ctNonBlocking - Port = 0 - OnConnect = ClientSocketInterfaceConnect - OnDisconnect = ClientSocketInterfaceDisconnect - OnRead = ClientSocketInterfaceRead - OnError = ClientSocketInterfaceError - Left = 264 - end object MainMenu1: TMainMenu Left = 560 object Afficher1: TMenuItem @@ -2440,6 +2444,17 @@ object FormPrinc: TFormPrinc Caption = 'Copier l'#39#233'tat actuel des aiguillages en initialisation' OnClick = Copierltatdesaiguillageseninitialisation1Click end + object N18: TMenuItem + Caption = '-' + end + object Mesurerlavitessedestrains: TMenuItem + Caption = 'Mesurer la vitesse des trains' + OnClick = MesurerlavitessedestrainsClick + end + object Affichelamesuredesvitesses1: TMenuItem + Caption = 'Afficher la mesure des trains' + OnClick = Affichelamesuredesvitesses1Click + end end end object ClientSocketCDM: TClientSocket diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 8716170..c4816d8 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,10 +1,17 @@ unit Unitprinc; -// 24/09/2024 18h30 +// 04/10/2024 10h (******************************************** Programme signaux complexes Graphique Lenz - [Delphi 7 ou RadStudio (Delphi 12)] + activeX Tmscomm + clientSocket - Delphi12 : Client Socket et ServerSocker, option sans activeX TMSCOMM pour la liaison série USB : fait par AsyncPro - AsyncPro est compilable en 32 et en 64 bits. + Delphi 7 : + on utilise activeX Tmscomm pour les liaisons série/USB + clientSocket et ServeurSocket pour les connexions réseau socket + + Delphi 12 : + on utilise AsyncPro pour les liaisons série/USB - ce composant est compilable en 32 et en 64 bits. + client Socket et ServerSocker pour les connexions réseau socket + + un essai avec IdTCPClient (Indy) est fait avec D7/D12. En D7 nécéssite le fichier Idtcpclient.dcu. + En D12 l'event Rx nécessite un thread et ne fonctionne pas bien. C'est ok en D7. Options de compilation: options du debugger/exception du langage : décocher "arreter sur exceptions delphi" sinon une exception surgira au moment de l'ouverture du com @@ -13,7 +20,7 @@ unit Unitprinc; Notes pour compilation sous Embarcadero : -------------------------------------------------- Pour compilation avec Rad Studio (Delphi12): Projet / Options // Application / Apparence / - Embarcadero technologies / cocher tous les thèmes : carbon Auric etc / et choisir le sytle par défaut : windows sinon plantage + Embarcadero technologies / cocher tous les thèmes : carbon Auric etc / et choisir le style par défaut : windows sinon plantage Pour le mode sombre sous Embarcadero, il faut sélectionner: Projet / Options // Application / manifeste / fichier manifeste : personnaliser @@ -22,7 +29,7 @@ unit Unitprinc; ******************************************** -in Pour TMSCOM : il est nécessaire d'avoir le fichier mscomm32.ocx dans le repertoire system de windows + Pour TMSCOM : il est nécessaire d'avoir le fichier mscomm32.ocx dans le repertoire system de windows (Pour un Os64, %systemroot%\sysWOW64 pour unOs32 : %systemroot%\system32) et que ce composant soit enregistré (avec regsvr32) @@ -58,35 +65,44 @@ in Pour TMSCOM : il est n // Les actionneurs fonctionnent. Les détecteurs ne sont pas renvoyés. // // En mode centrale connectée à signaux complexes (autonome) -// si on bouge un aiguillage à la raquette, on récupère bien sa position par XpressNet. +// si on bouge un aiguillage à la raquette, SC récupère bien sa position par XpressNet. // Une loco sur un détecteur au lancement ne renvoie pas son état statique. Seuls les changements // d'état sont renvoyés par la centrale. Ou alors il faut demander explicitement les états des détecteurs // à la centrale par le menu "interface / demander état détecteurs" // +// Si SC envoie une position d'aiguillage à CDM, il ne change pas sa représentation dans CDM. //{$Q-} // pas de vérification du débordement des opérations de calcul //{$R-} // pas de vérification des limites d'index du tableau et des variables +{$DEFINE xAvecIdTCP} // le composant IdTCPClient na pas d'evt receive, il faut le traiter dans un thread +// il ne marche pas bien en version D12, l'évent RX provoque une violation au démarrage puis plus rien + + interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MMSystem , Buttons, NB30, comObj, activeX ,DateUtils, PsAPI + {$IFDEF AvecIdTCP} + ,IdTCPClient // client socket indy + {$ENDIF} {$IF CompilerVersion >= 28.0} // si delphi>=12 ,Vcl.Themes // pour les thèmes d'affichage (auric etc) ,AdPort, OoMisc // AsyncPro pour COM/USB + ,idGlobal // pour utiliser tidBytes {$ELSE} - ,MSCommLib_TLB // TMSComm pour COM/USB + ,MSCommLib_TLB // TMSComm pour COM/USB {$IFEND} ; + type TFormPrinc = class(TForm) Timer1: TTimer; LabelTitre: TLabel; - ClientSocketInterface: TClientSocket; MainMenu1: TMainMenu; Interface1: TMenuItem; MenuConnecterUSB: TMenuItem; @@ -254,6 +270,10 @@ type Codificationdestrains1: TMenuItem; Afficheroutespartrain1: TMenuItem; Sauvegarderlaconfiguration1: TMenuItem; + N18: TMenuItem; + Mesurerlavitessedestrains: TMenuItem; + Affichelamesuredesvitesses1: TMenuItem; + Button0: TButton; procedure FormCreate(Sender: TObject); {$IF CompilerVersion >= 28.0} procedure RecuInterface(Sender: TObject;count : word); @@ -271,7 +291,6 @@ type procedure BoutonRafClick(Sender: TObject); procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); - procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); procedure MenuConnecterUSBClick(Sender: TObject); procedure DeconnecterUSBClick(Sender: TObject); procedure MenuConnecterEthernetClick(Sender: TObject); @@ -409,6 +428,9 @@ type procedure Afficheroutespartrain1Click(Sender: TObject); procedure Sauvegarderlaconfiguration1Click(Sender: TObject); procedure Button3Click(Sender: TObject); + procedure MesurerlavitessedestrainsClick(Sender: TObject); + procedure Affichelamesuredesvitesses1Click(Sender: TObject); + procedure Button0Click(Sender: TObject); private { Déclarations privées } procedure DoHint(Sender : Tobject); @@ -421,8 +443,109 @@ type procedure proc_checkBoxFV(Sender : Tobject); procedure proc_checkBoxFR(Sender : Tobject); procedure procAide(Sender : Tobject); + procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); + {$IF CompilerVersion >= 28.0} + procedure DataReceived(const Data: TidBytes); + {$ELSE} + procedure DataReceived(const Data: string); // réception interface socket indy + {$IFEND} end; + {$IFDEF AvecIdTCP} + {$IF CompilerVersion >= 28.0} + // thread interface socket Indy D12, pour créer event en réception + TDataEventInterface=procedure(const Data: TidBytes) of object; + TreadingThreadInterface=class(TThread) + private + FClient: TIdTCPClient; + Fdata : Tidbytes; + FOnData: TDataEventInterface; + protected + procedure Execute; override; + public + constructor Create(AClient: TIdTCPClient); reintroduce; + property OnData: TDataEventInterface read FOnData write FOnData; + procedure DataReceived; + end; + + // thread périphérique1 D12 socket Indy + TDataEventPeriph1=procedure(const Data: TidBytes) of object; + TreadingThreadPeriph1=class(TThread) + private + FClient: TIdTCPClient; + Fdata : Tidbytes; + FOnData: TDataEventPeriph1; + protected + procedure Execute; override; + public + constructor Create(AClient: TIdTCPClient); reintroduce; + property OnData: TDataEventPeriph1 read FOnData write FOnData; + procedure DataReceived; + end; + + // thread périphérique2 D12 socket Indy + TDataEventPeriph2=procedure(const Data: TidBytes) of object; + TreadingThreadPeriph2=class(TThread) + private + FClient: TIdTCPClient; + Fdata : Tidbytes; + FOnData: TDataEventPeriph2; + protected + procedure Execute; override; + public + constructor Create(AClient: TIdTCPClient); reintroduce; + property OnData: TDataEventPeriph2 read FOnData write FOnData; + procedure DataReceived; + end; + + {$ELSE} + + // Thread interface Indy D7 + TDataEventInterface=procedure(const Data: string) of object; + TreadingThreadInterface=class(TThread) + private + FClient: TIdTCPClient; + FData: string; + FOnData: TDataEventInterface; + protected + procedure Execute; override; + public + constructor Create(AClient: TIdTCPClient); reintroduce; + property OnData: TDataEventInterface read FOnData write FOnData; + procedure DataReceived; + end; + + // Thread périph1 Indy D7 + TDataEventPeriph1=procedure(const Data: string) of object; + TreadingThreadPeriph1=class(TThread) + private + FClient: TIdTCPClient; + FData: string; + FOnData: TDataEventPeriph1; + protected + procedure Execute; override; + public + constructor Create(AClient: TIdTCPClient); reintroduce; + property OnData: TDataEventPeriph1 read FOnData write FOnData; + procedure DataReceived; + end; + + // Thread périph2 Indy D7 + TDataEventPeriph2=procedure(const Data: string) of object; + TreadingThreadPeriph2=class(TThread) + private + FClient: TIdTCPClient; + FData: string; + FOnData: TDataEventPeriph2; + protected + procedure Execute; override; + public + constructor Create(AClient: TIdTCPClient); reintroduce; + property OnData: TDataEventPeriph2 read FOnData write FOnData; + procedure DataReceived; + end; + {$IFEND} + {$ENDIF} const titre='Signaux complexes GL '; @@ -464,7 +587,6 @@ NbCouleurTrain=8; MaxCdeDccpp=20; couleurTexte=$A0FFFF; clRose=$AAAAFF; - clCyan=$FFA0A0; clviolet=$FF00FF; GrisF=$191919; @@ -515,6 +637,7 @@ DeclZoneDet=5; DeclDemarTrain=6; DeclArretTrain=7; DeclSignal=8; +DeclLogique=9; // conditions CondVrai=1; @@ -524,6 +647,7 @@ CondPosAcc=4; CondHorl=5; CondTrainSig=6; + // Type d'opération (action) Action0=0; ActionAffTCO=1; @@ -561,6 +685,8 @@ IconeVrai=21; IconeFaux=15; IconeSignal=22; IconeDeclSignal=23; +IconeDroite=24; +IconeLogique=25; type @@ -591,7 +717,7 @@ Taiguillage = record ADroitB : char ; // P D S Z ADevie : integer ; // adresse (TJD:identifiant extérieur) adresse de l'élément connecté en position déviée ADevieB : char; // caractère (D ou S)si aiguillage de l'élément connecté en position déviée - APointe : integer; // adresse de l'élément connecté en position droite ; + APointe : integer; // adresse de l'élément connecté en position droite ; ou adresse de l'aiguillage triple APointeB : char; // P D S Z DDroit : integer; // destination de la TJD en position droite DDroitB : char ; @@ -643,7 +769,7 @@ TSignal = record AncienEtat : word ; // ancien état du signal AncienAff : word ; // état ancien affichage UniSemaf : integer ; // définition supplémentaire de la cible pour les décodeurs UNISEMAF - BinLin : integer; // Binaire=0 ou Linéaire décodeur LEB + BinLin : integer; // Binaire=0 ou Linéaire décodeur LEB - =1 : mode 2 signaux décodeur CDF AigDirection : array[1..7] of array of record // pour les signaux directionnels : contient la liste des aiguillages associés Adresse : integer; // 6 feux max associés à un tableau dynamique décrivant les aiguillages +1 position 0 posAig : char; @@ -729,7 +855,7 @@ Tactionneur = record NumBranche,IndexBranche : integer; end; -TelementRoute=record // l'index 0 contient le nombre d'éléments +TelementRoute=record // l'index 0 contient le nombre d'éléments dans "adresse" et le sens dans "talon" (si talon=true : consigne vitesse négative) adresse : integer; // adresse de l'élément typ : tequipement; // type de l'élément pos : integer; // position pour la route si l'élément est un aiguillage @@ -766,22 +892,23 @@ var prec1,prec2,Eprec,Esuiv,param1,param2,param3,MaxParcours,MaxRoutes : integer; ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc, - Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO, - Srvc_Pos,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif,Srvc_tdcc, + Raz_Acc_signaux,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO, + Srvc_Pos,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif,Srvc_tdcc,fermeSC, Hors_tension,TraceZone,parSocketLenz,ackCdm,PremierFD,doubleclic,debugRoulage, NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,AffTiers,AvecDemandeAiguillages, TraceListe,clignotant,nack,Maj_signaux_cours,configNulle,LanceCDM,AvecInitAiguillages, AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro, retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain, fichier_module_cdm,Diffusion,cdmDevant,serveurIPCDM_Touche,avecAckCDM,Stop_Maj_Sig, - sombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour : boolean; + sombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour, + mesureTrains,avecLogique : boolean; tick,Premier_tick : longint; {$IF CompilerVersion >= 28.0} MSCommUSBInterface, MsCommCde1,MsCommCde2 : tApdComPort; // objets AsyncPro {$ELSE} - MSCommUSBInterface, MsCommCde1,MsCommCde2 : TMSComm; + MSCommUSBInterface, MsCommCde1,MsCommCde2 : TMSComm; // objets TMSCOM {$IFEND} CDMhd : THandle; @@ -805,17 +932,25 @@ var AdrTrainRes : integer; // adresse du train qui réserve le détecteur IndexTrainRoulant : integer; // index du train placé (généré dans calcul_zones_V1F) Tempo0 : integer; // tempo de retombée à 0 du détecteur (filtrage) + Temps_cour : integer ; // tempo de comptage déecteur à 1 pour mesurer la vitesse du train NumBranche,IndexBranche : integer; // où se trouve le détecteur dans les branches index : integer; canton1,canton2 : integer; // Numéro (pas index) des deux cantons adjacents (1 ou 2) longueur : integer; // longueur en cm - temps : integer; // temps depuis détecteur à 1 ou à 0 - distanceTr : integer; // distance du train au fd du détecteur + distCour : integer; // distance courante accumulée, en mm + DistIncr : single ; // distance accumulée + ComptCour : integer; // compteur en 1/10s dét à 1 + distArret : integer; // distance du train au fd du détecteur si ModeArret=1 + ModeArret : integer; // 1=arret en fin de détecteur + DistArret 2=arret au milieu du détecteur suivant,precedent : integer; // éléments suivants/précédents pour le sens de circulation en cours TypSuivant,TypPrecedent : Tequipement; end; Adresse_detecteur : array[0..NbMaxDet] of integer; // adresses des détecteurs par index + {$IFDEF AvecIdTCP} + clientTCPInterface: tidtcpclient; + {$ENDIF} + Ecran : array[1..10] of record // écrans du pc x0,y0,larg,haut : integer; end; @@ -949,11 +1084,19 @@ var trains : array[0..Max_Trains] of record nom_train : string; inverse : boolean; // placement + detecteurA : integer; // détecteur sur lequel le train se trouve detecteurSuiv : integer; // détecteur vers lequel se dirige le train adresse,vitmax,VitNominale,VitRalenti : integer; - vitesse : integer; // vitesse actuelle de pilotage + AncVitesseCons : integer; // ancienne consigne + AVitesseCons : integer; // ancienne consigne du tick précédent + vitesseCons : integer; // vitesse Consigne actuelle de pilotage + VitesseReelleR : single; // Vitesse réelle calculée (tient compte de la décélération + VitesseReelle : integer; sens : integer; // sens de déplacement, stockage provisoire pour restocker dans le tableau canton[] + longueur: integer; // longueur de la loco compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s + cv3,cv4 : integer; + crans : integer; // crans du décodeur // pilotage des trains------------------- //TempoArret : integer; // tempo d'arret pour le timer TempoArretCour : integer; // valeur dynamique @@ -963,6 +1106,31 @@ var index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train arret_det : boolean; // arrêt du train sur le détecteur phase_arret : integer; // numéro de phase arret + // mesure et étalonnage de la vitesse------ + VitesseDetE : integer; // vitesse en entrée du détecteur + VitesseDetS : integer; // vitesse en sortie du détecteur + //Temps_cour : integer; // compteur du temps en 1/10 s évolution pendant le détecteur à 1 + pointMes : integer; // pointeur de mesures 1 à 100 + // tableau des mesures + mesure : array[1..100] of record + // valeurs mesurées: + VitCons : integer; // vitesse de consigne en crans + detecteurM : integer; // détecteur + temps : integer; // temps de passage sur le détecteue à 1 (1/10s) + // valeurs calculées: + vr : single; // vitesse réelle calculée en cm/s + end; + // Mesure vitesse des trains: affectation des vitesses moyennes aux détecteurs rencontrés + // par detecteur (NbMaxDet) et par consigne (128 max) + detecteurR : array[0..NbMaxDet,1..128] of record + nombre : integer; + moyenne : single; // moyenne de la vitesse calculée par détecteur/ + ecart : single; // + somme : single; + end; + ConsV1,consV2,consV3 : integer; // consignes auxquels les coefficients V1 V2 V3 ont été calculés + CoeffV1,CoeffV2,CoeffV3 : single; // coefficients pour calculer la vitesse réelle en cm/s depuis la vitesse en crans + pente1,b1,pente2,b2 : single; // pente et b des 2 équations de droite de vitesse //--------- canton : integer ; // numéro du canton (pas index) sur lequel le train se trouve icone : Timage ; @@ -976,9 +1144,11 @@ var dernierDet : integer; // dernier détecteur traité cantonOrg,CantonDest : integer; // cantons origine et destination si route route : TuneRoute; // tableau de la route en cours du train - routePref : TUneroute; // tableau de la route sauvegardée du train + NomRoute : array[1..30] of string; // nom de la route sauvegardée + NomRouteCour : string; // nom de la route courante + routePref : array[0..30] of TUneroute; // tableau de la route sauvegardée du train PointRout : integer; - // cantons sur lesquels le train doit d'arrêter + // cantons (via leurs déteceteurs) sur lesquels le train doit d'arrêter DetecteurArret : array[1..NbDetArret] of record Prec, // adresse précédent, pour le sens detecteur, // détecteur sur lequel s'arreter si le canton a 2 détecteurs @@ -1006,14 +1176,14 @@ var event_det_train : array[0..Max_Trains] of record NbEl : integer; // nombre d'éléments dans le tableau ci-dessous - AdrTrain : integer; + AdrTrain : integer; // index du train 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..3] of record // tableau des evts détecteurs par train - 1 train peut occuper 2 détecteurs simultanément donc il faut 3 états historique - adresse : integer; - etat : boolean; - end; + adresse : integer; + etat : boolean; + end; end; decodeur : array[0..30] of string[20]; @@ -1022,20 +1192,27 @@ var Aig_supprime,Aig_sauve : TAiguillage; BrancheN : array[1..MaxBranches,1..MaxElBranches] of TBranche; chaine_recue : TchaineBIN; + {$IFDEF AvecIdTCP} + ThreadInterface : TReadingThreadInterface; + ThreadPeriph1 : TReadingThreadPeriph1; + ThreadPeriph2 : TReadingThreadPeriph2; + ClientSocketIdInterface: tIdTCPClient; + {$ENDIF} + ClientSocketInterface: TClientSocket; {$R *.dfm} // utilisation des procédures et fonctions dans les autres unités function Index_Signal(adresse : integer) : integer; function Index_Aig(adresse : integer) : integer; -procedure dessine_signal2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_signal3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_signal4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_signal5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_signal7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); -procedure dessine_signal9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer); -procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,adresse : integer); -procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,N : integer); +procedure dessine_signal2(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); +procedure dessine_signal3(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); +procedure dessine_signal4(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); +procedure dessine_signal5(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); +procedure dessine_signal7(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); +procedure dessine_signal9(Acanvas : Tcanvas;x,y : integer;frX,frY : single;etatsignal : word;orientation : integer); +procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation,adresse : integer); +procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation,N : integer); procedure Maj_Etat_Signal(adresse,aspect : integer); procedure Maj_Etat_Signal_Belge(adresse,aspect : integer); procedure Affiche(s : string;lacouleur : TColor); @@ -1048,7 +1225,7 @@ function connecte_socket_periph(index : integer) : boolean; procedure deconnecte_socket_periph(index : integer); procedure deconnecte_usb; function IsWow64Process: Boolean; -procedure Dessine_signal_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer); +procedure Dessine_signal_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : single;adresse : integer;orientation : integer); procedure Pilote_acc0_X(adresse : integer;octet : byte); Function pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire) : boolean; overload; Function pilote_acc(adresse : integer;octet : byte;adrTrain : integer) : boolean; overload; @@ -1076,7 +1253,7 @@ procedure init_aiguillages; function index_adresse_detecteur(de : integer) : integer; function index_train_adresse(adr : integer) : integer; function index_train_nom(nom : string) : integer; -procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;repetition : boolean); +procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;repetition : integer); procedure Maj_Signaux(detect : boolean); procedure Det_Adj(adresse : integer); function reserve_canton(detecteur1,detecteur2,adrtrain,NumTrain,NCantons : integer) : integer; @@ -1130,25 +1307,110 @@ procedure interface_ou_cdm; procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor); procedure Event_vitesse(adr: integer ;train : string;vitesse : integer); function detecteur_suivant(prec : integer;TypeElPrec : TEquipement;actuel : integer;TypeElActuel : TEquipement;algo : integer) : integer ; -procedure prepare_route(IndexTCO,cantonOrg,arrivee,sens : integer); +function prepare_route(IndexTCO,cantonOrg,arrivee,sens : integer) : integer; function route_totale_to_string(tablo : tUneRoute) : string; function route_restreinte_to_string(tablo : tUneRoute) : string; procedure supprime_route_train(idtrain : integer); +procedure trouve_element(el: integer; TypeEl : TEquipement;Branche_pref : integer;erreur : boolean); overload; procedure trouve_element(el: integer; TypeEl : TEquipement); overload; procedure trouve_element_V1(el: integer; TypeEl : TEquipement; Offset,branche_pref,OffsetDsBranche : integer;erreur : boolean;it : integer); procedure procetape(s : string); procedure Affiche_routes_brut; procedure TJD4(adr1,pos1,adr2,pos2 : integer;var c1,c2 : char); procedure affecte_trains_config; +procedure Fonction_Loco_Operation(loco,fonction,etat : integer); +procedure calcul_equations_coeff(indexTrain : integer); +procedure connecte_interface_ethernet; implementation uses UnitDebug, UnitPilote, UnitSimule, UnitTCO, UnitConfig, verif_version , UnitCDF, UnitAnalyseSegCDM, UnitConfigCellTCO, UnitConfigTCO,UnitSR, UnitHorloge, UnitFicheHoraire, UnitClock, - UnitModifAction, - selection_train, UnitRouteTrains, - UnitRoute; + UnitModifAction, selection_train, UnitRouteTrains, UnitRoute, UnitMesure; + +{$IFDEF AvecIdTCP} + // création thread interface + constructor TReadingThreadInterface.Create(AClient: TIdTCPClient); + begin + inherited Create(True); + FClient:=AClient; + end; + + procedure TReadingThreadInterface.Execute; + begin + while not Terminated do + begin + {$IF CompilerVersion >= 28.0} + Fclient.IOHandler.ReadBytes(Fdata,0,false); + if (FData <> nil) and Assigned(FOnData) then + {$ELSE} + FData := FClient.CurrentReadBuffer; + if (FData <> '') and Assigned(FOnData) then + {$IFEND} + Synchronize(DataReceived); + end; + end; + + procedure TReadingThreadInterface.DataReceived; + begin + if Assigned(FOnData) then FOnData(FData); + end; + + constructor TReadingThreadPeriph1.Create(AClient: TIdTCPClient); + begin + inherited Create(True); + FClient := AClient; + end; + + // création thread périphérique1 + procedure TReadingThreadPeriph1.DataReceived; + begin + if Assigned(FOnData) then FOnData(FData); + end; + + procedure TReadingThreadPeriph1.Execute; + begin + while not Terminated do + begin + {$IF CompilerVersion >= 28.0} + Fclient.IOHandler.ReadBytes(Fdata,0,false); + if (FData <> nil) and Assigned(FOnData) then + {$ELSE} + FData := FClient.CurrentReadBuffer; + if (FData <> '') and Assigned(FOnData) then + {$IFEND} + Synchronize(DataReceived); + end; + end; + + // création thread périphérique2 + procedure TReadingThreadPeriph2.DataReceived; + begin + if Assigned(FOnData) then FOnData(FData); + end; + + constructor TReadingThreadPeriph2.Create(AClient: TIdTCPClient); + begin + inherited Create(True); + FClient := AClient; + end; + + procedure TReadingThreadPeriph2.Execute; + begin + while not Terminated do + begin + {$IF CompilerVersion >= 28.0} + Fclient.IOHandler.ReadBytes(Fdata,0,false); + if (FData <> nil) and Assigned(FOnData) then + {$ELSE} + FData := FClient.CurrentReadBuffer; + if (FData <> '') and Assigned(FOnData) then + {$IFEND} + Synchronize(DataReceived); + end; + end; +{$ENDIF} { procedure menu_interface(MA : TMA); @@ -1165,6 +1427,7 @@ begin end; } + // change le style en fonction de Style_aff pour Delphi12 (compilateur>=28) // Cette procédure doit être appellée depuis le module principal UnitPrinc sinon exception violation procedure change_style; @@ -1286,11 +1549,8 @@ begin positionne_principal; {$IFEND} calcul_pos_horloge; - if (versionSC<>'8.53') then - begin - if AffHorl then Affiche_horloge; - if LanceHorl then Demarre_horloge; - end; + if AffHorl then Affiche_horloge; + if LanceHorl then Demarre_horloge; formConfig.listBoxPeriph.clear; formModifAction.ComboBoxAccComUSB.Clear; @@ -1301,7 +1561,6 @@ begin ajoute_champs_combos(i); end; - if avecTCO then for i:=1 to NbreTco do begin @@ -1309,11 +1568,10 @@ begin Affiche_Fenetre_TCO(i,avecTCO); end; renseigne_tous_cantons; // les cantons doivent être renseignés pour les evts détecteurs - renseigne_TJDs; + renseigne_TJDs_TCO; interface_ou_cdm; // démarrer l'interface , génère les evts détecteurs ; ou cdm - maj_signaux(true); // si trains placés, mettre les signaux à jour formprinc.SetFocus; end; @@ -1401,15 +1659,16 @@ begin end; end; end; + {$ELSE} -// envoie une chaine s à un périphérique COM/USB en fonction du composant comp +// envoie une chaine s à un périphérique COM/USB en fonction du composant comp :tmscomm // contrôle si le pointeur comp est valide par traitement de l'exception procedure envoi_usb_comp(comp : Tmscomm;s : variant); var i : integer; begin if comp=nil then begin - Affiche('Erreur 600X: le composant périphérique n''est pas créé',clred); + Affiche('Erreur 600X: le composant périphérique tmscom n''est pas créé',clred); exit; end; @@ -1446,7 +1705,7 @@ var i,timeout,valto,l : integer; begin if simuInterface then exit; - s:=entete+s; + if protocole=1 then s:=entete+s; // ajout de l'entete en Xpressnet, pas en Dccpp l:=length(s); for i:=1 to l do z[i]:=byte(ord(s[i])); // transforme la chaine en tableau d'octets @@ -1525,9 +1784,15 @@ begin // par socket (ethernet) if parSocketLenz or (etat_init_interface>=11) then begin - Formprinc.ClientSocketInterface.Socket.SendBuf(z,l); + {$IFDEF AvecIdTCP} + ClientSocketIdInterface.IoHandler.write(RawToBytes(z,l)); // RawToBytes() convertit n'importe quoi en TidBytes + {$ELSE} + ClientSocketInterface.Socket.SendBuf(z,l); + {$ENDIF} + sleep(30); end; end; + {$ELSE} // envoi la chaîne trameIF à la centrale par USBLenz ou socket, n'attend pas l'ack // pour le protole XpressNet (1), on ajoute l'entete et le suffixe dans la trame. @@ -1538,10 +1803,10 @@ var i,timeout,valto,l : integer; begin if simuInterface then exit; - s:=entete+s; + if protocole=1 then s:=entete+s; // ajout de l'entete en Xpressnet, pas en Dccpp l:=length(s); Setlength(TrameIF,l); - for i:=0 to l-1 do TrameIF[i]:=byte(ord(s[i+1])); + for i:=0 to l-1 do TrameIF[i]:=byte(ord(s[i+1])); // transforme la chaine en tableau dynamique d'octets if traceTrames then begin @@ -1618,7 +1883,11 @@ begin // par socket (ethernet) if parSocketLenz or (etat_init_interface>=11) then begin - Formprinc.ClientSocketInterface.Socket.SendBuf(TrameIF[0],l); + {$IFDEF AvecIdTCP} + ClientSocketIdInterface.Socket.Send(TrameIF[0],l); + {$ELSE} + ClientSocketInterface.Socket.SendBuf(TrameIF[0],l); + {$ENDIF} Sleep(30); end; end; @@ -1631,8 +1900,8 @@ begin if simuInterface then begin result:=true; - exit; // #### - end; + exit; + end; begin if protocole=1 then // Xpressnet begin @@ -1684,7 +1953,7 @@ begin end; {$IF CompilerVersion >= 28.0} -// connecte un port usb interface avev AsyncPro. Si le port n'est pas ouvert, renvoie 0, sinon renvoie +// connecte un port usb interface vers centrale avec AsyncPro. Si le port n'est pas ouvert, renvoie 0, sinon renvoie // le numéro de port // affichage dans panel[3] function connecte_port_usb(port : integer) : integer; @@ -1738,7 +2007,7 @@ begin try open:=true; except - Affiche('Port COM'+intToSTR(port)+' absent',clOrange); + //Affiche('Port COM'+intToSTR(port)+' absent',clOrange); portCommOuvert:=false; end; if protocole=2 then DTR:=false // évite de reset de l'arduino à la connexion @@ -1771,7 +2040,7 @@ end; {$ELSE} -// connecte un port usb interface avec TMSCOMM. Si le port n'est pas ouvert, renvoie 0, sinon renvoie +// connecte un port usb interface vers centrale avec TMSCOMM. Si le port n'est pas ouvert, renvoie 0, sinon renvoie // le numéro de port // affichage dans panel[3] function connecte_port_usb(port : integer) : integer; @@ -1827,7 +2096,7 @@ begin MSCommUSBInterface.portopen:=true; except portCommOuvert:=false; - Affiche('Port COM'+intToSTR(port)+' absent',clOrange); + //Affiche('Port COM'+intToSTR(port)+' absent',clOrange); end; if simuInterface then PortCommOuvert:=true; @@ -2128,7 +2397,6 @@ end; // premierBit : code de la signalisation // Combine = code de la signalisation combinée // Exemple code_to_aspect(10001000000000) renvoie premierBit=jaune_cli (9) et Combine=rappel 60 (13) -// si pas de combinaison, renvoie -1 procedure code_to_aspect(codebin : word;var aspect,combine : integer) ; begin aspect:=PremBitNum(CodeBin and $3ff); @@ -2138,7 +2406,7 @@ end; // conversion d'un état signal binaire en état unique de 1 à 19 // exemple code_to_etat(10001000000000) (jaune_cli et rappel 60) renvoie 19 function code_to_etat(code : word) : integer; -var aspect,combine : integer; +var aspect,combine : integer; begin code_to_aspect(code,aspect,combine); result:=9999; @@ -2154,16 +2422,16 @@ begin if aspect=7 then result:=8; // blanc cli if aspect=8 then result:=9; // jaune if aspect=9 then result:=10; // jaune cli - end; + end; if aspect=-1 then begin if combine=10 then result:=11; // ralen 30 if combine=11 then result:=12; // ralen 60 - if combine=12 then result:=14; // rappel 30 - if combine=13 then result:=15; // rappel 60 + if combine=12 then result:=13; // rappel 30 + if combine=13 then result:=14; // rappel 60 end; - if (aspect=9) and (combine=11) then result:=13; //ralen 60 + jaune cli + if (aspect=9) and (combine=11) then result:=15; //ralen 60 + jaune cli if (aspect=8) and (combine=12) then result:=16; //rappel 30 + jaune if (aspect=9) and (combine=12) then result:=17; //rappel 30 + jaune cli if (aspect=8) and (combine=13) then result:=18; //rappel 60 + jaune @@ -2172,7 +2440,7 @@ begin code_to_etat:=result; {'Non commandé','carré','sémaphore','sémaphore cli','vert','vert cli','violet', 'blanc','blanc cli','jaune','jaune cli','ralen 30','ralen 60','ralen 60 + jaune cli','rappel 30','rappel 60', - 7 8 9 10 11 12 13 14 15 + 7 8 9 10 11 12 13 14 15 'rappel 30 + jaune','rappel 30 + jaune cli','rappel 60 + jaune','rappel 60 + jaune cli'); 16 17 18 19 } end; @@ -2231,12 +2499,12 @@ begin end; -// dessine un cercle plein dans le signal +// dessine un cercle plein dans le signal dans le canvas procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor); begin with Acanvas do begin - //brush.Style:=bsSolid; + //brush.Style:=bsSolid; brush.Color:=couleur; pen.Color:=clBlack; pen.Width:=1; @@ -2251,7 +2519,7 @@ end; // frX, frY : facteurs de réduction (pour agrandissement) // EtatSignal : état du signal // orientation à donner au signal : 1= vertical 2=90° à gauche 3=90° à droite 4=180° -procedure dessine_signal2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); +procedure dessine_signal2(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); var Temp,rayon,xViolet,YViolet,xBlanc,yBlanc, LgImage,HtImage,code,combine : integer; ech : real; @@ -2350,12 +2618,10 @@ begin XVert:=LgImage-Xvert; Yvert:=HtImage-Yvert; end; - XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y; Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y; XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y; - if signaux[index].AncienAff<>EtatSignal then begin Affiche('efface tout',clred); @@ -2380,7 +2646,7 @@ begin end; // dessine les feux sur une cible à 3 feux -procedure dessine_signal3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); +procedure dessine_signal3(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xvert,Yvert, LgImage,HtImage,code,combine : integer; ech : real; @@ -2453,7 +2719,7 @@ end; // dessine les feux sur une cible à 4 feux // orientation=1 vertical -procedure dessine_signal4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); +procedure dessine_signal4(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xcarre,Ycarre,Xvert,Yvert, LgImage,HtImage,code,combine : integer; ech : real; @@ -2525,7 +2791,7 @@ begin end; // dessine les feux sur une cible à 5 feux -procedure dessine_signal5(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); +procedure dessine_signal5(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); var XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre, Temp,rayon,LgImage,HtImage,code,combine : integer; ech : real; @@ -2606,7 +2872,7 @@ end; // dessine les feux sur une cible à 7 feux -procedure dessine_signal7(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer); +procedure dessine_signal7(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation : integer); var XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2, Temp,rayon,LgImage,HtImage,code,combine : integer; ech : real; @@ -2703,7 +2969,7 @@ begin end; // dessine les feux sur une cible à 9 feux -procedure dessine_signal9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer); +procedure dessine_signal9(Acanvas : Tcanvas;x,y : integer;frX,frY : single;etatsignal : word;orientation : integer); var rayon, XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2, Xrap1,Yrap1,Xrap2,Yrap2,Temp,LgImage,HtImage,xt,yt,code,combine : integer; @@ -2913,7 +3179,7 @@ end; // dessine les feux sur une cible belge à 5 feux // cette image peut être inversée (contre voie) -procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,adresse : integer); +procedure dessine_signal20(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation,adresse : integer); var xblanc,xvert,xrouge,Yblanc,xjauneBas,xJauneHaut,yJauneBas,yJauneHaut,YVert,Yrouge,largeur, index,Temp,rayon,LgImage,HtImage,code,combine,x1,y1,x2,y2,x3,y3,xChiffre,yChiffre,xfin,yfin,angle, AdrAig,IndexAig,vitesse,indexTCO,tailleFonte,xTexte,yTexte : integer; @@ -3141,7 +3407,7 @@ begin end; // dessine les feux sur une cible directionnelle à N feux -procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation,N : integer); +procedure dessine_dirN(Acanvas : Tcanvas;x,y : integer;frX,frY : single;EtatSignal : word;orientation,N : integer); var rayon,x1,x2,x3,y1,y2,y3,x4,y4,x5,y5,x6,y6,LgImage,HtImage,temp : integer; ech : real; begin @@ -3406,7 +3672,7 @@ end; } // dessine l'aspect du signal en fonction de son adresse dans la partie droite de droite -procedure Dessine_signal_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : real;adresse : integer;orientation : integer); +procedure Dessine_signal_mx(CanvasDest : Tcanvas;x,y : integer;FrX,frY : single;adresse : integer;orientation : integer); var i,aspect : integer; begin i:=Index_Signal(adresse); @@ -3551,6 +3817,7 @@ begin Transparent:=true; // mettre rouge par défaut + Signaux[rang].AncienEtat:=9999; if TypeSignal=2 then Signaux[rang].EtatSignal:=violet_F; if TypeSignal=3 then Signaux[rang].EtatSignal:=semaphore_F; if (TypeSignal>3) and (TypeSignal<10) and Signaux[rang].VerrouCarre then Signaux[rang].EtatSignal:=carre_F; @@ -3671,7 +3938,6 @@ begin tablo_HEX:=sa_hex; end; - // temporisation en x 100 ms (0,1 s) procedure Tempo(ValTemps : integer); var i : longint; @@ -3819,11 +4085,24 @@ begin chaine_CDM_Acc:=so+s; end; +// envoie une fonction F à une loco via CDM +// si c'est une fonction F>12 elle peut être envoyée en XpressNet procedure envoie_fonction_CDM(fonction,etat : integer;train : string); -var s : string; +var loco : integer; + s : string; begin - s:=chaine_CDM_Func(fonction,etat,train); - envoi_cdm(s); + if CDM_connecte and (fonction<=12) then + begin + s:=chaine_CDM_Func(fonction,etat,train); + envoi_cdm(s); + end; + + if (portCommOuvert or parSocketLenz) and (fonction>12) then + begin + loco:=index_train_nom(train); + loco:=trains[loco].adresse; + Fonction_Loco_operation(loco,fonction,etat); + end; end; // active ou désactive une sortie par xpressnet (mode autonome, donc connecté à la centrale) @@ -3875,7 +4154,7 @@ begin if protocole=2 then Affiche('D2: Commande DCC++ pas encore implantée',clred); end; - +// loco : adresse de la loco procedure demande_etat_loco(loco : integer); var ah,al,i : integer; s : string; @@ -3901,7 +4180,7 @@ begin end; end; -// loco=adresse de la loco fonction de 0 à 20 état 0/1 +// loco=adresse de la loco fonction de 0 à 28 état 0/1 procedure Fonction_Loco_Operation(loco,fonction,etat : integer); var s : string ; ah,al : integer; @@ -3938,7 +4217,7 @@ begin end; if (fonction>=13) and (fonction<=20) then b:=(fb shr 8) or setbit(0,fonction-13); // non doc if (fonction>=21) and (fonction<=28) then b:=(fb shr 8) or setbit(0,fonction-21); // non doc - end + end else begin case fonction of @@ -3955,7 +4234,7 @@ begin envoi(s); end; end; - if protocole=2 then + if protocole=2 then begin c:=0; if fonction<=4 then @@ -4080,29 +4359,31 @@ end; // faux non oui // vrai oui non // inversion train[].inverse xor (vitesse>=0) -procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;repetition : boolean); +procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;repetition : integer); var s : string; v,erreur : integer; begin + if debugRoulage then Affiche('Vitesse train @'+inttostr(adr_loco)+'='+inttostr(vitesse),clLime); + + if (index=0) and (adr_loco<>0) then index:=index_train_adresse(adr_loco); + if (s='') and (index<>0) then nom_train:=trains[index].nom_train; + // mettre à jour la trackBar si le train sélectionné=editAdrTrain + val(Formprinc.EditAdrTrain.Text,v,erreur); + if v=adr_loco then + begin + pasChgTBV:=true; // évite de repositionner la trackbar + Formprinc.TrackBarVit.Position:=vitesse; + pasChgTBV:=false; + end; + if not(hors_tension) and ((portCommOuvert or parSocketLenz)) then begin - if debugRoulage then Affiche('Vitesse train @'+inttostr(adr_loco)+'='+inttostr(vitesse),clLime); - - // mettre à jour la trackBar si le train sélectionné=editAdrTrain - val(Formprinc.EditAdrTrain.Text,v,erreur); - if v=adr_loco then - begin - pasChgTBV:=true; // évite de repositionner la trackbar - Formprinc.TrackBarVit.Position:=vitesse; - pasChgTBV:=false; - end; - if protocole=1 then begin //AfficheDebug('X9 train '+inttostr(loco)+' '+inttostr(vitesse),clOrange); - vitesse:=abs(vitesse); - if vitesse>127 then vitesse:=127; v:=vitesse; + v:=abs(v); + if v>127 then v:=127; if (trains[index].inverse) xor (vitesse>=0) then v:=v or 128; s:=#$e4+#$13+#$0+char(adr_loco)+char(v); s:=checksum(s); @@ -4127,13 +4408,12 @@ begin //affiche(s,clLime); end; - // répétition de la consigne dans 1 s - if repetition then + // répétition de la consigne dans x s + if repetition<>0 then begin - trains[index].vitesse:=vitesse; - trains[index].compteur_consigne:=10; + trains[index].compteur_consigne:=repetition; end; - trains[index].vitesse:=vitesse; + trains[index].vitesseCons:=vitesse; end; @@ -4358,12 +4638,12 @@ envoie les donn ===========================================================================*} procedure envoi_CDF(adresse : integer); var - combine,aspect,code : integer; - i,nombre : integer; + combine,aspect,code,i,nombre,c : integer; + AncRalRap,AncJau,jau,RalRap : boolean; s : string; // envoi les bits 0 à 3 - procedure ecrire(v : integer); + procedure Xecrire(v : integer); var j : integer; begin // bit 0 à 3 @@ -4396,7 +4676,7 @@ var end; // envoi les bits 0 à 7 - procedure ecrire_2(v : integer); + procedure Xecrire_2(v : integer); var bit2 : integer; begin // bit 0-1 (adresse) @@ -4465,6 +4745,12 @@ var bit2:=v and 3; //0000 0011 if bit2<>0 then begin + {if bit2=3 then + begin + pilote_acc(adresse,1,signal); + pilote_acc(adresse,2,signal); + end + else } pilote_acc(adresse,bit2,signal); exit; end; @@ -4476,6 +4762,12 @@ var bit2:=v and $c; //0000 1100 if bit2<>0 then begin + {if bit2=$c then + begin + pilote_acc(adresse+1,1,signal); + pilote_acc(adresse+1,2,signal); + end + else } pilote_acc(adresse+1,bit2 shr 2,signal); exit; end; @@ -4487,6 +4779,12 @@ var bit2:=v and $30; //0011 0000 if bit2<>0 then begin + {if bit2=$30 then + begin + pilote_acc(adresse+2,1,signal); + pilote_acc(adresse+2,2,signal); + end + else } pilote_acc(adresse+2,bit2 shr 4,signal); exit; end; @@ -4498,6 +4796,12 @@ var bit2:=v and $c0; //1100 0000 if bit2<>0 then begin + {if bit2=$c0 then + begin + pilote_acc(adresse+3,1,signal); + pilote_acc(adresse+3,2,signal); + end + else} pilote_acc(adresse+3,bit2 shr 6,signal); end; end; @@ -4519,7 +4823,6 @@ begin AfficheDebug(s,clyellow); end; - if combine=-1 then case aspect of carre : ecrire_3(Signaux[i].SR[1].sortie1); semaphore : ecrire_3(Signaux[i].SR[2].sortie1); @@ -4532,21 +4835,119 @@ begin jaune : ecrire_3(Signaux[i].SR[9].sortie1); jaune_cli : ecrire_3(Signaux[i].SR[10].sortie1); end; - if aspect=-1 then - case combine of - ral_30 : ecrire_3(Signaux[i].SR[11].sortie1); - ral_60 : ecrire_3(Signaux[i].SR[12].sortie1); - rappel_30 : ecrire_3(Signaux[i].SR[14].sortie1); - rappel_60 : ecrire_3(Signaux[i].SR[15].sortie1); - end; - if (aspect<>-1) and (combine<>-1) then + + // standard (mode 2 signaux décoché) + //if signaux[i].BinLin=0 then begin - if (Combine=ral_60) and (aspect=jaune_cli) then ecrire_3(Signaux[i].SR[13].sortie1); - if (Combine=rappel_30) and (aspect=jaune) then ecrire_3(Signaux[i].SR[16].sortie1); - if (Combine=rappel_30) and (aspect=jaune_cli) then ecrire_3(Signaux[i].SR[17].sortie1); - if (Combine=rappel_60) and (aspect=jaune) then ecrire_3(Signaux[i].SR[18].sortie1); - if (Combine=rappel_60) and (aspect=jaune_cli) then ecrire_3(Signaux[i].SR[19].sortie1); + case combine of + ral_30 : ecrire_3(Signaux[i].SR[11].sortie1); + ral_60 : ecrire_3(Signaux[i].SR[12].sortie1); + rappel_30 : ecrire_3(Signaux[i].SR[13].sortie1); + rappel_60 : ecrire_3(Signaux[i].SR[14].sortie1); + end; + exit; end; + exit; + { + else + begin + // mode 4 + // spécial Philippe30 : n'est pas standard : mode 2 signaux indépendants sur le décodeur + Ancralrap:=(TestBit(Signaux[i].AncienEtat,ral_30)) or (TestBit(Signaux[i].AncienEtat,ral_60)) or + (TestBit(Signaux[i].AncienEtat,rappel_30)) or (TestBit(Signaux[i].AncienEtat,rappel_60)) ; + // si ancien état du signal=jaune ou jaune cli + Ancjau:=(TestBit(Signaux[i].AncienEtat,jaune)) or (TestBit(Signaux[i].AncienEtat,jaune_cli)) ; + + // si état demandé du signal=ralentissement ou rappel + ralrap:=(TestBit(code,ral_30)) or (TestBit(code,ral_60)) or + (TestBit(code,rappel_30)) or (TestBit(code,rappel_60)) ; + // si état demandé du signal=jaune ou cli + jau:=TestBit(code,jaune) or TestBit(code,jaune_cli) ; + + if (combine=ral_30) and not(TestBit(Signaux[i].AncienEtat,ral_30)) then // si l'ancien état n'était pas au ral 30, allumer le Ral30 + begin // c'est le bit à gauche du groupe de 2 bits qui allume le RR30 + c:=Signaux[i].SR[11].sortie1; // le bit à 1 correspond à l'allumage + ecrire_3(c); // exemple : 0000 0010 soit 2 + end; + if (combine<>ral_30) and (TestBit(Signaux[i].AncienEtat,ral_30)) then // si l'ancien état était au ral 30, éteindre le Ral30 + begin + c:=Signaux[i].SR[11].sortie1; + case c of + $1 : c:=$2; // 01 devient 10 + $2 : c:=$1; // 10 devient 01 + $4 : c:=$8; // 0100 devient 1000 + $8 : c:=$4; // 1000 devient 0100 + $10 : c:=$20; // 01 0000 devient 10 0000 + $20 : c:=$10; // 10 0000 devient 01 0000 + $40 : c:=$80; // 0100 0000 devient 1000 0000 + $80 : c:=$40; // 1000 0000 devient 0100 0000 + end; + ecrire_3(c); + end; + + if (combine=ral_60) and not(TestBit(Signaux[i].AncienEtat,ral_60)) then // si l'ancien état n'était pas au ral 30, allumer le Ral30 + begin + c:=Signaux[i].SR[12].sortie1; // le bit à 1 correspond à l'allumage + ecrire_3(c); // exemple : 0000 0010 soit 2 + end; + if (combine<>ral_60) and (TestBit(Signaux[i].AncienEtat,ral_60)) then // si l'ancien état était au ral 30, éteindre le Ral30 + begin + c:=Signaux[i].SR[12].sortie1; // le bit à 1 correspond à l'allumage + case c of + $1 : c:=$2; // 01 devient 10 + $2 : c:=$1; // 10 devient 01 + $4 : c:=$8; // 0100 devient 1000 + $8 : c:=$4; // 1000 devient 0100 + $10 : c:=$20; // 01 0000 devient 10 0000 + $20 : c:=$10; // 10 0000 devient 01 0000 + $40 : c:=$80; // 0100 0000 devient 1000 0000 + $80 : c:=$40; // 1000 0000 devient 0100 0000 + end; + ecrire_3(c); + end; + + if (combine=rappel_30) and not(TestBit(Signaux[i].AncienEtat,rappel_30)) then // si l'ancien état n'était pas au rappel 30, allumer le Rappel 30 + begin + c:=Signaux[i].SR[13].sortie1; // le bit à 1 correspond à l'allumage + ecrire_3(c); // exemple : 0000 0010 soit 2 + end; + if (combine<>rappel_30) and (TestBit(Signaux[i].AncienEtat,rappel_30)) then // si l'ancien état était au rappel30, l'éteindre + begin + c:=Signaux[i].SR[13].sortie1; + case c of + $1 : c:=$2; // 01 devient 10 + $2 : c:=$1; // 10 devient 01 + $4 : c:=$8; // 0100 devient 1000 + $8 : c:=$4; // 1000 devient 0100 + $10 : c:=$20; // 01 0000 devient 10 0000 + $20 : c:=$10; // 10 0000 devient 01 0000 + $40 : c:=$80; // 0100 0000 devient 1000 0000 + $80 : c:=$40; // 1000 0000 devient 0100 0000 + end; + ecrire_3(c); // éteindre + end; + + if (combine=rappel_60) and not(TestBit(Signaux[i].AncienEtat,rappel_60)) then // si l'ancien état n'était pas au ral 30, allumer le Ral30 + begin // c'est le bit à gauche du groupe de 2 bits qui allume le RR30 + c:=Signaux[i].SR[14].sortie1; // le bit à 1 correspond à l'allumage + ecrire_3(c); // exemple : 0000 0010 soit 2 + end; + if (combine<>rappel_60) and (TestBit(Signaux[i].AncienEtat,rappel_60)) then // si l'ancien état était au ral 30, éteindre le Ral30 + begin + c:=Signaux[i].SR[14].sortie1; // le bit à 1 correspond à l'allumage + case c of + $1 : c:=$2; // 01 devient 10 + $2 : c:=$1; // 10 devient 01 + $4 : c:=$8; // 0100 devient 1000 + $8 : c:=$4; // 1000 devient 0100 + $10 : c:=$20; // 01 0000 devient 10 0000 + $20 : c:=$10; // 10 0000 devient 01 0000 + $40 : c:=$80; // 0100 0000 devient 1000 0000 + $80 : c:=$40; // 1000 0000 devient 0100 0000 + end; + ecrire_3(c); + end; + end; } end; end; @@ -4574,7 +4975,7 @@ begin AfficheDebug(s,clyellow); end; - etat:=code_to_etat(code); + etat:=code_to_etat(code); // transforme le motif de bits en état de 1 à 19 nAdr:=Signaux[index].Na; if index<>0 then @@ -4623,8 +5024,7 @@ begin Pilote_acc(adresse+i-1,1,signal); end; if not(s0) and not(s1) then - Affiche('Erreur 621 : décodeur SR du signal '+intToSTR(adresse)+' pas trouvé l''état demandé '+chaine_signal(etat)+' dans sa configuration',clOrange); - + Affiche('Erreur 621 : décodeur SR du signal '+intToSTR(adresse)+': pas trouvé l''état demandé '+chaine_signal(adresse)+' dans sa configuration',clOrange); end; end; end; @@ -4654,7 +5054,7 @@ var index,mode,code,aspect,cible,combine,offset,sortie : integer; Pilote_acc0_X(adresse+i,octet); Sleep(Tempo_Signal); Application.ProcessMessages; - end; + end; end; end; @@ -6186,7 +6586,7 @@ begin it:=index_train_nom(tr); if it>0 then begin - vit:=Trains[it].vitesse; + vit:=Trains[it].vitesseCons; condvalide:=(vit>=vit1) and (vit<=vit2); end; end; @@ -6251,7 +6651,6 @@ begin end; end; - procedure arret_train(nom : string;id,adresse : integer); var s : string; begin @@ -6263,18 +6662,17 @@ begin else if (portCommOuvert or parSocketLenz) then begin - vitesse_loco(nom,id,adr,0,true); + vitesse_loco(nom,id,adr,0,10); end; end; - // pilotage d'un signal, et mise à jour du graphisme du signal dans les 3 fenetres procedure envoi_signal(Adr : integer); var i,it,index_train,adresse,detect,a,b,aspect,x,y,TailleX,TailleY,Orientation, indexTCO,AdrTrain,dec,td : integer; etatAvert,etatBvert,etatArouge,etatBrouge : boolean; ImageSignal : TImage; - frX,frY : real; + frX,frY : single; s : string; begin i:=Index_Signal(Adr); @@ -6438,6 +6836,8 @@ begin begin adr:=Signaux[i].adresse; if not(fermeSC) and (adr<>0) then envoi_signal(adr); + Sleep(25); + Application.processMessages; end; end; @@ -6464,7 +6864,7 @@ end; // trouve l'index d'un détecteur dans une branche // si pas trouvé, renvoie 0 sinon renvoie l'index du détecteur dans la branche -function index_detecteur(detecteur,Num_branche : integer) : integer; +function index_detecteur_branche(detecteur,Num_branche : integer) : integer; var i,adr : integer; trouve,fin : boolean; // trouve si detecteur est dans la branche num_branche à partir de l'index i @@ -6489,7 +6889,7 @@ begin } i:=1; //affiche('------------------------',clWhite); - recherche; + recherche; //affiche('------------------------',clGreen); if trouve then result:=i else result:=0; //affiche('index2='+IntToSTR(index2_det),clWhite); @@ -6531,7 +6931,7 @@ var NBranche,i : integer; begin Nbranche:=1; repeat - i:=index_detecteur(detecteur,Nbranche); + i:=index_detecteur_branche(detecteur,Nbranche); if i=0 then inc(NBranche); until (Nbranche>NbreBranches) or (i<>0); // if (i<>0) and traceDet then Affiche('Détecteur trouvé en branche '+intToSTR(NBranche)+' index='+IntToSTR(i),clYellow); @@ -6554,8 +6954,6 @@ begin IndexBranche_trouve:=i; end; - - // vérifie la configuration du décodeur Unisemaf // si 0 = OK // si 1 = erreur code Unisemaf @@ -7130,13 +7528,17 @@ begin if (btypePrec=aig) then // car btype dans les branches vaut det, aig, buttoir mais jamais tjd ni tjs begin id:=true; - // changer l'adresse du précédent par l'autre adresse de la TJD/S - // V1 index:=index_aig(prec); index:=tablo_index_aiguillage[prec]; md:=aiguillage[index].modele; - if (md=tjs) or (md=tjd) then + // si aiguillage triple : prendre l'adresse de base de l'aig triple + if (md=aig) and aiguillage[index].visible then + begin + prec:=Aiguillage[index].APointe; + end; + + // changer l'adresse du précédent par l'autre adresse de la TJD/S + if (md=tjs) or (md=tjd) then // attention voir si on applique au TJD 2 et 4 états!!!!!!!!!!!!!!!!!!!!!! begin - //V1 prec:=Aiguillage[index_aig(prec)].Ddroit; prec:=Aiguillage[tablo_index_aiguillage[prec]].Ddroit; if NivDebug=3 then AfficheDebug('Le précedent est une TJD/S - substitution du précédent par la pointe de la TJD qui est '+intToSTR(prec),clYellow); end; @@ -9991,6 +10393,7 @@ begin j:=0; prec:=Signaux[i].Adr_det1; + if prec=0 then Begin affiche('Msg 681 : Signal '+intToSTR(adresse)+' détecteur non renseigné',clOrange);result:=0;exit;end; TypeElPrec:=Det; actuel:=Signaux[i].Adr_el_suiv1; if Signaux[i].Btype_suiv1=det then TypeElActuel:=det; // le type du signal 1=détecteur 2=aig 5=bis @@ -10572,6 +10975,7 @@ begin exit; end; prec:=Signaux[i].Adr_det1; + if prec=0 then begin affiche('Msg 683 : Signal '+intToSTR(adresse)+' détecteur non renseigné',clOrange);result:=0;exit;end; TypePrec:=det; actuel:=Signaux[i].Adr_el_suiv1; TypeActuel:=Signaux[i].Btype_suiv1 ; @@ -10730,7 +11134,7 @@ end; // adresse=adresse du signal function test_memoire_zones(adresse : integer) : boolean; var - AdrSuiv,prec,ife,actuel,i,j,it,AdrTr, + AdrSuiv,prec,ife,actuel,i,j,it, dernierdet,AdrSignal,NSignaux,NSigMax,voie1,voie2,indexSig2,indexSig1,ia : integer; TypePrec,TypeActuel : TEquipement; Pres_train : boolean; @@ -10815,8 +11219,8 @@ begin prec:=actuel;TypePrec:=TypeActuel; actuel:=AdrSuiv;TypeActuel:=typeGen; - Adrtr:=Test_train_canton(prec,typePrec,actuel,TypeActuel,true); - pres_train:=(adrTr<>0) or pres_train; + //Adrtr:=Test_train_canton(prec,typePrec,actuel,TypeActuel,true); // non!! + //pres_train:=(adrTr<>0) or pres_train; inc(it); until (typeactuel=det) or pres_Train or (it>100); @@ -11245,8 +11649,8 @@ begin inc(j); AdrSuiv:=suivant_alg3(prec,TypePrec,actuel,TypeActuel,2); // 2 car arrêt sur aiguille en talon mal positionnée // et vérifier si canton - - if adrtr=0 then Adrtr:=Test_train_canton(prec,typePrec,actuel,TypeActuel,false); + // non!! + //if adrtr=0 then Adrtr:=Test_train_canton(prec,typePrec,actuel,TypeActuel,false); if (adrTr<>0) then begin if nivDebug=3 then AfficheDebug('Trouvé train sur canton ',clYellow); @@ -12140,7 +12544,7 @@ begin proc:=Tlibere_canton; param1:=detecteur1; param2:=detecteur2; - //if traceliste or ProcPrinc or affres then + if traceliste or ProcPrinc or affres or debugroulage then affiche('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); if ProcPrinc or traceListe then AfficheDebug('Libère_Canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); @@ -12203,7 +12607,7 @@ begin proc:=Tlibere_canton; param1:=detecteur1; param2:=detecteur2; - //if traceliste or ProcPrinc or affres then + if traceliste or ProcPrinc or affres or debugroulage then affiche('Libère_canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); if ProcPrinc or traceListe then AfficheDebug('Libère_Canton '+intToSTR(detecteur1)+' '+intToSTR(detecteur2),clLime); @@ -12538,7 +12942,7 @@ begin exit; end; - index_signal_det(det2,voie1,indexSig1,voie2,indexSig2); + index_signal_det(det2,voie1,indexSig1,voie2,indexSig2); // renvoie les signaux1 et 2 (on peut avoir les signaux dan les 2 sens) if (indexSig1=0) and (indexSig2=0) then exit; adresse:=0;adresse1:=0;Adresse2:=0;indexSig:=0; @@ -12548,6 +12952,15 @@ begin if signaux[indexSig1].Adr_el_suiv1=detecteur[det2].suivant then indexSig:=indexSig1; if signaux[indexSig2].Adr_el_suiv1=detecteur[det2].suivant then indexSig:=indexSig2; + { + if (det1=523) and (det2=526) then + begin + Affiche('Adresse1='+intToSTR(Adresse1)+' IndexSig2='+intToSTR(Adresse2),clred); + Affiche('ADrElSuiv1 du signal1='+intToSTR(signaux[indexSig1].Adr_el_suiv1)+' det2.suivant='+intToSTR(detecteur[det2].suivant),clred); + Affiche('ADrElSuiv1 du signal2='+intToSTR(signaux[indexSig1].Adr_el_suiv1)+' det2.suivant='+intToSTR(detecteur[det2].suivant),clred); + end; + } + if indexSig=0 then exit; // non pas dans le bon sens adresse:=signaux[indexsig].adresse; etat:=Signaux[indexSig].EtatSignal; @@ -12595,8 +13008,9 @@ begin if (index_train<>0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (consigne<>0) then + begin + vitesseR:=10*(detecteur[detect].longueur+long_loco)/tps; // vitesse en cm/s + Affiche('Tps='+intToSTR(tps)+' Det='+intToSTR(detect)+' l='+intToSTR(detecteur[detect].longueur)+' Cons='+intToSTR(consigne)+' V='+FloatToSTRF(vitesser,ffFixed,35,1)+' cm/s ',clWhite); + + if trains[indexTrain].pointMes>=100 then exit; + inc(trains[indexTrain].pointMes); + n:=trains[indexTrain].pointMes; //nombre de mesures du tableau + + // remplir le tableau de mesures + with trains[indexTrain].mesure[n] do + begin + vitcons:=trains[indexTrain].vitesseCons; + detecteurM:=detect; + temps:=tps; + vr:=vitesser; + end; + + // phase 1 : additionner les vitesses réelles en cm/s par détecteur et par consigne, et compter leur nombre (ncd) + // les stocker dans trains[].detecteurR + begin + with trains[indexTrain] do + begin + inc(detecteurR[detect,consigne].nombre); + //Affiche('Nouvelle phase ',clLime); + ncd:=detecteurR[detect,consigne].nombre; + if (ncd=1) and (detecteurREF=0) then + begin + //Affiche('Détecteur de référence='+intToSTR(detect),clOrange); + detecteurREF:=detect; // détecteur de référence qui sert de bouclage + end; + FormMesure.LabelProg.Caption:=intToSTR(ncd)+'/'+FormMesure.EditNbrePassages.Text; + if (ncd mod NbreArret=0) and (detect=detecteurREF) then + begin + inc(PhaseVitesse); + if PhaseVitesse=2 then + begin + FormMesure.LabelMesC.Top:=202; + Affiche('Mesure vitesse 2',clYellow); + vitesse_loco('',0,trains[indexTrain].adresse,v2,10); + end + else + if PhaseVitesse=3 then + begin + formmesure.LabelMesC.top:=226; + Affiche('Mesure vitesse 3',clyellow); + vitesse_loco('',0,trains[indexTrain].adresse,v3,10); + end + else + if PhaseVitesse>=4 then + begin + formmesure.LabelMesC.Visible:=false; + dec(trains[indexTrain].pointMes); // ne pas prendre en compte la dernière mesure + mesureTrains:=false; + vitesse_loco('',0,trains[indexTrain].adresse,0,10); + Affiche_mesure_trains; + Affiche('Fin des mesures',clWhite); + with formMesure do + begin + ComboBoxTrains.Enabled:=true; + ButtonLanceMes.Enabled:=true; + end; + exit; + end; + end; + + + //Affiche('INC det'+intToSTR(detect)+' ='+intToSTR(ncd),clWhite); + if (mesure[n].detecteurM=detect) and (mesure[n].vitcons=consigne) and (consigne<>0) and (detect<>0) then + begin + //Affiche('Ajout de '+FloatToSTRF(vitesser,ffFixed,35,1)+' à '+FloatToSTRF(detecteurR[detect,consigne].somme,ffFixed,35,1),clLime); + detecteurR[detect,consigne].somme:=detecteurR[detect,consigne].somme+vitesseR; + detecteurR[detect,consigne].moyenne:=detecteurR[detect,consigne].somme/ncd; + end + else + begin + // Affiche('Refusé car ',clred); + // if consigne=0 then Affiche_suivi('consigne=0',clred); + end; + + // phase 2: mesurer les écarts entre les vitesses sur les détecteurs par vitesse de consigne + n:=0; + moy:=0; + // 1ere boucle pour déterminer la moyenne de la vitesse consigne + for j:=1 to nbMaxDet do + begin + vm:=detecteurR[j,consigne].moyenne; + if vm<>0 then + begin + inc(n); + moy:=moy+vm; + end; + end; + if n<>0 then + begin + moy:=moy/n; + ecartMin:=9999; + // 2eme boucle pour calculer l'écart entre les valeurs + for j:=1 to nbMaxDet do + begin + vm:=detecteurR[j,consigne].moyenne; + if vm<>0 then + begin + //Affiche(FloatToSTRF(vm,ffFixed,5,1),clOrange); + detecteurR[j,consigne].ecart:=abs(vm-moy); + Ecart:=round(abs(vm-moy)); + if ecartMin>Ecart then // on choisit le mini de l'écart pour calculer le coeff de vitesse + begin + EcartMin:=Ecart; + // Affiche(intToSTR(consigne)+' '+FloatToSTRF(vm,ffFixed,5,2),clOrange); + case phaseVitesse of + 1 : begin consV1:=consigne;coeffV1:=consigne/vm;end; // coefficient du train sauvegarde dans train + 2 : begin consV2:=consigne;coeffV2:=consigne/vm;end; // coeff = Consigne (crans) / Vitesse en (cm/s) + 3 : begin consV3:=consigne;coeffV3:=consigne/vm;calcul_equations_coeff(indexTrain);end; + end; + end; + end; + end; + end; + end; + end; + end; + detecteur[detect].Temps_cour:=0; // arret incrémente le compteur +end; // calcul des zones depuis le tableau des fronts montants ou descendants des évènements détecteurs // transmis dans le tableau Event_det @@ -12852,7 +13456,7 @@ end; // les aiguillages doivent être positionnés procedure calcul_zones_V1(adresse: integer;etat : boolean); var m,AdrSignal,AdrDetSignal,AdrTrainLoc,Nbre,i,i2,j,k,l,n,det1,det2,det3,det4,AdrSuiv,AdrPrec,Prev, - id_couleur,det_suiv,nc,etatSig,ntco,d1,d2,sens,idT,sensTCO,suivant2,prec,indexTrain, + id_couleur,det_suiv,nc,etatSig,ntco,d1,d2,sens,sensTCO,suivant2,prec,indexTrain, a1,a2 : integer ; traite,trouve,SuivOk1,Suivok2,casaig,rebond,finroute,but : boolean; couleur : tcolor; @@ -12939,9 +13543,12 @@ begin end else begin - idt:=Index_train_adresse(AdrTrainLoc); - if idt<>0 then trains[idt].detecteurSuiv:=AdrSuiv // affecter le détecteur suivant au train - else trains[i].detecteurSuiv:=AdrSuiv; + indexTrain:=Index_train_adresse(AdrTrainLoc); + if indexTrain<>0 then + begin + Trains[indexTrain].detecteurSuiv:=AdrSuiv; + end + else trains[i].detecteurSuiv:=AdrSuiv; end; //*** route validée *** if (det1nil then begin // désactivation - Zone_TCO(ntco,det1,det3,i,AdrTrainLoc,0,true); // tco,det1,det2,train, mode + Zone_TCO(ntco,det1,det3,i,AdrTrainLoc,0,true,true); // tco,det1,det2,train, mode // activation - if ModeCouleurCanton=0 then zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,1,true) - else zone_TCO(ntco,det3,adrSuiv,i,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train + if ModeCouleurCanton=0 then zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,1,true,true) + else zone_TCO(ntco,det3,adrSuiv,i,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train end; end; Maj_Signaux(false); @@ -13015,10 +13622,10 @@ begin begin Affiche_evt('1-0 Train '+intToSTR(i)+' Eléments '+intToSTR(det1)+' et '+intToSTR(det3)+' non contigus',clyellow); AdrTrainLoc:=detecteur[det3].AdrTrain; - idt:=index_train_Adresse(AdrTrainLoc); - if idt<>0 then + // idt:=index_train_Adresse(AdrTrainLoc); + if indexTrain<>0 then begin - det_Suiv:=trains[idt].detecteurSuiv; + det_Suiv:=trains[indexTrain].detecteurSuiv; {event_det_train[i].NbEl:=2; event_det_train[i].Det[1].adresse:=det3; event_det_train[i].Det[1].etat:=false; @@ -13029,9 +13636,9 @@ begin MemZone[det3,det_suiv].AdrTrain:=AdrTrainLoc; for ntco:=1 to nbreTCO do begin - raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc - if ModeCouleurCanton=0 then zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,1,true) - else zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train + //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc + if ModeCouleurCanton=0 then zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,1,true,true) + else zone_TCO(ntco,det3,det_suiv,i,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train end; end; for ntco:=1 to nbreTCO do @@ -13067,25 +13674,19 @@ begin begin Train_ch:=event_det_train[i].nom_train; AdrTrainLoc:=event_det_train[i].AdrTrain; - + indexTrain:=index_train_adresse(adrTrainLoc); event_det_tick[N_event_tick].train:=i; - // en mode roulage, on a placé les trains - //if roulage then + detecteur[det3].Temps_cour:=1; + trains[indexTrain].VitesseDetE:=trains[indexTrain].VitesseCons; + begin - { j:=1; - repeat - trouve:=trains[j].detdir=det3; - inc(j); - until (j>6) or trouve; - dec(j);} - //si début de démarrage train i - //if trouve and (TrainZone[i].Nbre=0) and (det10 then trains[idt].detecteurSuiv:=det_suiv // affecter le détecteur suivant au train + indexTrain:=Index_train_adresse(AdrTrainLoc); + if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=det_suiv // affecter le détecteur suivant au train else trains[i].detecteurSuiv:=det_suiv; end else @@ -13138,9 +13740,8 @@ begin // activation for ntco:=1 to nbreTCO do begin - raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc - if ModeCouleurCanton=0 then zone_TCO(ntco,det1,det3,i,AdrTrainLoc,1,true) - else zone_TCO(ntco,det1,det3,i,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train + if ModeCouleurCanton=0 then zone_TCO(ntco,det1,det3,i,AdrTrainLoc,1,true,true) + else zone_TCO(ntco,det1,det3,i,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train end; end; end; @@ -13150,7 +13751,7 @@ begin // actualiser le signal du det3 j:=signal_detecteur(det3); if j<>0 then Maj_Signal_P(j,false); - maj_route(det3); + if roulage then maj_route(det3); maj_signaux(false); exit; end; @@ -13209,9 +13810,15 @@ begin if TraceListe then AfficheDebug('Route est valide, dét '+intToSTR(det2)+' '+intToSTR(det3)+' contigus',couleur); // ici on cherche le suivant à det2 det3, algo=1 event_det_tick[N_event_tick].train:=i; + indexTrain:=Index_train_adresse(AdrTrainLoc); if not(casAig) and not(but) then AdrSuiv:=detecteur_suivant_el(det2,det,det3,det,0); // dans le cas de CasAig, alors adrSuiv=9996 donc AdrSuiv a été calculé plus haut (ligne -27) - if AdrSuiv<9990 then event_det_train[i].suivant:=AdrSuiv; + if AdrSuiv<9990 then + begin + event_det_train[i].suivant:=AdrSuiv; + if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=AdrSuiv // affecter le détecteur sursuivant au train + else trains[i].detecteurSuiv:=AdrSuiv; + end; if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur); if (Adrsuiv>=9990) and not(casaig) then begin @@ -13233,6 +13840,7 @@ begin // exit; // end; //end; + if (det20 then trains[idt].detecteurSuiv:=det4 // affecter le détecteur suivant au train - else trains[i].detecteurSuiv:=det4; + indexTrain:=Index_train_adresse(AdrTrainLoc); + // if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=det4 // affecter le détecteur sursuivant au train + // else trains[i].detecteurSuiv:=det4; + // Affiche('P3 detsuiv='+intToSTR(det4),clYellow); + end; + + // calculer la constante de vitesse du train + if indexTrain<>0 then + begin + calcul_vitesse_train(indextrain,det3); end; // stockage dans historique de zones @@ -13331,7 +13946,7 @@ begin s:='Train '+IntToSTR(i); if AdrTrainLoc<>0 then s:=s+' '+train_ch+' @'+intToSTR(AdrTrainLoc); s:=s+' sur zones '+IntToSTR(det3)+' à '+IntToStr(AdrSuiv); - Affiche(s,Couleur); + if AffLoc then Affiche(s,Couleur); if AffAigDet then AfficheDebug(s,couleur); Affiche_Evt('1.Tampon train '+intToStr(i)+' '+event_det_train[i].nom_train+'--------',couleur); @@ -13351,17 +13966,17 @@ begin if PcanvasTCO[ntco]<>nil then begin Maj_Aig_TCO(ntco); - zone_TCO(ntco,det2,det3,i,AdrTrainLoc,0,true); // désactivation + zone_TCO(ntco,det2,det3,i,AdrTrainLoc,0,true,true); // désactivation // activation //affiche('Efface train '+intToSTR(AdrTrainLoc),clred); - raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train - if ModeCouleurCanton=0 then zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,1,true) - else zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train + //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train + if ModeCouleurCanton=0 then zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,1,true,true) + else zone_TCO(ntco,det3,AdrSuiv,i,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train end; end; //Affiche('§§§ Le canton 7 contient le train '+intToSTR(canton[7].indexTrain),clWhite); - maj_route(det3); + if roulage then maj_route(det3); // mettre à jour si présence signal sur det3 pour le passer au rouge de suite j:=signal_detecteur(det3); if j<>0 then @@ -13413,6 +14028,7 @@ begin MemZone[det3,det2].etat:=False; // on dévalide la zone inverse Train_ch:=MemZone[det2,det3].train; AdrTrainLoc:=MemZone[det2,det3].AdrTrain; + IndexTrain:=index_train_adresse(AdrTrainLoc); detecteur[det3].train:=Train_ch; // affectation nom train au nouveau détecteur detecteur[det3].AdrTrain:=AdrTrainLoc; // affectation train au nouveau détecteur @@ -13427,18 +14043,24 @@ begin detecteur[det2].AdrTrain:=0; detecteur[det2].IndexTrainRoulant:=0; - i2:=index_train_adresse(AdrTrainLoc); - if i2<>0 then trains[i2].index_event_det_train:=i; // lier l'index du train en circulation + if indexTrain<>0 then + begin + trains[indexTrain].detecteurA:=det3; + trains[indexTrain].index_event_det_train:=i; // lier l'index du train en circulation + // lancer la mesure de vitesse + trains[indexTrain].VitesseDetE:=trains[indexTrain].vitesseCons; + detecteur[det3].Temps_cour:=1; + //Affiche('Début comptage det '+intToSTR(det3),clYellow); + //MessageBeep(mb_Iconwarning); + end; pilote_train(det2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant - //det_suiv:=det_suiv_cont(det2,det3,1); /// det_suiv:=detecteur_suivant_el(det2,det,det3,det,1); if det_suiv<9990 then begin - idt:=Index_train_adresse(AdrTrainLoc); - if idt<>0 then trains[idt].detecteurSuiv:=det_Suiv // affecter le détecteur suivant au train + if indexTrain<>0 then trains[indexTrain].detecteurSuiv:=det_Suiv // affecter le détecteur suivant au train else trains[i].detecteurSuiv:=det_Suiv; end else @@ -13482,7 +14104,7 @@ begin // désactivation du morceau avant l'aiguillage efface_trajet(det3,i); end; - maj_route(det3); + if roulage then maj_route(det3); exit; // sortir absolument end else @@ -13501,7 +14123,7 @@ begin if PcanvasTCO[ntco]<>nil then begin Maj_Aig_TCO(ntco); - zone_TCO(ntco,det2,det_suiv,i,AdrTrainLoc,0,true); // désactivation} + zone_TCO(ntco,det2,det_suiv,i,AdrTrainLoc,0,true,true); // désactivation} end; end; with event_det_train[i] do @@ -13566,7 +14188,7 @@ begin pilote_train(i2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant det_suiv:=det_suiv_cont(i2,det3,1); - maj_route(det3); + if roulage then maj_route(det3); Maj_Signaux(true); exit; end; @@ -13594,7 +14216,7 @@ begin nom_train:=''; end; - maj_route(det3); + if roulage then maj_route(det3); // vérifier si le détecteur du nouveau train est associé à un feu vers un buttoir for i:=1 to NbreSignaux do begin @@ -13654,8 +14276,11 @@ begin suivant:=trouve_det_suiv_canton(j,det3,sensTCO); if suivant>9990 then exit; adrTrainLoc:=canton[j].adresseTrain; - event_det_train[n_trains].suivant:=suivant; + IndexTrain:=index_train_adresse(AdrTrainLoc); + trains[IndexTrain].detecteurSuiv:=suivant; + event_det_train[n_trains].suivant:=suivant; + detecteur[det3].Train:=canton[j].NomTrain; detecteur[det3].AdrTrain:=AdrTrainLoc; detecteur[det3].IndexTrainRoulant:=n_trains; @@ -13670,9 +14295,9 @@ begin index_couleur:=((n_trains - 1) mod NbCouleurTrain) +1; for ntco:=1 to nbreTCO do begin - raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc - if ModeCouleurCanton=0 then zone_TCO(ntco,det3,suivant,AdrTrainloc,0,1,true) - else zone_TCO(ntco,det3,suivant,n_trains,AdrTrainLoc,2,true); // affichage avec la couleur de index_couleur du train + //raz_cantons_train(AdrTrainLoc); // efface tous les cantons contenant le train adrloc + if ModeCouleurCanton=0 then zone_TCO(ntco,det3,suivant,AdrTrainloc,0,1,true,true) + else zone_TCO(ntco,det3,suivant,n_trains,AdrTrainLoc,2,true,true); // affichage avec la couleur de index_couleur du train end; pilote_train(0,det3,adrtrainLoc,n_trains); // pilote le train sur det3 @@ -14067,7 +14692,7 @@ procedure action_operation(i,ida : integer); var decl,op,af,access,sortie,t,v,etat : integer; st,trainDest : string; Ts : TAccessoire; - tr : double; + tr : single; begin st:='Action '+Tablo_Action[i].NomAction+' : '; op:=Tablo_Action[i].tabloOp[ida].numoperation; @@ -14163,7 +14788,7 @@ begin begin traindest:=Tablo_Action[i].tabloOp[ida].train; Affiche(st+' Vitesse train='+trainDest+' à '+IntToSTR(Tablo_Action[i].tabloOp[ida].vitesse),clyellow); - vitesse_loco(trainDest,0,0,Tablo_Action[i].tabloOp[ida].vitesse,true); + vitesse_loco(trainDest,0,0,Tablo_Action[i].tabloOp[ida].vitesse,10); end; // 11 : commande COM/USB socket @@ -14181,12 +14806,13 @@ begin begin trainDest:=Tablo_Action[i].tabloOp[ida].train; // exécution de la fonction F vers CDM - etat:=Tablo_Action[i].tabloop[ida].TempoF; - tr:=etat/10; - Affiche(st+' TrainDest='+trainDest+' F'+IntToSTR(Tablo_Action[i].tabloOp[ida].fonctionF)+' t='+Format('%.1f', [tr])+'s',clyellow); + etat:=Tablo_Action[i].tabloop[ida].etat; + + tr:=Tablo_Action[i].tabloop[ida].TempoF/10; + Affiche(st+' TrainDest='+trainDest+' F'+IntToSTR(Tablo_Action[i].tabloOp[ida].fonctionF)+':'+intToSTR(etat)+' t='+Format('%.1f', [tr])+'s',clyellow); envoie_fonction_CDM(Tablo_Action[i].TabloOp[ida].fonctionF,etat,trainDest); Tablo_Action[i].tabloOp[ida].TrainCourant:=trainDest; // pour mémoriser le train pour la retombée de la fonction - Tablo_Action[i].TabloOp[ida].TempoCourante:=etat; + Tablo_Action[i].TabloOp[ida].TempoCourante:=Tablo_Action[i].tabloop[ida].TempoF; end; // 13 : son @@ -14288,7 +14914,7 @@ begin if adr>1024 then begin - Affiche('Erreur 81 : reçu adresse accessoire trop grande : '+intToSTR(adr),clred); + Affiche('Erreur 281 : reçu adresse accessoire trop grande : '+intToSTR(adr),clred); exit; end; @@ -14585,6 +15211,46 @@ begin if not(configNulle) then Maj_Signaux(false); // on ne traite pas les calculs si CDM en envoie plusieurs end; +// calcule la distance incrémentale en mm en fonction du temps en 1/10 et de la vitesse en cran du train d'index i +function distance_temps_incr(temps,i : integer) : integer; +var adrDet,vitesse,vitesseAbs : integer; + vitR,coeff,incr,d : single; +begin + if i<1 then begin result:=0;exit;end; + with trains[i] do + begin + vitesse:=VitesseReelle; + vitesseAbs:=abs(Vitesse); + if vitesse=0 then + begin + AdrDet:=detecteurA; + result:=round(detecteur[AdrDet].DistIncr); + exit; + end; + + coeff:=0; + if vitesseAbs0 then result:=round((vitesse*temps/10)/coeff) en cm + //temps:=temps-round(180*coeff/vitesse); // il ne faut pas enlever la distance de la loco, car on mesure en incrémetal + if (coeff<>0) and (coeff<9999) then + begin + incr:=(vitesseAbs*temps)/coeff; // en mm + adrDet:=detecteurA; + d:=detecteur[AdrDet].DistIncr; + if d=0 then d:=6*incr; // valeur initiale, pour l'intertie de mesure due a la vitesse + detecteur[adrDet].DistIncr:=d+incr; + // if debugRoulage then affiche('VitR='+intToSTR(vitesse)+' Incr='+intToSTR(round(incr))+' Dist='+intToSTR(round(detecteur[adrDet].DistIncr)),clYellow); + result:=round(detecteur[adrDet].distIncr); + end + else result:=round(temps*9/vitesseAbs); // si non étalonné, formule empirique + end; + + if coeff<>0 then vitR:=vitesseAbs/coeff; + // Affiche('Vitesse réelle='+intTostr(round(vitR))+' cm/s Temps='+intToSTR(temps),clYellow); +end; + // traitement des évènements détecteurs procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); @@ -14592,6 +15258,7 @@ var dr,i,AdrSuiv,AdrSignal,AdrDetSignal,index,Etat01,AdrPrec,d1,d2,AdrTrain : in TypeSuiv : tequipement; s : string; begin + //Affiche('Event Det '+inTToSTR(adresse)+' '+IntToSTR(etat01)+' '+train,ClCyan); if adresse>NbMaxDet then begin Affiche('Erreur 82 : reçu adresse de détecteur trop grande : '+intToSTR(adresse),clred); @@ -14627,7 +15294,7 @@ begin //if (train='') and (s<>'') then train:=s; if Etat then Etat01:=1 else Etat01:=0; - if traceliste or debugRoulage then Affiche('Event Det '+inTToSTR(adresse)+' '+IntToSTR(etat01),ClCyan); + if traceliste or (debugRoulage and roulage) then Affiche('Event Det '+inTToSTR(adresse)+' '+IntToSTR(etat01),ClCyan); // vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état // on reçoit un doublon dans deux index consécutifs. (* @@ -14645,9 +15312,10 @@ begin begin //s:='Evt Det '+intToSTR(adresse)+'='+intToSTR(etat01); s:='Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01)+' Train='+train; + if not etat then s:=s+' t='+IntToSTR(detecteur[adresse].ComptCour); AfficheDebug(s,clyellow); end; - if AFfDetSIg then AfficheDebug('Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01),clOrange); + if AFfDetSig then AfficheDebug('Tick='+IntToSTR(tick)+' Evt Det='+IntToSTR(adresse)+'='+intToSTR(etat01),clOrange); ancien_detecteur[Adresse]:=detecteur[Adresse].etat; detecteur[Adresse].etat:=etat; @@ -14660,6 +15328,7 @@ begin end; detecteur_chgt:=Adresse; + // stocke les changements d'état des détecteurs dans le tableau chronologique if (N_Event_tick>=Max_Event_det_tick) then begin @@ -14681,7 +15350,7 @@ begin repeat d1:=canton[i].el1;t1:=canton[i].typ1; d2:=canton[i].el2;t2:=canton[i].typ2; - if (d1=adresse) or (d2=adresse) then + if ((d1=adresse) and (t1=det)) or ((d2=adresse) and (t2=det)) then begin AdrTrain:=canton[i].adresseTrain; if AdrTrain<>0 then @@ -14709,6 +15378,12 @@ begin inc(N_event_det); if algo_localisation=1 then event_det[N_event_det].adresse:=Adresse; event_det[N_event_det].etat:=true; + with detecteur[adresse] do + begin + distCour:=0; + ComptCour:=0; + end; + detecteur[Adresse].distIncr:=0; if not(confignulle) then //explore les signaux pour voir si on démarre d'un buttoir @@ -14732,13 +15407,15 @@ begin end; end; - // gérer l'évènement actionneur pour action if etat then i:=1 else i:=0; - if not(confignulle) then calcul_zones(adresse,true); + if not(confignulle) then calcul_zones(adresse,true); // *** calcul zones + + // gérer l'évènement actionneur pour action event_act(Adresse,0,i,''); end; // détection fronts descendants + if ancien_detecteur[Adresse] and not(detecteur[Adresse].etat) and (N_Event_det0 then trains[idTrain].detecteurA:=adresse; + if etat then i:=1 else i:=0; + if not(confignulle) then calcul_zones(adresse,false); // *** calcul zones + + // gérer l'évènement detecteur pour action + event_act(Adresse,0,i,train); + + + end; end; if (N_event_det>=Max_event_det) then @@ -14783,10 +15465,6 @@ begin end; - // calcul distance loco - // AdrTrain:=detecteur[Adresse].AdrTrain; - detecteur[adresse].temps:=0; - // Envoyer évent vers périphériques si le service est demandé for i:=1 to NbPeriph do begin @@ -14822,7 +15500,7 @@ begin // Serveur envoi au clients Envoi_serveur('D'+intToSTR(adresse)+','+intToSTR(etat01)+','+train); - // Maj TCOs + // Maj des détecteurs des TCOs for i:=1 to nbreTCO do begin if PCanvasTCO[i]<>nil then Maj_TCO(i,Adresse); @@ -15083,13 +15761,13 @@ begin envoi_CDM(s); result:=true; - exit; + //exit; end; if (pilotage=0) or (pilotage>2) then begin result:=true;exit;end; // pilotage par USB ou par éthernet de la centrale ------------ - if (portCommOuvert or parSocketLenz) then + if (portCommOuvert or parSocketLenz) and not CDM_connecte then begin if hors_tension then begin @@ -15115,7 +15793,7 @@ begin // si aiguillage, faire une temporisation if Acc=AigP then begin - temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; + temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; if portCommOuvert or parSocketLenz then tempo2(temp); end; @@ -15126,7 +15804,7 @@ begin if avecAck then envoi(s) else envoi_ss_ack(s); // envoi de la trame avec ou sans Ack //affiche('5.'+intToSTR(tick),clyellow); result:=true; - exit; + //exit; end; if protocole=2 then // dcc++ @@ -15140,7 +15818,7 @@ begin //Affiche(s,clYellow); envoi(s); result:=true; - exit; + //exit; end; end; @@ -15642,35 +16320,24 @@ begin result:=x=0; end; +// supprime en décalant une longueur à partir de l'offset procedure Delete_tablo(var cb : TchaineBIN;offset,longueur : integer); var i,j : integer; begin if (Long_recue4 then begin // supprimer l'entete éventuelle FFFE ou FFFD - if (chaineINT[1]=$ff) and ((chaineINT[2]=$fe) or (chaineINT[2]=$fd)) then Delete_tablo(chaineINT,1,2); + if (chaine_recue[1]=$ff) and ((chaine_recue[2]=$fe) or (chaine_recue[2]=$fd)) then Delete_tablo(chaine_recue,1,2); end; l:=Long_recue; - if (chaineINT[1]=$01) then + if (chaine_recue[1]=$01) then begin nOctets:=3; connu:=true; if (l>=nOctets) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin - case chaineINT[2] of // page 13 doc XpressNet + case chaine_recue[2] of // page 13 doc XpressNet $01 : begin nack:=true;msg:='Erreur timeout transmission - Voir doc XpressNet p13';end; $02 : begin nack:=true;msg:='Erreur timout centrale - Voir doc XpressNet p13';end; $03 : begin nack:=true;msg:='Erreur communication inconnue - Voir doc XpressNet p13';end; @@ -15711,80 +16378,80 @@ begin $05 : begin nack:=true;msg:='Plus de time slot - Voir doc XpressNet p13';end; $06 : begin nack:=true;msg:='Débordement tampon LI100 - Voir doc XpressNet p13';end; end; - if traceTrames and (chaineINT[2]=4) then AfficheDebug(msg,clYellow); - if traceTrames and (chaineINT[2]<>4) then AfficheDebug(msg,clRed); - if (chaineINT[2]<>$4) then Affiche(msg,clRed); + if traceTrames and (chaine_recue[2]=4) then AfficheDebug(msg,clYellow); + if traceTrames and (chaine_recue[2]<>4) then AfficheDebug(msg,clRed); + if (chaine_recue[2]<>$4) then Affiche(msg,clRed); traite:=true; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(chaineINT),clred); + AfficheDebug('ErrCheck_01: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else - if (chaineINT[1]=$02) then + if (chaine_recue[1]=$02) then begin connu:=true; nOctets:=4; if (l>=nOctets) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin - msg:='Version matérielle '+intTohex(chaineINT[2],2)+' - Version soft '+intToHex(chaineINT[3],2); + msg:='Version matérielle '+intTohex(chaine_recue[2],2)+' - Version soft '+intToHex(chaine_recue[3],2); Affiche(msg,clYellow); - version_Interface:=intToSTR(chaineint[2]); + version_Interface:=intToSTR(chaine_recue[2]); traite:=true; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_02: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else - // accessory decodeur information response $40+N 40 N=1 à 14 - if (ord(chaineINT[1]) and $F0)=$40 then + // accessory decodeur information response $40+N 40 N=1 à 14 ex: 42 41 40 43 ou 44 xx xx yy yy + if (ord(chaine_recue[1]) and $F0)=$40 then begin connu:=true; - n:=(chaineINT[1]) and $0F; // nombre d'octets (doit être pair) - nOctets:=n+2; + n:=chaine_recue[1] and $0F; // nombre d'octets (doit être pair) + nOctets:=n+2; // nombre d'octets du message (+check + le premier) + if (l>=nOctets) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin n:= n div 2; for i:=1 to n do begin - decode_retro_XpressNet((chaineInt[i*2]),(chaineInt[i*2+1])); + decode_retro_XpressNet(chaine_recue[i*2],chaine_recue[i*2+1]); // traitement long end; traite:=true; end else begin - s:='ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)); - if TraceTrames then AfficheDebug(s,clred); + s:='ErrCheck_4X: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets'; + AfficheDebug(s,clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else - // recu 61 01 60 - if (chaineINT[1]=$61) then + if (chaine_recue[1]=$61) then begin nOctets:=3; connu:=true; if l>=nOctets then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin - case chaineINT[2] of + case chaine_recue[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; @@ -15814,62 +16481,62 @@ begin end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_61: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else - if (chaineINT[1]=$63) then // V3.6 uniquement + if (chaine_recue[1]=$63) then // V3.6 uniquement begin connu:=true; nOctets:=5; if (l>=nOctets) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin - if chaineINT[2]=$14 then + if chaine_recue[2]=$14 then begin // réception d'un CV. DocXpressNet p26 63 14 01 03 chk - cvLoc:=(chaineINT[3]); - //Affiche('Réception CV'+IntToSTR(cvLoc)+' à '+IntToSTR(ord(chaineINT[2])),clyellow); + cvLoc:=(chaine_recue[3]); + //Affiche('Réception CV'+IntToSTR(cvLoc)+' à '+IntToSTR(ord(chaine_recue[2])),clyellow); if cvLoc>255 then Affiche('Erreur Recu CV>255',clRed) else begin - tablo_cv[cvLoc]:=(chaineINT[4]); + tablo_cv[cvLoc]:=(chaine_recue[4]); inc(N_Cv); // nombre de CV recus end; recu_cv:=true; traite:=true; end; - if chaineINT[2]=$10 then + if chaine_recue[2]=$10 then begin traite:=true; end; - if chaineINT[2]=$21 then + if chaine_recue[2]=$21 then begin traite:=true; end; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_63: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else // 81 00 mise hors tension - if (chaineINT[1]=$81) then // arrêt urgence 3 octets + if (chaine_recue[1]=$81) then // arrêt urgence 3 octets begin connu:=true; nOctets:=3; if (l>=3) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin Affiche('Voie hors tension msg1',clRed); Hors_tension:=true; @@ -15877,9 +16544,9 @@ begin end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_81: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else @@ -15892,21 +16559,21 @@ begin // A3 5 // A4 6 - if (chaineInt[1]=$E1) then + if (chaine_recue[1]=$E1) then begin NOctets:=3; connu:=true; if (l>=NOctets) then begin - if check(chaineINT,NOctets) then + if check(chaine_recue,NOctets) then begin traite:=true; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,NOctets)),clred); + AfficheDebug('ErrCheck_E1: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineInt,1,NOctets); + delete_tablo(chaine_recue,1,NOctets); end; end else @@ -15914,52 +16581,52 @@ begin // E2 4 // E3 - if (chaineInt[1]=$E3) then + if (chaine_recue[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 + if check(chaine_recue,nOctets) then begin - if chaineInt[1]=$40 then + if chaine_recue[1]=$40 then begin end; - if chaineInt[2]=$50 then + if chaine_recue[2]=$50 then begin end; traite:=true; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_E3: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineInt,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else // E4 id speed FcA FcB xor loco information - if (chaineInt[1]=$E4) then + if (chaine_recue[1]=$E4) then begin connu:=true; nOctets:=6; if (l>=nOctets) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin - AdrTrainLoc:=(chaineInt[2]); // identification - i:=(chaineInt[3]); // vitesse - Fa:=(chaineInt[4]); // fonction A - Fb:=(chaineInt[5]); // fonction B + AdrTrainLoc:=(chaine_recue[2]); // identification + i:=(chaine_recue[3]); // vitesse + Fa:=(chaine_recue[4]); // fonction A en var globale + Fb:=(chaine_recue[5]); // fonction B en var globale traite:=true; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_E4: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineInt,1,nOctets); + delete_tablo(chaine_recue,1,nOctets); end; end else @@ -15968,47 +16635,50 @@ begin // E6 8 // spécifique Z21 : E7 0C 89 00 00 00 00 00 62 - // E7 0C 8F 00 00 00 00 00 64 + // E7 0C 8F 00 00 00 00 00 64 // on n'en fait rien, c'est un genre d'ack à la réponse de stop loco ? - if (chaineINT[1]=$E7) then + if (chaine_recue[1]=$E7) then begin connu:=true; nOctets:=9; if (l>=nOctets) then begin - if check(chaineINT,nOctets) then + if check(chaine_recue,nOctets) then begin traite:=true; end else begin - if TraceTrames then AfficheDebug('ErrCheck '+tablo_hex(copy_tablo(chaineINT,1,nOctets)),clred); + AfficheDebug('ErrCheck_E7: '+copy(tablo_hex(chaine_recue),1,noctets*3)+' : '+intToSTR(nOctets)+' octets',clred); end; - delete_tablo(chaineINT,1,nOctets); + delete_tablo(chaine_recue,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 '+intToHex(chaineINT[1],2),clred); - delete_tablo(chaineINT,1,1); + if traceTrames then AfficheDebug('Suppression '+intToHex(chaine_recue[1],2),clred); + delete_tablo(chaine_recue,1,1); traite:=true; end; - until ((Long_recue<3) or not(traite) or (it>20)); // conditions de sortie du repeat until + until ((Long_recue<3) or not(traite) or (it>=100)); // conditions de sortie du repeat until - if it>=20 then + if it>=100 then begin - s:='Erreur 623 : itérations trames XpressNet'; + s:=''; + for i:=1 to long_recue do s:=s+intToHex(chaine_recue[i],2)+' '; + s:='Erreur 623 : itérations trames XpressNet n='+intToSTR(long_recue)+' '+s; Affiche(s,clred); AfficheDebug(s,clred); Long_recue:=0; end; - decode_chaine_retro_Xpress:=chaineINT; + //decode_chaine_retro_Xpress:=chaineINT; end; + function pos_tablo(b : byte;t : tchaineBIN) : integer; var i : integer; trouve : boolean; @@ -16024,17 +16694,18 @@ end; // procédure appellée après réception sur le port USB ou socket // la chaine peut contenir plusieurs informations // on boucle tant qu'on a pas traitée toute la chaine -function interprete_reponse(chaine : tchaineBIN): tchaineBIN; -var chaineInt: TchaineBIN; +procedure interprete_reponse; +var //chaineInt: TchaineBIN; s : string; i,j : integer; balise : boolean; c : char; begin - chaineINT:=chaine; + //chaineINT:=chaine; if protocole=1 then // xpressNet begin - chaineINT:=decode_chaine_retro_Xpress(chaineINT); + decode_chaine_retro_Xpress; + //chaineINT:=decode_chaine_retro_Xpress(chaineINT); end; if protocole=2 then // Dccpp @@ -16043,7 +16714,7 @@ begin s:=''; for i:=1 to Long_recue do begin - c:=char(chaine[i]); + c:=char(chaine_recue[i]); if c<>#0 then s:=s+c else Affiche('DCC caractère #0 filtré',clOrange); end; i:=pos('<',s); @@ -16057,11 +16728,11 @@ begin end; // if not(balise) then Affiche(s,clLime); // retransformer en tchaineBIN - for i:=1 to length(s) do chaineINT[i]:=ord(s[i]); + for i:=1 to length(s) do chaine_recue[i]:=ord(s[i]); long_recue:=length(s); end; - interprete_reponse:=chaineINT; + //interprete_reponse:=chaineINT; end; function HexToStr(s: string) : string ; @@ -16254,26 +16925,108 @@ begin until (s='') or (i>MaxCdeDccpp); end; +procedure init_aig_det; +begin + modeStkRetro:=false; // avec evt + demande_etat_det; + + if not(ConfigNulle) and not(fermeSC) and (AvecInitAiguillages) then + begin + if maxaiguillage>0 then + begin + Affiche('Positionnement des aiguillages',clcyan); + init_aiguillages; // initialisation des aiguillages + end; + end; + 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; + Maj_Signaux(false); + Maj_Signaux(false); +end; + procedure connecte_interface_ethernet; +var trouve : boolean; begin etat_init_interface:=0; // ouvrir socket vers la centrale // Initialisation de la comm socket LENZ if AdresseIP<>'0' then begin - procetape('Ouverture interface socket'); etat_init_interface:=10; Affiche('Demande ouverture interface par Ethernet '+AdresseIP+':'+intToSTR(portinterface),clyellow); - with formprinc.ClientSocketInterface do + {$IFDEF AvecIdTCP} + with ClientSocketIdInterface do + {$ELSE} + with ClientSocketInterface do + {$ENDIF} + begin + {$IFDEF AvecIdTCP} + port:=portInterface; // composant Indy + //ClientSocketInterface. + host:=AdresseIP; + try + {$IF CompilerVersion >= 28.0} // si delphi>=12 + ConnectTimeOut:=1000; + connect; + {$ELSE} + connect(1000); + {$IFEND} + except + on e : exception do + begin + Affiche(e.message+' socket interface '+AdresseIP,clred); + exit; + end; + end; + + Affiche('Socket interface connecté ',clYellow); + AfficheDebug('Socket interface connecté ',clYellow); + with formprinc do + begin + ButtonEcrCV.Enabled:=true; + ButtonLitCV.Enabled:=true; + LireunfichierdeCV1.enabled:=true; + LabelTitre.caption:=titre+' Interface connectée par Ethernet'; + Formprinc.StatusBar1.Panels[4].Text:=AdresseIP; + etat_init_interface:=11; + trouve:=test_protocole; // appelle l'état des détecteurs + end; + if not trouve then + begin + Affiche('Socket connecté mais centrale muette',clred); + disconnect; + etat_init_interface:=0; + exit; + end; + if protocole=1 then + begin + etat_init_interface:=20; // interface protocole reconnue + parSocketLenz:=true; + end; + if (protocole=2) then + begin + init_dccpp; + etat_init_interface:=20; + end; + // interface ethernet connectée, faire les init + init_aig_det; + + {$ELSE} port:=portInterface; - Address:=AdresseIP; + Address:=AdresseIP; // ne pas mettre active et open en même temps, ca génère 2 evt onConnect et initialise les aig 2 fois. Open; + {$ENDIF} end; //Application.processMessages; end; end; + // connecte la centrale en USB/COM en explorant les ports USB/COM de 1 à MaxComPort // et demande les états des détecteurs procedure connecte_usb; @@ -16330,8 +17083,9 @@ begin init_dccpp; etat_init_interface:=20; end; - modeStkRetro:=false; // avec evt - demande_etat_det; + + init_aig_det; + end; end; @@ -16359,7 +17113,6 @@ end; function ProcessRunning(sExeName: String) : Boolean; var hSnapShot : THandle; ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 - t : ModuleEntry32; processID : DWord; //s : array[0..MAX_PATH - 1] of char; //PAnsiChar; begin @@ -16378,7 +17131,7 @@ begin begin processID:=ProcessEntry32.th32ProcessID; CDMhd:=GetWindowFromID(processID); - Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); + //Affiche('CDM rail processID='+IntToSTR(ProcessID)+' handle='+IntToSTR(CDMhd),clOrange); Result:=true; // marche pas - devrait récuperer le chemin d'install //n:=GetModuleFileNameExA(ProcessID,0, pchar(s), MAX_PATH); @@ -16504,9 +17257,9 @@ begin deconnecte_USB; Affiche('Lance les fonctions automatiques de CDM',clyellow); SetForegroundWindow(formprinc.Handle); // met SC devant - Sleep(300*TempoTC); + Sleep(500*TempoTC); Application.processMessages; - Sleep(400*tempoTC); // attend le lancement de CDM + Sleep(500*tempoTC); // attend le lancement de CDM if serveurIPCDM_touche then sleep(300*tempoTC); ProcessRunning(s); // récupérer le handle de CDM SetForegroundWindow(CDMhd); // met CDM en premier plan pour le télécommander par le clavier simulé @@ -16571,14 +17324,17 @@ begin KeybdInput(VK_DOWN,0); KeybdInput(VK_DOWN,KEYEVENTF_KEYUP); end; - // 2x TAB pour pointer sur OK + // 3x TAB pour pointer sur OK KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); + KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); // 3 TAB depuis version 24.10 + KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); Sleep(240*tempoTC); // Interface + // Xpressnet RS if (ServeurInterfaceCDM=1) or (ServeurInterfaceCDM=5) then begin for i:=1 to ServeurRetroCDM-1 do @@ -16587,6 +17343,11 @@ begin SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); end; + KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface + SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); + Application.processMessages; + Sleep(200*tempoTC); + // 2x TAB pour pointer sur OK KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); @@ -16601,12 +17362,13 @@ begin // TAB pour sélectionner OK KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); SendInput(Length(KeyInputs),KeyInputs[0],SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); - Sleep(240*tempoTC); + Sleep(300*tempoTC); end; KeybdInput(VK_SPACE,0);KeybdInput(VK_SPACE,KEYEVENTF_KEYUP); // valide la fenetre d'interface SendInput(Length(KeyInputs), KeyInputs[0], SizeOf(KeyInputs[0]));SetLength(KeyInputs,0); + Application.ProcessMessages; Sleep(500*tempoTC); application.ProcessMessages; KeybdInput(VK_RETURN,0);KeybdInput(VK_RETURN, KEYEVENTF_KEYUP); // valide la fenetre finale @@ -16709,16 +17471,17 @@ begin Tablo_Pn[i].compteur:=0; end; + { For i:=1 to ncantons do begin canton[i].indexTrain:=0; canton[i].adresseTrain:=0; canton[i].NomTrain:=''; - end; + end; } for i:=1 to Ntrains do begin - trains[i].canton:=0; + //trains[i].canton:=0; trains[i].detecteurSuiv:=0; //trains[i].TempoArret:=0; trains[i].TempoArretCour:=0; @@ -16799,6 +17562,7 @@ begin end; end; init_aig_cours:=false; + Maj_Signaux(false); end; // renvoyer date heure, MAC, version SC , verif_version, avec_roulage @@ -17072,6 +17836,7 @@ begin couleurs_SR; couleurs_cdf; couleurs_pilote; + couleurs_routeTrains; end; // renvoie la taille d'un fichier @@ -17314,7 +18079,14 @@ begin index:=DeclSignal; famille:=2; end; - Nbredeclencheurs:=DeclSignal; + with declencheurs[DeclLogique] do + begin + nom:='Logique'; + index:=DeclLogique; + famille:=0; + end; + if avecLogique then Nbredeclencheurs:=DeclLogique + else NbreDeclencheurs:=DeclSignal; end; function Index_Declencheur(s : string) : integer; @@ -17330,6 +18102,7 @@ begin if trouve then result:=i-1; end; + // ouvre l'interface vers la centrale ou CDM rail procedure interface_ou_cdm; begin @@ -17354,6 +18127,7 @@ begin if not(portCommOuvert) and AvecDemandeInterfaceEth then begin application.ProcessMessages; + procetape('Ouverture interface socket'); connecte_interface_ethernet; // la connexion du socket ne se fait qu'à la sortie de cette procédure create end; end; @@ -17374,25 +18148,7 @@ begin LireunfichierdeCV1.enabled:=false; end; - if AvecInit then - begin - if not(ConfigNulle) and not(fermeSC) and (AvecInitAiguillages) then - begin - if maxaiguillage>0 then - begin - Affiche('Positionnement des aiguillages',clcyan); - init_aiguillages; // initialisation des aiguillages - end; - end; - - 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; - //Menu_interface(valide); - end; + //Menu_interface(valide); end; // affecte les trains aux cantons d'après la config @@ -17422,29 +18178,69 @@ begin end; end; end; - - { - procetape('Affecter les sens des trains aux cantons'); - // affecter les sens des trains dans les cantons - for i:=1 to nCantons do - begin - t:=canton[i].indexTrain; - if t>nTrains then - begin - Affiche('Anomalie train index='+intToSTR(t)+'au canton '+intToSTR(i)+' - forçage à 0',clred); - t:=0; - canton[i].SensLoco:=0; - end - else - begin - if t>0 then canton[i].SensLoco:=trains[t].sens; - end; - end; } end; +// Event socket interface par indy +{$IF CompilerVersion >= 28.0} +procedure TFormPrinc.DataReceived(const Data: TidBytes); + var i,l,j,lo : integer; +begin + l:=length(data); + lo:=long_recue; // longueur ancien recu, non encore traité + j:=1; + for i:=lo+1 to lo+l do + begin + chaine_recue[i]:=ord(Data[j]); // mettre recu à la fin + inc(j); + end; + long_recue:=l+lo; + + //if traceTrames then afficheDebug('Tick='+intToSTR(tick)+'/Rec '+chaine_hex(data),clWhite); + interprete_reponse; +end; +{$ELSE} +procedure TFormPrinc.DataReceived(const Data: string); + var i,l,j,lo : integer; +begin + l:=length(data); + lo:=long_recue; // longueur ancien recu, non encore traité + j:=1; + for i:=lo+1 to lo+l do + begin + chaine_recue[i]:=ord(Data[j]); // mettre recu à la fin + inc(j); + end; + long_recue:=l+lo; + + if traceTrames then afficheDebug('Tick='+intToSTR(tick)+'/Rec '+chaine_hex(data),clWhite); + interprete_reponse; +end; +{$IFEND} + + +// lecture depuis socket interface +procedure TformPrinc.ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); +var tampon : TchaineBIN; + i,l,j,lo : integer; +begin + l:=ClientSocketInterface.Socket.ReceiveBuf(tampon[1],200); // réception binaire + lo:=long_recue; // longueur ancien recu, non encore traité + j:=1; + for i:=lo+1 to lo+l do + begin + chaine_recue[i]:=tampon[j]; // mettre recu à la fin + inc(j); + end; + long_recue:=l+lo; + + if traceTrames then afficheDebug('Tick='+intToSTR(tick)+'/Rec '+tablo_hex(tampon),clWhite); + interprete_reponse; +end; + + // démarrage principal du programme signaux_complexes procedure TFormPrinc.FormCreate(Sender: TObject); -var n,t,i,index,OrgMilieu : integer; +var n,t,i,j,index,OrgMilieu : integer; s : string; trouve : boolean; Sr : TSearchRec; @@ -17547,16 +18343,19 @@ begin debugPN:=false; option_demitour:=false; debugroulage:=false; + mesureTrains:=false; sombre:=false; - AvecInit:=true; // avec initialisation des aiguillages ou pas simuInterface:=false; Stop_Maj_Sig:=false; MaxParcours:=100; // Nombre maxi d'éléments d'une route MaxRoutes:=1000; // nombre maxi de routes Diffusion:=true; // &&&& mode diffusion publique + debug mise au point etc - AffAigDet:=not(diffusion); + avecLogique:=false; + AffAigDet:=false; Button3.Visible:=not(diffusion); + GetLocaleFormatSettings(0,FormatSettings); + FormatSettings.DecimalSeparator:='.'; FenRich.MaxLength:=$7FFFFFF0; NbDecodeur:=11; @@ -17573,22 +18372,49 @@ begin // créer icones des trains et raz champs for i:=1 to Max_Trains do begin - trains[i].canton:=0; - trains[i].detecteurSuiv:=0; - //trains[i].TempoArret:=0; - trains[i].TempoArretCour:=0; - trains[i].TempoDemarre:=0; - trains[i].arret_det:=false; - trains[i].phase_arret:=0; - trains[i].TempoArretTemp:=0; - trains[i].TempsDemarreSig:=0; - With Trains[i].routePref[0] do + with trains[i] do begin - adresse:=0; - pos:=0; - typ:=rien; + canton:=0; + detecteurSuiv:=0; + TempoArretCour:=0; + TempoDemarre:=0; + arret_det:=false; + phase_arret:=0; + TempoArretTemp:=0; + TempsDemarreSig:=0; + PointMes:=0; + PointRout:=0; end; + for j:=1 to 100 do + begin + with trains[i].mesure[j] do + begin + //detecteur:=0; + //moyenne:=0; + vr:=0; + temps:=0; + end; + end; + + for j:=1 to NbMaxDet do + for t:=1 to 128 do + with trains[i].detecteurR[j,t] do + begin + Nombre:=0; + moyenne:=0; + ecart:=0; + end; + + for j:=0 to 30 do + begin + With Trains[i].routePref[j][0] do + begin + adresse:=0; + pos:=0; + typ:=rien; + end; + end; Trains[i].icone:=Timage.create(self); with Trains[i].icone do @@ -17603,12 +18429,6 @@ begin end; end; - if versionSC='8.53' then - begin - Horaires1.enabled:=false; - LabelClock.Visible:=false; - end; - OsBits:=0; if IsWow64Process then begin @@ -17625,65 +18445,107 @@ begin // création des composants MSComm (USB COM) ----------------- - + {$IF CompilerVersion >= 28.0} - try MSCommUSBInterface:=tApdComPort.Create(formprinc); - except - s:='Erreur 6000 : Composant Interface non créé'; - AfficheDebug(s,clred); - Affiche(s,clred); - end; - if MSCommUSBInterface<>nil then MSCommUSBInterface.onTriggerAvail:=RecuInterface; // procédure de réception - Setlength(TrameIF,100); + // D12 + // composant AsycPro + try MSCommUSBInterface:=tApdComPort.Create(formprinc); + except + s:='Erreur 6000 : Composant Interface non créé'; + AfficheDebug(s,clred); + Affiche(s,clred); + end; + if MSCommUSBInterface<>nil then MSCommUSBInterface.onTriggerAvail:=RecuInterface; // procédure de réception + Setlength(TrameIF,100); - // pour deux périphériques COM/USB - try MSCommCde1:=tApdComPort.Create(formprinc); - except Affiche('Composant périphérique 1 non créé',clred); - end; - if MsCommCde1<>nil then MSCommCde1.onTriggerAvail:=RecuPeriph1; + // pour deux périphériques COM/USB + try MSCommCde1:=tApdComPort.Create(formprinc); + except Affiche('Composant périphérique 1 non créé',clred); + end; + if MsCommCde1<>nil then MSCommCde1.onTriggerAvail:=RecuPeriph1; - try MSCommCde2:=tApdComPort.Create(formprinc); - except Affiche('Composant périphérique 2 non créé',clred); - end; - if MsCommCde2<>nil then MSCommCde2.onTriggerAvail:=RecuPeriph2; + try MSCommCde2:=tApdComPort.Create(formprinc); + except Affiche('Composant périphérique 2 non créé',clred); + end; + if MsCommCde2<>nil then MSCommCde2.onTriggerAvail:=RecuPeriph2; + + {$IFDEF AvecIdTCP} + // composant Indy Interface réseausocket + ClientSocketIdInterface:=TIdTCPClient.Create(self); + try + ThreadInterface:=TReadingThreadInterface.Create(ClientSocketIdInterface); + ThreadInterface.OnData:=DataReceived ; + ThreadInterface.Resume; + except + ClientSocketIdInterface.Disconnect; + raise; + end; + {$ELSE} + // composant TclientSocket + ClientSocketInterface:=tClientSocket.Create(nil); + ClientSocketInterface.OnRead:=ClientSocketInterfaceRead; + ClientSocketInterface.onConnect:=ClientSocketInterfaceConnect; + ClientSocketInterface.OnDisconnect:=ClientSocketInterfaceDisconnect; + ClientSocketInterface.OnError:=ClientSocketInterfaceError; + {$ENDIF} {$ELSE} + // D7 + // vérifier ocx tmscomm + s:=cheminwin+'\mscomm32.ocx'; + i:=filesize(s); + if (i<>103744) and (i<>-1) then + begin + s:='Version fichier '+s+' incorrecte'; + AfficheDebug(s,clOrange);Affiche(s,clOrange); + end; + if i=-1 then + begin + s:='Ficher '+s+' inexistant'; + AfficheDebug(s,clred); + Affiche(s,clred); + end; - // vérifier ocx tmscomm - s:=cheminwin+'\mscomm32.ocx'; - i:=filesize(s); - if (i<>103744) and (i<>-1) then - begin - s:='Version fichier '+s+' incorrecte'; - AfficheDebug(s,clOrange);Affiche(s,clOrange); - end; - if i=-1 then - begin - s:='Ficher '+s+' inexistant'; - AfficheDebug(s,clred); - Affiche(s,clred); - end; - - // interface centrale - provoque l'apparition de la fenêtre "préparation de l'installation" - try MSCommUSBInterface:=TMSComm.Create(formprinc); - except - s:='Erreur 6000 : Composant Interface non créé'; - AfficheDebug(s,clred); - Affiche(s,clred); - end; - if MSCommUSBInterface<>nil then MSCommUSBInterface.onComm:=RecuInterface; // procédure de réception - Setlength(TrameIF,100); + {$IFDEF AvecIdTCP} + // D7 composant Indy Interface réseausocket + ClientSocketIdInterface:=TIdTCPClient.Create(self); + try + ThreadInterface:=TReadingThreadInterface.Create(ClientSocketIdInterface); + ThreadInterface.OnData:=DataReceived ; + ThreadInterface.Resume; + except + ClientSocketIdInterface.Disconnect; + raise; + end; - // pour deux périphériques COM/USB - try MSCommCde1:=TMSComm.Create(formprinc); - except Affiche('Composant périphérique 1 non créé',clred); - end; - if MsCommCde1<>nil then MSCommCde1.OnComm:=RecuPeriph1; + {$ELSE} + ClientSocketInterface:=tClientSocket.Create(nil); + ClientSocketInterface.OnRead:=ClientSocketInterfaceRead; + ClientSocketInterface.onConnect:=ClientSocketInterfaceConnect; + ClientSocketInterface.OnDisconnect:=ClientSocketInterfaceDisconnect; + ClientSocketInterface.OnError:=ClientSocketInterfaceError; + {$ENDIF} - try MSCommCde2:=TMSComm.Create(formprinc); - except Affiche('Composant périphérique 2 non créé',clred); - end; - if MsCommCde2<>nil then MSCommCde2.OnComm:=RecuPeriph2; + // interface centrale - provoque l'apparition de la fenêtre "préparation de l'installation" + try MSCommUSBInterface:=TMSComm.Create(formprinc); + except + s:='Erreur 6000 : Composant Interface non créé'; + AfficheDebug(s,clred); + Affiche(s,clred); + end; + if MSCommUSBInterface<>nil then MSCommUSBInterface.onComm:=RecuInterface; // procédure de réception + Setlength(TrameIF,100); + + // pour deux périphériques COM/USB + try MSCommCde1:=TMSComm.Create(formprinc); + except Affiche('Composant périphérique 1 non créé',clred); + end; + if MsCommCde1<>nil then MSCommCde1.OnComm:=RecuPeriph1; + + try MSCommCde2:=TMSComm.Create(formprinc); + except Affiche('Composant périphérique 2 non créé',clred); + end; + if MsCommCde2<>nil then MSCommCde2.OnComm:=RecuPeriph2; {$IFEND} //s:=GetCurrentDir; @@ -17879,7 +18741,6 @@ begin end; renseigne_tous_cantons; // les form des TCO doivent être créés - // ouvre les périphériques commandes actionneurs, car on a lu les com dans la config for i:=1 to NbPeriph do begin @@ -17918,8 +18779,6 @@ begin trains[i].SbitMap.height:=300; end; - - { //DoubleBuffered:=true; aiguillage[index_aig(1)].position:=const_devie; @@ -17950,8 +18809,6 @@ begin } procetape('Fin des initialisations'); - if debug=1 then Affiche('Positionnement des signaux',clLime); - Maj_Signaux(false); // vérifier si le fichier de segments existe fichier_module_CDM:=fileExists(NomModuleCDM); @@ -18003,7 +18860,8 @@ begin AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+s,Clwhite); end; end; - chaine_recue:=interprete_reponse(chaine_recue); +// chaine_recue:=interprete_reponse(chaine_recue); + interprete_reponse; end; {$ELSE} @@ -18066,7 +18924,8 @@ begin AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+s,Clwhite); end; end; - chaine_recue:=interprete_reponse(chaine_recue); + //chaine_recue:=interprete_reponse(chaine_recue); + interprete_reponse; end; end; {$IFEND} @@ -18112,10 +18971,16 @@ begin end; ServerSocket.Close; ClientSocketCDM.close; + {$IFDEF AvecIdTCP} + ClientSocketIdInterface.Disconnect; + ClientSocketIdInterface.Free; + {$ELSE} ClientSocketInterface.close; + {$ENDIF} end; // appellé sur réception trame train CDM +// vérifie qu'un train procedure verifie_train_horaire(adresse : integer;train : string;vitesse : integer); var i : integer; sens : boolean; @@ -18131,18 +18996,17 @@ begin begin Affiche('Arrêt du train '+Train+' hors horaire',clOrange); sens:=true; - vitesse_loco(train,i,adresse,0,true); + vitesse_loco(train,i,adresse,0,10); end; - end; end; end; // appelé par le timer, si l'horloge tourne procedure gestion_horaire; -var i,indexTrain,vitesse : integer; - traite : boolean; - train : string; +var n,i,j,indexTrain,vitesse : integer; + traite,trouve : boolean; + train,route : string; begin // démarrage des trains à l'horaire @@ -18151,24 +19015,49 @@ begin if (grilleHoraire[i].heure=heure) and (grilleHoraire[i].minute=minute) then begin train:=grilleHoraire[i].NomTrain; - + indexTrain:=index_train_nom(train); traite:=true; - if roulage then + if indexTrain>0 then begin - indexTrain:=index_train_nom(train); - traite:=trains[indexTrain].roulage>0; - end; + if roulage then + begin + traite:=trains[indexTrain].roulage>0; + end; - if traite then - begin - vitesse:=grilleHoraire[i].vitesse; - if not(grilleHoraire[i].sens) then vitesse:=-vitesse; - Affiche('Démarrage train '+train+' à l''horaire '+format('%.2dh%.2d',[heure,minute]),clyellow); - FormFicheHoraire.StringGridFO.Cells[1,i]:=GrilleHoraire[i].NomTrain+' Départ'; - Demarre_index_train(index_train_nom(train)); - end; - end; + if traite then + begin + vitesse:=grilleHoraire[i].vitesse; + if not(grilleHoraire[i].sens) then vitesse:=-vitesse; + Affiche('Démarrage train '+train+' à l''horaire '+format('%.2dh%.2d',[heure,minute]),clyellow); + // &&& voir pour la couleur + FormFicheHoraire.StringGridFO.Cells[1,i]:=GrilleHoraire[i].NomTrain; + Demarre_index_train(indextrain); + route:=grilleHoraire[i].route; + if route<>'' then + begin + // trouver la route dans la liste des routes sauvegardées du train + n:=trains[indexTrain].routePref[0][0].adresse; // nombre de routes sauvegardées du train + j:=1; + trouve:=false; + while not(trouve) and (j<=n) do + begin + trouve:=Trains[indexTrain].NomRoute[j]=route; + inc(j); + end; + if trouve then + begin + dec(j); //j est l'index de la route dans le train + // affecte la route au train + Affiche('La route est : '+route,clYellow); + trains[indexTrain].route:=trains[indexTrain].routePref[j]; // copier la route dans le train + trains[indexTrain].route[0].talon:=grilleHoraire[i].sens; // copier le sens + aig_canton(indexTrain,trains[indexTrain].route[1].adresse); // positionne aiguillage et fait les réservations + end; + end; + end; + end; + end; end; // évènements actionneurs horaires @@ -18185,40 +19074,37 @@ begin end; end; +// equation droite +procedure equation_droite(y1,y2,x1,x2 : single;var pente,b : single); +begin + if x2-x1<>0 then pente:=(y2-y1)/(x2-x1) else pente:=9999; + b:=y1-pente*x1; +end; + +// calcule les 2 équations de droite des coefficients +procedure calcul_equations_coeff(indexTrain : integer); +begin + with trains[indexTrain] do + begin + equation_droite(CoeffV1,CoeffV2,ConsV1,ConsV2,pente1,b1); + equation_droite(CoeffV2,CoeffV3,ConsV2,ConsV3,pente2,b2); + end; +end; + + // timer à 100 ms procedure TFormPrinc.Timer1Timer(Sender: TObject); -var n,vitesse,i,j,a,d,longueur,adresse,TailleX,TailleY,orientation,indexTCO,x,y,Bimage,aspect : integer; +var n,i,j,a,d,longueur,adresseEl,TailleX,TailleY,orientation,indexTCO,x,y,Bimage,aspect, + IdDet,longDet,LongLoco,distArret,vitcons,vitesseABS : integer; imageSignal : Timage; - frx,fry : real; + frx,fry : single; + incrementPas,tempsArret,coeff,vitR : single; faire : boolean; h,m,sec,ms : word; s : string; begin inc(tick); - {// si un détecteur comporte un train, calculer la distance du train au détecteur en fonction de la vitesse - if tick mod 4=0 then - begin - for i:=1 to NDetecteurs do - begin - adresse:=adresse_detecteur[i]; - AdrTrain:=detecteur[adresse].AdrTrain; - if adrTrain<>0 then - begin - j:=index_train_adresse(adrTrain); - vitesse:=trains[j].vitesse; - inc(detecteur[adresse].temps,4); // car modulo 4 - if vitesse<>0 then - begin - d:=round(detecteur[adresse].temps*100/vitesse); - detecteur[adresse].distanceTr:=d; - end; - if detecteur[adresse].etat then s:='1' else s:='0'; - //affiche(IntToSTR(adresse)+'='+s+' '+ intToSTR(d),clYellow); - end; - end; - end;} - // séquencement des actions après tempo if index_seqAct>0 then begin @@ -18245,7 +19131,7 @@ begin inc(comptSec); if not(horlogeInterne) then begin - if ComptSec=9 then + if ComptSec>=9 then begin comptSec:=0; decodeTime(GetTime,h,m,sec,ms); @@ -18309,7 +19195,16 @@ begin if TpsTimeoutSL<=0 then begin TpsTimeoutSL:=450; // envoyer caractère toutes les 45 secondes + {$IFDEF AvecIdTCP} + s:=' '; + {$IF CompilerVersion >= 28.0} + ClientSocketIdInterface.IoHandler.write(RawToBytes(s,1),1); + {$ELSE} + ClientSocketIdInterface.Socket.Send(s,1) + {$IFEND} + {$ELSE} ClientSocketInterface.Socket.SendText(' '); + {$ENDIF} end; end; @@ -18334,14 +19229,14 @@ begin for i:=1 to NbreSignaux do begin a:=Signaux[i].EtatSignal; // a = état binaire du signal - adresse:=Signaux[i].adresse; + adresseEl:=Signaux[i].adresse; // signal belge if Signaux[i].aspect=20 then begin // signal belge if TestBit(a,clignote) or Signaux[i].contrevoie then begin - Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adresse,1); + Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adresseEl,1); end; end else @@ -18351,7 +19246,7 @@ begin TestBit(a,rappel_60) or testBit(a,semaphore_cli) or testBit(a,vert_cli) or testbit(a,blanc_cli) then begin - Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adresse,1); + Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adresseEl,1); //Affiche('Clignote signal '+IntToSTR(adresse),clyellow); end; end; @@ -18371,8 +19266,8 @@ begin BImage:=TCO[indexTCO,x,y].bImage; if Bimage=Id_signal then begin - adresse:=TCO[indexTCO,x,y].adresse; - i:=Index_Signal(adresse); + adresseEl:=TCO[indexTCO,x,y].adresse; + i:=Index_Signal(adresseEl); a:=Signaux[i].EtatSignal; // a = état binaire du signal faire:=false; if Signaux[i].aspect<>20 then @@ -18386,7 +19281,7 @@ begin end; if faire then begin - aspect:=Signaux[Index_Signal(adresse)].Aspect; + aspect:=Signaux[Index_Signal(adresseEl)].Aspect; case aspect of 2 : ImageSignal:=Formprinc.Image2feux; 3 : ImageSignal:=Formprinc.Image3feux; @@ -18402,7 +19297,7 @@ begin Orientation:=TCO[indexTCO,x,y].FeuOriente; // réduction variable en fonction de la taille des cellules calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]); - Dessine_signal_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indexTCO,x,y].y,frx,fry,adresse,orientation); + Dessine_signal_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indexTCO,x,y].y,frx,fry,adresseEl,orientation); end; end; end; @@ -18449,7 +19344,8 @@ begin actionFonctionF : begin s:=Tablo_Action[i].tabloOp[j].trainCourant; - Affiche('Action TrainDest='+s+' F'+IntToSTR(Tablo_Action[i].TabloOP[j].fonctionF)+':0',clyellow); + //Affiche('Action TrainDest='+s+' F'+IntToSTR(Tablo_Action[i].TabloOP[j].fonctionF)+':0',clyellow); + Affiche('Action TrainDest='+s+' F'+format('%d',[Tablo_Action[i].TabloOP[j].fonctionF])+':0',clyellow); envoie_fonction_CDM(Tablo_Action[i].tabloOP[j].fonctionF,0,s); end; actionTempo : @@ -18471,95 +19367,169 @@ begin //if (tick mod 10)=0 then Affiche(intToSTR(trains[4].TempoArretCour),clWhite); for i:=1 to ntrains do begin - if trains[i].arret_det then - begin - adresse:=trains[i].dernierDet; - if adresse<>0 then - begin - case trains[i].phase_arret of - 0 : begin - vitesse:=trains[i].VitRalenti div 2; - trains[i].vitesse:=vitesse; - if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,true); - trains[i].phase_arret:=1; - detecteur[adresse].temps:=0; - end; - 1 : begin - inc(detecteur[adresse].temps); - vitesse:=trains[i].vitesse; - if vitesse<>0 then - d:=abs(round(detecteur[adresse].temps*90/vitesse)) // distance parcourue depuis l'arrivée sur le détecteur - else d:=9999; // si la vitesse du train est nulle, mettre une condition qui arrete le train en fin de parcours sur le détecteur - //Affiche('TempoarretCour='+intToSTR(a)+' train '+intToSTR(i)+' detecteur='+intToSTR(adresse)+' TpsDet='+intToSTR(detecteur[adresse].temps),clOrange); - // si la longueur déclarée du canton <>0 on s'arrete sur la longueur sinon on s'arrete sur la tempo d'arret. - // arrêt - if debugRoulage then Affiche('Timer Dist='+intToSTR(d),clYellow); - longueur:=detecteur[adresse].longueur; - if ((d>longueur-5) and (longueur>0)) or - ((d>10) and (longueur=0)) then - begin - //trains[i].TempoArret:=0; - trains[i].TempoArretCour:=0; - trains[i].arret_det:=false; - trains[i].phase_arret:=0; - if debugRoulage then Affiche('Timer '+trains[i].nom_train+' Arrêté',ClWhite); - vitesse:=0; - trains[i].vitesse:=vitesse; - if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,false); // arrêt du train - train_sarrete(i); // vérifie si fin de route, et copie tempo_demarre si détecteur arrêt optionnel+ tempo de redémarrage - end; - end; + // calculer la vitesse instantanée du train en fonction des accel et des décel + with trains[i] do + begin + if vitesseCons<>AVitesseCons then + begin + // mémoriser changement de consigne vitesse + AncVitesseCons:=AvitesseCons; // ancienne vitesse conservée + //Affiche('Ancienne vitesse='+intToSTR(ancVitesseCons),clYellow); + AVitesseCons:=vitesseCons; // ancienne vitesse du tick précédent + end; + + // calcul vitesse réelle instantanée en crans, tenant compte des accel et décel + if (vitesseReelle<>VitesseCons) then + begin + IncrementPas:=0; + if (cv3<>0) and (AncVitesseConsVitesseCons then VitesseReelleR:=VitesseCons; + VitesseReelle:=round(vitesseReelleR); + end + else + if (cv4<>0) and (AncVitesseCons>VitesseCons) and (vitesseReelle>vitesseCons) then + begin + //IncrementPas:=(128*0.1)/(0.896*cv4); // décélération + IncrementPas:=128/(8.96*cv4); // nombre de pas à décrémenter toutes les 1/10 de s + VitesseReelleR:=round(vitesseReelleR-Incrementpas); + if VitesseReelleR0 then Affiche('Vitesse réelle '+intToSTR(vitesseReelle)+' crans',clOrange); + + // mesure temps de parcours et distance d'un train sur détecteur à 1 + j:=detecteurA; + if j<>0 then + begin + if detecteur[j].Etat then + begin + d:=abs(distance_temps_incr(1,i)); // distance incrémentale en mm sur détecteur : distance additionnée tous les 1/10 seconde + detecteur[j].distCour:=d; + //Affiche('DistInc='+intToSTR(d),clWhite); end; - end - else - begin - if DebugRoulage then Affiche('Erreur 681 : adresse detecteur nul train '+Trains[i].nom_train,clred); - end; - end; - // démarrage sur tempo - a:=trains[i].TempoDemarre; - if a<>0 then - begin - if debugRoulage then Affiche('Timer tempo démarre '+intToSTR(a)+' '+intToSTR(trains[i].TempsDemarreSig-5),clWhite); - if a=(trains[i].TempsDemarreSig*10)-5 then // renvoi consigne d'arret 5x1/10 de secondes apres - begin -{ s:=trains[i].nom_train; - s:=chaine_CDM_StopTrainST(s); - envoi_cdm(s); ???!! } - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,false); + if detecteur[j].Temps_cour<>0 then + begin + inc(detecteur[j].Temps_cour); + if trains[i].vitesseCons=0 then detecteur[j].Temps_cour:=0; // impossible de mesurer vitesse train si elle est nulle + end; end; - dec(a); - if a mod 10=0 then Affiche_temps_arret(i,a); // affiche le temps d'arrêt sur le canton - trains[i].TempoDemarre:=a; - if a=0 then // fin de la tempo d'arrêt: on redémarre! + // gestion ralenti : on doit arreter le train sur le détecteur + if trains[i].arret_det then // le train est sur un détecteur d'arrêt begin - vitesse:=trains[i].VitNominale; - if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,false); - end; - end; + adresseEl:=dernierDet; // identifie le détecteur + if adresseEl<>0 then + case phase_arret of // !! voir si phase arret est multitrains!!! + 0 : begin + //if debugroulage then Affiche('Phase arret 0',clred); + vitesseCons:=VitRalenti div 2; + if route[0].talon then vitesseCons:=-vitesseCons; + vitesse_loco(nom_train,i,trains[i].adresse,vitesseCons,3); // répétition dans 0,3 s + phase_arret:=1; + end; + 1 : begin + //if debugroulage then Affiche('Phase arret 1',clred); + //inc(detecteur[adresseEl].temps); + if vitesseReelle<>0 then + begin + if CV4<>0 then d:=d div 10; // distance mesure incrémentale en cm, calculée plus haut + //else d:=abs(round(detecteur[adresseEl].temps_cour*90/vitesseReelle)) // distance parcourue depuis l'arrivée sur le détecteur + end + else d:=9999; // si la vitesse du train est nulle, mettre une condition qui arrete le train en fin de parcours sur le détecteur + if not detecteur[adresseEl].Etat then d:=9999; // si on passe le détecteur arrêter le train. + if DebugRoulage then Affiche('D='+intToSTR(d)+' train '+intToSTR(i),clOrange); + // arrêt + //if debugRoulage then Affiche('Timer Dist='+intToSTR(d)+' Vit='+intToSTR(trains[i].vitesseReelle),clYellow); + longDet:=detecteur[adresseEl].longueur; + LongLoco:=trains[i].longueur; + longueur:=longDet-longLoco; - // démarrage sur consigne - a:=trains[i].compteur_consigne; - if a<>0 then - begin - dec(a); - //Affiche('consigne '+intToSTR(a),clWhite); - trains[i].compteur_consigne:=a; - if a=0 then + // calculer quelle distance il faudra pour s'arrêter avec la décélération + TempsArret:=abs(0.896*cv4*VitesseCons/128); + // convertir la vitesse en cran en cm/s + VitesseAbs:=abs(VitesseCons); + if vitesseAbs0 then vitR:=vitesseAbs/coeff else vitR:=0; + distArret:=round(TempsArret*vitR/2.2); // en cm 2.2 est empirique + + //Affiche('Vreelle='+intToSTR(round(VitR))+' Dist arret='+intToSTR(DistArret),clRed); + + // long du det distance dynamique + if ( (detecteur[adresseEl].modeArret<=1) and (d>=(longDet-detecteur[adresseEl].distArret-distArret)) ) or // arret en fin + ( (detecteur[adresseEl].modeArret=2) and (d>=(longDet div 2)) ) then // arret au milieu + + {if ((d>longueur-5) and (longueur>0)) or + ((d>10) and (longueur=0)) then } + begin + //Affiche('TempsArret='+FloatToSTRF(TempsArret,ffFixed,5,2)+' Vreelle='+intToSTR(round(VitR))+' Dist arret='+intToSTR(DistArret),clRed); + trains[i].TempoArretCour:=0; + trains[i].arret_det:=false; + trains[i].phase_arret:=0; + if debugRoulage then Affiche('Timer '+trains[i].nom_train+' Arrêté',ClWhite); + + trains[i].vitesseCons:=0; + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,0); // arrêt du train + train_sarrete(i); // vérifie si fin de route, et copie tempo_demarre si détecteur arrêt optionnel+ tempo de redémarrage + end; + end; + end // case + else + begin + if DebugRoulage then Affiche('Erreur 682 : adresse detecteur nul train '+Trains[i].nom_train,clred); + end; + end; // fin du ralenti + + // démarrage sur tempo + a:=trains[i].TempoDemarre; + if a<>0 then begin - vitesse:=trains[i].Vitesse; - if (trains[i].inverse) then vitesse:=-vitesse; - vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitesse,false); - end; - //Affiche('vitesse ' +intToSTR(i)+' '+intToSTR(trains[i].vitesse),clred); - end; - end; + if debugRoulage then Affiche('Timer tempo démarre '+intToSTR(a)+' '+intToSTR(trains[i].TempsDemarreSig-5),clWhite); + if a=(trains[i].TempsDemarreSig*10)-5 then // renvoi consigne d'arret 5x1/10 de secondes apres + begin + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,0); // vitesse nulle + end; + + dec(a); + if a mod 10=0 then Affiche_temps_arret(i,a); // affiche le temps d'arrêt sur le canton + trains[i].TempoDemarre:=a; + if a=0 then // fin de la tempo d'arrêt: on redémarre! + begin + vitcons:=trains[i].VitNominale; + if trains[i].roulage<>0 then if trains[i].route[0].talon then vitcons:=-vitCons; + trains[i].vitesseCons:=vitCons; + + //if (trains[i].inverse) then trains[i].vitesseCons:=-trains[i].vitesseCons; + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitcons,0); + end; + + // démarrage sur consigne + a:=trains[i].compteur_consigne; + if a<>0 then + begin + dec(a); + //Affiche('consigne '+intToSTR(a),clWhite); + trains[i].compteur_consigne:=a; + if a=0 then + begin + //trains[i].vitesseCons:=trains[i].VitesseCons; + vitesse_loco(trains[i].nom_train,i,trains[i].adresse,trains[i].vitesseCons,0); + end; + //Affiche('vitesse ' +intToSTR(i)+' '+intToSTR(trains[i].vitesse),clred); + end; + end; // fin démarre sur tempo + end; // fin du with + end; // fin de la boucle de trains // simulation if (i_simule<>0) then @@ -18616,17 +19586,19 @@ begin end; // temporisation détecteur à 0 - for i:=1 to NbMaxDet do // i=index détecteur + for i:=1 to NDetecteurs do begin - a:=detecteur[i].tempo0; + adr:=Adresse_detecteur[i]; + if detecteur[adr].Etat then inc(detecteur[adr].ComptCour); // pour affichage du temps détecteur à 1 + a:=detecteur[adr].tempo0; if a<>0 then begin dec(a); - detecteur[i].tempo0:=a; + detecteur[adr].tempo0:=a; if (a=0) then begin - detecteur[i].tempo0:=99; // indicateur tempo échue - event_detecteur(i,false,detecteur[i].train); + detecteur[adr].tempo0:=99; // indicateur tempo échue + event_detecteur(adr,false,detecteur[adr].train); end; end; end; @@ -18731,25 +19703,6 @@ begin ErrorCode:=0; end; -// lecture depuis socket interface -procedure TFormPrinc.ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); -var tampon : TchaineBIN; - i,l,j,lo : integer; -begin - l:=ClientSocketInterface.Socket.ReceiveBuf(tampon[1],100); // réception binaire - - lo:=long_recue; - j:=1; - for i:=lo+1 to lo+1+l do - begin - chaine_recue[i]:=tampon[j]; - inc(j); - end; - long_recue:=l+lo; - - if traceTrames then afficheDebug(tablo_hex(tampon),clWhite); - 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 procedure TFormprinc.proc_checkBoxFB(Sender : Tobject); @@ -18852,9 +19805,9 @@ begin if not simuInterface then begin {$IF CompilerVersion >= 28.0} - MSCommUSBInterface.open:=false; + MSCommUSBInterface.open:=false; // AsyncPro {$ELSE} - MSCommUSBInterface.Portopen:=false; + MSCommUSBInterface.Portopen:=false; // Tmscomm {$IFEND} end; Affiche('Port USB déconnecté',clyellow); @@ -18864,7 +19817,11 @@ begin portCommOuvert:=false; with formprinc do begin + {$IFDEF AvecIdTCP} + ClientSocketIdInterface.Disconnect; + {$ELSE} ClientSocketInterface.close; + {$ENDIF} MenuConnecterUSB.enabled:=true; DeConnecterUSB.enabled:=false; ConnecterCDMRail.enabled:=true; @@ -18923,20 +19880,17 @@ end; procedure TFormPrinc.MenuConnecterEthernetClick(Sender: TObject); begin - if AdresseIP<>'0' then - begin - Affiche('Demande de connexion de l''interface en ethernet sur '+AdresseIP+':'+IntToSTR(PortInterface),clyellow); - ClientSocketInterface.port:=portInterface; - ClientSocketInterface.Address:=AdresseIP; - ClientSocketInterface.Open; - Hors_tension:=false; - end; + connecte_interface_ethernet; end; procedure TFormPrinc.MenuDeconnecterEthernetClick(Sender: TObject); begin Affiche('Déconnexion interface ethernet',clyellow); + {$IFDEF AvecIdTCP} + ClientSocketIdInterface.disconnect; + {$ELSE} ClientSocketInterface.Close; + {$ENDIF} end; procedure TFormPrinc.AffEtatDetecteurs(Sender: TObject); @@ -19097,7 +20051,7 @@ begin ButtonLitCV.Enabled:=true; LireunfichierdeCV1.enabled:=true; LabelTitre.caption:=titre+' Interface connectée par Ethernet'; - Formprinc.StatusBar1.Panels[4].Text:=ClientSocketInterface.Address; + Formprinc.StatusBar1.Panels[4].Text:=AdresseIP; etat_init_interface:=11; // socket connecté trouve:=test_protocole; // appelle l'état des détecteurs @@ -19114,24 +20068,11 @@ begin etat_init_interface:=20; end; // interface ethernet connectée, faire les init - demande_etat_det; - if AvecInit then - begin - if not(ConfigNulle) and not(fermeSC) and (AvecInitAiguillages) then - begin - Affiche('Positionnement des signaux',clYellow); - init_aiguillages; // initialisation des aiguillages - end; - 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; + init_aig_det; end; + {$IFNDEF AvecIdTCP} if not(trouve) then ClientSocketInterface.Close; + {$ENDIF} end; // CDM rail connecté @@ -19715,7 +20656,7 @@ begin idt:=index_train_adresse(adr); if idt>0 then begin - trains[idt].vitesse:=vitesse; + trains[idt].vitesseCons:=vitesse; end; Event_vitesse(adr,train,vitesse); // déclenche évent actionneur vitesse train // fait bouger le train dans la fenetre cdm @@ -20014,6 +20955,7 @@ procedure TFormPrinc.ClientSocketInterfaceDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin parSocketLenz:=False; + LabelTitre.caption:=titre; Formprinc.StatusBar1.Panels[4].Text:=''; end; @@ -20276,15 +21218,15 @@ begin //if not(portCommOuvert) and not(parSocketLenz) and not(CDM_Connecte) then exit; s:=editVitesse.Text; val(s,vit,erreur); - if (erreur<>0) or (vit<-100) or (vit>100) then exit; + if (erreur<>0) or (vit<-127) or (vit>127) then exit; i:=0;s:=''; if combotrains.itemindex<>-1 then begin s:=combotrains.Items[combotrains.itemindex]; i:=index_train_nom(s); end; - Affiche('Commande vitesse train '+s+' ('+intToSTR(adr)+') à '+IntToSTR(vit)+'%',cllime); - vitesse_loco(s,i,adr,vit,true); + Affiche('Commande vitesse train '+s+' ('+intToSTR(adr)+')',cllime); + vitesse_loco(s,i,adr,vit,10); if s='' then s:=intToSTR(adr); end; @@ -20319,6 +21261,27 @@ begin end; end; +procedure affiche_routes; +var i,j,v : integer; + s : string; +begin + for i:=1 to N_trains do + begin + v:=event_det_train[i].AdrTrain; + s:=intToSTR(i)+' AdresseTrain='+intToSTR(v)+' '+event_det_train[i].nom_train+' '; + v:=event_det_train[i].NbEl; + s:=s+' NbEl='+intToSTR(v)+' '; + Affiche(s,clWhite); + for j:=1 to v do + begin + s:=' -> El='+intToSTR(j)+' '+intToSTR(event_det_train[i].Det[j].adresse)+' état='; + if event_det_train[i].Det[j].etat then s:=s+'1' else s:=s+'0'; + Affiche(s,clwhite); + end; + end; +end; + + procedure TFormPrinc.Etatdeszonespartrain1Click(Sender: TObject); var i,j,n,train : integer; couleur : tcolor; @@ -20388,6 +21351,8 @@ begin end; end; + affiche_routes; + Affiche(' ',clyellow); for i:=1 to ntrains do @@ -20685,7 +21650,7 @@ var erreur,fonction,etat,loco : integer; s : string; begin val(editNumFonction.Text,fonction,erreur); - if (erreur<>0) or (fonction<1) then exit; + if (erreur<>0) or (fonction<0) then exit; val(editFonc01.Text,etat,erreur); if (erreur<>0) or (etat<0) then exit; if not(portCommOuvert) and not(parSocketLenz) and not(CDM_connecte) then exit; @@ -20694,13 +21659,9 @@ begin if CDM_connecte then begin if s='' then begin Affiche('Sélectionnez un train',clOrange);exit;end; - if fonction>12 then - begin - Affiche('Avec CDM Rail, F12 maxi',clOrange); - exit; - end; envoie_fonction_CDM(fonction,etat,s); Affiche('Train='+s+' F'+IntToSTR(fonction)+':'+intToSTR(etat),clyellow); + exit; end; begin @@ -20796,7 +21757,7 @@ begin //if not(portCommOuvert) and not(parSocketLenz) and not(CDM_Connecte) then exit; s:=editVitesse.Text; val(s,vit,erreur); - if (erreur<>0) or (vit<-100) or (vit>100) then exit; + if (erreur<>0) or (vit<-126) or (vit>126) then exit; i:=0;s:=''; if combotrains.itemindex<>-1 then begin @@ -20815,7 +21776,7 @@ procedure TFormPrinc.EditVitesseChange(Sender: TObject); var i,e : integer; begin val(EditVitesse.Text,i,e); - if (e=0) and (i>=-100) and (i<=100) then TrackBarVit.position:=i; + if (e=0) and (i>=-127) and (i<=127) then TrackBarVit.position:=i; end; procedure TFormPrinc.ButtonEnvClick(Sender: TObject); @@ -20991,10 +21952,11 @@ begin if adr<>0 then begin Affiche('Arrêt train @'+intToSTR(adr)+' '+Trains[i].nom_train,clyellow); - vitesse_loco('',i,adr,0,true); - //trains[i].TempoArretCour:=0; - //trains[i].arret_det:=true; - //trains[i].TempoArret:=0; + vitesse_loco('',i,adr,0,10); + trains[i].TempoArretCour:=0; + trains[i].arret_det:=false; + trains[i].phase_arret:=0; + end; end; end; @@ -21937,6 +22899,7 @@ procedure TFormPrinc.FormResize(Sender: TObject); begin // pour éviter de coincer le splitter à gauche fenetre réduite et on le glisse complètement à gauche splitterV.Left:=FenRich.left+FenRich.Width-5; + calcul_pos_horloge; end; procedure TFormPrinc.Affichagenormal1Click(Sender: TObject); @@ -22298,29 +23261,13 @@ begin if canton[i].typ1=aig then s:=s+' Aig' else s:=s+' Det'; s:=s+' El contigu2='+intToSTR(canton[i].el2); if canton[i].typ2=aig then s:=s+' Aig' else s:=s+' Det'; + if canton[i].NumcantonOrg<>0 then s:=s+' CantonDépart='+intToSTR(canton[i].NumcantonOrg); + if canton[i].NumcantonDest<>0 then s:=s+' CantonArrivée='+intToSTR(canton[i].NumcantonDest); + Affiche(s,clyellow); end; end; -procedure affiche_routes; -var i,j,v : integer; - s : string; -begin - for i:=1 to N_trains do - begin - v:=event_det_train[i].AdrTrain; - s:=intToSTR(i)+' AdresseTrain='+intToSTR(v)+' '+event_det_train[i].nom_train+' '; - v:=event_det_train[i].NbEl; - s:=s+' NbEl='+intToSTR(v)+' '; - Affiche(s,clWhite); - for j:=1 to v do - begin - s:=' -> El='+intToSTR(j)+' '+intToSTR(event_det_train[i].Det[j].adresse)+' état='; - if event_det_train[i].Det[j].etat then s:=s+'1' else s:=s+'0'; - Affiche(s,clwhite); - end; - end; -end; // renvoie les poinnts ouverts d'une TJD 4 états en fonction de son état passé en paramètres procedure TJD4(adr1,pos1,adr2,pos2 : integer;var c1,c2 : char); @@ -22439,7 +23386,7 @@ begin param1:=prec; param2:=actuel; inc(ctot); - AffRouteR:=false; + AffRouteR:=false; // pour débug détaillé DebugRoute:=formRoute.CheckBoxDebugRoutes.Checked; // pour debug @@ -22552,7 +23499,7 @@ begin if not ok then begin if affRouteR or DebugRoute then - Affiche('Route '+intToSTR(nroute)+' Détecteur '+intToSTR(actuel)+' à 1',clyellow); + Affiche('Route '+intToSTR(nroute)+' annulée car détecteur '+intToSTR(actuel)+' à 1',clyellow); result:=13; exit; end; @@ -22715,15 +23662,15 @@ begin end; if suivant=0 then TypSuiv:=buttoir; - if TypActuel=Triple then // pour faire droit droit + if TypActuel=Triple then // pour prendre aiguillage droit droit begin inc(id); - tabloroute[nroute,id-1].adresse:=aiguillage[indexAig].Adevie2; + tabloroute[nroute,id-1].adresse:=aiguillage[indexAig].Adrtriple; + tabloroute[nroute,id-1].typ:=triple; tabloroute[nroute,id-1].pos:=const_droit; tabloroute[nroute,id-1].talon:=false; end; - r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); if affrouteR then affiche('1.Retour explore_el de l''aig '+intToSTR(actuel)+' pos droit :'+intToSTR(r),clCyan); if r=9 then @@ -22748,9 +23695,24 @@ begin end; if suivant=0 then TypSuiv:=buttoir; - tabloroute[nroute,id-1].pos:=const_devie; - tabloroute[nroute,id-1].talon:=false; + if typActuel=Triple then // 1ere position: déviée : aig triple=adr1=devié - adr2=droit + begin + dec(id); + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].talon:=false; + inc(id); + tabloroute[nroute,id-1].adresse:=aiguillage[indexAig].Adrtriple; + + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].talon:=false; + end + else + begin + // aig normal + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id-1].talon:=false; + end; if nroute>NbreRoutes then NbreRoutes:=nroute; r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); if affrouteR then affiche('2.Retour explore_el de l''aig '+intToSTR(actuel)+' pos dévié :'+intToSTR(r),clCyan); @@ -22782,9 +23744,13 @@ begin TypSuiv:=aiguillage[indexAigSuiv].modele; end; if suivant=0 then TypSuiv:=buttoir; + dec(id); + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id-1].talon:=false; + inc(id); + tabloroute[nroute,id-1].adresse:=aiguillage[indexAig].Adrtriple; tabloroute[nroute,id-1].pos:=const_devie; tabloroute[nroute,id-1].talon:=false; - tabloroute[nroute,id-1].typ:=typsuiv; r:=explore_El(actuel,typActuel,Suivant,TypSuiv,nroute,id,ir,depart,fin,ctot); if affrouteR then affiche('2.Retour explore_el de l''aig '+intToSTR(actuel)+' pos dévié2 :'+intToSTR(r),clCyan); @@ -22807,8 +23773,37 @@ begin // aig ou triple en talon //déterminer la position - if aiguillage[indexaig].Adevie=prec then tabloroute[nroute,id].pos:=const_devie; - if aiguillage[indexaig].Adroit=prec then tabloroute[nroute,id].pos:=const_droit; + if typActuel=triple then + begin + tabloroute[nroute,id].talon:=true; + + inc(id); + //indexAig2:=index_aig(aiguillage[indexaig].Adrtriple); + tabloroute[nroute,id].adresse:=aiguillage[indexaig].Adrtriple; + tabloroute[nroute,id].typ:=triple; + + if aiguillage[indexaig].Adroit=prec then + begin + tabloroute[nroute,id-1].pos:=const_droit; // aig1 + tabloroute[nroute,id].pos:=const_droit; // aig2 + end; + if aiguillage[indexaig].Adevie=prec then + begin + tabloroute[nroute,id-1].pos:=const_devie; + tabloroute[nroute,id].pos:=const_droit; + end; + if aiguillage[indexaig].Adevie2=prec then + begin + tabloroute[nroute,id-1].pos:=const_droit; + tabloroute[nroute,id].pos:=const_devie; + end; + + end + else + begin + if aiguillage[indexaig].Adevie=prec then tabloroute[nroute,id].pos:=const_devie; + if aiguillage[indexaig].Adroit=prec then tabloroute[nroute,id].pos:=const_droit; + end; tabloroute[nroute,id].talon:=true; {if test_reboucle then @@ -22838,7 +23833,7 @@ begin if (typactuel=tjd) or (typactuel=tjs) then begin inc(id); - origine:=tabloroute[nroute,id-2].adresse; // d'où on vient + origine:=tabloroute[nroute,id-2].adresse; // d'où on vient : identique à prec/typprec !! prec:=origine; if (typPrec=aig) or (typPrec=tjd) or (typPrec=triple) then posPrec:=TabloRoute[nroute,id-2].pos; //position de l'aig précédent indexAig:=index_aig(actuel); // 28: entrée TJD @@ -23146,14 +24141,26 @@ begin // TJD d'entrée origine:=prec; - tabloroute[nroute,id-1].typ:=tjd; - tabloroute[nroute,id-1].adresse:=actuel; // 28 + TjdS:=aiguillage[indexAig].Ddroit; // TJD de sortie indexAig2:=index_Aig(TjdS); + + // trouver la bonne entrée de la TJD + if (aiguillage[indexAig2].Adroit=prec) or (aiguillage[indexAig2].ADevie=prec) then + begin + // c'est l'autre! + Echange(actuel,TjdS); // inverser les adresses + Echange(IndexAig,IndexAig2); // et les index + end; + TjdEntre:=actuel; + tabloroute[nroute,id-1].typ:=tjd; + tabloroute[nroute,id-1].adresse:=actuel; // 28 + + if typSuiv=det then c:='Z'; - if (typPrec=Tjd) or (TypPrec=det) then //le précédent est une TJD ou un détecteur (traité de la même façon, on ne vérifie pas l'élément B + if (typPrec=Tjd) or (TypPrec=det) then //le précédent est une TJD ou un détecteur (traité de la même façon, on ne vérifie pas l'élément B) begin // chercher d'ou on vient de la TJD if aiguillage[indexAig].Adroit=prec then @@ -23189,7 +24196,8 @@ begin c:=aiguillage[indexAig2].AdevieB; end; end; - if (typPrec=aig) or (typPrec=triple) then // le précédent est un aiguillage + + if (typPrec=aig) or (typPrec=triple) then // le précédent est un aiguillage ou un triple begin // si l'aig préc est dévié et n'a pas été pris en talon c:='P'; @@ -23197,8 +24205,17 @@ begin begin if typprec=triple then begin - adresse2:=aiguillage[indexAig].Adrtriple; - // à finir !!!Adevie2 + // position de l'aig triple: + // Droit : droit droit : le précédent est la 2ème adresse + // Dévié1 : dévié droit : le précédent est la 1ere adresse + // Dévié2 : droit dévié : le précédént est la 2ème adresse + if (tabloroute[nroute,id-3].pos=const_droit) and (tabloroute[nroute,id-2].pos=const_droit) then c:='D'; + if (tabloroute[nroute,id-3].pos=const_devie) and (tabloroute[nroute,id-2].pos=const_droit) then + begin + c:='S'; + prec:=tabloroute[nroute,id-3].adresse; + end; + if (tabloroute[nroute,id-3].pos=const_droit) and (tabloroute[nroute,id-2].pos=const_devie) then c:='S'; end else if tabloroute[nroute,id-2].pos=const_devie then c:='S' else c:='D'; end; @@ -23221,6 +24238,7 @@ begin c:=aiguillage[indexAig2].AdroitB; end else + if (aiguillage[indexAig].ADevie=prec) and (aiguillage[indexAig].ADevieB=c) then // on vient de Adevie begin // on vient de la position déviée de l'entrée de la TJD, ce qui détermine l'aiguille de sortie @@ -23248,11 +24266,6 @@ begin end; end; - if typPrec=triple then - begin - - end; - if (c='Z') or (c=#0) then TypSuiv:=det; if suivant=0 then TypSuiv:=buttoir; if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; @@ -23322,12 +24335,28 @@ begin c:=aiguillage[indexAig2].AdroitB; // ok cas validé end; end; - if typPrec=aig then // le précédent est un aiguillage + if (typPrec=aig) or (typprec=triple) then // le précédent est un aiguillage begin // si l'aig préc est dévié et n'a pas été pris en talon c:='P'; if not tabloroute[nroute,id-2].talon then - if (tabloroute[nroute,id-2].pos=const_devie) then c:='S' else c:='D'; + begin + if typprec=triple then + begin + // position de l'aig triple: + // Droit : droit droit : le précédent est la 2ème adresse + // Dévié1 : dévié droit : le précédent est la 1ere adresse + // Dévié2 : droit dévié : le précédént est la 2ème adresse + if (tabloroute[nroute,id-3].pos=const_droit) and (tabloroute[nroute,id-2].pos=const_droit) then c:='D'; + if (tabloroute[nroute,id-3].pos=const_devie) and (tabloroute[nroute,id-2].pos=const_droit) then + begin + c:='S'; + prec:=tabloroute[nroute,id-3].adresse; + end; + if (tabloroute[nroute,id-3].pos=const_droit) and (tabloroute[nroute,id-2].pos=const_devie) then c:='S'; + end + else if tabloroute[nroute,id-2].pos=const_devie then c:='S' else c:='D'; + end; // test d'ou l'on vient sur la tjd if (aiguillage[indexAig].ADroit=prec) and (aiguillage[indexAig].ADroitB=c) then // on vient de Adroit @@ -23374,12 +24403,6 @@ begin end; end; - if typPrec=triple then - begin - - end; - - if (c='Z') or (c=#0) then TypSuiv:=det; if suivant=0 then TypSuiv:=buttoir; if (c='S') or (c='D') or (c='P') then typSuiv:=aig else TypSuiv:=det; @@ -23770,10 +24793,10 @@ end; // CantonOrg : canton de départ (numéro) // arrivee : détecteur à trouver // sens de démarrage du canton de départ -procedure prepare_route(IndexTCO,CantonOrg,arrivee,sens : integer); -var r,i,j,n,p,nroute,id,Suiv,ctot,IndexCanton,prec,detDepart : integer; +function prepare_route(IndexTCO,CantonOrg,arrivee,sens : integer) : integer; +var r,i,j,n,p,nroute,id,Suiv,ctot,IndexCanton,prec,detDepart,det1,det2 : integer; s : string; - TypeS,TypeP : tequipement; + T1,t2,typeS,TypeP : tequipement; tg : boolean; temp : Tuneroute; begin @@ -23807,22 +24830,58 @@ begin indexCanton:=index_canton_numero(CantonOrg); // trouver l'élément précédent/suivant - case sens of + {case sens of SensTCO_O : begin prec:=canton[indexcanton].el2;TypeP:=canton[indexcanton].Typ2;Suiv:=canton[indexcanton].el1;TypeS:=canton[indexcanton].Typ1;end; SensTCO_E : begin prec:=canton[indexcanton].el1;TypeP:=canton[indexcanton].Typ1;Suiv:=canton[indexcanton].el2;TypeS:=canton[indexcanton].Typ2;end; SensTCO_N : begin prec:=canton[indexcanton].el2;TypeP:=canton[indexcanton].Typ2;Suiv:=canton[indexcanton].el1;TypeS:=canton[indexcanton].Typ1;end; SensTCO_S : begin prec:=canton[indexcanton].el1;TypeP:=canton[indexcanton].Typ1;Suiv:=canton[indexcanton].el2;TypeS:=canton[indexcanton].Typ2;end; end; - + } // la procédure explore_el attend un détecteur en 1er paramètre et un élément en 2ème paramètre detDepart:=0; - // pour le départ, on choisit l'un des deux éléments du canton qui est un détecteur - if TypeP=det then DetDepart:=prec; - if typeS=det then DetDepart:=suiv; + + // convention : le 1er élément de la route doit être un détecteur + // démarrer sur le détecteur à 1 du canton + det1:=canton[indexcanton].el1;T1:=canton[indexcanton].Typ1; + det2:=canton[indexcanton].el2;T2:=canton[indexcanton].Typ2; + + prec:=0; + if t1=det then + begin + if detecteur[det1].Etat then prec:=det1; + end; + if t2=det then + begin + if detecteur[det2].Etat then prec:=det2; + end; + if prec=0 then + begin + FormRoute.ListBoxRoutes.Clear; + FormRoute.ListBoxRoutes.items.AddObject('Erreur 846: aucun des deux détecteurs du canton n''est activé',pointer(CoulText)); + result:=1; + exit; + end; + detDepart:=prec; + TypeP:=det; + + zone_tco(indexTCO,DetDepart,det,sens,13,false,false); // trouver le suivant dans le sens, résultat dans xCanton, tel1 + Suiv:=xCanton; + TypeS:=tel1; + + if Suiv=0 then + begin + FormRoute.ListBoxRoutes.Clear; + FormRoute.ListBoxRoutes.items.AddObject('Erreur 15 : le sens de la loco du canton de départ aboutit à un buttoir',pointer(CoulText)); + result:=2; + exit; + end; + if detDepart=0 then begin - Affiche('Erreur 14 : configuration canton '+intToSTR(cantonOrg)+' sans détecteur contigu',clred); + FormRoute.ListBoxRoutes.Clear; + FormRoute.ListBoxRoutes.items.AddObject('Erreur 14 : configuration canton '+intToSTR(cantonOrg)+' sans détecteur contigu',pointer(CoulText)); + result:=3; exit; end; @@ -23845,19 +24904,14 @@ begin // stocker le départ nroute:=1; detAtrouve:=arrivee; - id:=2; + id:=1; ctot:=0; - tabloroute[nroute,1].adresse:=prec; - tabloroute[nroute,1].typ:=det; - tabloroute[nroute,0].adresse:=1; - + tabloroute[nroute,id].adresse:=DetDepart; + tabloroute[nroute,id].typ:=det; + tabloroute[nroute,0].adresse:=1; // nombre d'éléments + inc(id); // trouve toutes les routes de DetDeprt à Suivant - { - prec:=100;TypeP:=crois; - Suiv:=523;TypeS:=det; - DetDepart:=523;DetAtrouve:=523; - } Screen.Cursor:=crSQLWait; r:=explore_el(prec,TypeP,suiv,TypeS,nroute,id,0,DetDepart,detAtrouve,ctot); @@ -23932,6 +24986,7 @@ begin end; end; if traceListe then Affiche('il y a '+intToSTR(NbreRoutes)+' routes',clYellow); + result:=0; end; function route_restreinte_to_string(tablo : tUneRoute) : string; @@ -23973,23 +25028,24 @@ begin n:=tablo[0].adresse; if n<>0 then begin - s:=intToSTR(tablo[1].adresse)+'->'; // premier détecteur + // s:=intToSTR(tablo[1].adresse)+'->'; // premier détecteur + s:=''; for i:=1 to n do begin - p:=tablo[i].pos; + s:=s+intToSTR(tablo[i].adresse); typ:=tablo[i].typ; - if typ<>det then + if (typ=tjd) or (typ=tjs) or (typ=aig) or (typ=triple) then begin - s:=s+intToSTR(tablo[i].adresse)+' '; + p:=tablo[i].pos; case p of const_droit : s:=s+'droit'; const_devie : s:=s+'dev'; else s:=s+intToSTR(p); end; - s:=s+'->'; end; + if typ=crois then s:=s+'crois'; + if i'; end; - s:=s+intToSTR(tablo[n].adresse); // dernier détecteur end; result:=s; end; @@ -24001,7 +25057,6 @@ var i,j,n,p,nr : integer; s : string; typ : tequipement; begin -// Affiche_routes; nr:=0; for i:=1 to Ntrains do begin @@ -24038,7 +25093,11 @@ end; procedure TFormPrinc.Routes1Click(Sender: TObject); begin - formRouteTrain.show; + with formRouteTrain do + begin + TabSheetRA.Enabled:=true; + show; + end; end; procedure TFormPrinc.Codificationdestrains1Click(Sender: TObject); @@ -24048,7 +25107,7 @@ begin begin Affiche('Train '+intToSTR(i)+' @='+intToSTR(trains[i].adresse)+' '+trains[i].nom_train+ ' Roulage='+intToSTR(trains[i].roulage)+ - ' Vitesse='+intToSTR(trains[i].vitesse)+ + ' Vitesse='+intToSTR(trains[i].vitesseCons)+ ' DernierDet='+intToSTR(trains[i].dernierDet) ,clyellow); // ' DetDepart='+intToSTR(trains[i].Det_depart)+' DetFin='+intToSTR(trains[i].Det_fin),clYellow); @@ -24066,16 +25125,34 @@ begin end; procedure TFormPrinc.Button3Click(Sender: TObject); -var prec,suiv,nroute,id,detDepart,detAtrouve,ctot : integer; - TypeP,TypeS : tequipement; begin - //debugTCO:=true; - //zone_tco(1,30,SensTCO_O,0,0,11,false); - //debugtco:=false; - affiche(intToSTR(Trains[4].sens),clred); + event_det_train[1].NbEl:=0; + end; + +procedure TFormPrinc.MesurerlavitessedestrainsClick(Sender: TObject); +begin + if CDM_connecte then + begin + Affiche('La mesure de la vitesse des trains n''est disponible qu''en mode autonome sans CDM rail',clYellow); + exit; + end; + if (parSocketLenz or portCommOuvert) then FormMesure.showModal + else Affiche('Interface non connectée',clYellow); +end; + + +procedure TFormPrinc.Affichelamesuredesvitesses1Click(Sender: TObject); +begin + Affiche_mesure_trains; +end; + +procedure TFormPrinc.Button0Click(Sender: TObject); +begin + EditVitesse.Text:='0'; + TrackBarVit.Position:=0; +end; + +begin end. - - - diff --git a/UnitRoute.pas b/UnitRoute.pas index 6b52d0f..78e2e3d 100644 --- a/UnitRoute.pas +++ b/UnitRoute.pas @@ -67,21 +67,23 @@ var procedure raz_route_fenetre; procedure raz_toutes_routes; -procedure efface_route_tco; +procedure efface_route_tco(affecte_loco :boolean); function affiche_route_tco : boolean; procedure Efface_Affiche_route; implementation -uses UnitDebug,unitTCO,UnitConfig, UnitRouteTrains; +uses UnitDebug,unitTCO,UnitConfig, UnitRouteTrains , Selection_Train; {$R *.dfm} -// efface la route parcoursDet[] -procedure efface_route_tco; +// efface la route parcoursDet[] du TCO indexTCOcourant +// si affecte_loco=true : affecte la loco rencontrée aux cantons +procedure efface_route_tco(affecte_loco :boolean); var n,det1,nti,x,y,det2,i,indexAig : integer; t : tequipement; begin + if Nbretco<1 then exit; n:=parcoursdet[0].adresse; det1:=parcoursdet[1].adresse; for i:=2 to n do @@ -96,7 +98,7 @@ begin end; if t=det then begin - zone_tco(1,det1,det2,1,0,0,true); // mode "aiguillages mis" + zone_tco(indexTCOcourant,det1,det2,1,0,0,true,affecte_loco); // mode "aiguillages mis" det1:=det2; end; end; @@ -130,21 +132,21 @@ end; // efface la fenetre et la route du tco procedure raz_route_fenetre; begin - efface_route_tco; + efface_route_tco(false); // ne change pas l'affectation de la loco rencontrée formRoute.ListBoxRoutes.Clear; Indexligneroute:=-1; NumRoute:=-1; end; -// Affiche sans effacer l'ancienne, la route du TCO du tableau ParcoursDet[] -// détruit l'index du train dans le canton !!!! + +// Affiche sans effacer l'ancienne, la route du TCO indexTCOcourant du tableau ParcoursDet[] function Affiche_route_TCO : boolean ; var i,n,det1,det2,indexAig : integer; t :tequipement; ok : boolean; begin - //exit; + if Nbretco<1 then begin result:=false;exit;end; n:=ParcoursDet[0].adresse; ok:=true; det1:=parcoursDet[1].adresse; @@ -161,7 +163,8 @@ begin if t=det then begin det2:=ParcoursDet[i].adresse; - ok:=zone_tco(1,det1,det2,1,0,1,true) and ok; //çà efface laloco du canton + // tco,det1,det2,train,adrTrain,Mode,posAig,affecte_loco + ok:=zone_tco(indexTCOcourant,det1,det2,1,0,1,true,false) and ok; //posAig=true=teste les routes en récursif affecte_loco=n'affecte pas la loco det1:=det2; end; end; @@ -179,12 +182,13 @@ begin result:=ok; end; -// Efface, fabrique le tableau ParcoursDet[] depuis TabloRoute[id] affiche la route dans le TCO contenue dans ParcoursDet[] +// Efface, fabrique le tableau ParcoursDet[] depuis TabloRoute[id] et affiche la route dans le TCO contenue dans ParcoursDet[] procedure Efface_Affiche_route; var n,id : integer; ok : boolean; s : string; begin + if Nbretco<1 then exit; AncLigneRoute:=IndexLigneRoute; if IndexLigneRoute<0 then exit; @@ -192,7 +196,7 @@ begin formRoute.ButtonDetail.caption:='Détail route '+intToSTR(id+1); formRoute.ButtonEfface.caption:='Efface route '+intToSTR(id+1)+' du TCO'; - efface_route_tco; + efface_route_tco(false); // fabriquer le tableau parcoursDet[] depuis tabloRoute[] parcoursDet:=tabloRoute[NumRoute]; @@ -211,7 +215,6 @@ end; procedure clic_route(r : integer); var idTrain : integer; begin -// IndexLigneRoute:=r; // copier la route au train if (idcantonroute<1) or (Indexligneroute<0) then exit; idTrain:=Index_Train_adresse(canton[idCantonRoute].AdrTrainRoute); @@ -227,8 +230,8 @@ begin formRoute.ButtonFenPil.enabled:=trains[IdTrain].route[0].adresse<>0; + // efface une éventuelle autre route du tco et affiche la route cliquée dans le tco Efface_affiche_route; - end; // transforme la liste de chaine des cantons obligatoires en détecteurs @@ -309,11 +312,9 @@ end; // affiche les routes du train courant procedure maj_fenetre; -var iI,iO,c,l,pluslongue,n,i,j,k,pixelLength,erreur,np : integer; +var iI,iO,l,pluslongue,n,j,k,pixelLength,np : integer; s,chaineLongue : string; trouveObl,trouveint,aflongue : boolean; - list_cantons_obl : array[1..10] of integer; - begin if (idcantonroute<1) or (cantonorg=0) or (cantonDest=0) then begin @@ -329,7 +330,6 @@ begin formRoute.ButtonEfface.caption:='Efface route '; if idcantonRoute<>0 then formRoute.ListBoxRoutes.Hint:='Sélectionne une route pour l''affecter au train '+canton[idcantonRoute].NomTrain; - formRoute.listBoxRoutes.Clear; IdCantonClic:=Idcantonroute; IdTrainCourant:=canton[idcantonRoute].indexTrain; @@ -347,6 +347,9 @@ begin // regarder chaque route pour les détecteurs obligatoires / interdits et l'afficher aflongue:=FormRoute.checkBoxRoutesLongues.checked; np:=tabloroute[1,0].adresse; + + if NbreRoutes>0 then formRoute.listBoxRoutes.Clear; + for j:=1 to NbreRoutes do begin // compter le nombre de détecteur obligatoires et interdits @@ -416,7 +419,7 @@ begin Screen.Cursor:=crDefault; PixelLength:=FormRoute.ListboxRoutes.Canvas.TextWidth(chaineLongue)+30; - // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength + // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength SendMessage(FormRoute.ListBoxRoutes.Handle,LB_SETHORIZONTALEXTENT,PixelLength,0); // icone train @@ -451,7 +454,7 @@ end; procedure TFormRoute.ButtonEffaceClick(Sender: TObject); begin - efface_route_tco; + efface_route_tco(false); end; procedure TFormRoute.ButtonQuitteClick(Sender: TObject); @@ -499,7 +502,7 @@ end; procedure RAZ_toutes_routes; var i,idt : integer; begin - efface_route_tco; + efface_route_tco(false); raz_route_fenetre; // raz état des boutons des cantons org et dest @@ -604,24 +607,28 @@ begin end; end; - efface_route_tco; + efface_route_tco(false); end; procedure TFormRoute.ButtonFenPilClick(Sender: TObject); begin if idcantonRoute<1 then exit; indexTrainFR:=canton[idcantonRoute].indexTrain; - FormRouteTrain.show; + with FormRouteTrain do + begin + TabSheetRA.Enabled:=true; + show; + end; close; end; procedure TFormRoute.ButtonParcours(Sender: TObject); -var i,j,n,p,det1,det2 : integer; +var i,j,n,p,det1,det2,indexAig : integer; s : string; typ : tequipement; begin if (Indexligneroute<0) or (NumRoute<1) then exit; - efface_route_tco; + efface_route_tco(false); hide; j:=NumRoute; n:=tabloroute[j,0].adresse; @@ -633,12 +640,20 @@ begin p:=tabloRoute[j,i].pos; typ:=tabloRoute[j,i].typ; + if (typ=aig) or (typ=tjd) or (typ=triple) then + begin + indexaig:=index_aig(ParcoursDet[i].adresse); + aiguillage[indexAig].AncPos:=aiguillage[IndexAig].position; // sauvegarder position + //Affiche('Aig='+intToSTR(ParcoursDet[i].adresse)+' pos='+intToSTR(aiguillage[IndexAig].position),clYellow); + aiguillage[indexAig].position:=ParcoursDet[i].pos; // forcer la position de l'aiguillage sue le parcours + end; + if typ=det then begin // attention on ne gère que le TCO1 - Zone_TCO(1,det1,det2,1,0,0,false); // faire true et positionner les aiguillages + Zone_TCO(indexTCOcourant,det1,det2,1,0,0,true,false); // faire true et positionner les aiguillages det1:=det2; det2:=tabloroute[j,i].adresse; - Zone_TCO(1,det1,det2,1,0,1,false); + Zone_TCO(indexTCOcourant,det1,det2,1,0,1,false,false); FormTCO[1].Caption:=intToSTR(i)+'/'+intToSTR(n)+' '+intToSTR(det1)+' '+intToSTR(det2)+ ' Arrêt par touche Echap'; //Affiche(intToSTR(det1)+' '+intToSTR(det2),clyellow); end; @@ -648,6 +663,19 @@ begin inc(i); until (i>n) or (toucheTCO=#27); + + // remettre les aiguillages + for i:=2 to n do + begin + typ:=ParcoursDet[i].typ; + if (typ=aig) or (typ=tjd) or (typ=triple) then + begin + indexaig:=index_aig(ParcoursDet[i].adresse); + aiguillage[indexAig].Position:=aiguillage[indexAig].AncPos; // restitue position + end; + end; + + Affiche_route_tco; titre_fenetre(1); Show; //Affiche('Fini',clred); @@ -669,7 +697,7 @@ begin end; procedure TFormRoute.ButtonTrouverClick(Sender: TObject); -var sens,sensCanton,indexTCO,IdCantonOrg : integer; +var r,sens,sensCanton,indexTCO,IdCantonOrg : integer; begin if cantonOrg=0 then exit; @@ -683,19 +711,25 @@ begin SensBas : begin sens:=SensTCO_S;end; end; IndexTCO:=canton[IdcantonOrg].Ntco; - prepare_route(IndexTCO,CantonOrg,DetaTrouve,sens); + r:=prepare_route(IndexTCO,CantonOrg,DetaTrouve,sens); + if r<>0 then + begin + { case r of + 1 : s:='Erreur 846: aucun des deux détecteurs du canton n''est activé'; + 2 : s:='Erreur 15 : le sens de la loco du canton de départ aboutit à un buttoir'; + 3 : s:='Erreur 14 : configuration canton de départ '+intToSTR(canton[cantonOrg].numero)+' sans détecteur contigu'; + end; + ListBoxRoutes.Clear; + ListBoxRoutes.items.AddObject(s,pointer(CoulText)); } + exit; + end; maj_fenetre; - end; procedure TFormRoute.ListBoxRoutesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); - var - myColor: TColor; - myBrush: TBrush; - myPen : Tpen; begin - myBrush := TBrush.Create; + //myBrush := TBrush.Create; with (Control as TListBox).Canvas do // draw on control canvas, not on the form begin { if Index = 3 then @@ -710,7 +744,6 @@ begin //Pen.color:=clWhite;//CoulText; //myBrush.color:=clBlue; //Brush.Style := bsClear; - // display the text // TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]); //MyBrush.Free; FillRect(Rect); diff --git a/UnitRouteTrains.dfm b/UnitRouteTrains.dfm index bdf8b99..724078a 100644 --- a/UnitRouteTrains.dfm +++ b/UnitRouteTrains.dfm @@ -1,10 +1,10 @@ object FormRouteTrain: TFormRouteTrain - Left = 518 - Top = 183 + Left = 202 + Top = 190 BorderStyle = bsDialog Caption = 'Liste des routes affect'#233'es aux trains' - ClientHeight = 156 - ClientWidth = 580 + ClientHeight = 194 + ClientWidth = 853 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -14,120 +14,258 @@ object FormRouteTrain: TFormRouteTrain OldCreateOrder = False OnActivate = FormActivate OnClose = FormClose + OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 - object ImageTrainR: TImage - Left = 328 - Top = 8 - Width = 241 - Height = 33 - ParentShowHint = False - ShowHint = False - end - object LabelRoute: TLabel - Left = 16 - Top = 48 - Width = 71 - Height = 13 - Caption = 'Route affect'#233'e' + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 849 + Height = 193 + Caption = 'Panel1' + Color = clBtnShadow + TabOrder = 3 + object LabelRoute: TLabel + Left = 8 + Top = 112 + Width = 71 + Height = 13 + Caption = 'Route affect'#233'e' + end + object ImageTrainR: TImage + Left = 8 + Top = 8 + Width = 241 + Height = 33 + ParentShowHint = False + ShowHint = False + end end object ComboBoxTrains: TComboBox - Left = 16 - Top = 16 - Width = 225 + Left = 8 + Top = 56 + Width = 241 Height = 21 Style = csDropDownList ItemHeight = 13 TabOrder = 0 OnChange = ComboBoxTrainsChange end + object PageControlRoutes: TPageControl + Left = 256 + Top = 8 + Width = 585 + Height = 177 + ActivePage = TabSheetRM + TabOrder = 1 + object TabSheetRA: TTabSheet + Caption = 'Route affect'#233'e' + object LabelRC: TLabel + Left = 8 + Top = 16 + Width = 154 + Height = 13 + Caption = 'Route courante affect'#233'e au train' + end + object ButtonEfface: TButton + Left = 384 + Top = 108 + Width = 97 + Height = 33 + Hint = 'Efface le trac'#233' du train s'#233'lectionn'#233' du TCO' + Caption = 'Efface route du TCO' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + WordWrap = True + OnClick = ButtonEffaceClick + end + object ButtonSupprime: TButton + Left = 275 + Top = 108 + Width = 97 + Height = 33 + Hint = 'Supprime la route du train s'#233'lectionn'#233 + Caption = 'Supprimer la route du train' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + WordWrap = True + OnClick = ButtonSupprimeClick + end + object ButtonRouler1Tr: TButton + Left = 184 + Top = 108 + Width = 83 + Height = 33 + Hint = 'Roule le train s'#233'lectionn'#233' s'#39'il dispose d'#39'une route' + Caption = 'Rouler le train' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + WordWrap = True + OnClick = ButtonRouler1TrClick + end + object ButtonRoulerTsTrains: TButton + Left = 96 + Top = 108 + Width = 75 + Height = 33 + Hint = 'Roule tous les trains qui ont une route affect'#233'e' + Caption = 'Rouler tous les trains' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + WordWrap = True + OnClick = ButtonRoulerTsTrainsClick + end + object ButtonSauveRoute: TButton + Left = 8 + Top = 108 + Width = 81 + Height = 33 + Hint = 'Sauve la route et l'#39'affecte '#224' ce train' + Caption = 'Sauve route' + ParentShowHint = False + ShowHint = True + TabOrder = 4 + OnClick = ButtonSauveRouteClick + end + object ListBoxRA: TListBox + Left = 8 + Top = 40 + Width = 561 + Height = 49 + Color = clBlack + Font.Charset = DEFAULT_CHARSET + Font.Color = clYellow + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + TabOrder = 5 + OnMouseDown = ListBoxRAMouseDown + end + object CheckBoxSIRA: TCheckBox + Left = 464 + Top = 14 + Width = 97 + Height = 17 + Hint = 'Consigne inverse du train' + Caption = 'Sens inverse' + ParentShowHint = False + ShowHint = True + TabOrder = 6 + OnClick = CheckBoxSIRAClick + end + end + object TabSheetRM: TTabSheet + Caption = 'Routes m'#233'moris'#233'es' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ImageIndex = 1 + ParentFont = False + object LabelRM: TLabel + Left = 8 + Top = 8 + Width = 135 + Height = 13 + Caption = 'Route m'#233'moris'#233'e de ce train' + end + object Label1: TLabel + Left = 264 + Top = 8 + Width = 78 + Height = 13 + Caption = 'Nom de la route:' + end + object ButtonM: TButton + Left = 8 + Top = 110 + Width = 81 + Height = 33 + Hint = + 'Affecter la route '#224' ce train et affecter le train au canton dans' + + ' le sens de d'#233'marrage de la route' + Caption = 'Choisir cette route' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + WordWrap = True + OnClick = ButtonMClick + end + object ListBoxRM: TListBox + Left = 8 + Top = 32 + Width = 561 + Height = 73 + Color = clBlack + Font.Charset = DEFAULT_CHARSET + Font.Color = clYellow + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + TabOrder = 1 + OnKeyDown = ListBoxRMKeyDown + OnMouseDown = ListBoxRMMouseDown + end + object ButtonSR: TButton + Left = 104 + Top = 110 + Width = 81 + Height = 33 + Caption = 'Supprimer route' + TabOrder = 2 + WordWrap = True + OnClick = ButtonSRClick + end + object ButtonSRS: TButton + Left = 200 + Top = 110 + Width = 81 + Height = 33 + Hint = 'Sauve les routes m'#233'moris'#233'es' + Caption = 'Sauve routes' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnClick = ButtonSRSClick + end + object EditnomRoute: TEdit + Left = 344 + Top = 5 + Width = 217 + Height = 21 + TabOrder = 4 + OnChange = EditnomRouteChange + end + object CheckBoxSens: TCheckBox + Left = 352 + Top = 118 + Width = 97 + Height = 17 + Hint = 'Consigne inverse du train' + Caption = 'Sens inverse' + ParentShowHint = False + ShowHint = True + TabOrder = 5 + OnClick = CheckBoxSensClick + end + end + end object ButtonQuitte: TButton Left = 8 - Top = 120 + Top = 156 Width = 81 Height = 33 Caption = 'Quitter' - TabOrder = 1 + TabOrder = 2 OnClick = ButtonQuitteClick end - object RichEditRoute: TRichEdit - Left = 8 - Top = 64 - Width = 569 - Height = 49 - Color = clNone - Font.Charset = DEFAULT_CHARSET - Font.Color = clYellow - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - ReadOnly = True - TabOrder = 2 - OnMouseDown = RichEditRouteMouseDown - end - object ButtonEfface: TButton - Left = 480 - Top = 120 - Width = 97 - Height = 33 - Hint = 'Efface le trac'#233' du train s'#233'lectionn'#233' du TCO' - Caption = 'Efface route du TCO' - ParentShowHint = False - ShowHint = True - TabOrder = 3 - WordWrap = True - OnClick = ButtonEffaceClick - end - object ButtonSupprime: TButton - Left = 371 - Top = 120 - Width = 97 - Height = 33 - Hint = 'Supprime la route du train s'#233'lectionn'#233 - Caption = 'Supprimer la route du train' - ParentShowHint = False - ShowHint = True - TabOrder = 4 - WordWrap = True - OnClick = ButtonSupprimeClick - end - object ButtonRouler1Tr: TButton - Left = 280 - Top = 120 - Width = 83 - Height = 33 - Hint = 'Roule le train s'#233'lectionn'#233' s'#39'il dispose d'#39'une route' - Caption = 'Rouler le train' - ParentShowHint = False - ShowHint = True - TabOrder = 5 - WordWrap = True - OnClick = ButtonRouler1TrClick - end - object ButtonRoulerTsTrains: TButton - Left = 192 - Top = 120 - Width = 75 - Height = 33 - Hint = 'Roule tous les trains qui ont une route affect'#233'e' - Caption = 'Rouler tous les trains' - ParentShowHint = False - ShowHint = True - TabOrder = 6 - WordWrap = True - OnClick = ButtonRoulerTsTrainsClick - end - object ButtonSauveRoute: TButton - Left = 104 - Top = 120 - Width = 81 - Height = 33 - Hint = 'Sauve la route et l'#39'affecte '#224' ce train' - Caption = 'Sauve route' - ParentShowHint = False - ShowHint = True - TabOrder = 7 - OnClick = ButtonSauveRouteClick - end end diff --git a/UnitRouteTrains.pas b/UnitRouteTrains.pas index d63299f..d2bdf6e 100644 --- a/UnitRouteTrains.pas +++ b/UnitRouteTrains.pas @@ -12,15 +12,29 @@ uses type TFormRouteTrain = class(TForm) ComboBoxTrains: TComboBox; - ImageTrainR: TImage; - ButtonQuitte: TButton; - RichEditRoute: TRichEdit; - LabelRoute: TLabel; + PageControlRoutes: TPageControl; + TabSheetRA: TTabSheet; + TabSheetRM: TTabSheet; ButtonEfface: TButton; ButtonSupprime: TButton; ButtonRouler1Tr: TButton; ButtonRoulerTsTrains: TButton; ButtonSauveRoute: TButton; + ButtonM: TButton; + ButtonQuitte: TButton; + Panel1: TPanel; + LabelRoute: TLabel; + ImageTrainR: TImage; + ListBoxRM: TListBox; + ListBoxRA: TListBox; + LabelRC: TLabel; + LabelRM: TLabel; + ButtonSR: TButton; + ButtonSRS: TButton; + EditnomRoute: TEdit; + Label1: TLabel; + CheckBoxSens: TCheckBox; + CheckBoxSIRA: TCheckBox; procedure FormActivate(Sender: TObject); procedure ButtonQuitteClick(Sender: TObject); procedure ComboBoxTrainsChange(Sender: TObject); @@ -32,6 +46,19 @@ type procedure ButtonRouler1TrClick(Sender: TObject); procedure ButtonRoulerTsTrainsClick(Sender: TObject); procedure ButtonSauveRouteClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ButtonMClick(Sender: TObject); + procedure ListBoxRMMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure ListBoxRAMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure ButtonSRClick(Sender: TObject); + procedure ButtonSRSClick(Sender: TObject); + procedure EditnomRouteChange(Sender: TObject); + procedure ListBoxRMKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure CheckBoxSensClick(Sender: TObject); + procedure CheckBoxSIRAClick(Sender: TObject); private { Déclarations privées } public @@ -40,13 +67,15 @@ type var FormRouteTrain: TFormRouteTrain; + IrPref : integer; function aig_canton(idTrain,detect : integer) : integer; function demarre_index_train(indexTrain : integer) : boolean; +procedure couleurs_routeTrains; implementation -uses unitprinc,UnitConfig,unitTCO,UnitHorloge,unitFicheHoraire,UnitDebug,UnitRoute; +uses unitprinc,UnitConfig,unitTCO,UnitHorloge,unitFicheHoraire,UnitDebug,UnitRoute,selection_train; {$R *.dfm} @@ -61,6 +90,7 @@ var i,n,det1,el2,vitesse,AdrTrain,idcanton,voie1,voie2,indexSig1,indexSig2,AdrSi begin formprinc.SBMarcheArretLoco.Visible:=true; + //Affiche('demarre_index_Train',clWhite); // si il y a un signal sur le détecteur de démarrage du train est il au rouge? @@ -75,76 +105,78 @@ begin trouve:=detecteur[detect].AdrTrain=AdrTrain; inc(i); until trouve or (i>NDetecteurs); - if not trouve then detect:=0; - - if trouve then + if not trouve then begin - trains[indexTrain].dernierdet:=detect; - if debugRoulage then + detect:=0; + Affiche('Le train '+train+' n''est pas déclaré sur le détecteur d''un canton',clOrange); + Affiche('ou le décteur du train n''est pas activé',clOrange); + exit; + end; + + roulage:=true; + trains[indexTrain].dernierdet:=detect; + if debugRoulage then + begin + Affiche('Le train '+train+' est sur le détecteur '+intToSTR(detect),clWhite); + end; + + index_signal_det(detect,voie1,indexSig1,voie2,indexSig2); + AdrSig1:=0;AdrSig2:=0; + if indexSig1<>0 then AdrSig1:=signaux[indexSig1].adresse; + if indexSig2<>0 then AdrSig2:=signaux[indexSig2].adresse; + + // si le détecteur sur le train au départ dispose d'un signal + if (AdrSig1<>0) or (AdrSig2<>0) then + begin + // trouver le premier détecteur de la route et son suivant non traité pour trouver le signal dans le bon sens + n:=trains[indexTrain].route[0].adresse; + i:=1;det1:=0;el2:=0;trouve:=false; + with trains[indexTrain] do begin - Affiche('Le détecteur du train '+train+' est le '+intToSTR(detect),clWhite); + repeat + if route[i].typ=det then + begin + det1:=route[i].adresse; + el2:=route[i+1].adresse;tel2:=route[i+1].typ; + trouve:=true + end; + inc(i); + until trouve or (i>n); end; - index_signal_det(detect,voie1,indexSig1,voie2,indexSig2); - AdrSig1:=0;AdrSig2:=0; - if indexSig1<>0 then AdrSig1:=signaux[indexSig1].adresse; - if indexSig2<>0 then AdrSig2:=signaux[indexSig2].adresse; - - // si le détecteur sur le train au départ dispose d'un signal - if (AdrSig1<>0) or (AdrSig2<>0) then + //trouve le signal dans le bon sens + IndexSig:=0; + if AdrSig1<>0 then begin - // trouver le premier détecteur de la route et son suivant non traité pour trouver le signal dans le bon sens - n:=trains[indexTrain].route[0].adresse; - i:=1;det1:=0;el2:=0;trouve:=false; - with trains[indexTrain] do - begin - repeat - if route[i].typ=det then - begin - det1:=route[i].adresse; - el2:=route[i+1].adresse;tel2:=route[i+1].typ; - trouve:=true - end; - inc(i); - until trouve or (i>n); - end; + if (signaux[indexSig1].Adr_el_suiv1=el2) and (signaux[indexSig1].Btype_suiv1=tel2) then IndexSig:=IndexSig1; + end; + if adrSig2<>0 then + begin + if (signaux[indexSig2].Adr_el_suiv1=el2) and (signaux[indexSig2].Btype_suiv1=tel2) then IndexSig:=IndexSig2; + end; - //trouve le signal dans le bon sens - IndexSig:=0; - if AdrSig1<>0 then + AdrSig:=signaux[indexSig].adresse; + if adrSig<>0 then + begin + if traceliste then Affiche('Le signal dans le bon sens est '+intToSTR(AdrSig)+' '+chaine_signal(AdrSig),clOrange); + if signal_rouge(AdrSig) then begin - if (signaux[indexSig1].Adr_el_suiv1=el2) and (signaux[indexSig1].Btype_suiv1=tel2) then IndexSig:=IndexSig1; - end; - if adrSig2<>0 then - begin - if (signaux[indexSig2].Adr_el_suiv1=el2) and (signaux[indexSig2].Btype_suiv1=tel2) then IndexSig:=IndexSig2; - end; - - AdrSig:=signaux[indexSig].adresse; - if adrSig<>0 then - begin - if traceliste then Affiche('Le signal dans le bon sens est '+intToSTR(AdrSig)+' '+chaine_signal(AdrSig),clOrange); - if signal_rouge(AdrSig) then - begin - s:='Le train '+train+' est arreté au signal '+intToSTR(signaux[IndexSig].adresse); - affiche(s,clyellow); - trains[indexTrain].roulage:=1; - exit; // on sort car on ne démarre pas un train arrêté au rouge - end; + s:='Le train '+train+' est arreté au signal '+intToSTR(signaux[IndexSig].adresse); + affiche(s,clyellow); + trains[indexTrain].roulage:=1; + exit; // on sort car on ne démarre pas un train arrêté au rouge end; end; end; vitesse:=trains[indexTrain].VitNominale; - if roulage then - begin - if trains[indexTrain].inverse then vitesse:=-vitesse; - Idcanton:=trains[indexTrain].canton; + // trains[indexTrain].route[0].talon:=grilleHoraire[i].sens; // copier le sens +// if trains[indexTrain].inverse then vitesse:=-vitesse; - //init_route_canton(idcanton,Indextrain,true); - - end; + if trains[indexTrain].route[0].talon then vitesse:=-vitesse; + Idcanton:=trains[indexTrain].canton; + // à supprimer, utilisé pour démarrer le train à la vitesse de la grille horaire mais à supprimer aussi if horloge then begin // trouver le train dans la grille horaire @@ -159,17 +191,14 @@ begin begin dec(i); vitesse:=GrilleHoraire[i].vitesse; + if trains[indexTrain].route[0].talon then vitesse:=-vitesse; trains[indexTrain].roulage:=2; - vitesse_loco(train,indextrain,adrTrain,vitesse,true); + vitesse_loco(train,indextrain,adrTrain,vitesse,10); end; end; Maj_Signaux(true); // avec détecteurs - if not(roulage) then exit; - - - s:='Lancement du train '+train; if detect<>0 then s:=s+' depuis détecteur '+intToSTR(Detect); Affiche(s,clYellow); @@ -177,22 +206,44 @@ begin trains[indexTrain].roulage:=2; if traceListe then AfficheDebug(s,clyellow); + // supprimer les evts du trains + + i:=1; + repeat + if event_det_train[i].AdrTrain=AdrTrain then + begin + event_det_train[i].NbEl:=1; + event_det_train[i].Det[1].adresse:=trains[indexTrain].DetecteurA; + event_det_train[i].Det[1].etat:=true; + end; + inc(i); + until (i>n_trains); + + i:=trains[indexTrain].TempsDemarreSig; if i=0 then i:=1; trains[indextrain].TempoDemarre:=i; // démarrage à la vitesse nominale end; +// mise à jour des infos de la fenetre : combobox procedure maj_infos(idtrain : integer); -var i : integer; +var i,j,indexcanton,det1,det2,PixelLength : integer; s : string; begin formRouteTrain.comboBoxTrains.Clear; - + formRouteTrain.ListBoxRM.Clear; for i:=1 to NTrains do begin s:=trains[i].nom_train; if trains[i].route[0].adresse<>0 then s:=s+' [route affectée]'; + j:=trains[i].routePref[0][0].adresse; + if j<>0 then + begin + s:=s+' ['+intToSTR(j)+' route'; + if j=1 then s:=s+' mémorisée]'; + if j>1 then s:=s+'s mémorisées]'; + end; formRouteTrain.comboBoxTrains.items.add(s); end; @@ -201,15 +252,48 @@ begin Maj_icone_train(FormRouteTrain.ImageTrainR,idTrain); with formRouteTrain do begin - RicheditRoute.Clear; - RichEditRoute.Lines.Add(route_restreinte_to_string(trains[idTrain].route)); - if trains[idtrain].route[0].adresse<>0 then + TabSheetRM.Enabled:=false; + ListBoxRA.Clear; + + if trains[idtrain].route[0].adresse<>0 then // route affectée au train begin + LabelRC.Caption:='Route courante affectée au train '+trains[idtrain].nom_train+ + ' : '+trains[idTrain].NomRouteCour; + s:=route_restreinte_to_string(trains[idTrain].route); + ListBoxRA.items.Add(s); + // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength + PixelLength:=Canvas.TextWidth(s)+30; + SendMessage(ListBoxRA.Handle,LB_SETHORIZONTALEXTENT,PixelLength,0); + labelroute.caption:='Route affectée au train '+trains[idtrain].nom_train; ButtonRouler1tr.caption:='Rouler le train '+trains[idtrain].nom_train; ButtonRouler1tr.enabled:=true; end - else + else LabelRC.Caption:='Pas de route courante affectée au train '+trains[idtrain].nom_train; + + j:=trains[idtrain].routePref[0][0].adresse; + if j<>0 then // route mémorisée du train + begin + s:=intToSTR(j)+' route'; + if j=1 then s:=s+' mémorisée au train '; + if j>1 then s:=s+'s mémorisées au train '; + s:=s+trains[idtrain].nom_train; + LabelRM.Caption:=s; + TabSheetRM.Enabled:=true; + i:=1; + PixelLength:=0; + for j:=1 to trains[idtrain].routePref[0][0].adresse do + begin + s:=IntToSTR(j)+'. '+route_restreinte_to_string(trains[idTrain].routePref[j]); + if Canvas.TextWidth(s)+30>PixelLength then PixelLength:=Canvas.TextWidth(s)+30; + ListBoxRM.Items.Add(s); + end; + EditNomRoute.Text:=trains[idTrain].NomRouteCour; + SendMessage(ListBoxRM.Handle,LB_SETHORIZONTALEXTENT,PixelLength,0); // crée la HorzScroll baz + end + else LabelRM.Caption:='Pas de route mémorisée au train '+trains[idtrain].nom_train; + + if (trains[idTrain].route[0].adresse=0) and (trains[idTrain].routePref[1][0].adresse=0) then begin labelroute.caption:='Pas de route affectée au train '+trains[idtrain].nom_train; ButtonRouler1tr.caption:=' '; @@ -233,7 +317,7 @@ end; procedure TFormRouteTrain.ComboBoxTrainsChange(Sender: TObject); begin indexTrainFR:=ComboBoxTrains.ItemIndex+1; - efface_route_tco; + efface_route_tco(false); maj_infos(indexTrainFR); end; @@ -245,15 +329,16 @@ begin if trains[indexTrainFR].roulage=0 then affiche_route_tco; end; + procedure TFormRouteTrain.ButtonEffaceClick(Sender: TObject); begin - efface_route_tco; + efface_route_tco(false); end; procedure TFormRouteTrain.FormClose(Sender: TObject; var Action: TCloseAction); begin - efface_route_tco; + efface_route_tco(false); end; procedure TFormRouteTrain.ButtonSupprimeClick(Sender: TObject); @@ -267,11 +352,11 @@ begin ,mtConfirmation,[mbNo,mbYes],0) ; if r=mrNo then exit; - efface_route_tco; + efface_route_tco(false); supprime_route_train(indexTrainFR); + maj_infos(indexTrainFR); - close; end; // Réserve les éléments s'ils ne sont pas déja réservés et positionne les aiguillages @@ -373,7 +458,8 @@ begin begin // route traitée , arrêter le train if debugRoulage then Affiche('AC - Route terminée *****',clred); - trains[idTrain].arret_det:=true; + trains[idTrain].arret_det:=true; // arret du train par le timer + trains[idTrain].PointRout:=0; Trains[idTrain].phase_arret:=0; end; @@ -484,6 +570,7 @@ begin if aiguillage[index].AdrTrain=0 then begin pilote_acc(adr,pos,AdrTrain); // pilote l'aig si il est reservé par le train ou non réservé + Sleep(100); s:='AC-Pilote aiguillage '+intToSTR(adr)+'='+intToSTR(pos); case pos of const_devie : s:=s+' (dévié)'; @@ -494,7 +581,7 @@ begin if debugRoulage then Affiche(s,clWhite); if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig); // réservation - Affiche('Réservation Aig '+intToSTR(adr),clCyan); + if debugRoulage then Affiche('Réservation Aig '+intToSTR(adr),clCyan); aiguillage[index].adrTrain:=AdrTrain; end; end; @@ -510,259 +597,23 @@ begin //TraceListe:=false; end; -// Réserve les éléments s'ils ne sont pas déja réservés et positionne les aiguillages -// jusqu'au signal suivant (soit 1 canton) -// en entrée : index du train ; detect=détecteur à partir duquel faire la réservation et le positionnement des aiguillages -// en sortie : si erreur : -1 ou adresse du train qui a réservé le canton -// phase 0 : si le détecteur detect est en fin de route, alors on active l'arret du train -// phase 1 : tester si éléments réservés par train tiers jusqu'aux cantons suivants. Si oui, sortir. -// phase 2 : positionner les aiguillages -// phase 3 : réserver les aiguillages -function aig_cantonX(idTrain,detect : integer) : integer; -var AdrSig,n,i,ic,j,ideb,iFin,AdrTrain,etat,pointeur,voie1,voie2,indexSig1,indexSig2,AncPr, - Trainexistant,adr,pos,index,Ncanton,icanton,NumCanton,det_arret,it,PointRoute,ElPrec, - adr2 : integer; - typ,tprec: tequipement; - trainTiers,SigBonSens,trouve : boolean; - s : string; -begin - //traceliste:=true; - if ProcPrinc then AfficheDebug('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); - if debugRoulage then Affiche('Aig_canton '+intToSTR(idTrain)+' '+intToSTR(detect),clWhite); - result:=0; - - If traceliste then - begin - if detecteur[detect].Etat then etat:=1 else etat:=0; - affiche('Aig_canton Train id='+intToSTR(idtrain)+' '+intToSTR(detect)+' à '+intToSTR(etat)+'---------------Phase 1',clWhite); - end; - AdrTrain:=trains[idTrain].adresse; - - pointeur:=0; - n:=trains[idTrain].route[0].adresse; - repeat - inc(pointeur); - until (trains[idTrain].route[pointeur].traite=false) or (pointeur+1>=n); - - i:=pointeur-1; - if i=0 then i:=1; // on commence à 1 - - if DebugRoulage then - begin - Affiche('AC train @'+intToSTR(AdrTrain)+'Detecteur='+intToSTR(detect)+' Pointeur'+intToSTR(pointeur)+' ->'+intToSTR(trains[idTrain].route[i].adresse),clOrange); - if i>=n then - begin - affiche('La route a été complètement traitée (réservation)',clOrange); - result:=0; - end; - end; - - // mettre le pointeur de route j sur le détecteur "detect", après le pointeur 'AncPr' - j:=1; - AncPr:=trains[idTrain].PointRout; - repeat - trouve:=(trains[idTrain].route[j].adresse=detect) and (trains[idTrain].route[j].typ=det) and (j>=AncPr); - if trouve then - begin - trains[idTrain].PointRout:=j; //<<<<<<<<< le pointeur est stocké - PointRoute:=j; - if DebugRoulage then Affiche('Le pointeur de route est '+intToSTR(j)+'/'+intToSTR(n)+' au détecteur '+intToSTR(detect),clWhite); - end; - inc(j); - until trouve or (j>n); - - // arrêt temporisé sur détecteur demandé - trouve:=false; - it:=1; // boucle de détecteurs dans les trains - if roulage and (trains[idTrain].roulage>0) and (pointRoute>1) then - repeat - det_arret:=trains[idTrain].DetecteurArret[it].detecteur; - elPrec:=trains[idTrain].DetecteurArret[it].prec; - Tprec:=trains[idTrain].DetecteurArret[it].tprec; - adr2:=0; - // si le précédent est une TJD 4 états il faut tester les 2 adresses - if Tprec=aig then - begin - j:=index_aig(elprec); - if (aiguillage[j].modele=tjd) and (aiguillage[j].EtatTJD=4) then - begin - adr2:=aiguillage[j].DDroit; // homologue - end; - end; - if debugRoulage and (Det_arret<>0) then Affiche('Détecteur demande arrêt rencontré ('+intToSTR(det_arret)+')',clYellow); - // detecteur courant=arret - if (det_arret=detect) and (detecteur[detect].etat) and - (trains[idTrain].route[PointRoute-1].adresse=ElPrec) and (trains[idTrain].route[PointRoute-1].typ=tPrec) and - (pointrouteNbDetArret) or trouve; - - if pointRoute>=n then - begin - // route traitée , arrêter le train - if debugRoulage then Affiche('AC - Route terminée *****',clred); - trains[idTrain].arret_det:=true; - Trains[idTrain].phase_arret:=0; - end; - - traintiers:=false; - icanton:=0; - ncanton:=0; - TrainExistant:=0; - ideb:=trains[idTrain].PointRout; // i; //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - AdrSig:=0; - SigBonSens:=false; - //TraceListe:=true; - if traceliste then Affiche('Aiguillages',clOrange); - with trains[idtrain] do - begin - // boucle de vérification de réservation des aiguillages par un train même lui même, jusqu'à rencontrer n cantons - repeat - typ:=route[i].typ; - adr:=route[i].adresse; - typ:=route[i].typ; - if (typ=Aig) or (typ=tjd) or (typ=tjs) or (typ=crois) or (typ=triple) then - begin - if TraceListe then Affiche(intToSTR(adr)+' ',clOrange); - // vérifier si l'aiguillage est libre - TrainExistant:=Aiguillage[index_aig(adr)].AdrTrain; - //if (trainexistant<>AdrTrain) and (TrainExistant<>0) then - if (TrainExistant<>0) then - begin - result:=TrainExistant; - trains[idtrain].roulage:=1; - trainTiers:=true; - if traceListe then Affiche('AC-Aiguillage '+intToSTR(adr)+' réservé par autre train : @='+intToSTR(result),clyellow); - end; - end; - if (typ=det) then - begin - TrainExistant:=detecteur[adr].AdrTrainRes; - if (TrainExistant<>AdrTrain) and (trainExistant<>0) then - begin - result:=TrainExistant; - trains[idtrain].roulage:=1; // le roulage est arrêté - traintiers:=true; - if traceListe then Affiche('AC-Détecteur '+intToSTR(adr)+' réservé par autre train : @='+intToSTR(result),clyellow); - //exit; - end; - // si détecteur comporte signal - index_signal_det(adr,voie1,indexSig1,voie2,indexSig2); - if indexSig1<>0 then - begin - AdrSig:=0; - // si le signal est dans le bon sens - if (i+1<=n) then // si on arrive pas en bout de route - begin - if (signaux[indexSig1].Adr_el_suiv1=route[i+1].adresse) then - begin - AdrSig:=signaux[indexSig1].adresse; - if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(AdrSig)+' dans bon sens',clYellow); - inc(nCanton); - icanton:=i; - SigBonSens:=true; - end - else - begin - if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(signaux[indexSig1].adresse)+' dans mauvais sens',clYellow); - end; - - if indexSig2<>0 then - begin - if (signaux[indexSig2].Adr_el_suiv1=route[i+1].adresse) then - begin - AdrSig:=signaux[indexSig2].adresse; - if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(AdrSig)+' dans bon sens',clYellow); - inc(nCanton); - icanton:=i; - SigBonSens:=true; - end - else - begin - if TraceListe then Affiche('AC-Trouvé signal '+intToSTR(signaux[indexSig2].adresse)+' dans mauvais sens',clYellow); - end; - end; - end; - end; - end; - inc(i); - until (i>n) or (SigBonSens and (nCanton=nCantonsRes+1)) or (trainTiers); - - If traceliste then affiche('Phase 2-3',clWhite); - // phases 2 et 3 - trains[idtrain].roulage:=2; // roulage effectif - result:=AdrTrain; - if not(traintiers) then iFin:=i-1 else iFin:=icanton; //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - AdrTrain:=trains[idTrain].adresse; - - // balayage du (des) cantons libres - if traceListe then Affiche('Balayage de '+intToSTR(ideb)+' à '+intToSTR(ifin)+' pour positionner et réserver aiguillages',clYellow); - for i:=iDeb to iFin do - begin - route[i].traite:=true; - typ:=route[i].typ; - adr:=route[i].adresse; - if (typ=aig) or (typ=triple) or (typ=tjs) or (typ=tjd) or (typ=crois) then - begin - pos:=route[i].pos; - index:=index_aig(adr); - - if ((typ=aig) or (typ=triple) or (typ=tjs) or (typ=tjd)) then - begin - if aiguillage[index].AdrTrain=0 then - begin - pilote_acc(adr,pos,AdrTrain); // pilote l'aig si il est reservé par le train ou non réservé - s:='AC-Pilote aiguillage '+intToSTR(adr)+'='+intToSTR(pos); - case pos of - const_devie : s:=s+' (dévié)'; - const_droit : s:=s+' (droit)'; - else - s:=s+' non positionné'; - end; - if debugRoulage then Affiche(s,clWhite); - if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig); - // réservation - Affiche('Réservation Aig '+intToSTR(adr),clCyan); - aiguillage[index].adrTrain:=AdrTrain; - end; - end; - end; - if typ=det then - begin - detecteur[adr].AdrTrainRes:=adrTrain; - end; - Texte_aig_fond(adr); - end; - end; - maj_signaux(false); - //TraceListe:=false; -end; - - // bouton rouler 1 train procedure TFormRouteTrain.ButtonRouler1TrClick(Sender: TObject); var demarre : boolean; begin if (indexTrainFR<1) then exit; - roulage:=true; - efface_route_tco; + hide; + efface_route_tco(false); + maj_signaux(true); maj_signaux(true); // positionner les aiguillages de la route // si le train est doté d'une route if trains[indexTrainFR].route[0].adresse>0 then begin - demarre:=demarre_index_train(indexTrainFR); // met la mémoire de roulage du train à 1 - aig_canton(indexTrainFR,trains[indexTrainFR].route[1].adresse); // positionne aiguillage et fait les réservations if debugRoulage then Affiche_routes_brut; + aig_canton(indexTrainFR,trains[indexTrainFR].route[1].adresse); // positionne aiguillage et fait les réservations + demarre:=demarre_index_train(indexTrainFR); // met la mémoire de roulage du train à 1 end; close; // efface la route du TCO end; @@ -773,8 +624,8 @@ var idtrain : integer; demarre : boolean; begin if (indexTrainFR<1) then exit; - roulage:=true; - efface_route_tco; + hide; + efface_route_tco(false); maj_signaux(true); maj_signaux(true); @@ -785,25 +636,323 @@ begin if trains[idTrain].route[0].adresse>0 then begin if debugRoulage then Affiche_routes_brut; - demarre:=demarre_index_train(idtrain); // met la mémoire de roulage du train à 1 aig_canton(idTrain,trains[idTrain].route[1].adresse); + demarre:=demarre_index_train(idtrain); // met la mémoire de roulage du train à 1 end; end; close; end; procedure TFormRouteTrain.ButtonSauveRouteClick(Sender: TObject); -var n : integer; +var n,i,j : integer; + trouve : boolean; begin if (indexTrainFR<1) then exit; n:=trains[indexTrainFr].route[0].adresse; - if n=0 then exit; + if n=0 then exit; // si pas de route - Trains[indexTrainFr].routePref:=Trains[IndexTrainFr].route; + //vérifier si la route existe déja en route pref + i:=1; + trouve:=false; + repeat + if trains[indexTrainFR].routePref[i][0].adresse=n then + begin + // comparer les éléments de la route "route" aux "routesPref" + trouve:=true; + for j:=1 to n do + trouve:=(trains[indexTrainFR].routePref[i][j].adresse=trains[indexTrainFR].route[j].adresse) and trouve; + end; + inc(i); + until (i>trains[indexTrainFR].routePref[0][0].adresse) or trouve; + if trouve then + begin + LabelRoute.Caption:='La route existe déja en zone sauvegardée'; + exit; + end; + + i:=Trains[indexTrainFr].routePref[0][0].adresse; // nombre de routes pref + inc(i); + if i>30 then + begin + LabelRoute.Caption:='Nombre de routes sauvegardées atteint'; + exit; + end; + Trains[indexTrainFr].routePref[0][0].adresse:=i; // nombre de routes pref incrémenté + + Trains[indexTrainFr].routePref[i]:=Trains[IndexTrainFr].route; + maj_infos(indexTrainFR); Sauve_config; end; +procedure couleurs_routeTrains; +var c : tcomponent; + i : integer; +begin + if sombre then with formRouteTrain do + begin + Color:=Couleurfond; + for i:=0 to ComponentCount-1 do + begin + c:=Components[i]; + if c is tListBox then + begin + (c as tListbox).Color:=color; + end; + end; + end; +end; +procedure TFormRouteTrain.FormCreate(Sender: TObject); +begin + PageControlRoutes.ActivePageIndex:=0; + ButtonM.hint:='Affecter la route à ce train lors de sa sauvegarde et '+#13+'affecter le train au canton dans le sens de démarrage de la route'; + couleurs_RouteTrains; + +end; + +// choisir cette route mémorisée +procedure TFormRouteTrain.ButtonMClick(Sender: TObject); +var n,sens,el1R,el2R,el1,el2,IdCanton,detfin,IdCantonDest,IdCantonOrg : integer; + t1,t2,t1R,t2R : tequipement; + trouve : boolean; +begin + if indexTrainFR<0 then begin labelRoute.caption:='Pas de train';exit;end; + + // la route préférentielle ne peut être validée que si le bon train est sur le bon canton + // et qu'un des détecteurs est à 1 + // et dans le bon sens + {//&&& + det1:=trains[idtrain].routePref[1].adresse; + IndexCanton:=index_canton_det(det1); + if false and (canton[indexCanton].IndexTrain=idTrain) and (trains[idtrain].routePref[0].adresse<>0) then + begin + RichEditRoute.Lines.Add(route_restreinte_to_string(trains[idTrain].routePref)); + if trains[idtrain].routePref[0].adresse<>0 then + begin + labelroute.caption:='Route mémorisée affectée au train '+trains[idtrain].nom_train; + ButtonRouler1tr.caption:='Rouler le train '+trains[idtrain].nom_train; + ButtonRouler1tr.enabled:=true; + end; + end; + } + + + if trains[indexTrainFR].routePref[IrPref][0].adresse<>0 then + begin + trains[indexTrainFR].route:=trains[indexTrainFR].routePref[IrPref]; // affectation de la route au train + checkBoxSIRA.checked:=trains[indexTrainFR].route[0].talon; + trains[indexTrainFR].NomRouteCour:=trains[indexTrainFR].NomRoute[IrPref]; + + el1R:=trains[indexTrainFR].routePref[IrPref][1].adresse; + t1R:=trains[indexTrainFR].routePref[IrPref][1].typ; + el2R:=trains[indexTrainFR].routePref[IrPref][2].adresse; + t2R:=trains[indexTrainFR].routePref[IrPref][2].typ; + + IdCanton:=index_canton_det(el1R); // trouve l'index du canton du détecteur el1R (départ de route) = c'est le canton origine de la route + if IdCanton=0 then begin labelRoute.caption:='Le train de départ n''est pas sur un canton';exit;end; + FormRouteTrain.Caption:=trains[indexTrainFR].nom_train+' départ depuis canton '+intToSTR(canton[IdCanton].numero)+' '+canton[idcanton].nom; + + // déterminer le sens de la route pour affecter le sens de la loco dans le canton origine + el1:=canton[idcanton].el1; + t1:=canton[idcanton].typ1; // toujours un détecteur + el2:=canton[idcanton].el2; + t2:=canton[idcanton].typ2; + + sens:=0; + // cas 1 : les deux éléments du canton sont des détecteurs + if (t1=det) and (t2=det) then + begin + // sous cas 1 : le 2ème élément de la route est un détecteur + if t2r=det then + begin + if (el1r=el1) and (el2r=el2) then + if canton[IdCanton].horizontal then sens:=SensDroit else sens:=SensBas; + if (el1r=el2) and (el2r=el1) then + if canton[IdCanton].horizontal then sens:=SensGauche else sens:=SensHaut; + end + else + // sous cas 2 : le 2ème élement de la route est un aiguillage + begin + if (el1r=el2) then + if canton[IdCanton].horizontal then sens:=SensDroit else sens:=SensBas; + if (el1r=el1) then + if canton[IdCanton].horizontal then sens:=SensGauche else sens:=SensHaut; + end; + end; + + // cas 2 : l'élément 1 (G) du canton est un aiguillage + if (t1<>det) and (t2=det) then + begin + if (el1r=el2) then + if canton[IdCanton].horizontal then sens:=SensDroit else sens:=SensBas; + if (el1r=el2) and (el2r=el1) then + if canton[IdCanton].horizontal then sens:=SensGauche else sens:=SensHaut; + end; + + // cas 3 : l'élément 2 (D) du canton est un aiguillage + if (t1=det) and (t2<>det) then + begin + if (el1r=el2) and (el2r=el2) then + if canton[IdCanton].horizontal then sens:=SensDroit else sens:=SensBas; + if (el1r=el1) then + if canton[IdCanton].horizontal then sens:=SensGauche else sens:=SensHaut; + end; + + if sens=0 then begin labelRoute.caption:='Le sens de circulation est incorrect';exit;end; + affecte_Train_canton(Trains[indexTrainFR].adresse,IdCanton,sens); // affecte le train au canton avec le sens + + // La procédure efface_affiche_route nécessite la variable "tabloroute" à jour, on utilise l'indice 1 + NumRoute:=1; + tabloRoute[NumRoute]:=trains[indexTrainFR].route; + Efface_Affiche_route; + + // supprimer les anciens cantons origine et destination + idCantonOrg:=index_canton_numero(trains[indexTrainFR].cantonOrg); + idCantonDest:=index_canton_numero(trains[indexTrainFR].cantonDest); + + if idcantonOrg<>0 then + begin + canton[idCantonOrg].NumcantonOrg:=0; + canton[idCantonOrg].NumcantonDest:=0; + canton[idCantonOrg].Bouton:=0; + dessin_canton(IdCantonOrg,0); + end; + if idcantonOrg<>0 then + begin + canton[idCantonDest].NumcantonOrg:=0; + canton[idCantonDest].NumcantonDest:=0; + canton[idCantonDest].Bouton:=0; + dessin_canton(IdCantonDest,0); + end; + + // affecter le canton origine et destination + canton[IdCanton].bouton:=3; + + n:=trains[indexTrainFR].route[0].adresse ; + detfin:=trains[indexTrainFR].route[n].adresse; + IdCantonDest:=index_canton_det(detFin); + if IdCantonDest<1 then begin labelRoute.caption:='Canton de destination incorrect';exit;end; + + canton[IdCanton].NumcantonOrg:=canton[Idcanton].numero; + canton[IdCanton].NumcantonDest:=canton[IdcantonDest].numero; + dessin_canton(IdCanton,0); + + // maj des champs org et dest du train + trains[indexTrainFR].cantonOrg:=canton[IdCanton].NumCantonOrg; + trains[indexTrainFR].cantonDest:=canton[IdCanton].NumCantonDest; + + canton[IdCantonDest].bouton:=4; + canton[IdCantonDest].NumcantonOrg:=canton[Idcanton].numero; + canton[IdCantonDest].NumcantonDest:=canton[IdcantonDest].numero; + dessin_canton(IdCantonDest,0); + maj_infos(indexTrainFR); + + PageControlRoutes.ActivePageIndex:=0; + end; +end; + + +procedure TFormRouteTrain.ListBoxRMMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + NumRoute:=1; + IrPref:=ListBoxRM.ItemIndex+1; + if irPref<1 then exit; + IndexLigneRoute:=IrPref; + tabloRoute[NumRoute]:=trains[indexTrainFR].routePref[IrPref]; + Efface_Affiche_route; + checkBoxSens.checked:=trains[indexTrainFR].routePref[IrPref][0].talon; + + + // si le train de la route est en roulage, ne pas afficher la route car + // sinon les index des trains passent à 0 dans les cantons par la fonction zone_tco + if trains[indexTrainFR].roulage=0 then affiche_route_tco; + EditNomRoute.Text:=trains[indexTrainFR].NomRoute[irPref]; +end; + +procedure TFormRouteTrain.ListBoxRAMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // si le train de la route est en roulage, ne pas afficher la route car + // sinon les index des trains passent à 0 dans les cantons par la fonction zone_tco + if trains[indexTrainFR].roulage=0 then affiche_route_tco; + { Affiche(route_totale_to_string(trains[IndexTrainFR].routePref[1]),clYellow); + Affiche(route_totale_to_string(trains[IndexTrainFR].route),clYellow); + } +end; + +procedure TFormRouteTrain.ButtonSRClick(Sender: TObject); +var i,n : integer; + s : string; +begin + if IrPref<0 then exit; + + s:='Voulez-vous supprimer la route sauvegardée n°'+intToSTR(IrPref)+' ?'; + if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; + + n:=trains[indexTrainFR].routePref[0][0].adresse; // nombre de routes + for i:=IrPref to n do + tabloRoute[i]:=tabloRoute[i+1]; + trains[indexTrainFR].routePref[0][0].adresse:=n-1; + dec(irPref); + maj_infos(indexTrainFR); +end; + +procedure TFormRouteTrain.ButtonSRSClick(Sender: TObject); +begin + labelRoute.Caption:='Routes sauvegardées'; + Sauve_config; +end; + +procedure TFormRouteTrain.EditnomRouteChange(Sender: TObject); +begin + if (IrPref<1) or (indexTrainFR<1) then exit; + trains[indexTrainFR].NomRoute[irPref]:=EditNomRoute.text; +end; + +procedure TFormRouteTrain.ListBoxRMKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if IrPref<0 then exit; + if (ord(Key)=VK_UP) and (IrPref>1) then + begin + dec(IrPref); + end + else + if (ord(Key)=VK_DOWN) and (IrPrefNcantons) or trouve; + if trouve then result:=i-1; +end; + // renvoie l'index du canton en fonction de son numéro function index_canton_numero(n : integer) : integer; var i : integer; trouve : boolean; begin + if n=0 then begin result:=0;exit;end; i:=1; result:=0; repeat @@ -1126,7 +1168,7 @@ begin color:=clWhite; width:=1; end; - Brush.Color:=clFondCantonV; + Brush.Color:=CoulCantonLibre[indexTCO]; Rectangle(canton[indexCanton].Gd); // Grand rectangle h:=canton[indexcanton].horizontal; @@ -1414,13 +1456,13 @@ begin if horz then begin - zone_tco(t,i,SensTCO_O,0,0,11,false); // demande éléments contigus à gauche (5) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_O,0,0,11,false,false); // demande éléments contigus à gauche (5) du canton, résultats dans var globales xCanton et tel1 canton[i].el1:=xCanton; canton[i].typ1:=tel1; canton[i].SensEl1:=SensGauche; if tel1=det then detecteur[xCanton].canton1:=canton[i].numero; - zone_tco(t,i,SensTCO_E,0,0,11,false); // demande éléments contigus à droite (6) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_E,0,0,11,false,false); // demande éléments contigus à droite (6) du canton, résultats dans var globales xCanton et tel1 canton[i].el2:=xCanton; canton[i].typ2:=tel1; canton[i].SensEl2:=SensDroit; @@ -1428,13 +1470,13 @@ begin end else begin - zone_tco(t,i,SensTCO_N,0,0,11,false); // demande éléments contigus en haut (7) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_N,0,0,11,false,false); // demande éléments contigus en haut (7) du canton, résultats dans var globales xCanton et tel1 canton[i].el1:=xCanton; canton[i].typ1:=tel1; canton[i].SensEl1:=SensHaut; if tel1=det then detecteur[xCanton].canton1:=canton[i].numero; - zone_tco(t,i,SensTCO_S,0,0,11,false); // demande éléments contigus en bas (8) du canton, résultats dans var globales xCanton et tel1 + zone_tco(t,i,SensTCO_S,0,0,11,false,false); // demande éléments contigus en bas (8) du canton, résultats dans var globales xCanton et tel1 canton[i].el2:=xCanton; canton[i].typ2:=tel1; canton[i].SensEl2:=SensBas; @@ -1477,7 +1519,7 @@ begin end; // renseigne les éléments contigus des tjd des tco -procedure renseigne_TJDs; +procedure renseigne_TJDs_TCO; var t,x,y,adr1,Bim,Netats,Adr2,index1,index2 : integer; typEL : tequipement; deb : boolean; @@ -1508,22 +1550,22 @@ begin case Bim of 21 : begin - zone_tco(t,adr1,typEl,SensTCO_E,13,false); // chercher 1er élément à droite - xcanton Tel1 + zone_tco(t,adr1,typEl,SensTCO_E,13,false,false); // chercher 1er élément à droite - xcanton Tel1 tco[t,x,y].SuivE:=xCanton; tco[t,x,y].TypeE:=tel1; if deb then Affiche('E='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_SO,13,false); // chercher 1er élément SO + zone_tco(t,adr1,typEl,SensTCO_SO,13,false,false); // chercher 1er élément SO tco[t,x,y].SuivSO:=xCanton; tco[t,x,y].TypeSO:=tel1; if deb then Affiche('SO='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_O,13,false); // élément à gauche + zone_tco(t,adr1,typEl,SensTCO_O,13,false,false); // élément à gauche tco[t,x,y].SuivO:=xCanton; tco[t,x,y].TypeO:=tel1; if deb then Affiche('O='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_NE,13,false); // chercher 1er élément NE + zone_tco(t,adr1,typEl,SensTCO_NE,13,false,false); // chercher 1er élément NE tco[t,x,y].SuivNE:=xCanton; tco[t,x,y].TypeNE:=tel1; if deb then Affiche('NE='+intToSTR(xcanton),clLime); @@ -1556,22 +1598,22 @@ begin end; 22 : begin - zone_tco(t,adr1,typEl,SensTCO_E,13,false); // chercher 1er élément à droite - xcanton Tel1 + zone_tco(t,adr1,typEl,SensTCO_E,13,false,false); // chercher 1er élément à droite - xcanton Tel1 tco[t,x,y].SuivE:=xCanton; tco[t,x,y].TypeE:=tel1; if deb then Affiche('E='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_SE,13,false); // chercher 1er élément à droite - xcanton Tel1 + zone_tco(t,adr1,typEl,SensTCO_SE,13,false,false); // chercher 1er élément à droite - xcanton Tel1 tco[t,x,y].SuivSE:=xCanton; tco[t,x,y].TypeSE:=tel1; if deb then Affiche('SE='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_O,13,false); // élément à gauche + zone_tco(t,adr1,typEl,SensTCO_O,13,false,false); // élément à gauche tco[t,x,y].SuivO:=xCanton; tco[t,x,y].TypeO:=tel1; if deb then Affiche('O='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_NO,13,false); // chercher 1er élément à droite - xcanton Tel1 + zone_tco(t,adr1,typEl,SensTCO_NO,13,false,false); // chercher 1er élément à droite - xcanton Tel1 tco[t,x,y].SuivNO:=xCanton; tco[t,x,y].TypeNO:=tel1; if deb then Affiche('NO='+intToSTR(xcanton),clLime); @@ -1602,22 +1644,22 @@ begin end; end; 23 : begin - zone_tco(t,adr1,typEl,SensTCO_N,13,false); // haut + zone_tco(t,adr1,typEl,SensTCO_N,13,false,false); // haut tco[t,x,y].SuivN:=xCanton; tco[t,x,y].TypeN:=tel1; if deb then Affiche('N='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_S,13,false); // élément bas + zone_tco(t,adr1,typEl,SensTCO_S,13,false,false); // élément bas tco[t,x,y].SuivS:=xCanton; tco[t,x,y].TypeS:=tel1; if deb then Affiche('S='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_NE,13,false); + zone_tco(t,adr1,typEl,SensTCO_NE,13,false,false); tco[t,x,y].SuivNE:=xCanton; tco[t,x,y].TypeNE:=tel1; if deb then Affiche('NE='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_SO,13,false); + zone_tco(t,adr1,typEl,SensTCO_SO,13,false,false); tco[t,x,y].SuivSO:=xCanton; tco[t,x,y].TypeSO:=tel1; if deb then Affiche('SO='+intToSTR(xcanton),clLime); @@ -1649,22 +1691,22 @@ begin end; 25 : begin - zone_tco(t,adr1,typEl,SensTCO_N,13,false); // haut + zone_tco(t,adr1,typEl,SensTCO_N,13,false,false); // haut tco[t,x,y].SuivN:=xCanton; tco[t,x,y].TypeN:=tel1; if deb then Affiche('N='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_S,13,false); // élément bas + zone_tco(t,adr1,typEl,SensTCO_S,13,false,false); // élément bas tco[t,x,y].SuivS:=xCanton; tco[t,x,y].TypeS:=tel1; if deb then Affiche('S='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_NO,13,false); // chercher 1er élément à droite - xcanton Tel1 + zone_tco(t,adr1,typEl,SensTCO_NO,13,false,false); // chercher 1er élément à droite - xcanton Tel1 tco[t,x,y].SuivNO:=xCanton; tco[t,x,y].TypeNO:=tel1; if deb then Affiche('NO='+intToSTR(xcanton),clLime); - zone_tco(t,adr1,typEl,SensTCO_SE,13,false); // chercher 1er élément à droite - xcanton Tel1 + zone_tco(t,adr1,typEl,SensTCO_SE,13,false,false); // chercher 1er élément à droite - xcanton Tel1 tco[t,x,y].SuivSE:=xCanton; tco[t,x,y].TypeSE:=tel1; if deb then Affiche('SE='+intToSTR(xcanton),clLime); @@ -1702,8 +1744,6 @@ begin end; end; - - // créée un nouveau TCO qui n'existait pas procedure Init_TCO(indexTCO : integer); var x,y : integer; @@ -1718,7 +1758,8 @@ begin ClVoies[indexTCO]:=$0077FF; ClAllume[indexTCO]:=$00FFFF; ClGrille[IndexTCO]:=$404040; - + CoulCantonLibre[indexTCO]:=$004000; + CoulCantonOccupe[indexTCO]:=$000040; ClQuai[indexTCO]:=$808080; clPiedSignal[indexTCO]:=$4080FF; ClCanton[indexTCO]:=$00FFFF; @@ -1757,7 +1798,7 @@ var fichier : textfile; Bim,nv,x,y,i,j,m,adresse,valeur,erreur,FeuOriente,PiedFeu,tailleFont,e,NPar : integer; trouve_CoulFond,trouve_clVoies,trouve_clAllume,trouve_clGrille,trouve_clCanton, trouve_clTexte,trouve_clQuai,trouve_matrice,trouve_ratio,trouve_ModeCanton, - trouve_AvecGrille,trouve_clPiedSignal,cuc : boolean; + trouve_AvecGrille,trouve_clPiedSignal,cuc,trouve_clCantonOccupe,trouve_clCantonLibre : boolean; function lit_ligne : string ; var c : char; begin @@ -1796,7 +1837,8 @@ begin trouve_matrice:=false; trouve_ratio:=false; trouve_clCanton:=false; - + trouve_clCantonLibre:=False; + trouve_clCantonOccupe:=False; trouve_ModeCanton:=false; trouve_AvecGrille:=false; eval_format:=false; @@ -1904,6 +1946,28 @@ begin clQuai[indexTCO]:=i; end; + sa:=uppercase(ClCantonLibre_ch)+'='; + i:=pos(sa,s); + if i<>0 then + begin + inc(nv); + trouve_clCantonLibre:=true; + delete(s,i,length(sa)); + val('$'+s,i,erreur); + CoulCantonLibre[indexTCO]:=i; + end; + + sa:=uppercase(ClCantonOccupe_ch)+'='; + i:=pos(sa,s); + if i<>0 then + begin + inc(nv); + trouve_clCantonOccupe:=true; + delete(s,i,length(sa)); + val('$'+s,i,erreur); + CoulCantonOccupe[indexTCO]:=i; + end; + sa:=uppercase(clPiedSignal_ch)+'='; i:=pos(sa,s); if i<>0 then @@ -1959,6 +2023,16 @@ begin EcranTCO[indexTCO]:=i; end; + sa:=uppercase(JeuCouleurs_ch)+'='; + i:=pos(sa,s); + if i<>0 then + begin + inc(nv); + delete(s,i,length(sa)); + val(s,i,erreur); + if (i<1) or (i>3) then i:=1; + JeuCouleurs:=i; + end; sa:=uppercase(Epaisseur_voies_ch)+'='; i:=pos(sa,s); @@ -2195,11 +2269,11 @@ begin begin if jx1 then a:=(y2-y1)/(x2-x1) else a:=99999; b:=y1-a*x1; end; - procedure sauve_fichiers_tco; var fichier : textfile; s : string; couleurFonte : Tcolor; - x,y,i,Bimage : integer; + x,y,i,id,Bimage : integer; begin //x:=formconfig.MemoNomTCO.Lines.Count; //if x<0 then for i:=1 to NbreTCO do begin + restitue_styles(i); AssignFile(fichier,nomfichierTCO[i]); rewrite(fichier); Writeln(fichier,'/ Définitions TCO version '+versionSC+sousversion); @@ -2346,11 +2425,15 @@ begin Writeln(fichier,clQuai_ch+'='+IntToHex(ClQuai[i],6)); Writeln(fichier,clPiedSignal_ch+'='+intToHex(clPiedSignal[i],6)); Writeln(fichier,ClCanton_ch+'='+IntToHex(ClCanton[i],6)); + Writeln(fichier,ClCantonLibre_ch+'='+IntToHex(CoulCantonLibre[i],6)); + Writeln(fichier,ClCantonOccupe_ch+'='+IntToHex(CoulCantonOccupe[i],6)); + Writeln(fichier,ModeCouleurCanton_ch+'='+intToSTR(ModeCouleurCanton)); if avecGrille[i] then s:='1' else s:='0'; Writeln(fichier,Avecgrille_ch+'='+s); writeln(fichier,Graphisme_ch+'=',graphisme); writeln(fichier,Ecran_ch+'=',EcranTCO[i]); + writeln(fichier,JeuCouleurs_ch+'=',JeuCouleurs); writeln(fichier,Epaisseur_voies_ch+'=',Epaisseur_voies); if EvtClicDet then s:='1' else s:='0'; Writeln(fichier,EvtClicDet_ch+'='+s); @@ -2383,8 +2466,13 @@ begin else s:=s+IntToSTR(tco[i,x,y].PiedFeu); s:=s+','; - // texte - s:=s+tco[i,x,y].Texte+','; + // texte ou nom du canton + if (Bimage=Id_CantonH) or (Bimage=Id_cantonV) then + begin + id:=index_canton_numero(tco[i,x,y].NumCanton); + s:=s+canton[id].nom+','; + end + else s:=s+tco[i,x,y].Texte+','; // représentation s:=s+intToSTR(tco[i,x,y].repr); // NomFonte @@ -2449,7 +2537,7 @@ end; // arc elliptique à deux rayons différents procedure D_Arc2R(Canvas: TCanvas; CentreX,CentreY: integer; - rayonX,rayonY: Integer; StartDegres, StopDegres: Double); + rayonX,rayonY: Integer; StartDegres, StopDegres: single); var sinA,cosA : extended; x1,x2,x3,x4,y1,y2,y3,y4: Integer; begin @@ -2684,7 +2772,14 @@ begin //yl:=(y-1)*round((l*tf)); delete(s,length(s),1); yl:=round(1.5*l*tf)+((y-1)*haut); - PCanvasTCO[indexTCO].TextOut((x-1)*larg+5,yl+3,s); + + with PCanvasTCO[indexTCO] do + begin + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut((x-1)*larg+5,yl+3,s); + end; inc(l); until (i>NombreMots); end; @@ -2710,23 +2805,21 @@ begin c:=PcanvasTCO[indextco]; if c=nil then exit; + {$IF CompilerVersion >= 28.0} + c.font.orientation:=0; + {$IFEND} + c.Brush.Color:=tco[indexTCO,x,y].CouleurFond; x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; //PCanvasTCO.Brush.Style:=bsSolid; s:=tco[indextco,x,y].Texte; - b:=tco[indextco,x,y].BImage; if not NB then begin - if (b=id_Quai) then PCanvasTCO[indextco].Brush.Color:=clQuai[indexTCO] - else if ((b=id_cantonH) or (b=id_CantonV)) then - begin - if TCO[IndexTCO,x,y].train=0 then - PCanvasTCO[indextco].Brush.Color:=clFondCantonV - else PCanvasTCO[indextco].Brush.Color:=clFondCantonR; - end - else PCanvasTCO[indextco].Brush.Color:=tco[indextco,x,y].CouleurFond; + if (b=id_Quai) then c.Brush.Color:=clQuai[indexTCO] + else + c.Brush.Color:=tco[indextco,x,y].CouleurFond; c.Font.Color:=tco[indextco,x,y].CoulFonte; end @@ -2755,12 +2848,14 @@ begin if b=Id_cantonH then begin - repr:=0;xt:=4;yt:=4;s:=intToSTR(TCO[indexTCO,x,y].Numcanton); + repr:=0;xt:=4;yt:=4; + s:=format('%d',[TCO[indexTCO,x,y].Numcanton]); end else if b=Id_cantonV then begin - repr:=0;xt:=2;yt:=4;s:=intToSTR(TCO[indexTCO,x,y].NumCanton); + repr:=0;xt:=2;yt:=4; + s:=format('%d',[TCO[indexTCO,x,y].Numcanton]); end else @@ -2789,7 +2884,7 @@ begin if repr=4 then texte_reparti(s,indextco,x,y,tf) else c.Textout(x0+xt,y0+yt,s); - + // texte encadré if tco[indextco,x,y].buttoir=1 then begin largCell:=LargeurCell[indexTCO]; @@ -2807,7 +2902,7 @@ begin LineTo(x0,y0+hautCell); LineTo(x0,y0); end; - end; + end; end; procedure dessin_2L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); @@ -5936,7 +6031,7 @@ end; procedure dessin_21(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont,adr1,adr2, index1,index2,etatTJD,position1,position2,sHG,sBD : integer; - a1,b1,a2,b2 : double; + a1,b1,a2,b2 : single; md,tHG,tBD : tequipement; fond : tcolor; procedure horizontale; @@ -6218,7 +6313,7 @@ procedure dessin_22(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,position1,position2, adr1,adr2,index1,index2,etatTJD,sHG,sBD : integer; md,tHG,tBD : tequipement; - a1,b1,a2,b2 : double; + a1,b1,a2,b2 : single; fond : Tcolor; procedure horizontale; begin @@ -6552,7 +6647,7 @@ begin case act of AcChangeTCO : begin - if s='' then s:='TCO'+intToSTR(tco[indexTCO,x,y].FeuOriente); // feuoriente contient le numéro du TCO + if s='' then s:='TCO'+format('%d',[TCO[indexTCO,x,y].FeuOriente]); // feuoriente contient le numéro du TCO tco[indexTCO,x,y].texte:=s; tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; @@ -6662,7 +6757,7 @@ begin begin Pen.Width:=1; - Brush.Color:=clFondCantonV; + Brush.Color:=CoulCantonLibre[indexTCO]; pen.color:=clwhite; Roundrect(x0,yc1,xf,yc2,(xf-x0) div 2,(yc2-yc1) div 2); @@ -6709,14 +6804,18 @@ begin 1 : cf:=ClCyan; 2 : cf:=ClLime; end; - - PcanvasTCO[IndexTCO].Brush.color:=cf; - PcanvasTCO[IndexTCO].Font.Color:=clBlue; - if tps=0 then PcanvasTCO[IndexTCO].TextOut(xRond,yRond,' ') else - PcanvasTCO[IndexTCO].TextOut(xRond,yRond,IntToSTR(tps div 10)+' '); - -end; + with PcanvasTCO[IndexTCO] do + begin + Brush.color:=cf; + Font.Color:=clBlue; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + if tps=0 then TextOut(xRond,yRond,' ') else + TextOut(xRond,yRond,format('%d',[tps div 10])+' '); + end; +end; // dessine le canton H @@ -6726,7 +6825,7 @@ procedure dessin_cantonH(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer) var i,xi,yi,x0,y0,yf,yc,xt,yt,dx,dy,larg,haut,xr,xm,LargDest,Hautdest,indexTrain,NumC,sens, offsetY,xf,AdrTrain,Xcentre,yCentre,n,al,r,l,h,HautDestF,LargDestF,LargSrc,HautSrc,OffsetX, bouton : integer; - frX,frY,rd : real; + frX,frY,rd : single; coul : tcolor; p : array[0..2] of TPoint; s : string; @@ -6746,7 +6845,7 @@ begin with canvas do begin Pen.Width:=1; - brush.Color:=tco[indexTCO,x,y].CouleurFond; + // brush.Color:=tco[indexTCO,x,y].CouleurFond; s:=tco[indexTCO,x,y].Fonte; if s='' then tco[indexTCO,x,y].Fonte:='Arial'; @@ -6754,19 +6853,14 @@ begin i:=index_canton_numero(NumC); // index du canton "piedfeu" if i=0 then begin Affiche('Erreur 19H : index canton nul en TCO'+intToSTR(indexTCO)+' x='+intToSTR(x)+' y='+intToSTR(y),clred);exit;end; - // texte à gauche du canton -{ s:=canton[i].nom; - Pen.color:=clwhite; - textOUT(x0-length(s)*8,y0+1,s); - } indexTrain:=TCO[IndexTCO,x,y].train; AdrTrain:=canton[i].adresseTrain; //Affiche('Canton '+intToSTR(canton[i].numero)+' adrTrain='+intToSTR(AdrTrain),clLime); if AdrTrain<>0 then indexTrain:=index_train_adresse(adrTrain); - if (AdrTrain<>0) or (indexTrain=9999) then coul:=clFondCantonR // couleurCanton - else coul:=clFondCantonV; + if (AdrTrain<>0) or (indexTrain=9999) then coul:=CoulCantonOccupe[indexTCO] // couleurCanton + else coul:=CoulCantonLibre[indexTCO]; Brush.Color:=coul; // mode=1 : représenter avec les poignées de sélection @@ -6793,12 +6887,29 @@ begin canton[i].select:=false; end; - pen.color:=clwhite; + if coul<$50000 then + begin + pen.color:=clwhite; + Font.color:=clYellow; + end + else + begin + pen.color:=clBlack; + font.color:=ClBlue; + end; Roundrect(x0,y0,xf,yf,15,15); + font.style:=style(tco[indextco,x,y].FontStyle); // numéro de canton - font.color:=clYellow; - Textout(x0+6,y0+2,intToSTR(canton[i].numero)); + with font do + begin + Name:=tco[indextco,x,y].fonte; + {$IF CompilerVersion >= 28.0} + orientation:=0; + {$IFEND} + end; + Textout(x0+6,y0+2,format('%d',[TCO[indexTCO,x,y].Numcanton])); + //Textout(x0+6,y0+2,intToSTR(canton[i].numero)); // bouton Xcentre:=Xf-(larg div 2); @@ -6814,23 +6925,34 @@ begin else begin if bouton=3 then + // drapeau vert StretchBlt(PcanvasTCO[indexTCO].Handle,xf-larg,yf-haut,larg,haut, FormTCO[indexTCO].ImageDrapVert.canvas.Handle,1,1,63,63,srccopy); if bouton=4 then + // drapeau rouge StretchBlt(PcanvasTCO[indexTCO].Handle,xf-larg,yf-haut,larg,haut, FormTCO[indexTCO].ImageDrapRouge.canvas.Handle,1,1,63,63,srccopy); end; + calcul_reduction(frx,fry,Larg,haut); if (indexTrain=0) or (indexTrain=9999) then begin - //Affiche('pas de train',clYellow); + // affiche le nom du canton + s:=canton[i].nom; + if s<>'' then + begin + font.Size:=((Larg*10) div 30)+1; //((LargCell*5) div 29); + Brush.Color:=coul; + dx:=TextWidth(s) div 2; + dy:=TextHeight(s) div 2; + Textout(((x0+xf) div 2)-dx,((y0+yf) div 2)-dy,s); + end; exit; end; if (trains[indexTrain].icone=nil) or (Trains[indexTrain].Icone.height=0) then exit; //---redimensionnement - calcul_reduction(frx,fry,Larg,haut); HautDest:=round(haut/1.2); LargSrc:=Trains[indexTrain].Icone.width; @@ -6911,7 +7033,7 @@ end; procedure dessin_cantonV(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); var AdrTrain,i,xi,yi,xt,yt,x0,xc,yc,y0,xf,yf,dx,dy,larg,haut,hautDest,LargDest,LargSrc,HautSrc,yr,ym,l, xCentre,yCentre,r,indexTrain,n,al,bouton,sens : integer; - frX,frY,rd : real; + frX,frY,rd : single; coul : tcolor; s : string; p : array[0..2] of TPoint; @@ -6936,7 +7058,7 @@ begin with canvas do begin Pen.Width:=1; - brush.Color:=tco[indexTCO,x,y].CouleurFond; + //brush.Color:=tco[indexTCO,x,y].CouleurFond; s:=tco[indexTCO,x,y].Fonte; if s='' then tco[indexTCO,x,y].Fonte:='Arial'; @@ -6953,8 +7075,8 @@ begin AdrTrain:=canton[i].adresseTrain; if AdrTrain<>0 then indexTrain:=index_train_adresse(adrTrain); - if (AdrTrain<>0) or (indexTrain=9999) then coul:=clFondCantonR // couleurCanton - else coul:=clFondCantonV; + if (AdrTrain<>0) or (indexTrain=9999) then coul:=CoulCantonOccupe[indexTCO] // couleurCanton + else coul:=CoulCantonLibre[indexTCO]; Brush.Color:=coul; // mode=1 représenter avec les poignées de sélection @@ -6980,14 +7102,28 @@ begin canton[i].select:=false; end; - pen.color:=clwhite; + if coul<$50000 then + begin + pen.color:=clwhite; + Font.color:=clYellow; + end + else + begin + pen.color:=clBlack; + font.color:=ClBlue; + end; Roundrect(x0,y0,xf,yf,15,15); + font.style:=style(tco[indextco,x,y].FontStyle); // numéro de canton - pen.Mode:=pmcopy; - pen.color:=clyellow; - font.Color:=clyellow; - Textout(x0+2,y0+6,intToSTR(canton[i].numero)); + with font do + begin + Name:=tco[indextco,x,y].fonte; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + end; + Textout(x0+2,y0+6,format('%d',[canton[i].numero])); Xcentre:=Xc+1; Ycentre:=Yf-(haut div 2); @@ -7013,17 +7149,35 @@ begin end; end; - + calcul_reduction(frx,fry,Larg,haut); if (indexTrain=0) or (indexTrain=9999) then begin + // affiche le nom du canton //Affiche('pas de train',clYellow); + s:=canton[i].nom; + if s<>'' then + begin + font.Size:=((Larg*10) div 30)+1; //((LargCell*5) div 29); + Brush.Color:=coul; + dy:=TextWidth(s) div 2; + dx:=TextHeight(s) div 2; + xi:=((x0+xf) div 2)-dx-1; + yi:=((y0+yf) div 2)+dy; + {$IF CompilerVersion >= 28.0} + font.orientation:=900; + Textout(xi,yi,s); + {$ELSE} + AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xi,yi, + PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,coul,s+' ',900); + {$IFEND} + end; exit; end; + // pas d'icone if (trains[indexTrain].icone=nil) or (Trains[indexTrain].Icone.height=0) then exit; // ----- prépare l'icone du train - calcul_reduction(frx,fry,Larg,haut); hautdest:=round(haut/1.2); LargSrc:=Trains[indexTrain].Icone.width; @@ -7064,9 +7218,15 @@ begin l:=TextWidth(s); Brush.Color:=coul; if l= 28.0} + begin + font.orientation:=900; + Textout(xi,yi,s); + end; + {$ELSE} AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xt,yt, - PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,ClBlack,s,-910); - + PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,ClBlack,s,-900); + {$IFEND} if canton[i].SensLoco=SensHaut then begin with FormTCO[indexTCO].ImageTemp2.Canvas do @@ -7141,7 +7301,8 @@ end; //idcanton : indexcanton -// dessine le canton IdCantonen mode "mode" +// dessine le canton IdCanton en mode "mode" +// mode 0:canton normal 1:canton avec poignées procedure dessin_canton(IdCanton : integer;mode : integer) ; overload; var indexTCO,x,y : integer; begin @@ -7178,48 +7339,46 @@ var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; fond: tcolor; procedure trajet_droit; - begin - couleur:=clvoies[indexTCO]; - if mode>0 then - begin - if position=const_droit then - begin - if mode=1 then couleur:=clcanton[indexTCO]; - if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; - end; - end; + begin + couleur:=clvoies[indexTCO]; + if mode>0 then + begin + if position=const_droit then + begin + if mode=1 then couleur:=clcanton[indexTCO]; + if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; + end; + end; + with canvas do + begin + if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + pen.color:=couleur; + moveto(xc,y0);lineto(xc,yc); + if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xc,yf); + end; + end; - with canvas do - begin - if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - pen.color:=couleur; - moveto(xc,y0);lineto(xc,yc); - if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineto(xc,yf); - end; - end; - - procedure trajet_devie; - begin - couleur:=clvoies[indexTCO]; - if mode>0 then - begin - if position=const_devie then - begin - if mode=1 then couleur:=clcanton[indexTCO]; - if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; - end; - end; - - with canvas do - begin - pen.color:=couleur; - if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - moveto(x0,y0);lineto(xc,yc); - if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; - lineto(xc,yf); - end; - end; + procedure trajet_devie; + begin + couleur:=clvoies[indexTCO]; + if mode>0 then + begin + if position=const_devie then + begin + if mode=1 then couleur:=clcanton[indexTCO]; + if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; + end; + end; + with canvas do + begin + pen.color:=couleur; + if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + moveto(x0,y0);lineto(xc,yc); + if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xc,yf); + end; + end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine @@ -7454,7 +7613,7 @@ end; procedure dessin_23(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont, adr1,adr2,index1,index2,position1,position2,EtatTJD,sHG,sBD : integer; - a1,b1,a2,b2 : double; + a1,b1,a2,b2 : single; md,tHG,tBD : tEquipement; fond : tcolor; procedure verticale; @@ -7734,7 +7893,7 @@ begin lineTo(xc,yc+epaisseur); LineTo(xc+epaisseur,round((xc+epaisseur)*a1+b1) ); LineTo(xf,y0); - end; + end; end; end; end; @@ -7749,7 +7908,7 @@ end; procedure dessin_25(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2, adr1,adr2,index1,index2,position1,position2,EtatTJD,sHG,sBD : integer; - a1,b1,a2,b2 : double; + a1,b1,a2,b2 : single; md,tHG,tBD : tEquipement; fond : tcolor; procedure verticale; @@ -8085,7 +8244,6 @@ var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; end; end; - begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine @@ -9240,7 +9398,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position,ep : integer; lineto(xc,yf); end; end; - + begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine @@ -9618,7 +9776,7 @@ begin pen.width:=epaisseur div 2; moveTo(xf,yf);LineTo(xc,yc);LineTo(xc,y0); end; - end; + end; end; end; @@ -10063,7 +10221,7 @@ begin end; // calcul des facteurs de réductions X et Y pour l'adapter à l'image de destination -procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY : integer); +procedure calcul_reduction(Var frx,fry : single;DimDestX,DimDestY : integer); begin //frX:=DimDestX/DimOrgX; //frY:=DimDestY/DimOrgY; @@ -10746,7 +10904,7 @@ procedure dessin_Signal(indexTCO : integer;CanvasDest : Tcanvas;x,y : integer ); var index,x0,y0,xp,yp,orientation,adresse,aspect,PiedFeu,TailleX,TailleY,larg,haut : integer; ImageFeu : Timage; Contrevoie : boolean; - frX,frY : real; + frX,frY : single; begin if (x>NbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x<1) or (y<1) or (NbreSignaux=0) then exit; @@ -10996,107 +11154,113 @@ begin adresse:=tco[indextco,x,y].Adresse; BImage:=tco[indextco,x,y].BImage; mode:=tco[indextco,x,y].mode; // mode pour la couleur + clFond:=tco[indextco,x,y].CouleurFond; repr:=tco[indextco,x,y].repr; Epaisseur:=LargeurCell[indexTCO]*epaisseur_voies div 30; HautCell:=hauteurCell[indexTCO]; largCell:=LargeurCell[indexTCO]; if not NB then clFond:=tco[indextco,x,y].CouleurFond else clFond:=clWhite; - Xorg:=(x-1)*LargeurCell[indexTCO]; + Xorg:=(x-1)*LargCell; Yorg:=(y-1)*HautCell; - with PCanvasTCO[indexTCO] do - begin - font.Size:=(LargeurCell[indexTCO] div 10)+4; - if NB then font.color:=clBlack else - Font.Color:=tco[indextco,x,y].coulFonte; - Font.Name:='Arial'; - Font.Style:=style(tco[indextco,x,y].FontStyle); - end; - - - // ------------- affichage de l'adresse ------------------ - s:=IntToSTR(adresse); // affiche d'abord l'icone de la cellule et colore la voie si zone ou détecteur actionnée selon valeur mode dessine_icone(indexTCO,PCanvasTCO[indexTCO],Bimage,X,Y,mode); - - // dessin du train sur le canton - if (Bimage=Id_CantonH) or (Bimage=Id_CantonV) then dessin_canton(indexTCO,PCanvasTCO[indexTCO],x,y,0); + if (Bimage=Id_CantonH) or (Bimage=Id_CantonV) then dessin_canton(indexTCO,PCanvasTCO[indexTCO],x,y,0); - //Affiche(intToSTR( (LargeurCell[indexTCO] div 30)+6),clyellow); - - // affiche le texte des aiguillages - if IsAigTCO(Bimage) and (adresse<>0) then + if LargCell>24 then begin - if adresse<>0 then s:='A'+s+' ' else s:=' '; with PCanvasTCO[indexTCO] do begin - // si réservation par train - i:=index_aig(adresse); - AdrTr:=aiguillage[i].AdrTrain; - typ:=aiguillage[i].modele; - - if AdrTr=0 then - begin - if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; - //SetBkMode(PCanvasTCO[indexTCO].Handle,TRANSPARENT); - if roulage then s:=s+' '; // efface l'adresse de réservation - end - else - begin - // couleur de fond de la réservation - Brush.style:=bsSolid; - Brush.Color:=clBlue; - s:=s+intToSTR(AdrTr); - //SetBkMode(PCanvasTCO[indexTCO].Handle,OPAQUE); - end; - - //Brush.Style:=Bsclear; - - xt:=0;yt:=0; - if Bimage=2 then begin xt:=LargeurCell[indexTCO] div 2;yt:=1;end; - if Bimage=3 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(18*fryGlob[indexTCO]);end; - if Bimage=4 then begin xt:=10*round(frxGlob[indexTCO]);yt:=1;end; - if Bimage=5 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(18*fryGlob[indexTCO]);end; - if Bimage=12 then begin xt:=round(35*frxGlob[indexTCO]);yt:=2;end; - if Bimage=13 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - if Bimage=14 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=1;end; - if Bimage=15 then begin xt:=3;yt:=1;end; - if Bimage=21 then begin xt:=(LargeurCell[indexTCO] div 2)+round(2*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; - if Bimage=22 then begin xt:=(LargeurCell[indexTCO] div 2);yt:=-2;end; - if Bimage=23 then begin xt:=round(33*frxGlob[indexTCO]);yt:=round(35*fryGlob[indexTCO]);end; - if Bimage=24 then begin xt:=LargeurCell[indexTCO]-round(20*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - if Bimage=25 then begin xt:=round(34*frxGlob[indexTCO]);yt:=round(8*fryGlob[indexTCO]);end; - if Bimage=26 then begin xt:=round(35*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - if Bimage=27 then begin xt:=3;yt:=1;end; - if Bimage=28 then begin xt:=round(35*frxGlob[indexTCO]);yt:=1;end; - if Bimage=29 then begin xt:=LargeurCell[indexTCO] div 2;yt:=1;end; - if Bimage=32 then begin xt:=3;yt:=1;end; - if Bimage=33 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - if Bimage=34 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - TextOut(xOrg+xt,yOrg+yt,s); - end; - end; - - // détecteurs voie horizontale - if ((BImage=1) ) and (adresse<>0) then - begin // Adresse de l'élément - xt:=3; - if repr<>0 then - with PCanvasTCO[indexTCO] do - begin - if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.Color:=clwhite; - if NB then font.color:=clblack else + Brush.Color:=clFond; + font.Size:=((LargCell*6) div 30)+1; //((LargCell*5) div 29); + if NB then font.color:=clBlack else Font.Color:=tco[indextco,x,y].coulFonte; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); - xt:=round(4*frxGlob[indexTCO]); - case repr of - 1 : yt:=(hauteurCell[indexTCO] div 2)-round(7*fryGlob[indexTCO]); // milieu - 2 : yt:=2; // haut - 3 : yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]); // bas + end; + + + // ------------- affichage de l'adresse ------------------ + //s:=IntToSTR(adresse); + s:=format('%d',[adresse]); + + // affiche le texte des aiguillages + if IsAigTCO(Bimage) and (adresse<>0) then + begin + if adresse<>0 then s:='A'+s+' ' else s:=' '; + with PCanvasTCO[indexTCO] do + begin + // si réservation par train + i:=index_aig(adresse); + AdrTr:=aiguillage[i].AdrTrain; + typ:=aiguillage[i].modele; + + if AdrTr=0 then + begin + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; + //SetBkMode(PCanvasTCO[indexTCO].Handle,TRANSPARENT); + if roulage then s:=s+' '; // efface l'adresse de réservation + end + else + begin + // couleur de fond de la réservation + Brush.style:=bsSolid; + Brush.Color:=clBlue; + //s:=s+intToSTR(AdrTr); + s:=s+format('%d',[adrTr]); + //SetBkMode(PCanvasTCO[indexTCO].Handle,OPAQUE); + end; + + //Brush.Style:=Bsclear; + + xt:=0;yt:=0; + if Bimage=2 then begin xt:=LargeurCell[indexTCO] div 2;yt:=1;end; + if Bimage=3 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(18*fryGlob[indexTCO]);end; + if Bimage=4 then begin xt:=10*round(frxGlob[indexTCO]);yt:=1;end; + if Bimage=5 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(18*fryGlob[indexTCO]);end; + if Bimage=12 then begin xt:=round(35*frxGlob[indexTCO]);yt:=2;end; + if Bimage=13 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + if Bimage=14 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=1;end; + if Bimage=15 then begin xt:=3;yt:=1;end; + if Bimage=21 then begin xt:=-round(5*frxGlob[indexTCO]);yt:=0;end; + if Bimage=22 then begin xt:=(LargeurCell[indexTCO] div 2);yt:=-2;end; + if Bimage=23 then begin xt:=round(33*frxGlob[indexTCO]);yt:=round(35*fryGlob[indexTCO]);end; + if Bimage=24 then begin xt:=LargeurCell[indexTCO]-round(20*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + if Bimage=25 then begin xt:=round(34*frxGlob[indexTCO]);yt:=round(8*fryGlob[indexTCO]);end; + if Bimage=26 then begin xt:=round(35*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + if Bimage=27 then begin xt:=3;yt:=1;end; + if Bimage=28 then begin xt:=round(35*frxGlob[indexTCO]);yt:=1;end; + if Bimage=29 then begin xt:=LargeurCell[indexTCO] div 2;yt:=1;end; + if Bimage=32 then begin xt:=3;yt:=1;end; + if Bimage=33 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + if Bimage=34 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+xt,yOrg+yt,s); end; + end; + + // détecteurs voie horizontale + if ((BImage=1) ) and (adresse<>0) then + begin // Adresse de l'élément + xt:=3; + if repr<>0 then + with PCanvasTCO[indexTCO] do + begin + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.Color:=clwhite; + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + Font.Name:='Arial'; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + xt:=round(4*frxGlob[indexTCO]); + case repr of + 1 : yt:=(hauteurCell[indexTCO] div 2)-round(7*fryGlob[indexTCO]); // milieu + 2 : yt:=0; // haut + 3 : yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]); // bas + end; { // affiche/efface le nom du train du détecteur @@ -11116,226 +11280,255 @@ begin else if roulage then s:=s+' '; } //PCanvasTCO[indexTCO].font.Size:=(LargeurCell[indexTCO] div 13)+4 ; - AdrTr:=detecteur[adresse].AdrTrainRes; - if AdrTr<>0 then - begin - Brush.style:=bsSolid; - Brush.Color:=clBlue; - s:=s+' '+intToSTR(AdrTr); - end - else - begin - Brush.style:=bsSolid; - Brush.Color:=clfond; - Pen.color:=clfond; - pen.mode:=PmCopy; - pen.Width:=1; - rectangle(xOrg+xt,Yorg+yt-1,xOrg+LargCell-1,Yorg+yt+round(17*fryGlob[indexTCO])); - end; - TextOut(xOrg+xt,Yorg+yt,s); - - end; - end; - - if ((Bimage=8) or (Bimage=10) ) and (adresse<>0) then - begin - with PCanvasTCO[indexTCO] do - begin - xt:=round(25*frxGlob[indexTCO]); - yt:=round(35*fryGlob[indexTCO]); - Font.Name:='Arial'; - Font.Style:=style(tco[indextco,x,y].FontStyle); - if NB then font.color:=clblack else - Font.Color:=tco[indextco,x,y].coulFonte; - AdrTr:=detecteur[adresse].AdrTrainRes; - if AdrTr<>0 then - begin - Brush.style:=bsSolid; - Brush.Color:=clBlue; - s:=s+' '+intToSTR(AdrTr); - end - else - begin - Brush.style:=bsSolid; - Brush.Color:=clfond; - Pen.color:=clfond; - pen.mode:=PmCopy; - pen.Width:=1; - rectangle(xOrg+xt,Yorg+yt,xOrg+LargCell,Yorg+yt+11); - end; - TextOut(xOrg+xt,yOrg+yt,s); - end; - end; - - // autres détecteurs - if ((Bimage=7) or (Bimage=9) or (Bimage=17) ) and (adresse<>0) then - begin // Adresse de l'élément - with PCanvasTCO[indexTCO] do - begin - xt:=round(2*frxGlob[indexTCO]); - yt:=round(2*fryGlob[indexTCO]); - Font.Name:='Arial'; - Font.Style:=style(tco[indextco,x,y].FontStyle); - if NB then font.color:=clblack else - Font.Color:=tco[indextco,x,y].coulFonte; - AdrTr:=detecteur[adresse].AdrTrainRes; - if AdrTr<>0 then - begin - Brush.style:=bsSolid; - if not NB then Brush.Color:=clBlue else Brush.color:=clwhite; - s:=s+' '+intToSTR(AdrTr); - end - else - begin - Brush.style:=bsSolid; - Brush.Color:=clfond; - Pen.color:=clfond; - pen.mode:=PmCopy; - pen.Width:=1; - rectangle(xOrg+xt,Yorg+yt,xOrg+LargCell,Yorg+yt+11); - end; - TextOut(xOrg+xt,yOrg+yt,s); - end; - end; - - // écriture adresse à 90° - if (Bimage=20) and (adresse<>0) then - begin - with PCanvasTCO[indexTCO] do - begin - Font.Name:='Arial'; - Font.Style:=style(tco[indextco,x,y].FontStyle); - if NB then font.color:=clblack else - Font.Color:=tco[indextco,x,y].coulFonte; - AdrTr:=detecteur[adresse].AdrTrainRes; - if (AdrTr<>0) then - begin - Brush.style:=bsSolid; - if not NB then clfond:=clBlue else clfond:=clwhite; - s:=s+' '+intToSTR(AdrTr); - end; - - PCanvasTCO[indexTCO].font.Size:=PCanvasTCO[indexTCO].font.Size+1; - AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],Xorg,yOrg+HautCell-round(2*fryGlob[indexTCO]), - PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,clfond,s+' ',910); - end; - end; - - // autres détecteurs - if ((Bimage=18) or (Bimage=19)) and (adresse<>0) then - begin // Adresse de l'élément - with PCanvasTCO[indexTCO] do - begin - if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; - Font.Name:='Arial'; - Font.Style:=style(tco[indextco,x,y].FontStyle); - if NB then font.color:=clblack else - Font.Color:=tco[indextco,x,y].coulFonte; - TextOut(xOrg+round(20*frxGlob[indexTCO]),yOrg+hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]),s); - end; - end; - - // autres détecteurs - if ((Bimage=6) or (Bimage=11) or (Bimage=16)) and (adresse<>0) then - begin // Adresse de l'élément - with PCanvasTCO[indexTCO] do - begin - if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; - if NB then font.color:=clblack else - Font.Color:=tco[indextco,x,y].coulFonte; - Font.Style:=style(tco[indextco,x,y].FontStyle); - Font.Name:='Arial'; - TextOut(xOrg+round(28*frxGlob[indexTCO]),yOrg+round(2*fryGlob[indexTCO]),s); - //exit; - end; - end; - - // adresse des signaux - if (BImage=Id_signal) and (adresse<>0) then - begin - index:=Index_Signal(adresse); - aspect:=Signaux[index].Aspect; - oriente:=tco[indextco,x,y].FeuOriente; - pied:=tco[indextco,x,y].PiedFeu; - inverse:=Signaux[index].contrevoie; // pour signal belge - xt:=0;yt:=0; - // signal belge - if (aspect=20) then - begin - if (Oriente=1) then - begin - if inverse then begin xt:=2;yt:=2*hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end + AdrTr:=detecteur[adresse].AdrTrainRes; + if AdrTr<>0 then + begin + Brush.style:=bsSolid; + Brush.Color:=clBlue; + //s:=s+' '+intToSTR(AdrTr); + s:=s+format('%d',[adrTr]); + end else - begin xt:=(LargeurCell[indexTCO] div 2)+round(5*frxGlob[indexTCO]);yt:=2*hauteurCell[indexTCO]-round(20*fryGlob[indexTCO]); end; - end; - if (Oriente=2) then + begin + Brush.style:=bsSolid; + Brush.Color:=clfond; + Pen.color:=clfond; + pen.mode:=PmCopy; + pen.Width:=1; + rectangle(xOrg+xt,Yorg+yt-1,xOrg+LargCell-1,Yorg+yt+round(17*fryGlob[indexTCO])); + end; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+xt,Yorg+yt,s); + end; + end; + + if ((Bimage=8) or (Bimage=10) ) and (adresse<>0) then + begin + with PCanvasTCO[indexTCO] do begin - if inverse then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(3*fryGlob[indexTCO]);end + xt:=round(25*frxGlob[indexTCO]); + yt:=round(35*fryGlob[indexTCO]); + Font.Name:='Arial'; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + AdrTr:=detecteur[adresse].AdrTrainRes; + if AdrTr<>0 then + begin + Brush.style:=bsSolid; + Brush.Color:=clBlue; + //s:=s+' '+intToSTR(AdrTr); + s:=s+' '+format('%d',[adrTr]); + end else - begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end; - end; - if (Oriente=3) then - begin - if inverse then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(50*frxGlob[indexTCO]);end - else begin xt:=round(60*frxGlob[indexTCO]);yt:=round(1*frxGlob[indexTCO])end; - end; - if (oriente=4) then - begin - if inverse then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end - else begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*fryGlob[indexTCO]);end; + begin + Brush.style:=bsSolid; + Brush.Color:=clfond; + Pen.color:=clfond; + pen.mode:=PmCopy; + pen.Width:=1; + rectangle(xOrg+xt,Yorg+yt,xOrg+LargCell,Yorg+yt+11); + end; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+xt,yOrg+yt,s); end; end; - if (aspect=9) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=round(60*fryGlob[indexTCO]);end; - if (aspect=9) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]);end; // orientation G - if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+round(25*frxGlob[indexTCO]);yt:=1;end; - if (aspect=9) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; - if (aspect=9) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - if (aspect=7) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; - if (aspect=7) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; - if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+2;yt:=1;end; - if (aspect=7) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; - if (aspect=7) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + // autres détecteurs + if ((Bimage=7) or (Bimage=9) or (Bimage=17) ) and (adresse<>0) then + begin // Adresse de l'élément + with PCanvasTCO[indexTCO] do + begin + xt:=round(2*frxGlob[indexTCO]); + yt:=round(2*fryGlob[indexTCO]); + Font.Name:='Arial'; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + AdrTr:=detecteur[adresse].AdrTrainRes; + if AdrTr<>0 then + begin + Brush.style:=bsSolid; + if not NB then Brush.Color:=clBlue else Brush.color:=clwhite; + //s:=s+' '+intToSTR(AdrTr); + s:=s+' '+format('%d',[adrTr]); + end + else + begin + Brush.style:=bsSolid; + Brush.Color:=clfond; + Pen.color:=clfond; + pen.mode:=PmCopy; + pen.Width:=1; + rectangle(xOrg+xt,Yorg+yt,xOrg+LargCell,Yorg+yt+11); + end; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+xt,yOrg+yt,s); + end; + end; - if (aspect=5) and (Oriente=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]+round(25*fryGlob[indexTCO]);end; - if (aspect=5) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO] ;end; - if (aspect=5) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; - if (aspect=5) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - if (aspect=5) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - - if (aspect=4) and (Oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]+round(20*fryGlob[indexTCO]);end; - if (aspect=4) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; - if (aspect=4) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; - if (aspect=4) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - if (aspect=4) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - - if (aspect=3) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite - if (aspect=3) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche - if (aspect=3) and (Oriente=2) and (pied=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // signal à G - if (aspect=3) and (Oriente=2) and (pied=2) then begin xt:=round(20*frxGlob[indexTCO]);yt:=0;end; // signal à droite - if (aspect=3) and (Oriente=3) then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(36*fryGlob[indexTCO]);end; - if (aspect=3) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - if (aspect=3) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; - - if (aspect=2) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite - if (aspect=2) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche - if (aspect=2) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; // orientation G - if (aspect=2) and (Oriente=3) then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // orientation D - if (aspect=2) and (Oriente=4) then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(10*fryglob[indexTCO]);end; // orientation 180 - - // signaux directionnels - if (aspect>10) and (aspect<20) and(oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end; - if (aspect>10) and (aspect<20) and (oriente=2) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; - if (aspect>10) and (aspect<20) and (oriente=3) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; - - with PCanvasTCO[indexTCO] do + // écriture adresse à 90° + if (Bimage=20) and (adresse<>0) then begin - if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; - if NB then font.color:=clblack else - Font.Color:=tco[indextco,x,y].coulFonte; - Font.Style:=style(tco[indextco,x,y].FontStyle); - Font.Name:='Arial'; - TextOut(xOrg+xt,yOrg+yt,s); + with PCanvasTCO[indexTCO] do + begin + Font.Name:='Arial'; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + AdrTr:=detecteur[adresse].AdrTrainRes; + if (AdrTr<>0) then + begin + Brush.style:=bsSolid; + if not NB then clfond:=clBlue else clfond:=clwhite; + //s:=s+' '+intToSTR(AdrTr); + s:=s+' '+format('%d',[adrTr]); + end; + + PCanvasTCO[indexTCO].font.Size:=PCanvasTCO[indexTCO].font.Size+1; + xt:=Xorg-1; + yt:=yOrg+HautCell-round(2*fryGlob[indexTCO]); + {$IF CompilerVersion >= 28.0} + font.orientation:=900; + Textout(xt,yt,s); + {$ELSE} + AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],xt,yt, + PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,clfond,s+' ',900); + {$IFEND} + end; + end; + + // autres détecteurs + if ((Bimage=18) or (Bimage=19)) and (adresse<>0) then + begin // Adresse de l'élément + with PCanvasTCO[indexTCO] do + begin + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; + Font.Name:='Arial'; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+round(20*frxGlob[indexTCO]),yOrg+hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]),s); + end; + end; + + // autres détecteurs + if ((Bimage=6) or (Bimage=11) or (Bimage=16)) and (adresse<>0) then + begin // Adresse de l'élément + with PCanvasTCO[indexTCO] do + begin + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + Font.Name:='Arial'; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+round(28*frxGlob[indexTCO]),yOrg+round(2*fryGlob[indexTCO]),s); + //exit; + end; + end; + + // adresse des signaux + if (BImage=Id_signal) and (adresse<>0) then + begin + index:=Index_Signal(adresse); + aspect:=Signaux[index].Aspect; + oriente:=tco[indextco,x,y].FeuOriente; + pied:=tco[indextco,x,y].PiedFeu; + inverse:=Signaux[index].contrevoie; // pour signal belge + xt:=0;yt:=0; + // signal belge + if (aspect=20) then + begin + if (Oriente=1) then + begin + if inverse then begin xt:=2;yt:=2*hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end + else + begin xt:=(LargeurCell[indexTCO] div 2)+round(5*frxGlob[indexTCO]);yt:=2*hauteurCell[indexTCO]-round(20*fryGlob[indexTCO]); end; + end; + if (Oriente=2) then + begin + if inverse then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(3*fryGlob[indexTCO]);end + else + begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end; + end; + if (Oriente=3) then + begin + if inverse then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(50*frxGlob[indexTCO]);end + else begin xt:=round(60*frxGlob[indexTCO]);yt:=round(1*frxGlob[indexTCO])end; + end; + if (oriente=4) then + begin + if inverse then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end + else begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*fryGlob[indexTCO]);end; + end; + end; + if (aspect=9) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=round(60*fryGlob[indexTCO]);end; + if (aspect=9) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]);end; // orientation G + if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+round(25*frxGlob[indexTCO]);yt:=1;end; + if (aspect=9) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; + if (aspect=9) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=7) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; + if (aspect=7) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; + if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+2;yt:=1;end; + if (aspect=7) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; + if (aspect=7) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=5) and (Oriente=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]+round(25*fryGlob[indexTCO]);end; + if (aspect=5) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO] ;end; + if (aspect=5) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; + if (aspect=5) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=5) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=4) and (Oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]+round(20*fryGlob[indexTCO]);end; + if (aspect=4) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; + if (aspect=4) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; + if (aspect=4) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=4) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=3) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite + if (aspect=3) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche + if (aspect=3) and (Oriente=2) and (pied=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // signal à G + if (aspect=3) and (Oriente=2) and (pied=2) then begin xt:=round(20*frxGlob[indexTCO]);yt:=0;end; // signal à droite + if (aspect=3) and (Oriente=3) then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(36*fryGlob[indexTCO]);end; + if (aspect=3) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + if (aspect=3) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; + + if (aspect=2) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite + if (aspect=2) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche + if (aspect=2) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; // orientation G + if (aspect=2) and (Oriente=3) then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // orientation D + if (aspect=2) and (Oriente=4) then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(10*fryglob[indexTCO]);end; // orientation 180 + + // signaux directionnels + if (aspect>10) and (aspect<20) and(oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end; + if (aspect>10) and (aspect<20) and (oriente=2) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; + if (aspect>10) and (aspect<20) and (oriente=3) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; + + with PCanvasTCO[indexTCO] do + begin + if not NB then Brush.Color:=tco[indextco,x,y].CouleurFond else Brush.color:=clwhite; + if NB then font.color:=clblack else + Font.Color:=tco[indextco,x,y].coulFonte; + //Font.Style:=style(tco[indextco,x,y].FontStyle); + Font.Name:='Arial'; + {$IF CompilerVersion >= 28.0} + font.orientation:=0; + {$IFEND} + TextOut(xOrg+xt,yOrg+yt,s); + end; end; end; end; @@ -11362,7 +11555,6 @@ begin; end; end; - procedure Entoure_cell(indexTCO,x,y : integer); var r : Trect; x0,y0 : integer; @@ -11510,7 +11702,7 @@ begin end; end; - //afficher les cellules des signaux et les textes pour que les pieds recouvrent le reste et afficher les textes + //afficher les cellules des signaux et des cantons et les textes pour que les pieds recouvrent le reste et afficher les textes for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin @@ -11547,6 +11739,7 @@ procedure TFormTCO.FormCreate(Sender: TObject); var s : string; begin NB:=false; // mode noir et blanc pour l'affichage + if jeucouleurs=0 then JeuCouleurs:=1; // style de couleur sombre par défaut if affevt or (debug=1) then Affiche('FormTCO'+intToSTR(indexTCOCreate)+' create',clLime); procetape('Création fenêtre TCO'); @@ -11564,8 +11757,6 @@ begin affPosFil:=true; visible:=false; // ne s'affiche pas par défaut et évite l'effet fenetre fantome. ClTexte:=$00FF00; - clFondCantonV:=$206020; - clFondCantonR:=$202060; IdCantonSelect:=0; indexTrainFR:=0; PCanvasTCO[indexTCOCreate]:=nil; @@ -11679,11 +11870,9 @@ begin tcoCree:=true; if debug=1 then Affiche('Fin création fenêtre TCO',clLime); - end; - procedure Erreur_TCO(indexTCO,x,y : integer); var s : string; i,adresse : integer; @@ -11736,12 +11925,39 @@ begin end; end; -// affiche le trajet dans le tco du train,ir =nombre d'éléments du tableau trace_train mode=couleur +// renvoie le sens de la loco en circulation dans le canton +// on utilise le détecteur suivant du train pour trouver le sens de déplacement du train +function sens_train_canton(AdrTrain,Idcanton : integer) : integer; +var adrdet,IndexTrain : integer; + horz : boolean; +begin + result:=0; + indexTrain:=index_train_adresse(AdrTrain); + if indexTrain=0 then exit; + + adrdet:=trains[indexTrain].detecteurSuiv; + //Affiche('DetecteurSuiv='+intToSTR(adrDet),clYellow); + + if adrdet=0 then exit; + horz:=canton[idcanton].horizontal; + if horz then + begin + if (canton[idcanton].el1=AdrDet) and (canton[idcanton].typ1=det) then begin result:=SensGauche;exit;end; + if (canton[idcanton].el2=AdrDet) and (canton[idcanton].typ2=det) then begin result:=SensDroit;exit;end; + end; + if (canton[idcanton].el1=AdrDet) and (canton[idcanton].typ1=det) then begin result:=SensHaut;exit;end; + if (canton[idcanton].el2=AdrDet) and (canton[idcanton].typ2=det) then begin result:=SensBas;exit;end; + +end; + +// affiche le trajet Trace_Train[] dans le tco du train,ir =nombre d'éléments du tableau trace_train mode=couleur // mode=0 : effacement du trajet // sinon mode = couleur du train -// affecte le train au canton -procedure affiche_trajet(indexTCO,train,AdrTrain,ir,mode : integer); -var i,sx,sy,x,y,ax,ay,Bimage,adresse,IdCanton,IdTrain,AncTrain,d1,d2: integer; +// affecte_loco = true : procède à l'affectation du train dans les cantons +// = false : ne change pas le train dans le canton +procedure affiche_trajet(indexTCO,train,AdrTrain,ir,mode : integer;affecte_loco : boolean); +var i,sx,sy,x,y,ax,ay,Bimage,adresse,IdCanton,IdTrain,AncTrain, + DernierDet,sens : integer; cant : boolean; begin // et affichage de la route @@ -11774,6 +11990,11 @@ begin else IdTrain:=0; // efface train adresse:=tco[indextco,x,y].Adresse; + if adresse<>0 then + begin + // si l'adresse est un détecteur + if (index_adresse_detecteur(adresse)<>0) then DernierDet:=adresse; + end; tco[indextco,x,y].trajet:=0; @@ -11782,42 +12003,33 @@ begin if not(cant) then TCO[IndexTCO,x,y].train:=IdTrain else begin - // si canton + // si canton affecte ou désaffecte le train au canton + // voir pour afficher le train si le détecteur d'entrée du canton passa à 1 + IdCanton:=index_canton_numero(TCO[indexTCO,x,y].NumCanton); // index canton - { - if (idTrain<>0) and (idcanton<>0) then - begin - if canton[IdCanton].indexTrain<>0 then //si train dans canton - begin - if AdrTrain<>0 then canton[idCanton].indexTrain:=Index_Train_Adresse(AdrTrain); - IdTrain:=canton[IdCanton].indexTrain; - Affiche('1.Affecte train '+intToSTR(adrTrain)+' au canton n°'+intToSTR(index_canton_numero(TCO[indexTCO,x,y].PiedFeu)),clred); - affecte_train_canton(AdrTrain,IdCanton); - end; - if idTrain<=Ntrains then // dans le cas de la libération d'un canton par un train qui avance, - begin // IdTrain=0 - AncTrain:=canton[IdCanton].indexTrain; - if (idTrain<>0) and (AncTrain=0) and (adrtrain=0) then adrTrain:=0; //9999 adresse train inconnue - if (idTrain=0) and (AncTrain=9999) and (adrtrain=0) then adrTrain:=0; - //if (ancTrain=0) or (IdTrain=0) then // si le canton est déja affecté à un train et que le nouveau train<>0, on ne réaffecte pas le train qui arrive - //if idTrain=0 then AdrTrain:=0; - Affiche('2. Affecte train '+intToSTR(adrTrain)+' au canton n°'+intToSTR(index_canton_numero(TCO[indexTCO,x,y].NumCanton)),clorange); - affecte_Train_canton(AdrTrain,IdCanton); - end; - end; } + AncTrain:=0; - if idcanton<>0 then + if (idcanton<>0) and affecte_loco then begin - if canton[idCanton].typ1=det then + if mode=0 then // désaffecter le train begin - d1:=canton[idCanton].el1; - AncTrain:=detecteur[d1].AdrTrain; if AncTrain<>0 then affecte_Train_canton(AncTrain,IdCanton,canton[idcanton].SensLoco); - end; - if (canton[idCanton].typ2=det) and (ancTrain=0) then // si déja affecté train + //Affiche('Désaffecte train canton'+intToSTR(canton[idcanton].numero),clYellow); + affecte_train_canton(0,idCanton,canton[idcanton].sensLoco) + end + else begin - d2:=canton[idCanton].el2; - AncTrain:=detecteur[d2].AdrTrain; if AncTrain<>0 then affecte_Train_canton(AncTrain,IdCanton,canton[idcanton].SensLoco); + begin + AncTrain:=detecteur[dernierDet].AdrTrain; + if ancTrain<>0 then + begin + //Affiche('Affecte train canton'+intToSTR(canton[idcanton].numero),clYellow); + sens:=sens_train_canton(AdrTrain,Idcanton); + + affecte_train_canton(AncTrain,idcanton,sens); + end; + end; end; + end; end; @@ -11918,11 +12130,12 @@ end; // direction=det2 = TCO_N TCO_NE etc // =13 : det1=adresse de l'élément TypEL : type de l'élément, s'arrête au suivant, suivant la direction // Ne nécessite pas que les aiguillages en talon soient bien positionnés entre det1 et det2 -// PosAig = False:teste toutes les routes en récursif les aiguillages en pointe -// True: les aiguillages en pointe doivent être positionnés +// PosAig = False: teste toutes les routes en récursif les aiguillages en pointe +// True: suit les aiguillages en pointe qui doivent être positionnés +// affecte_loco : true : efface la loco // en sortie : true si det2 a été trouvé // -function zone_tco_gx(indexTCO,det1: integer;typEL : tequipement;det2,train,adrTrain,mode: integer;posAig : boolean) : boolean; +function zone_tco_gx(indexTCO,det1: integer;typEL : tequipement;det2,train,adrTrain,mode: integer;posAig,affecte_loco : boolean) : boolean; var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteration,indexIr,AdrTr, NbTrouve,AdrTr1,adrTr2 : integer; memtrouve,sortir,indextrouve : boolean; @@ -13485,21 +13698,21 @@ begin AdrTr:=Adrtr2; //Affiche(intToSTR(det1)+' '+intToSTR(det2)+' Mode '+intToSTR(mode)+' Le détecteur2 '+intToSTR(Det2)+ ' est affecté au train @'+intToSTR(AdrTr2),clYellow); end; - Affiche_trajet(indexTCO,train,AdrTrain,indexIr,mode); // affiche le trajet dans le TCO + Affiche_trajet(indexTCO,train,AdrTrain,indexIr,mode,affecte_loco); // affiche le trajet dans le TCO end; end; end; // fonction appellable en modes 1 2 3 10 11 12 -function zone_tco(indexTCO,det1,det2,train,adrTrain,mode: integer;posAig : boolean) : boolean; overload; +function zone_tco(indexTCO,det1,det2,train,adrTrain,mode: integer;posAig,affecte_loco : boolean) : boolean; overload; begin - result:=zone_tco_gx(indexTCO,det1,det,det2,train,adrTrain,mode,posAig); + result:=zone_tco_gx(indexTCO,det1,det,det2,train,adrTrain,mode,posAig,affecte_loco); end; // fonction appellable en mode 13 -function zone_tco(indexTCO,adr : integer;typEl : tequipement;sens,mode: integer;posAig : boolean) : boolean; overload; +function zone_tco(indexTCO,adr : integer;typEl : tequipement;sens,mode: integer;posAig,affecte_loco : boolean) : boolean; overload; begin - result:=zone_tco_gx(indexTCO,adr,typEL,sens,0,0,mode,posAig); + result:=zone_tco_gx(indexTCO,adr,typEL,sens,0,0,mode,posAig,affecte_loco); end; @@ -13801,9 +14014,8 @@ begin positionne(indexTCO); renseigne_tous_cantons; - renseigne_TJDs; + renseigne_TJDs_TCO; FormInit[indexTCO]:=true; - end; if indexTCO=NbreTCO then TCOActive:=true; end; @@ -14372,7 +14584,7 @@ begin larg:=largeurCell[indexTCO]; haut:=hauteurCell[indexTCO]; -// zone de sélection bleue en cellules + // zone de sélection bleue en cellules xMiniSel:=(Xentoure[indexTCO]); yMiniSel:=(Yentoure[indexTCO]); xMaxiSel:=(cellX); @@ -15701,7 +15913,8 @@ begin IdCantonSelect:=index_canton_numero(TCO[IndexTCO,xt,yt].NumCanton); end; //Affiche('Selection canton id='+intToSTR(IdCantonSelect)+' num='+intToSTR(TCO[IndexTCO,xt,yt].NumCanton),clYellow); - if (IdCantonSelect<1) or (IdCantonSelect>ncantons) then begin Affiche('Anomalie 5 : '+intToSTR(IdCantonSelect),clred);exit;end; + if (IdCantonSelect<1) or (IdCantonSelect>ncantons) then + begin Affiche('TCO'+inttoSTR(indexTCO)+' anomalie 5 : indexCanton='+intToSTR(IdCantonSelect)+' '+intToSTR(xt)+','+intToSTR(yt),clred);exit;end; // provoque l'affichage du canton en mode sélection (1) Dessin_canton(IdCantonSelect,1); @@ -15872,47 +16085,6 @@ begin exit; end; - // - n:=trains[indexTrain].routePref[0].adresse; - if n<>0 then - begin - Affiche('trouvé route affectée au train',clYellow); - el1:=trains[indexTrain].routePref[1].adresse; - // vérifier si le détecteur est l'un des deux du canton cliqué - if ((canton[IdCantonClic].el1=el1) and (canton[IdCantonClic].typ1=det)) or - ((canton[IdCantonClic].el2=el2) and (canton[IdCantonClic].typ2=det)) then - begin - // trouver le canton destination - if trains[indexTrain].routePref[n].typ<>det then exit; - el2:=trains[indexTrain].routePref[n].adresse; - i:=1; - repeat - trouve:=((canton[i].el1=el2) and (canton[i].typ1=det)) or - ((canton[i].el2=el2) and (canton[i].typ2=det)) ; - inc(i); - until trouve or (i>ncantons); - if not trouve then exit; - dec(i); - Idcantondest:=i; - - canton[IdCantonClic].bouton:=3; - canton[IdCantonClic].NumcantonOrg:=canton[IdcantonClic].numero; - canton[IdCantonClic].NumcantonDest:=canton[IdcantonDest].numero; - dessin_canton(IdCantonClic,0); - - canton[IdCantonDest].bouton:=4; - canton[IdCantonDest].NumcantonOrg:=canton[IdcantonClic].numero; - canton[IdCantonDest].NumcantonDest:=canton[IdcantonDest].numero; - dessin_canton(IdCantonDest,0); - - indexTrainFR:=indexTrain; - trains[indexTrain].route:=trains[indexTrain].routePref; - FormRouteTrain.Show; - - exit; - end; - end; - if tel1=det then detDepart:=el1; if tel2=det then detDepart:=el2; cantonOrg:=canton[IdCantonClic].numero; @@ -15990,7 +16162,11 @@ begin application.processMessages; prepare_route(indexTCO,cantonOrg,detAtrouve,sens); // à gauche(5) du détecteur / droite (6) / en bas (8) / haut (7) - if trains[indexTrain].route[0].adresse<>0 then formRouteTrain.show else formRoute.show; + if trains[indexTrain].route[0].adresse<>0 then formRouteTrain.show else + begin + indexTCOcourant:=indexTCO; + formRoute.show; + end; titre_Fenetre(indexTCO); //detatrouve:=0; //detDepart:=0; @@ -17168,7 +17344,7 @@ begin aiguillage[Index_Aig(117)].position:=const_devie; //debugTco:=true; - zone_tco(1,527,519,1,0,1,false); + zone_tco(1,527,519,1,0,1,false,false); // zone_tco(518,515,1); //zone_tco(522,514,1); @@ -18031,7 +18207,6 @@ begin xmaxi:=XmaxiSel; ymaxi:=YmaxiSel; - if selectionaffichee[indexTCO] then begin if (FormTCO[indexTCO].RadioGroupSel.ItemIndex=1) and (Rect_select.NumTCO=indexTCO) then @@ -18075,6 +18250,7 @@ begin ShapeCoulFond.Brush.Color:=ColorDialog1.Color; + sauve_styles_tco(indexTCO); TCO_modifie:=true; Affiche_TCO(indexTCO); end; @@ -18616,6 +18792,8 @@ begin if Application.MessageBox(pchar(s),pchar('confirmation'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idYes then begin supprime_route_train(canton[idcantonDragOrg].indexTrain); + AdrTrain:=canton[idcantonDragOrg].adresseTrain; + Raz_cantons_train(AdrTrain,true); raz_canton_org_dest(idcantonDragOrg); end; @@ -18681,7 +18859,8 @@ begin // raz train canton d'origine IdTrain:=canton[IdCantonDragOrg].indexTrain; supprime_route_train(canton[idcantonDragOrg].indexTrain); - Raz_trains_idcanton(IdCantonDragOrg); // raz du train du canton + //Raz_trains_idcanton(IdCantonDragOrg); // raz du train du canton + raz_cantons_train(canton[idCantonDragOrg].adresseTrain,true); // true=avec raz détecteur // affectation train canton destination affecte_Train_canton(trains[idTrain].adresse,IdCantonDest,sens); @@ -18713,14 +18892,17 @@ end; procedure TFormTCO.AffRoutesClick(Sender: TObject); begin - formrouteTrain.windowState:=wsNormal; //Maximized;; - //formroute.Create(self); - formRouteTrain.Show; + with formrouteTrain do + begin + windowState:=wsNormal; //Maximized;; + TabSheetRA.Enabled:=true; + Show; + end; end; procedure TFormTCO.Button1Click(Sender: TObject); begin - zone_tco(1,523,518,1,0,1,false); + zone_tco(1,523,518,1,0,1,false,false); end; procedure TFormTCO.Optiondesroutes1Click(Sender: TObject); diff --git a/selection_train.dfm b/selection_train.dfm index 6635bc1..b3fda76 100644 --- a/selection_train.dfm +++ b/selection_train.dfm @@ -1,8 +1,8 @@ object FormSelTrain: TFormSelTrain - Left = 358 - Top = 131 - Width = 860 - Height = 370 + Left = 405 + Top = 201 + Width = 800 + Height = 464 Caption = 'S'#233'lection train' Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -14,16 +14,16 @@ object FormSelTrain: TFormSelTrain OnActivate = FormActivate OnCreate = FormCreate DesignSize = ( - 844 - 331) + 792 + 433) PixelsPerInch = 96 TextHeight = 13 object LabelInfo: TLabel Left = 125 - Top = 306 + Top = 400 Width = 44 Height = 13 - Anchors = [akBottom] + Anchors = [akLeft, akBottom] Caption = 'LabelInfo' end object Label1: TLabel @@ -329,10 +329,10 @@ object FormSelTrain: TFormSelTrain end object ButtonOK: TButton Left = 29 - Top = 300 + Top = 394 Width = 75 Height = 24 - Anchors = [akBottom] + Anchors = [akLeft, akBottom] Caption = 'Ok' TabOrder = 0 OnClick = ButtonOKClick @@ -347,8 +347,8 @@ object FormSelTrain: TFormSelTrain OnChange = ComboBoxCantonChange end object ButtonSauve: TButton - Left = 695 - Top = 300 + Left = 644 + Top = 394 Width = 82 Height = 25 Hint = 'Sauvegarde le placement des trains dans les cantons' @@ -359,39 +359,27 @@ object FormSelTrain: TFormSelTrain TabOrder = 2 OnClick = ButtonSauveClick end - object ScrollBoxST: TScrollBox - Left = 11 - Top = 49 - Width = 821 - Height = 240 - HorzScrollBar.Smooth = True - HorzScrollBar.Tracking = True - VertScrollBar.Increment = 21 - VertScrollBar.Tracking = True - Anchors = [akLeft, akTop, akRight, akBottom] + object StringGridTrains: TStringGrid + Left = 8 + Top = 40 + Width = 769 + Height = 329 + ColCount = 8 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goAlwaysShowEditor, goThumbTracking] + ScrollBars = ssVertical TabOrder = 3 - object StringGridTrains: TStringGrid - Left = 0 - Top = 0 - Width = 793 - Height = 233 - ColCount = 8 - FixedCols = 0 - Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goAlwaysShowEditor] - ScrollBars = ssNone - TabOrder = 0 - OnDrawCell = StringGridTrainsDrawCell - OnKeyDown = StringGridTrainsKeyDown - OnSelectCell = StringGridTrainsSelectCell - ColWidths = ( - 43 - 214 - 172 - 57 - 105 - 108 - 32 - 29) - end + OnDrawCell = StringGridTrainsDrawCell + OnKeyDown = StringGridTrainsKeyDown + OnSelectCell = StringGridTrainsSelectCell + ColWidths = ( + 43 + 214 + 172 + 57 + 105 + 108 + 32 + 29) end end diff --git a/selection_train.pas b/selection_train.pas index a3400da..ad1ecdd 100644 --- a/selection_train.pas +++ b/selection_train.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, Grids, ExtCtrls, UnitPrinc; + Dialogs, StdCtrls, Grids, ExtCtrls, UnitPrinc, ComCtrls; type TFormSelTrain = class(TForm) @@ -18,7 +18,6 @@ type ImageDroite: TImage; LabelCanton: TLabel; ButtonSauve: TButton; - ScrollBoxST: TScrollBox; StringGridTrains: TStringGrid; procedure ButtonOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -33,7 +32,7 @@ type procedure ButtonSauveClick(Sender: TObject); private { Déclarations privées } - public + public { Déclarations publiques } end; @@ -47,8 +46,8 @@ var procedure actualise_seltrains; procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer); -procedure raz_trains_Idcanton(idc : integer); -procedure raz_cantons_train(AdrTrain : integer); +procedure xxxraz_trains_Idcanton(idc : integer); +procedure raz_cantons_train(AdrTrain : integer;raz : boolean); procedure trouve_det_canton(idcanton : integer;var el1,el2 : integer); function trouve_det_suiv_canton(idcanton,detecteur,sensTCO : integer) : integer; procedure Maj_detecteurs_canton(i,AdrTrain,adresse : integer); @@ -175,18 +174,45 @@ function trouve_det_suiv_canton(idcanton,detecteur,sensTCO : integer) : integer; var t : integer; begin t:=canton[idcanton].ntco; - zone_tco(t,detecteur,sensTCO,0,0,12,false); // élément contigu à droite (6) du canton , résultat dans xcanton , teste les 2 pos des aig + zone_tco(t,detecteur,sensTCO,0,0,12,false,false); // élément contigu à droite (6) du canton , résultat dans xcanton , teste les 2 pos des aig if tel1=Aig then xcanton:=detecteur_suivant(detecteur,det,xcanton,aig,1); result:=xcanton; end; +// raz des trains affectés au canton d'index "idc" +procedure xxxraz_trains_idcanton(idc : integer); +var ax,ay,i,ic : integer; +begin + if traceliste then Affiche('Raz train affectés au canton index='+intToSTR(idc),clyellow); + for i:=1 to Ntrains do + begin + ic:=index_canton_numero(trains[i].canton); + if ic=idc then + begin + routeSav:=trains[i].route; // sauvegarde la route + trains[i].canton:=0; + trains[i].route[0].adresse:=0; + if ic<>0 then + begin + ax:=canton[Ic].x; + ay:=canton[Ic].y; + tco[IndexTCOCourant,ax,ay].train:=0; + canton[Ic].indexTrain:=0; + canton[Ic].adresseTrain:=0; + canton[Ic].NomTrain:=''; + end; + end; + end; +end; + // supprime le train AdrTrain de tous les cantons, et réaffiche les cantons effacés concernés -procedure raz_cantons_train(AdrTrain : integer); +// si raz=true : raz aussi le train du détecteur +procedure raz_cantons_train(AdrTrain : integer;raz : boolean); var i,t,idTCO,x,y,detect : integer; trouve : boolean; begin if (AdrTrain=0) then exit; - //Affiche('Raz_cantons_train @='+intToSTR(AdrTrain),clyellow); + if procPrinc then AfficheDebug('Raz_cantons_train @='+intToSTR(AdrTrain),clyellow); if adrTrain<>0 then begin for i:=1 to Ncantons do @@ -195,7 +221,7 @@ begin begin t:=canton[i].indexTrain; trains[t].canton:=0; - + routeSav:=trains[t].route; // sauvegarde la route canton[i].indexTrain:=0; canton[i].adresseTrain:=0; canton[i].NomTrain:=''; @@ -210,30 +236,31 @@ begin // balayer les détecteurs pour trouver sur quel détecteur est le train pour le razer // non - { - i:=1; - repeat - detect:=adresse_detecteur[i]; - trouve:=detecteur[detect].AdrTrain=AdrTrain; - if trouve then - begin - detecteur[detect].Train:=''; - detecteur[detect].IndexTrainRoulant:=0; - detecteur[detect].AdrTrain:=0; - detecteur[detect].Suivant:=0; - detecteur[detect].TypSuivant:=rien; - detecteur[detect].Precedent:=0; - detecteur[detect].TypPrecedent:=rien; - end; - inc(i); - until trouve or (i>NDetecteurs);} + if raz then + begin + i:=1; + repeat + detect:=adresse_detecteur[i]; + trouve:=detecteur[detect].AdrTrain=AdrTrain; + if trouve then + begin + detecteur[detect].Train:=''; + detecteur[detect].IndexTrainRoulant:=0; + detecteur[detect].AdrTrain:=0; + detecteur[detect].Suivant:=0; + detecteur[detect].TypSuivant:=rien; + detecteur[detect].Precedent:=0; + detecteur[detect].TypPrecedent:=rien; + end; + inc(i); + until trouve or (i>NDetecteurs); + end; end; end; // affecte le train id train ou adresse à l'Index canton et au TCO. -// -// désaffecte ce train pour tous les autres canton +// désaffecte ce train pour tous les autres cantons // si adrTrain=9999 , train inconnu // si adrTrain=0 ; efface // et les pointeurs de trains de l'idTrain sont razés @@ -241,14 +268,14 @@ procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer); var idTrain,t,el1,el2 : integer; t1,t2 : tequipement; begin - //Affiche('Affecte_train_canton: IdTrain='+intToSTR(idTrain)+' @='+intToSTR(AdrTrain)+' Idcanton='+intToSTR(idcanton),clorange); + if ProcPrinc then AfficheDebug('Affecte_train_canton: @='+intToSTR(AdrTrain)+' Idcanton='+intToSTR(idcanton),clorange); if (IdCanton>0) and (idCanton<=nCantons) then begin if (AdrTrain<>0) and (adrTrain<>9999) then begin idTrain:=Index_train_adresse(adrTrain); - raz_cantons_train(AdrTrain); // efface tous les cantons contenant le train Adrtrain + raz_cantons_train(AdrTrain,false); // efface tous les cantons contenant le train Adrtrain sans raz du détecteur trains[idTrain].canton:=canton[idcanton].numero; trains[idTrain].sens:=sens; @@ -337,6 +364,7 @@ var i,ic,t,NumCanton : integer; s : string; begin // maj de la stringGrig + if AffEvt then Affiche('Maj_stringGrid',clYellow); if IdCantonSelect>0 then begin s:='Sélection d''un train'; @@ -415,30 +443,18 @@ begin with ImageDroite do begin Width:=60;Height:=60;visible:=false; end; with ImageGauche do begin Width:=60;Height:=60;visible:=false; end; - with ScrollBoxST do - begin - Anchors:=[akTop,AkLeft,akRight,AkBottom]; - VertScrollBar.Smooth:=false; // ne pas mettre true sinon çà plante quand on clique sur la ScrollBar - VertScrollBar.tracking:=true; - end; - hautC:=25; largC:=130; LabelInfo.caption:=''; with StringGridTrains do begin Anchors:=[]; - Anchors:=[AkTop,AkLeft,akright]; + Anchors:=[AkTop,AkLeft,akright,akBottom]; - Height:=nTrains*HauteurLigneSGT; - Top:=0; - Left:=0; - //Options:=StringGridTrains.Options+[goEditing]; Hint:='Sélection d''un train'; ShowHint:=true; ColCount:=8; // nombre de colonnes RowCount:=Ntrains+1; - Options := StringGridTrains.Options + [goEditing]; ColWidths[0]:=50; ColWidths[1]:=200; // icone ColWidths[2]:=150; // nom du train @@ -473,20 +489,23 @@ begin end; end; - // interdit la modification des cellules au clavier - StringGridTrains.Options:=StringGridTrains.Options - [goEditing] - [goRangeSelect]; + //options de la stringgrid + StringGridTrains.Options:=StringGridTrains.options + //pas édition pas multiselect trackbar dynamique autoriz le dimensionnement des colonnes + - [goEditing] - [goRangeSelect] + [goThumbTracking]+ [goColSizing] + + [goAlwaysShowEditor] //- [goFixedRowDefAlign]; + end; procedure TFormSelTrain.StringGridTrainsDrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState); var indextrain,l,h,hautdest,largdest : integer; - rd : double; + rd : single; r : trect; coul: Tcolor; s : string; begin //Affiche('DrawCell '+intToSTR(Acol)+'x'+intToSTR(Arow),clred); - // titres sur 2 lignes if Arow=0 then with StringGridTrains do @@ -559,32 +578,6 @@ begin end; end; -// raz des trains affectés au canton d'index "idc" -procedure raz_trains_idcanton(idc : integer); -var ax,ay,i,ic : integer; -begin - if traceliste then Affiche('Raz train affectés au canton index='+intToSTR(idc),clyellow); - for i:=1 to Ntrains do - begin - ic:=index_canton_numero(trains[i].canton); - if ic=idc then - begin - routeSav:=trains[i].route; // sauvegarde la route - trains[i].canton:=0; - trains[i].route[0].adresse:=0; - if ic<>0 then - begin - ax:=canton[Ic].x; - ay:=canton[Ic].y; - tco[IndexTCOCourant,ax,ay].train:=0; - canton[Ic].indexTrain:=0; - canton[Ic].adresseTrain:=0; - canton[Ic].NomTrain:=''; - end; - end; - end; -end; - // cliqué ou roulé la molette souris sur cellule pour changer la sélection du train ou voir la route ou la flèche procedure TFormSelTrain.StringGridTrainsSelectCell(Sender: TObject; ACol, @@ -594,9 +587,8 @@ var f,AutreTrain,AutreCanton,idAutrecanton,i,ancienSens,AdrTrain,IdTrain,sensloc s : string; begin if IdCantonSelect=0 then IdCantonSelect:=AncienIdCantonSelect; - if affevt then Affiche('FormSelTrain.StringGridTrainsSelectCell '+intToSTR(ACol)+' '+intToSTR(ARow),clYellow); + if affevt then Affiche('FormSelTrain.StringGridTrainsSelectCell col='+intToSTR(ACol)+' lig='+intToSTR(ARow),clYellow); if (Arow>nTrains) or (IdCantonSelect<1) then exit; - faire:=false; //------------change la sélection du train if (Arow>=1) and (ACol<=5) then @@ -637,7 +629,7 @@ begin AutreTrain:=canton[IdCantonSelect].indexTrain; if autreTrain<>0 then begin - LabelInfo.caption:='Le train '+intToSTR(AutreTrain)+' '+trains[AutreTrain].nom_train+' est déjà affecté au canton - Effacement'; + LabelInfo.caption:='Suppression du train '+intToSTR(AutreTrain)+' '+trains[AutreTrain].nom_train+' du canton '+intToSTR(autrecanton); // affecter la route de l'ancien train au nouveau train routeSav:=trains[AutreTrain].route; // sauve la route trains[AutreTrain].route[0].adresse:=0; @@ -648,8 +640,8 @@ begin faire:=true; if trains[indexTrainClic].canton=canton[IdCantonSelect].numero then faire:=false ; // ne pas faire l'affectaction, c'est une désaffectaction - - raz_trains_idcanton(IdCantonSelect); // au retour, route contient la route du train razé du canton + //raz_trains_idcanton(IdCantonSelect); // au retour, route contient la route du train razé du canton + raz_cantons_train(trains[AutreTrain].adresse,true); //Affiche('Et 1',clYellow); maj_signaux(true); end; @@ -665,7 +657,7 @@ begin //canton[IdCantonSelect].SensLoco:=sensLoco; affecte_Train_canton(trains[indexTrainClic].adresse,IdCantonSelect,sensLoco); // le train affecté contient la route du train razé - + LabelInfo.caption:='Affectation du train '+intToSTR(IndexTrainClic)+' '+trains[indexTrainClic].nom_train+' au canton '+intToSTR(canton[idcantonSelect].numero); maj_signaux(true); end; end; @@ -695,11 +687,11 @@ begin inc(f); if canton[IdAutreCanton].horizontal then begin - if (f<1) or (f>SensDroit) then f:=SensGauche; + if (fSensDroit) then f:=SensGauche; end else begin - if (f=5) or (fSensBas) or (f0) and (canton[IdAutreCanton].SensCirc<>f) then begin @@ -712,7 +704,7 @@ begin exit; end; - renseigne_canton(IdAutreCanton); + renseigne_canton(IdAutreCanton); //?? pourquoi faire le canton est normalement déje renseigné affecte_Train_canton(AdrTrain,idAutreCanton,f); //Affiche('Et 3',clYellow); maj_signaux(true); @@ -751,7 +743,7 @@ begin end; Quel_canton; - FormSelTrain.caption:=s; + FormSelTrain.caption:=s; // s est indéfini !! with formSelTrain.ComboBoxCanton do begin @@ -770,28 +762,10 @@ end; // positionne la VertscrollBar de la stringGrid procedure Positionne_SG(n : integer); var i : integer; - { - SB_LINEUP ; - SB_LINELEFT ; - SB_LINEDOWN ; - SB_LINERIGHT ; - SB_PAGEUP ; - SB_PAGELEFT ; - SB_PAGEDOWN ; - SB_PAGERIGHT ; - SB_THUMBPOSITION ; - SB_THUMBTRACK ; - SB_TOP ; - SB_LEFT ; - SB_BOTTOM ; - SB_RIGHT ; - SB_ENDSCROLL ; - } begin - // Positionne la stringGrid - SendMessage(formSelTrain.StringGridTrains.Handle, WM_VScroll, SB_TOP, 0); // déplace en haut - for i:=1 to n-5 do // 7-2 c'est le nombre de lignes affichées par la stringgrid - SendMessage(formSelTrain.StringGridTrains.Handle, WM_VScroll, SB_LINEDOWN, 0); // déplace d'une ligne à la fois + formSelTrain.stringGridTrains.Perform(WM_VSCROLL,SB_TOP,0); + for i:=1 to n-1 do + formSelTrain.stringGridTrains.Perform(WM_VSCROLL,SB_LINEDOWN,0); end; procedure TFormSelTrain.FormActivate(Sender: TObject); @@ -806,7 +780,6 @@ begin // trouver si le train est dans la grille with StringGridTrains do begin - Height:=nTrains*HauteurLigneSGT+HauteurLigneSGT; // actualiser la taille de la stringGrig en fonction du nombre de trains i:=1;n:=RowCount; repeat trouve:=cells[2,i]=nomTrain; @@ -814,7 +787,7 @@ begin until trouve or (i>=n); if trouve then begin - Positionne_SG(i); + Positionne_SG(i-1); end; end; end; @@ -840,5 +813,6 @@ end; + end. diff --git a/tco.jpg b/tco.jpg new file mode 100644 index 0000000..3af8edc Binary files /dev/null and b/tco.jpg differ diff --git a/tcon.png b/tcon.png deleted file mode 100644 index e6b2b95..0000000 Binary files a/tcon.png and /dev/null differ diff --git a/verif_version.pas b/verif_version.pas index 259a582..521b03d 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -26,7 +26,7 @@ var f : text; Const -VersionSC ='9.3'; // sert à la comparaison de la version publiée +VersionSC ='9.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; @@ -463,7 +463,6 @@ begin if debug=1 then Affiche('Création fenêtre version',clLime); if debug=1 then Affiche('Fin création fenêtre version',clLime); - if not(AvecInit) then exit; if not(verifVersion) then exit; if debug=1 then Affiche('Vérification version en ligne',clLime); V_publie:=verifie_version; @@ -485,7 +484,6 @@ begin if lance_verif>0 then dec(lance_verif); if lance_verif=0 then begin - if not(AvecInit) then exit; if not(verifVersion) then exit; if debug=1 then Affiche('Vérification version en ligne',clLime); V_publie:=verifie_version; diff --git a/versions.txt b/versions.txt index 8bfd678..2d99971 100644 --- a/versions.txt +++ b/versions.txt @@ -271,6 +271,21 @@ version 9.3 : Am Renforcement de la vérification des TJD. Amélioration des aiguillages triples, et de leur représentation dans le TCO. Gestion des erreurs de vérification d'étendue. +version 9.4 : Correction du pilotage du décodeur CDF. + Correction bug suppression aiguillages. + Possibilité d'attribuer plusieurs routes sur un train en mode autonome + et de les sauvegarder. +version 9.41 : Affichage des noms des cantons dans les cantons du TCO. + En mode CDM, envoi des fonctions F>12 à la centrale par Ethernet. + Pilotage de la fonction F0. + Pilotage de l'état (0/1) des fonctions F dans les actions. + Décodeurs CDF : sélection du pilotage en mode 4 (2 signaux indépendants) +version 9.42 : Affiche des exclusions dans la fenêtre de pilotage des signaux. + Correction décodeur SR pour aspects combinés. + Sélection correcte des routes mémorisées. + Mesure pour étalonnage des vitesses des locomotives. + Correction bug sauvegarde route avec croisement. + Correction décodeur SR pour aspects combinés. +version 9.5 : Etalonnage des vitesses des locomotives pour le mode autonome + pour arret précis sur détecteurs à distance souhaitée. - -