diff --git a/Importation.pas b/Importation.pas index b85d1db..839df33 100644 --- a/Importation.pas +++ b/Importation.pas @@ -70,6 +70,7 @@ procedure TFormImportation.EditBaseCroisChange(Sender: TObject); var i,erreur : integer; begin val(editBaseCrois.text,i,erreur); + if i<0 then i:=0; if erreur=0 then BaseCroisement:=i; end; diff --git a/Installeur.exe b/Installeur.exe index 55cca09..8189618 100644 Binary files a/Installeur.exe and b/Installeur.exe differ diff --git a/Notice d'utilisation des signaux_complexes_GL_V8.5.pdf b/Notice d'utilisation des signaux_complexes_GL_V8.51.pdf similarity index 80% rename from Notice d'utilisation des signaux_complexes_GL_V8.5.pdf rename to Notice d'utilisation des signaux_complexes_GL_V8.51.pdf index dd940cf..de5007a 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V8.5.pdf and b/Notice d'utilisation des signaux_complexes_GL_V8.51.pdf differ diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index 5ccec48..d194579 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -130,9 +130,3 @@ OriginalFilename= ProductName= ProductVersion=8.1.0.0 Comments= -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlSearchPath] -Count=1 -Item0=$(DELPHI)\Lib\Debug diff --git a/Signaux_complexes_GL.dpr b/Signaux_complexes_GL.dpr index d052485..b9019a7 100644 --- a/Signaux_complexes_GL.dpr +++ b/Signaux_complexes_GL.dpr @@ -2,8 +2,8 @@ program Signaux_complexes_GL; uses Forms, - UnitPrinc in 'UnitPrinc.pas' {FormPrinc}, UnitDebug in 'UnitDebug.pas' {FormDebug}, + UnitPrinc in 'UnitPrinc.pas' {FormPrinc}, verif_version in 'verif_version.pas' {FormVersion}, UnitPilote in 'UnitPilote.pas' {FormPilote}, UnitSimule in 'UnitSimule.pas' {FormSimulation}, @@ -17,7 +17,8 @@ uses Unitplace in 'Unitplace.pas' {FormPlace}, UnitPareFeu in 'UnitPareFeu.pas', UnitAnalyseSegCDM in 'UnitAnalyseSegCDM.pas' {FormAnalyseCDM}, - Importation in 'Importation.pas' {FormImportation}; + Importation in 'Importation.pas' {FormImportation}, + MSCommLib_TLB in 'MSCommLib_TLB.pas'; {$R *.res} @@ -26,6 +27,7 @@ begin Application.Initialize; Application.Title := 'Signaux complexes GL'; Application.CreateForm(TFormPrinc, FormPrinc); + Application.CreateForm(TFormDebug, FormDebug); Application.CreateForm(TFormVersion, FormVersion); Application.CreateForm(TFormPilote, FormPilote); Application.CreateForm(TFormSimulation, FormSimulation); @@ -36,7 +38,6 @@ begin Application.CreateForm(TFormConfCellTCO, FormConfCellTCO); Application.CreateForm(TFormCDF, FormCDF); Application.CreateForm(TFormPlace, FormPlace); - Application.CreateForm(TFormDebug, FormDebug); Application.CreateForm(TFormAnalyseCDM, FormAnalyseCDM); Application.CreateForm(TFormImportation, FormImportation); {$IF CompilerVersion >= 28.0} diff --git a/Signaux_complexes_GL.exe b/Signaux_complexes_GL.exe new file mode 100644 index 0000000..f68ed16 Binary files /dev/null and b/Signaux_complexes_GL.exe differ diff --git a/Signaux_complexes_GL.map b/Signaux_complexes_GL.map index b7ff0da..d761a1d 100644 --- a/Signaux_complexes_GL.map +++ b/Signaux_complexes_GL.map @@ -1,104 +1,104 @@ Start Length Name Class - 0001:00000000 0018322CH .text CODE - 0002:00000000 00002C88H .data DATA - 0002:00002C88 045E33F9H .bss BSS + 0001:00000000 0017F73CH .text CODE + 0002:00000000 00002CB0H .data DATA + 0002:00002CB0 045E33E9H .bss BSS Detailed map of segments - 0001:00000000 00005F13 C=CODE S=.text G=(none) M=System ACBP=A9 - 0001:00005F14 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 - 0001:00006054 00000108 C=CODE S=.text G=(none) M=Types ACBP=A9 - 0001:0000615C 00000F38 C=CODE S=.text G=(none) M=Windows ACBP=A9 - 0001:00007094 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 - 0001:000070CC 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 - 0001:00007404 00006FF8 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 - 0001:0000E3FC 0000081B C=CODE S=.text G=(none) M=VarUtils ACBP=A9 - 0001:0000EC18 0000809E C=CODE S=.text G=(none) M=Variants ACBP=A9 - 0001:00016CB8 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 - 0001:00016E58 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 - 0001:00017694 00000358 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 - 0001:000179EC 0000A7EA C=CODE S=.text G=(none) M=Classes ACBP=A9 - 0001:000221D8 00000370 C=CODE S=.text G=(none) M=Consts ACBP=A9 - 0001:00022548 00009BFB C=CODE S=.text G=(none) M=Graphics ACBP=A9 - 0001:0002C144 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 - 0001:0002C268 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 - 0001:0002C520 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 - 0001:0002C6B8 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 - 0001:0002CE40 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 - 0001:0002CE78 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 - 0001:0002DE70 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 - 0001:0002DEC8 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 - 0001:0002EF90 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 - 0001:0002F2B0 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 - 0001:0002F6A0 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 - 0001:0003005C 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 - 0001:00030094 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 - 0001:000300CC 00000048 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 - 0001:00030114 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 - 0001:0003014C 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 - 0001:000301A4 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 - 0001:000301DC 0000007C C=CODE S=.text G=(none) M=ShlObj ACBP=A9 - 0001:00030258 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 - 0001:000302B8 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 - 0001:000302F0 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 - 0001:000339C4 00004ADA C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 - 0001:000384A0 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 - 0001:00038530 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 - 0001:00038CD0 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 - 0001:00038DF8 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 - 0001:0003C61C 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 - 0001:0003C654 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 - 0001:0003C6BC 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 - 0001:0003C724 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 - 0001:0003C790 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 - 0001:0003C7E8 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 - 0001:0003C820 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 - 0001:00046168 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 - 0001:00047008 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 - 0001:000536A0 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 - 0001:00053808 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 - 0001:00054528 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 - 0001:0006592C 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 - 0001:00066BC0 00001B9C C=CODE S=.text G=(none) M=ImgList ACBP=A9 - 0001:0006875C 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 - 0001:0006EE40 0000CF8C C=CODE S=.text G=(none) M=Forms ACBP=A9 - 0001:0007BDCC 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 - 0001:0007BE2C 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 - 0001:0007D088 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 - 0001:0007D0C0 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 - 0001:0007E854 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 - 0001:0007E8B4 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 - 0001:00081DD0 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 - 0001:00081E20 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 - 0001:0009520C 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 - 0001:00095520 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 - 0001:00095648 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 - 0001:000990C0 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 - 0001:000999AC 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 - 0001:00099F44 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 - 0001:00099F84 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 - 0001:00099FBC 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 - 0001:0009A9D4 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 - 0001:0009CADC 0000924C C=CODE S=.text G=(none) M=Grids ACBP=A9 - 0001:000A5D28 0000191C C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 - 0001:000A7644 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 - 0001:000A7BC0 00019434 C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 - 0001:000C0FF4 0000289B C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 - 0001:000C3890 00000D78 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 - 0001:000C4608 00003D24 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 - 0001:000C832C 00031BF8 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 - 0001:000F9F24 000031F0 C=CODE S=.text G=(none) M=UnitSR ACBP=A9 - 0001:000FD114 00002BF0 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 - 0001:000FFD04 0000283F C=CODE S=.text G=(none) M=verif_version ACBP=A9 - 0001:00102544 000011D0 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 - 0001:00103714 0003C750 C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 - 0001:0013FE64 00002BCC C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 - 0001:00142A30 00000D2C C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 - 0001:0014375C 000027E8 C=CODE S=.text G=(none) M=Unitplace ACBP=A9 - 0001:00145F44 0003CE27 C=CODE S=.text G=(none) M=UnitPrinc ACBP=A9 - 0001:00182D6C 000004C0 C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 + 0001:00000000 00005ED3 C=CODE S=.text G=(none) M=System ACBP=A9 + 0001:00005ED4 00000140 C=CODE S=.text G=(none) M=SysInit ACBP=A9 + 0001:00006014 00000108 C=CODE S=.text G=(none) M=Types ACBP=A9 + 0001:0000611C 00000F38 C=CODE S=.text G=(none) M=Windows ACBP=A9 + 0001:00007054 00000038 C=CODE S=.text G=(none) M=Messages ACBP=A9 + 0001:0000708C 00000338 C=CODE S=.text G=(none) M=SysConst ACBP=A9 + 0001:000073C4 00006FF8 C=CODE S=.text G=(none) M=SysUtils ACBP=A9 + 0001:0000E3BC 0000081B C=CODE S=.text G=(none) M=VarUtils ACBP=A9 + 0001:0000EBD8 0000804E C=CODE S=.text G=(none) M=Variants ACBP=A9 + 0001:00016C28 000001A0 C=CODE S=.text G=(none) M=RTLConsts ACBP=A9 + 0001:00016DC8 0000083C C=CODE S=.text G=(none) M=TypInfo ACBP=A9 + 0001:00017604 00000358 C=CODE S=.text G=(none) M=ActiveX ACBP=A9 + 0001:0001795C 0000A7EA C=CODE S=.text G=(none) M=Classes ACBP=A9 + 0001:00022148 00000370 C=CODE S=.text G=(none) M=Consts ACBP=A9 + 0001:000224B8 00009BFB C=CODE S=.text G=(none) M=Graphics ACBP=A9 + 0001:0002C0B4 00000124 C=CODE S=.text G=(none) M=Math ACBP=A9 + 0001:0002C1D8 000002B8 C=CODE S=.text G=(none) M=Contnrs ACBP=A9 + 0001:0002C490 00000198 C=CODE S=.text G=(none) M=CommCtrl ACBP=A9 + 0001:0002C628 00000787 C=CODE S=.text G=(none) M=MultiMon ACBP=A9 + 0001:0002CDB0 00000038 C=CODE S=.text G=(none) M=Imm ACBP=A9 + 0001:0002CDE8 00000FF8 C=CODE S=.text G=(none) M=HelpIntfs ACBP=A9 + 0001:0002DDE0 00000058 C=CODE S=.text G=(none) M=WinSpool ACBP=A9 + 0001:0002DE38 000010C8 C=CODE S=.text G=(none) M=Printers ACBP=A9 + 0001:0002EF00 0000031F C=CODE S=.text G=(none) M=FlatSB ACBP=A9 + 0001:0002F220 000003F0 C=CODE S=.text G=(none) M=SyncObjs ACBP=A9 + 0001:0002F610 000009BB C=CODE S=.text G=(none) M=UxTheme ACBP=A9 + 0001:0002FFCC 00000038 C=CODE S=.text G=(none) M=RichEdit ACBP=A9 + 0001:00030004 00000038 C=CODE S=.text G=(none) M=ToolWin ACBP=A9 + 0001:0003003C 00000048 C=CODE S=.text G=(none) M=ShellAPI ACBP=A9 + 0001:00030084 00000038 C=CODE S=.text G=(none) M=RegStr ACBP=A9 + 0001:000300BC 00000058 C=CODE S=.text G=(none) M=WinInet ACBP=A9 + 0001:00030114 00000038 C=CODE S=.text G=(none) M=UrlMon ACBP=A9 + 0001:0003014C 0000007C C=CODE S=.text G=(none) M=ShlObj ACBP=A9 + 0001:000301C8 00000060 C=CODE S=.text G=(none) M=CommDlg ACBP=A9 + 0001:00030228 00000038 C=CODE S=.text G=(none) M=Dlgs ACBP=A9 + 0001:00030260 000036D1 C=CODE S=.text G=(none) M=Dialogs ACBP=A9 + 0001:00033934 00004ADA C=CODE S=.text G=(none) M=ExtCtrls ACBP=A9 + 0001:00038410 00000090 C=CODE S=.text G=(none) M=ComStrs ACBP=A9 + 0001:000384A0 000007A0 C=CODE S=.text G=(none) M=Clipbrd ACBP=A9 + 0001:00038C40 00000128 C=CODE S=.text G=(none) M=StrUtils ACBP=A9 + 0001:00038D68 00003821 C=CODE S=.text G=(none) M=Buttons ACBP=A9 + 0001:0003C58C 00000038 C=CODE S=.text G=(none) M=ExtDlgs ACBP=A9 + 0001:0003C5C4 00000068 C=CODE S=.text G=(none) M=IniFiles ACBP=A9 + 0001:0003C62C 00000068 C=CODE S=.text G=(none) M=Registry ACBP=A9 + 0001:0003C694 0000006C C=CODE S=.text G=(none) M=Mapi ACBP=A9 + 0001:0003C700 00000058 C=CODE S=.text G=(none) M=ExtActns ACBP=A9 + 0001:0003C758 00000038 C=CODE S=.text G=(none) M=ListActns ACBP=A9 + 0001:0003C790 00009948 C=CODE S=.text G=(none) M=ComCtrls ACBP=A9 + 0001:000460D8 00000EA0 C=CODE S=.text G=(none) M=Themes ACBP=A9 + 0001:00046F78 0000C698 C=CODE S=.text G=(none) M=StdCtrls ACBP=A9 + 0001:00053610 00000168 C=CODE S=.text G=(none) M=StdActns ACBP=A9 + 0001:00053778 00000D1F C=CODE S=.text G=(none) M=WinHelpViewer ACBP=A9 + 0001:00054498 00011403 C=CODE S=.text G=(none) M=Controls ACBP=A9 + 0001:0006589C 00001292 C=CODE S=.text G=(none) M=ActnList ACBP=A9 + 0001:00066B30 00001B9C C=CODE S=.text G=(none) M=ImgList ACBP=A9 + 0001:000686CC 000066E1 C=CODE S=.text G=(none) M=Menus ACBP=A9 + 0001:0006EDB0 0000CF8C C=CODE S=.text G=(none) M=Forms ACBP=A9 + 0001:0007BD3C 00000050 C=CODE S=.text G=(none) M=JConsts ACBP=A9 + 0001:0007BD8C 000133EC C=CODE S=.text G=(none) M=jpeg ACBP=A9 + 0001:0008F178 00000060 C=CODE S=.text G=(none) M=ComConst ACBP=A9 + 0001:0008F1D8 00001259 C=CODE S=.text G=(none) M=ComObj ACBP=A9 + 0001:00090434 00000038 C=CODE S=.text G=(none) M=StdVCL ACBP=A9 + 0001:0009046C 00001793 C=CODE S=.text G=(none) M=AxCtrls ACBP=A9 + 0001:00091C00 00000060 C=CODE S=.text G=(none) M=OleConst ACBP=A9 + 0001:00091C60 00003519 C=CODE S=.text G=(none) M=OleCtrls ACBP=A9 + 0001:0009517C 00000314 C=CODE S=.text G=(none) M=TlHelp32 ACBP=A9 + 0001:00095490 00000128 C=CODE S=.text G=(none) M=WinSock ACBP=A9 + 0001:000955B8 00003A78 C=CODE S=.text G=(none) M=ScktComp ACBP=A9 + 0001:00099030 000008EA C=CODE S=.text G=(none) M=OleServer ACBP=A9 + 0001:0009991C 00000598 C=CODE S=.text G=(none) M=MSCommLib_TLB ACBP=A9 + 0001:00099EB4 00000040 C=CODE S=.text G=(none) M=MMSystem ACBP=A9 + 0001:00099EF4 00000038 C=CODE S=.text G=(none) M=Nb30 ACBP=A9 + 0001:00099F2C 00000A18 C=CODE S=.text G=(none) M=MaskUtils ACBP=A9 + 0001:0009A944 00002108 C=CODE S=.text G=(none) M=Mask ACBP=A9 + 0001:0009CA4C 0000924C C=CODE S=.text G=(none) M=Grids ACBP=A9 + 0001:000A5C98 00001820 C=CODE S=.text G=(none) M=UnitPilote ACBP=A9 + 0001:000A74B8 0000057C C=CODE S=.text G=(none) M=Importation ACBP=A9 + 0001:000A7A34 000147DC C=CODE S=.text G=(none) M=UnitAnalyseSegCDM ACBP=A9 + 0001:000BC210 0000289B C=CODE S=.text G=(none) M=UnitConfigTCO ACBP=A9 + 0001:000BEAAC 00000C64 C=CODE S=.text G=(none) M=Unit_Pilote_aig ACBP=A9 + 0001:000BF710 00003D24 C=CODE S=.text G=(none) M=UnitConfigCellTCO ACBP=A9 + 0001:000C3434 00032118 C=CODE S=.text G=(none) M=UnitTCO ACBP=A9 + 0001:000F554C 00003410 C=CODE S=.text G=(none) M=UnitSR ACBP=A9 + 0001:000F895C 000027B4 C=CODE S=.text G=(none) M=UnitCDF ACBP=A9 + 0001:000FB110 0000284B C=CODE S=.text G=(none) M=verif_version ACBP=A9 + 0001:000FD95C 000011D0 C=CODE S=.text G=(none) M=UnitPareFeu ACBP=A9 + 0001:000FEB2C 00000C00 C=CODE S=.text G=(none) M=UnitSimule ACBP=A9 + 0001:000FF72C 00002850 C=CODE S=.text G=(none) M=Unitplace ACBP=A9 + 0001:00101F7C 0003D29F C=CODE S=.text G=(none) M=UnitPrinc ACBP=A9 + 0001:0013F21C 0003D35C C=CODE S=.text G=(none) M=UnitConfig ACBP=A9 + 0001:0017C578 00002D04 C=CODE S=.text G=(none) M=UnitDebug ACBP=A9 + 0001:0017F27C 000004C0 C=CODE S=.text G=(none) M=Signaux_complexes_GL ACBP=A9 0002:00000000 000000CC C=DATA S=.data G=DGROUP M=System ACBP=A9 0002:000000CC 00000020 C=DATA S=.data G=DGROUP M=SysInit ACBP=A9 0002:000000EC 00000254 C=DATA S=.data G=DGROUP M=SysUtils ACBP=A9 @@ -123,15 +123,15 @@ Detailed map of segments 0002:00001030 00000020 C=DATA S=.data G=DGROUP M=ImgList ACBP=A9 0002:00001050 000000EC C=DATA S=.data G=DGROUP M=Menus ACBP=A9 0002:0000113C 00000124 C=DATA S=.data G=DGROUP M=Forms ACBP=A9 - 0002:00001260 00000030 C=DATA S=.data G=DGROUP M=ComObj ACBP=A9 - 0002:00001290 0000002C C=DATA S=.data G=DGROUP M=OleCtrls ACBP=A9 - 0002:000012BC 00000908 C=DATA S=.data G=DGROUP M=jpeg ACBP=A9 - 0002:00001BC4 00000058 C=DATA S=.data G=DGROUP M=MSCommLib_TLB ACBP=A9 - 0002:00001C1C 00000009 C=DATA S=.data G=DGROUP M=MaskUtils ACBP=A9 - 0002:00001C28 00000004 C=DATA S=.data G=DGROUP M=Mask ACBP=A9 - 0002:00001C2C 00000006 C=DATA S=.data G=DGROUP M=Grids ACBP=A9 - 0002:00001C34 000000D4 C=DATA S=.data G=DGROUP M=UnitTCO ACBP=A9 - 0002:00001D08 0000060D C=DATA S=.data G=DGROUP M=UnitPrinc ACBP=A9 + 0002:00001260 00000908 C=DATA S=.data G=DGROUP M=jpeg ACBP=A9 + 0002:00001B68 00000030 C=DATA S=.data G=DGROUP M=ComObj ACBP=A9 + 0002:00001B98 0000002C C=DATA S=.data G=DGROUP M=OleCtrls ACBP=A9 + 0002:00001BC4 00000080 C=DATA S=.data G=DGROUP M=MSCommLib_TLB ACBP=A9 + 0002:00001C44 00000009 C=DATA S=.data G=DGROUP M=MaskUtils ACBP=A9 + 0002:00001C50 00000004 C=DATA S=.data G=DGROUP M=Mask ACBP=A9 + 0002:00001C54 00000006 C=DATA S=.data G=DGROUP M=Grids ACBP=A9 + 0002:00001C5C 000000D4 C=DATA S=.data G=DGROUP M=UnitTCO ACBP=A9 + 0002:00001D30 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 @@ -189,14 +189,14 @@ Detailed map of segments 0002:00003BD4 0000000C C=BSS S=.bss G=DGROUP M=ImgList ACBP=A9 0002:00003BE0 00000010 C=BSS S=.bss G=DGROUP M=Menus ACBP=A9 0002:00003BF0 00000020 C=BSS S=.bss G=DGROUP M=Forms ACBP=A9 - 0002:00003C10 00000004 C=BSS S=.bss G=DGROUP M=ComConst ACBP=A9 - 0002:00003C14 00000011 C=BSS S=.bss G=DGROUP M=ComObj ACBP=A9 - 0002:00003C28 00000004 C=BSS S=.bss G=DGROUP M=StdVCL ACBP=A9 - 0002:00003C2C 0000001C C=BSS S=.bss G=DGROUP M=AxCtrls ACBP=A9 - 0002:00003C48 00000004 C=BSS S=.bss G=DGROUP M=OleConst ACBP=A9 - 0002:00003C4C 00000014 C=BSS S=.bss G=DGROUP M=OleCtrls ACBP=A9 - 0002:00003C60 00000004 C=BSS S=.bss G=DGROUP M=JConsts ACBP=A9 - 0002:00003C64 00000004 C=BSS S=.bss G=DGROUP M=jpeg ACBP=A9 + 0002: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 @@ -218,11 +218,11 @@ Detailed map of segments 0002:00430E84 00000014 C=BSS S=.bss G=DGROUP M=UnitCDF ACBP=A9 0002:00430E98 00000020 C=BSS S=.bss G=DGROUP M=verif_version ACBP=A9 0002:00430EB8 00000004 C=BSS S=.bss G=DGROUP M=UnitPareFeu ACBP=A9 - 0002:00430EBC 00000560 C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 - 0002:0043141C 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 - 0002:00431448 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 - 0002:00431454 00000008 C=BSS S=.bss G=DGROUP M=Unitplace ACBP=A9 - 0002:0043145C 041B4F9C C=BSS S=.bss G=DGROUP M=UnitPrinc ACBP=A9 + 0002:00430EBC 0000000C C=BSS S=.bss G=DGROUP M=UnitSimule ACBP=A9 + 0002:00430EC8 00000008 C=BSS S=.bss G=DGROUP M=Unitplace ACBP=A9 + 0002:00430ED0 041B4F80 C=BSS S=.bss G=DGROUP M=UnitPrinc ACBP=A9 + 0002:045E5E50 0000056C C=BSS S=.bss G=DGROUP M=UnitConfig ACBP=A9 + 0002:045E63BC 0000002C C=BSS S=.bss G=DGROUP M=UnitDebug ACBP=A9 Bound resource files @@ -239,13 +239,13 @@ UnitTCO.dfm UnitSR.dfm UnitCDF.dfm verif_version.dfm -UnitConfig.dfm -UnitDebug.dfm UnitSimule.dfm Unitplace.dfm UnitPrinc.dfm +UnitConfig.dfm +UnitDebug.dfm Signaux_complexes_GL.res Signaux_complexes_GL.drf -Program entry point at 0001:0018307C +Program entry point at 0001:0017F58C diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index ad594c4..eab0888 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -1,7 +1,7 @@ unit UnitAnalyseSegCDM; // importation des données de CDM // Affichage de la page du réseau CDM -// les Tjs ne sont pas traitées +// les Tjs ne sont pas traitées (de toute façon CDM ne les gère pas) // fichier source CDM générateur de l'export : cd_cdb.c version 2.0 interface @@ -11,18 +11,16 @@ uses math, Printers ; const - max_db = 20; // 20 détecteurs maxi entre 2 aiguillages + max_db = 20; // 20 détecteurs maxi entre 2 aiguillages pisur180=pi/180 ; _180surpi=180/pi; - - // décalages d'affichages - yCrOffset=-5; + yCrOffset=-5; // décalages d'affichages pour les adresses yCrOffset2=-14; yTurnoutOffset=-16; - Zmini=50; - Zmaxi=100; - fond_cdm=$303000; - precision_clic=4; // précision du clic sur un élément + Zmini=50; // zoom mini + Zmaxi=100; // zoom maxi + fond_cdm=$303000; // couleur de fond de la fenêtre + precision_clic=4; // précision en pixels du clic sur un élément type TFormAnalyseCDM = class(TForm) @@ -79,91 +77,86 @@ type { Déclarations publiques } end; + // tableau des détecteurs sur un segment TdetSeg= array[1..10] of record index,periph : integer; - end; + end; Trec_cdm = record adresse : integer; distance : integer; // distance au port d'entrée end; tDetect_cdm= array[1..max_db] of Trec_cdm; + // structure d'aiguillage de CDM TAig_CDM = record - adresse,adrtriple,temps : integer; - modele : TEquipement ; - ADroit : integer ; // (TJD:identifiant extérieur) connecté sur la position droite en talon - ADroitB : char ; // P D S Z - - ADevie : integer ; // (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 ; - APointeB : char; - DDroit : integer; // destination de la TJD en position droite - DDroitB : char ; - DDevie : integer; // destination de la TJD en position déviée - DDevieB : char ; + adresse,adrtriple,temps : integer; + modele : TEquipement ; + ADroit : integer ; // (TJD:identifiant extérieur) connecté sur la position droite en talon + ADroitB : char ; // P D S Z + ADevie : integer ; // (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 ; + APointeB : char; + DDroit : integer; // destination de la TJD en position droite + DDroitB : char ; + DDevie : integer; // destination de la TJD en position déviée + DDevieB : char ; - Adevie2 : integer; - Adevie2B : char ; - // états d'une TJD (2 ou 4, 4 par défaut) - EtatTJD : integer; - // si l'aiguillage provient d'une traversée double jonction - bdj : boolean; - adrCDM : integer; // adresse de la bjd dans cdm - IndexSeg : integer; // + Adevie2 : integer; + Adevie2B : char ; + // états d'une TJD (2 ou 4, 4 par défaut) + EtatTJD : integer; + bdj : boolean; // si l'aiguillage provient d'une traversée double jonction + adrCDM : integer; // adresse de la bjd dans cdm + IndexSeg : integer; + end; - end; + // structure segment, port et periph de CDM + TInter = record + x,y,z : integer; + typ : string[20]; + MirrorZ : integer; + MirrorParent : integer; + end; - // structure segment, port et periph de CDM - TInter = - record - x,y,z : integer; - typ : string[20]; - MirrorZ : integer; - MirrorParent : integer; - end; + Tport = record + numero : integer; // numéro du port + typ : string[20]; + x,y,z,angle : integer; + local : integer; // numéro de port local + connecte : boolean; + ConnecteAuPort : integer; // connecté au port + ConnecteAuSeg : integer; // connecté au segment + end; - Tport = - record - numero : integer; // numéro du port - typ : string[20]; - x,y,z,angle : integer; - local : integer; // numéro de port local - connecte : boolean; - ConnecteAuPort : integer; // connecté au port - ConnecteAuSeg : integer; // connecté au segment - end; + TPeriph = record + numero : integer; // numéro du port + typ : string[20]; + pere : integer; + x,y,z,angle : integer; + bright,bdown : integer;// sens et position par rapport à la voie + location : integer; // ?? en % + adresse : integer; + status : integer; + OnDevicePort : integer; + end; - TPeriph = - record - numero : integer; // numéro du port - typ : string[20]; - pere : integer; - x,y,z,angle : integer; - bright,bdown : integer;// sens et position par rapport à la voie - location : integer; // ?? en % - adresse : integer; - status : integer; - OnDevicePort : integer; - end; - - Tsegment = - record - numero : integer; - typ : string[20]; // arc, turnout, ... - nport,nperiph,nInter : integer; // nombre de ports et de peripheriques et d'intersections - port : array of TPort; - periph : array of TPeriph; - inter : array of TInter; - XMin,Ymin,XMax,Ymax,StartAngle,ArcAngle,Rayon,radius0,angle0,angle,lengthdev,deltadev0 : integer; - lXc,lYc : integer; - // turnout - longueur,longueurDev,DeltaDev,Curveoffset : integer; - // turnout curve - xc0,yc0,DeltaDev2,xc,yc : integer; - // pour signaux complexes - adresse,adresse2,duree,adr_CDM : integer; - end; + Tsegment = record + numero : integer; + typ : string[20]; // arc, turnout, ... + nport,nperiph,nInter : integer; // nombre de ports, de peripheriques et d'intersections + port : array of TPort; + periph : array of TPeriph; + inter : array of TInter; + XMin,Ymin,XMax,Ymax,StartAngle,ArcAngle,Rayon,radius0,angle0,angle,lengthdev,deltadev0 : integer; + lXc,lYc : integer; + // turnout + longueur,longueurDev,DeltaDev,Curveoffset : integer; + // turnout curve + xc0,yc0,DeltaDev2,xc,yc : integer; + // pour signaux complexes + adresse,adresse2,duree,adr_CDM : integer; + end; var Segment : array of Tsegment; @@ -193,7 +186,7 @@ uses Importation; {$R *.dfm} -// +// renvoie l'index d'un aiguillage CDM d'adresse "adresse" function index_aigCdm(adresse : integer) : integer; var i : integer; trouve : boolean; @@ -206,7 +199,10 @@ begin if trouve then result:=i-1 else result:=0; end; -// cherche, isole et restreint la chaine s qui contient "chercher" +// cherche, isole et restreint la chaine s qui contient "chercher", et réduit s +// ex: isole_valeur(' periph #135 ','periph #',true) +// renvoie '135' et s='periph' + function isole_valeur(var s : string; chercher : string;afficheErr : boolean) : string; var i : integer; serr : string; @@ -316,7 +312,7 @@ begin val(s2,i,erreur); Segment[nSeg-1].periph[nperiph-1].status:=i; - // peut être suivi de 'On device port' + // peut être suivi de 'On device port' si une adresse de détecteur ou d'actionneur se trouve sur l'appareil de voie Segment[nSeg-1].periph[nperiph-1].OnDevicePort:=-1; // marqueur d'invalidité s:=AnsiLowerCase(lignes[nligne+1]); if pos('on device port',s)<>0 then @@ -880,6 +876,7 @@ 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); var @@ -1009,7 +1006,7 @@ end; // trace un arc selon les coordonnées CDM procedure angle_cdm(canvas : Tcanvas;centreX,centreY:integer;debut,fin : double ;rayon : integer); begin - coords(centreX,centreY); + coords(centreX,centreY); // transforme en coords windows rayon:=round(rayon*reducX) div 1000; D_arc(Canvas,centreX,centreY,rayon,debut,fin); end; @@ -1081,7 +1078,7 @@ end; // dessine un arc orienté de xa,ya à xb,yb dans le canvas image (pas imprimante) // coordonnées CDM -procedure arc_xy(canvas : tcanvas;centreX,centreY,rayon,xa,ya,xb,yb : integer); +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,vectoriel,AngleAB: double; @@ -1235,7 +1232,7 @@ begin canvas.pen.color:=clred; //ligneCDM(canvas,milieuX,milieuY,centreX,centreY); //ligneCDM(canvas,x0,y0,x1,y1); - arc_xy(canvas,centreX,centreY,round(rayonD)+250,x1,y1,x0,y0); + arc_xy_CDM(canvas,centreX,centreY,round(rayonD)+250,x1,y1,x0,y0); centreX:=round(-rayonD*cos(alpha))+MilieuX; centreY:=round(pente*centreX+b); @@ -1243,7 +1240,7 @@ begin canvas.pen.color:=clyellow; //ligneCDM(canvas,milieuX,milieuY,centreX,centreY); //ligneCDM(canvas,x0,y0,x1,y1); - arc_xy(canvas,centreX,centreY,round(rayonD)+250,x1,y1,x0,y0); + arc_xy_CDM(canvas,centreX,centreY,round(rayonD)+250,x1,y1,x0,y0); exit; // méthode directe @@ -1284,7 +1281,7 @@ begin centreX:=x0+5000; centreY:=round(pente*centreX+b); rayon:=round(sqrt(sqr(centreX-x0)+sqr(centreY-y0))); - arc_xy(canvas,centreX,centreY,rayon,x2,y2,x0,y0); + arc_xy_CDM(canvas,centreX,centreY,rayon,x2,y2,x0,y0); // point de départ en vert canvas.pen.color:=clLime; @@ -1309,7 +1306,7 @@ begin TmpBmp.Free; end; -// rotation matricielle autour de Centre +// rotation matricielle de l'angle (en radians) autour de Centre function XForm_Rotation(Angle : Single;Centre : TPoint) : TXForm; var SinA,CosA: Extended; begin @@ -1389,10 +1386,10 @@ begin GMode:=SetGraphicsMode(ACanvas.Handle, GM_ADVANCED); if GetWorldTransform(ACanvas.Handle, XFormOld) then // renvoie la matrice courante dans XformOld begin - // faire les transformations + // faire les 3 transformations XFormRot:=XForm_Rotation(Angle,Point(l2,h2)); // rotation autour du centre - XFormScale:=XForm_Echelle(Zoom,Zoom,point(l2,h2)); // Zoom au point central - XFormXLat:=XForm_Translation(x-l2,y-h2); // décalage + XFormScale:=XForm_Echelle(Zoom,Zoom,point(l2,h2)); // Zoom au point central + XFormXLat:=XForm_Translation(x-l2,y-h2); // décalage // Combiner les 3 transformations CombineTransform(XForm,XFormRot,XFormScale); // Xform<-- f(XformRot,XformScale) @@ -1401,7 +1398,7 @@ begin // calcule les coordonnées des 4 points de coins de l'icone qui a tourné et zoomé // x0,y0 x3,y3 // x1,y1 x2,y2 - d:=sqrt( sqr(l2)+ sqr(h2)); + d:=sqrt(sqr(l2)+ sqr(h2)); //c1:=round(zoom*l2); // pour faire la rotation à la tete du train //c2:=round(zoom*h2); z:=zoom*d; @@ -3845,7 +3842,7 @@ begin end; -// compile le fichier Texte de CDM et l'importe +// compile le fichier Texte de CDM se trouvant en fenêtre principale et l'importe procedure Compilation; var s : string; nombre,position,adresse,i,j,n,ISegA1,ISegA2,ISegA3,ISegA4,ISegCrois,SegBJD, @@ -4638,8 +4635,6 @@ begin result:=itablo>0; end; - - // allume la zone du détecteur "adresse" 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, @@ -4705,7 +4700,7 @@ begin x2:=segment[ind1].periph[per2].x; y2:=segment[ind1].periph[per2].y; canvas.pen.Color:=clred; - arc_xy(canvas,centreX,centreY,rayon,x1,y1,x2,y2); + arc_xy_CDM(canvas,centreX,centreY,rayon,x1,y1,x2,y2); coords(centreX,centreY); {coords(x2,y2); @@ -4842,7 +4837,7 @@ begin xs:=Segment[index].port[IndexPort].x; ys:=Segment[index].port[IndexPort].y; // donc tracer un arc de (x,y) détecteur à (xs,ys) port - arc_xy(canvas,centreX,centreY,rayon,x,y,xs,ys); + arc_xy_CDM(canvas,centreX,centreY,rayon,x,y,xs,ys); end; if (ctyp='straight') or (ctyp='pre_curve') or (ctyp='bumper_stop') then begin @@ -4917,7 +4912,7 @@ begin xs:=Segment[index].port[IndexPort].x; ys:=Segment[index].port[IndexPort].y; // donc tracer un arc de (x,y) (détecteur) à (xs,ys) port - arc_xy(canvas,centreX,centreY,rayon,x,y,xs,ys); + arc_xy_CDM(canvas,centreX,centreY,rayon,x,y,xs,ys); end; if (ctyp='straight') or (ctyp='pre_curve') or (ctyp='bumper_stop') then begin diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 8fe655b..19efb02 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -681,7 +681,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetCDM + ActivePage = TabSheetPeriph Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -1266,14 +1266,14 @@ object FormConfig: TFormConfig end object Label8: TLabel Left = 14 - Top = 50 + Top = 48 Width = 82 Height = 13 Caption = 'Port de l'#39'interface' end object EditIPLenz: TEdit Left = 176 - Top = 24 + Top = 20 Width = 81 Height = 21 TabStop = False @@ -1281,7 +1281,7 @@ object FormConfig: TFormConfig end object EditportLenz: TEdit Left = 176 - Top = 48 + Top = 44 Width = 81 Height = 21 TabStop = False @@ -1944,7 +1944,7 @@ object FormConfig: TFormConfig Left = 192 Top = 56 Width = 89 - Height = 49 + Height = 41 Hint = 'Change les adresses dans les points de connexions des aiguillage' + 's et des branches si on a chang'#233' l'#39'adresse d'#39'un aiguillage' @@ -4035,7 +4035,7 @@ object FormConfig: TFormConfig Height = 13 end object SBMonte: TSpeedButton - Left = 240 + Left = 256 Top = 184 Width = 25 Height = 33 @@ -4059,7 +4059,7 @@ object FormConfig: TFormConfig OnClick = SBMonteClick end object SBDesc: TSpeedButton - Left = 240 + Left = 256 Top = 224 Width = 25 Height = 33 @@ -4097,7 +4097,7 @@ object FormConfig: TFormConfig object ListBoxPeriph: TListBox Left = 8 Top = 96 - Width = 233 + Width = 249 Height = 273 Color = clBlack Font.Charset = DEFAULT_CHARSET @@ -4134,8 +4134,8 @@ object FormConfig: TFormConfig OnClick = ButtonSupAccComClick end object GroupBoxDesc: TGroupBox - Left = 280 - Top = 88 + Left = 288 + Top = 72 Width = 329 Height = 129 Caption = 'Description du p'#233'riph'#233'rique' @@ -4148,9 +4148,9 @@ object FormConfig: TFormConfig Caption = 'Nom du p'#233'riph'#233'rique' end object EditNomPeriph: TEdit - Left = 150 + Left = 128 Top = 24 - Width = 170 + Width = 192 Height = 21 Hint = 'Nom au choix du p'#233'riph'#233'rique' ParentShowHint = False @@ -4163,12 +4163,13 @@ object FormConfig: TFormConfig Left = 14 Top = 421 Width = 75 - Height = 20 + Height = 36 Hint = 'R'#233'ouvre les ports COMs et Sockets demand'#233's' - Caption = 'Ouvre COMs' + Caption = 'Ouvre COMs Sockets' ParentShowHint = False ShowHint = True TabOrder = 4 + WordWrap = True OnClick = ButtonOuvreComClick end end diff --git a/UnitConfig.pas b/UnitConfig.pas index 5212315..dfa5092 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -358,7 +358,6 @@ type Label31: TLabel; Label39: TLabel; procedure ButtonAppliquerEtFermerClick(Sender: TObject); - procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -542,6 +541,7 @@ type procedure ButtonPropageClick(Sender: TObject); procedure EditAdrAigExit(Sender: TObject); procedure EditAdrAigChange(Sender: TObject); + procedure FormActivate(Sender: TObject); private { Déclarations privées } @@ -658,7 +658,7 @@ var // composants dynamiques Gp1,GroupBoxAvance,GroupBoxExpert : TGroupBox; - CheckBoxCR,Cb1,Cb2,Cb3,CbVis : TCheckBox; + CheckBoxCR,Cb1,Cb2,Cb3,CbVis,cbDTR,cbRTS : TCheckBox; MemoPeriph : Tmemo; @@ -679,7 +679,7 @@ var LabelStyle,LabelOuvreEcran,LabelAvance1,LabelAvance2,LabelAntiTO, LabelTD,LabelNC,LabelFiltre,LabelAlgo,LabelNbSignBS,LabelnCantonsRes : Tlabel; - RadioReserve : TradioGroup; + RadioReserve,RadioServeurCDM : TradioGroup; LabelDecCde : array[1..19] of TLabel; @@ -896,7 +896,7 @@ begin delete(s,1,i); val(s,vitesse,i); if (vitesse<>300) and (vitesse<>1200) and (vitesse<>2400) and (vitesse<>4800) and (vitesse<>9600) and - (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) then + (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) and (vitesse<>128000) and (vitesse<>256000) then begin Affiche('Vitesse COM ('+intToSTR(vitesse)+') incorrecte',clred); result:=false; @@ -947,6 +947,8 @@ begin if Tablo_periph[index].ScvAct then s:=s+',1' else s:=s+',0'; if Tablo_periph[index].ScvVis then s:=s+',1' else s:=s+',0'; if Tablo_periph[index].cr then s:=s+',1' else s:=s+',0'; + if Tablo_periph[index].dtr then s:=s+',1' else s:=s+',0'; + if Tablo_periph[index].rts then s:=s+',1' else s:=s+',0'; s:=s+','+Tablo_periph[index].protocole; result:=s; @@ -1183,6 +1185,7 @@ begin s:=s+intToSTR(Signaux[i].SR[nc].sortie0); if nc<8 then s:=s+',' else s:=s+')'; end; + s:=s+',NA'+intToSTR(Signaux[i].na); end; // décodeur CDF ou digikeijs @@ -1579,6 +1582,15 @@ begin delete(s,1,k); Signaux[i].SR[l].sortie0:=j; end; + if length(s)>2 then + if copy(s,1,2)='NA' then + begin + delete(s,1,2); + val(s,j,erreur); + delete(s,1,erreur); + Signaux[i].na:=j; + + end; end; // champ motif @@ -2242,7 +2254,6 @@ var s,sa,SOrigine: string; maxTablo_act:=1; NbrePN:=0;Nligne:=1; - for i:=1 to 10 do tablo_com_cde[i].NumPeriph:=0; // définition des actionneurs repeat @@ -3032,9 +3043,22 @@ var s,sa,SOrigine: string; val(sa,i,erreur); Tablo_periph[NbPeriph].cr:=i=1; + // nouveaux champ dtr i:=pos(',',sa);Delete(sa,1,i); val(sa,i,erreur); - Tablo_periph[NbPeriph].protocole:=sa; + + if (i<2) and (upcase(sa[1])<>'C') then // adresse ip ou Com + begin + val(sa,i,erreur); + Tablo_periph[NbPeriph].dtr:=i=1; + i:=pos(',',sa);Delete(sa,1,i); + + val(sa,i,erreur); + Tablo_periph[NbPeriph].rts:=i=1; + i:=pos(',',sa);Delete(sa,1,i); + end; + + Tablo_periph[NbPeriph].protocole:=uppercase(sa); i:=com_socket(NbPeriph); if i=1 then begin @@ -3052,7 +3076,6 @@ var s,sa,SOrigine: string; i:=extract_int(sa); if i=0 then Affiche('Erreur 97 - Port COM nul : '+sOrigine,clred); Tablo_periph[NbPeriph].NumCom:=i; - Tablo_com_cde[NbPeriph].NumPeriph:=NbPeriph; end; until (sOrigine='0') or (NbPeriph>=NbMaxi_Periph); end; @@ -4160,6 +4183,7 @@ begin if (AdrBaseDetDccpp<0) or (AdrBaseDetDccpp>2048) then AdrBaseDetDccpp:=513; mode_Reserve:=RadioReserve.ItemIndex; // 0 = par canton - 1=par détecteurs + serveurIPCDM_Touche:=radioServeurCDM.ItemIndex=0; val(EditAlgo.Text,i,erreur); if (i<1) or (i>1) then i:=1; @@ -4220,150 +4244,14 @@ begin end; -procedure TFormConfig.FormActivate(Sender: TObject); -var i : integer; - s : string; -begin - if affevt then affiche('FormConfig activate',clLime); - activ:=true; - clicListe:=false; - Edit_HG.Visible:=false; - labelHG.Visible:=false; - EditP1.Visible:=false; - EditP2.Visible:=false; - EditP3.Visible:=false; - EditP4.Visible:=false; - LabelTJD1.Visible:=false; - LabelTJD2.Visible:=false; - EditDevieS2.Visible:=false; - Label18.Visible:=false; - Label20.Visible:=false; - if AvecRoulage=1 then LabelInfVitesse.Visible:=false else LabelInfVitesse.Visible:=true; - EditP1.ReadOnly:=false; - EditP2.ReadOnly:=false; - EditP3.ReadOnly:=false; - EditP4.ReadOnly:=false; - EditPointe_BG.ReadOnly:=false; - EditDevie_HD.ReadOnly:=false; - EditDroit_BD.ReadOnly:=false; - Edit_HG.ReadOnly:=false; - - CheckBoxAffMemo.Checked:=AffMemoFenetre=1; - EditNbCantons.text:=intToSTR(Nb_cantons_Sig); - EditTempoFeu.Text:=IntToSTR(Tempo_Signal); - EditNbDetDist.text:=IntToSTR(Nb_Det_dist); - EditAdrIPCDM.text:=adresseIPCDM; - EditPortCDM.Text:=IntToSTR(portCDM); - EditIPLenz.text:=AdresseIP; - EditportLenz.text:=IntToSTR(PortInterface); - EditTempoAig.Text:=IntToSTR(Tempo_Aig); - EditFiltrDet.text:=intToSTR(filtrageDet0); - EditnCantonsRes.Text:=intToSTR(nCantonsRes); - EditAntiTO.Text:=intToSTR(AntiTimeoutEthLenz); - - {$IF CompilerVersion >= 28.0} - ComboStyle.itemIndex:=Style_Aff; - {$IFEND} - EditOuvreEcran.Text:=intToSTR(ecran_SC); - EditComUSB.Text:=PortCom; - EditFonte.text:=IntToSTR(TailleFonte); - editdebug.Text:=IntToSTR(debug); - CheckBoxVerifXpressNet.Checked:=Verif_AdrXpressNet=1; - editPortServeur.Text:=intToSTR(portServeur); - checkRoulage.Checked:=AvecRoulage=1; - EditTempoOctetUSB.text:=IntToSTR(TempoOctet); - EditTempoReponse.Text:=IntToSTR(TimoutMaxInterface); - RadioButton1.checked:=false; - RadioButton2.checked:=false; - if Valeur_entete=0 then RadioButton1.checked:=true; - if Valeur_entete=1 then RadioButton2.checked:=true; - LabelInfo.Width:=240;LabelInfo.Height:=65;LabelInfo.AutoSize:=false; - LabelResult.width:=137;LabelResult.Height:=25; - LabelNomSon.top:=16;LabelNomSon.Left:=48; - SpeedButtonJoue.Top:=60; SpeedButtonCharger.Top:=60; - EditSon.Top:=38;EditSon.Left:=16; - - CheckBoxResa.Checked:=AvecResa; - CheckVerifVersion.Checked:=verifVersion; - CheckFenEt.Checked:=Fenetre=1; - CheckInfoVersion.Checked:=notificationVersion; - CheckLanceCDM.Checked:=LanceCDM; - CheckAvecTCO.checked:=avecTCO; - CheckBandeauTCO.Checked:=MasqueBandeauTCO; - - RadioButtonSS.Checked:=ServeurInterfaceCDM=0; - RadioButtonXN.Checked:=ServeurInterfaceCDM=1; - RadioButtonP50.Checked:=ServeurInterfaceCDM=2; - RadioButtonSP.Checked:=ServeurInterfaceCDM=3; - RadioButtonFIS.Checked:=ServeurInterfaceCDM=4; - RadioButtonRS.Checked:=ServeurInterfaceCDM=5; - 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; - checkBoxZ21.Checked:=Z21; - - CheckBoxServAig.checked:=Srvc_Aig; - CheckBoxServDet.checked:=Srvc_Det; - CheckBoxServAct.checked:=Srvc_Act; - CheckServPosTrains.checked:=Srvc_Pos; - CheckBoxSrvSig.Checked:=Srvc_Sig; - - CheckBoxRazSignaux.checked:=Raz_Acc_signaux; - CheckBoxInitAig.checked:=AvecInitAiguillages; - CheckPosAig.checked:=AvecDemandeAiguillages; - CheckBoxDemarUSB.checked:=AvecDemandeInterfaceUSB; - CheckBoxDemarEth.checked:=AvecDemandeInterfaceEth; - CheckBoxSombre.Checked:=sombre; - - RadioButtonXpress.Checked:=protocole=1; - RadioButtonDcc.Checked:=protocole=2; - - if NbreDecPers>0 then - ComboBoxNation.Itemindex:=decodeur_pers[1].nation-1; - - clicListe:=true; // empeche le traitement de l'evt text - editLAY.Text:=lay; - - LabelNbDecPers.caption:=intToSTR(NbreDecPers); - - - //l'onglet affiché est sélectionné à l'appel de la fiche dans l'unité UnitPrinc - clicListe:=false; - activ:=false; - - if clicproprietes then clicListeSignal(IndexSignalClic); - clicproprietes:=false; - - // aiguillages - ListBoxAig.Clear; - for i:=1 to MaxAiguillage do - begin - s:=encode_aig(i); - ListBoxAig.Items.AddObject(s, Pointer(clRed)); - Aiguillage[i].modifie:=false; - end; - ListBoxAig.itemindex:=0; - - RadioReserve.ItemIndex:=mode_Reserve; - editAlgo.Text:=intToSTR(Algo_localisation); - EditMaxSignalSens.Text:=intToSTR(Max_Signal_Sens); - -end; - -procedure champs_dec_centrale; +procedure champs_dec_centrale; var i,nombre : integer; begin if decCourant<1 then exit; decodeur_pers[decCourant].commande:=0; nombre:=decodeur_pers[decCourant].nbreAdr; - for i:=1 to nombre do + for i:=1 to nombre do begin ComboTS1[i].Visible:=true; ComboTS2[i].Visible:=true; @@ -4372,7 +4260,7 @@ begin ComboL2[i].Visible:=true; ShapeT[i].Visible:=true; end; - for i:=nombre+1 to 10 do + for i:=nombre+1 to 10 do begin ComboTS1[i].Visible:=false; ComboTS2[i].Visible:=false; @@ -4551,6 +4439,9 @@ begin 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; @@ -4730,7 +4621,6 @@ begin LabelInfo.caption:=''; Tablo_periph[ligneClicAccPeriph+1].NumCom:=i; - Tablo_com_cde[ligneClicAccPeriph+1].NumPeriph:=ligneClicAccPeriph+1; ListBoxPeriph.Selected[ligneClicAccPeriph]:=true; maj_champs_combos(ligneClicAccPeriph+1); @@ -4747,14 +4637,12 @@ 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; - Tablo_com_cde[i].NumPeriph:=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; - Tablo_com_cde[i].NumPeriph:=NbPeriph_Socket; end; end; end; @@ -4832,8 +4720,9 @@ procedure TFormConfig.FormCreate(Sender: TObject); var i,j,x,y,l,LongestLength,PixelLength : integer; cs,s,LongestString : string; begin - if debug=1 then Affiche('Création fenêtre config',clLime); - + if AffEvt or (debug=1) then Affiche('Création fenêtre config',clLime); + + visible:=false; clicListe:=true; position:=poMainFormCenter; cs:='ColorA='+IntToHex(couleurFond,6); // pour rajouter aux couleurs personnalisées de la fenetre couleur @@ -4886,7 +4775,8 @@ begin ShowHint:=false; visible:=true; end; - // création des champs dynamiques de l'onglet décodeurs + + // création des champs dynamiques de l'onglet décodeurs for i:=1 to 10 do begin y:=i*40+20; @@ -5708,9 +5598,9 @@ begin MemoPeriph:=Tmemo.Create(Formconfig.TabSheetPeriph); with MemoPeriph do begin - left:=gp1.Left-30; + left:=gp1.Left-20; top:=LabelMP.Top+15; - width:=gp1.Width+30; + width:=gp1.Width+20; height:=110; parent:=TabSheetPeriph; Name:='MemoPeriph'; @@ -5725,12 +5615,13 @@ begin BoutonCom:=Tbutton.Create(FormConfig.TabSheetPeriph); with BoutonCom do begin - Left:=100;Top:=ButtonOuvreCom.top;Width:=75;Height:=20; + 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; @@ -5792,6 +5683,31 @@ begin 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 ligne RTS'; + ShowHint:=true; + onclick:=formconfig.cb_onclick; + end; + + // compilation avec D11---------------------------------------- {$IF CompilerVersion >= 28.0} labelD11.Visible:=true; @@ -5839,7 +5755,7 @@ begin LabelAvance1:=TLabel.Create(FormConfig.TabAvance); with LabelAvance1 do begin - Left:=10;Top:=10;Width:=170;Height:=12; + Left:=10;Top:=10;Width:=180;Height:=12; caption:='Paramètres avancés et experts'; name:='LabelAvance1'; Font.Style:=[fsBold]; @@ -5850,7 +5766,7 @@ begin GroupBoxAvance:=TGroupBox.Create(FormConfig.TabAvance); with GroupBoxAvance do begin - Left:=20;Top:=40;Width:=350;Height:=150; // maxi=580 + Left:=3;Top:=40;Width:=300;Height:=150; // maxi=580 caption:='Jeu de paramètres avancés'; name:='GroupBoxAvance'; parent:=TabAvance; @@ -5961,7 +5877,7 @@ begin RadioReserve:=TRadioGroup.Create(TabAvance); with RadioReserve do begin - Left:=20;Top:=GroupBoxAvance.top+GroupBoxAvance.Height+20;Width:=GroupBoxAvance.width;Height:=60; + Left:=5;Top:=GroupBoxAvance.top+GroupBoxAvance.Height+10;Width:=GroupBoxAvance.width;Height:=60; name:='RadioReserve'; Caption:='Réservation des aiguillages'; parent:=TabAvance; @@ -5971,11 +5887,12 @@ begin items.Add('Réservation par canton'); items.Add('Réservation par détecteurs'); end; + GroupBoxExpert:=TGroupBox.Create(FormConfig.TabAvance); with GroupBoxExpert do begin - Left:=20;;Width:=350;Height:=100; // maxi=580 - Top:=RadioReserve.Top+RadioReserve.Height+20 ; + Left:=GroupBoxAvance.Left;Width:=GroupBoxAvance.width;Height:=100; // maxi=580 + Top:=RadioReserve.Top+RadioReserve.Height+10 ; caption:='Jeu de paramètres experts'; name:='GroupBoxExpert'; parent:=TabAvance; @@ -6021,6 +5938,19 @@ begin 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; ImageSignaux.picture.Assign(formpilote.ImageSignaux.Picture); @@ -6155,7 +6085,11 @@ begin 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; + CheckBoxCR.Checked:=Tablo_periph[index].cr; + EditPortCde.text:=Tablo_periph[index].protocole; MemoPeriph.Clear; clicliste:=false; @@ -6163,7 +6097,7 @@ end; // affiche le graphisme de l'aiguillage en fonction du tablo en index procedure Aff_champs_aig_tablo(index : integer); -var Adresse,Adr2,ind,id2,erreur,position : integer; +var Adresse,Adr2,ind,id2,erreur,position,AncienAdresse : integer; tjd,tri,tjs,croi : boolean; s,ss : string; i,vitesse : integer; @@ -6408,6 +6342,17 @@ begin if croi then s:='Croisement ' else s:='Aiguillage '; formconfig.labelInfo.caption:=s+'décrivant la BJS '+intToSTR(aiguillage[index].AdrCDM); end; + + adresse:=aiguillage[ligneclicAig+1].Adresse; + if adresse=0 then exit; + index:=Index_Aig(Adresse); + AncienAdresse:=aiguillage[index].AncienAdresse; + if adresse<>AncienAdresse then + FormConfig.ButtonPropage.Hint:='Change les adresses '+intToSTR(AncienAdresse)+' dans les points de connexions'+#13+ + 'des aiguillages et des branches par l''adresse '+intToSTR(adresse) + else FormConfig.ButtonPropage.Hint:='Change les adresses dans les points de connexions'+#13+ + 'des aiguillages, des branches et des signaux'+#13+ + 'si on a changé l''adresse d''un aiguillage'; clicListe:=false; end; @@ -9320,6 +9265,32 @@ begin Signaux[i].Aspect:=3; Signaux[i].decodeur:=0; Signaux[i].verrouCarre:=false; + Signaux[i].SR[1].sortie0:=1; + Signaux[i].SR[1].sortie1:=6; + Signaux[i].SR[2].sortie0:=2; + Signaux[i].SR[2].sortie1:=3; + Signaux[i].SR[3].sortie0:=9; + Signaux[i].SR[3].sortie1:=10; + Signaux[i].SR[4].sortie0:=4; + Signaux[i].SR[4].sortie1:=5; + Signaux[i].SR[5].sortie0:=7; + Signaux[i].SR[5].sortie1:=8; + Signaux[i].SR[6].sortie0:=0; + Signaux[i].SR[6].sortie1:=0; + Signaux[i].SR[7].sortie0:=16; + Signaux[i].SR[7].sortie1:=18; + Signaux[i].SR[8].sortie0:=19; + Signaux[i].SR[8].sortie1:=0; + Signaux[i].Na:=4; + + + + + + + + + cree_image(i); s:=encode_signal(i); @@ -9565,7 +9536,7 @@ begin 93,94,95,96,97,98,99 : nc:=4; end; end; - if dec=7 then nc:=8; // SR + if dec=7 then nc:=Signaux[i].Na; // SR if dec=8 then // arcomora begin case x of @@ -13509,7 +13480,6 @@ var ss,s : string; s:=encode_Periph(i); if s<>'' then begin - Tablo_com_cde[i].NumPeriph:=i; FormConfig.ListBoxPeriph.items.Add(s); ajoute_champs_combos(i); end; @@ -13621,7 +13591,7 @@ begin begin if com_socket(i)=1 then // si port com$usb begin - if connecte_port_usb_periph(i) then + if connecte_usb_periph(i) then Affiche('COM'+intToSTR(Tablo_periph[i].numcom)+' périphérique ouvert',clLime) else Affiche('COM'+intToSTR(Tablo_periph[i].numcom)+' périphérique non ouvert',clOrange); end @@ -13908,6 +13878,7 @@ begin inc(i); until (i=n) or trouve; if not(trouve) then exit; + dec(i); if i=0 then exit; @@ -14252,12 +14223,16 @@ begin end; end; + ButtonPropage.Hint:='Change les adresses dans les points de connexions'+#13+ + 'des aiguillages, des branches et des signaux'+#13+ + 'si on a changé l''adresse d''un aiguillage'; + clicListe:=false; end; procedure change_adr_aig; var s : string; - nEtat,i,vide,erreur,index,adr2 : integer; + nEtat,i,vide,erreur,index,adr2,AncienAdresse : integer; modele: TEquipement; c : char; begin @@ -14339,6 +14314,14 @@ begin end; ListBoxSig.selected[ligneClicSig]:=true; end; + + adresse:=aiguillage[ligneclicAig+1].Adresse; + if adresse=0 then exit; + index:=Index_Aig(Adresse); + AncienAdresse:=aiguillage[index].AncienAdresse; + if adresse<>AncienAdresse then + ButtonPropage.Hint:='Change les adresses '+intToSTR(AncienAdresse)+' dans les points de connexions'+#13+ + 'des aiguillages et des branches par l''adresse '+intToSTR(adresse); end; end; @@ -14357,8 +14340,145 @@ begin change_adr_aig; end; +procedure TFormConfig.FormActivate(Sender: TObject); + var i : integer; + s : string; +begin + if affevt or (debug=1) then affiche('FormConfig activate',clLime); + activ:=true; + clicListe:=false; + Edit_HG.Visible:=false; + labelHG.Visible:=false; + EditP1.Visible:=false; + EditP2.Visible:=false; + EditP3.Visible:=false; + EditP4.Visible:=false; + LabelTJD1.Visible:=false; + LabelTJD2.Visible:=false; + EditDevieS2.Visible:=false; + Label18.Visible:=false; + Label20.Visible:=false; + if AvecRoulage=1 then LabelInfVitesse.Visible:=false else LabelInfVitesse.Visible:=true; - + EditP1.ReadOnly:=false; + EditP2.ReadOnly:=false; + EditP3.ReadOnly:=false; + EditP4.ReadOnly:=false; + EditPointe_BG.ReadOnly:=false; + EditDevie_HD.ReadOnly:=false; + EditDroit_BD.ReadOnly:=false; + Edit_HG.ReadOnly:=false; + + CheckBoxAffMemo.Checked:=AffMemoFenetre=1; + EditNbCantons.text:=intToSTR(Nb_cantons_Sig); + EditTempoFeu.Text:=IntToSTR(Tempo_Signal); + EditNbDetDist.text:=IntToSTR(Nb_Det_dist); + EditAdrIPCDM.text:=adresseIPCDM; + EditPortCDM.Text:=IntToSTR(portCDM); + EditIPLenz.text:=AdresseIP; + EditportLenz.text:=IntToSTR(PortInterface); + EditTempoAig.Text:=IntToSTR(Tempo_Aig); + EditFiltrDet.text:=intToSTR(filtrageDet0); + EditnCantonsRes.Text:=intToSTR(nCantonsRes); + EditAntiTO.Text:=intToSTR(AntiTimeoutEthLenz); + + {$IF CompilerVersion >= 28.0} + ComboStyle.itemIndex:=Style_Aff; + {$IFEND} + EditOuvreEcran.Text:=intToSTR(ecran_SC); + EditComUSB.Text:=PortCom; + EditFonte.text:=IntToSTR(TailleFonte); + editdebug.Text:=IntToSTR(debug); + CheckBoxVerifXpressNet.Checked:=Verif_AdrXpressNet=1; + editPortServeur.Text:=intToSTR(portServeur); + checkRoulage.Checked:=AvecRoulage=1; + EditTempoOctetUSB.text:=IntToSTR(TempoOctet); + EditTempoReponse.Text:=IntToSTR(TimoutMaxInterface); + RadioButton1.checked:=false; + RadioButton2.checked:=false; + if Valeur_entete=0 then RadioButton1.checked:=true; + if Valeur_entete=1 then RadioButton2.checked:=true; + LabelInfo.Width:=240;LabelInfo.Height:=65;LabelInfo.AutoSize:=false; + LabelResult.width:=137;LabelResult.Height:=25; + LabelNomSon.top:=16;LabelNomSon.Left:=48; + SpeedButtonJoue.Top:=60; SpeedButtonCharger.Top:=60; + EditSon.Top:=38;EditSon.Left:=16; + + CheckBoxResa.Checked:=AvecResa; + CheckVerifVersion.Checked:=verifVersion; + CheckFenEt.Checked:=Fenetre=1; + CheckInfoVersion.Checked:=notificationVersion; + CheckLanceCDM.Checked:=LanceCDM; + CheckAvecTCO.checked:=avecTCO; + CheckBandeauTCO.Checked:=MasqueBandeauTCO; + + RadioButtonSS.Checked:=ServeurInterfaceCDM=0; + RadioButtonXN.Checked:=ServeurInterfaceCDM=1; + RadioButtonP50.Checked:=ServeurInterfaceCDM=2; + RadioButtonSP.Checked:=ServeurInterfaceCDM=3; + RadioButtonFIS.Checked:=ServeurInterfaceCDM=4; + RadioButtonRS.Checked:=ServeurInterfaceCDM=5; + 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; + checkBoxZ21.Checked:=Z21; + + CheckBoxServAig.checked:=Srvc_Aig; + CheckBoxServDet.checked:=Srvc_Det; + CheckBoxServAct.checked:=Srvc_Act; + CheckServPosTrains.checked:=Srvc_Pos; + CheckBoxSrvSig.Checked:=Srvc_Sig; + + CheckBoxRazSignaux.checked:=Raz_Acc_signaux; + CheckBoxInitAig.checked:=AvecInitAiguillages; + CheckPosAig.checked:=AvecDemandeAiguillages; + CheckBoxDemarUSB.checked:=AvecDemandeInterfaceUSB; + CheckBoxDemarEth.checked:=AvecDemandeInterfaceEth; + CheckBoxSombre.Checked:=sombre; + + RadioButtonXpress.Checked:=protocole=1; + RadioButtonDcc.Checked:=protocole=2; + + if NbreDecPers>0 then + ComboBoxNation.Itemindex:=decodeur_pers[1].nation-1; + + clicListe:=true; // empeche le traitement de l'evt text + editLAY.Text:=lay; + + LabelNbDecPers.caption:=intToSTR(NbreDecPers); + + + //l'onglet affiché est sélectionné à l'appel de la fiche dans l'unité UnitPrinc + clicListe:=false; + activ:=false; + + if clicproprietes then clicListeSignal(IndexSignalClic); + clicproprietes:=false; + + // aiguillages + ListBoxAig.Clear; + for i:=1 to MaxAiguillage do + begin + s:=encode_aig(i); + ListBoxAig.Items.AddObject(s, Pointer(clRed)); + Aiguillage[i].modifie:=false; + end; + ListBoxAig.itemindex:=0; + + RadioReserve.ItemIndex:=mode_Reserve; + if serveurIPCDM_Touche then RadioServeurCDM.ItemIndex:=0 else RadioServeurCDM.ItemIndex:=1; + editAlgo.Text:=intToSTR(Algo_localisation); + EditMaxSignalSens.Text:=intToSTR(Max_Signal_Sens); + +end; + + end. diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index 26a9a06..b26adae 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -338,7 +338,7 @@ object FormConfCellTCO: TFormConfCellTCO object EditNumTCO: TEdit Left = 104 Top = 20 - Width = 33 + Width = 25 Height = 21 TabOrder = 1 OnChange = EditNumTCOChange @@ -366,7 +366,10 @@ object FormConfCellTCO: TFormConfCellTCO Top = 72 Width = 89 Height = 17 + Hint = 'Active un accessoire de fa'#231'on impulsionelle' Caption = 'Activer sortie' + ParentShowHint = False + ShowHint = True TabOrder = 4 OnClick = RadioButtonActionClick end @@ -392,10 +395,10 @@ object FormConfCellTCO: TFormConfCellTCO object RadioButtonStop: TRadioButton Left = 8 Top = 88 - Width = 177 + Width = 137 Height = 17 Hint = 'Arr'#234'te tous les trains (mode autonome et CDM)' - Caption = 'Arr'#234'ter toutes les trains' + Caption = 'Arr'#234'ter tous les trains' ParentShowHint = False ShowHint = True TabOrder = 7 diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index fbb4d03..3b79d4b 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -477,7 +477,7 @@ var i : integer; begin // fenetre toujours dessus position:=poMainFormCenter; - if affevt then Affiche('FormConfCellTCO create',clyellow); + if affevt then Affiche('FormConfCellTCO create',clLime); actualize:=false; SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); iconeX:=50; // taille de l'icone @@ -594,7 +594,7 @@ end; procedure TFormConfCellTCO.FormActivate(Sender: TObject); begin if indexTCOcourant=0 then exit; - if affevt then Affiche('FormConfCellTCO activate',clyellow); + if affevt then Affiche('FormConfCellTCO activate',clLime); if selectionaffichee[indexTCOcourant] then ButtonFond.caption:='Couleur de fond de la sélection' else ButtonFond.caption:='Couleur de fond de la cellule'; ConfCellTCO:=true; diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 7b6f42b..476fdad 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -1,12 +1,13 @@ object FormDebug: TFormDebug - Left = 234 - Top = 128 - Width = 884 - Height = 732 + Left = 196 + Top = 37 VertScrollBar.Increment = 67 - VertScrollBar.Position = 17 VertScrollBar.Tracking = True + VertScrollBar.Visible = False + AutoScroll = False Caption = 'Fen'#234'tre de d'#233'bug' + ClientHeight = 757 + ClientWidth = 946 Color = clWindow TransparentColorValue = clTeal Font.Charset = DEFAULT_CHARSET @@ -21,689 +22,725 @@ object FormDebug: TFormDebug OnCreate = FormCreate OnKeyPress = FormKeyPress DesignSize = ( - 859 - 701) + 946 + 757) PixelsPerInch = 96 TextHeight = 13 - object Label1: TLabel - Left = 615 - Top = -13 - Width = 108 - Height = 13 - Anchors = [akTop, akRight] - Caption = 'Niveau du Debug (0-3)' - Color = clWhite - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlue - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] + object ScrollBoxDebug: TScrollBox + Left = 0 + Top = 0 + Width = 940 + Height = 772 + HorzScrollBar.Visible = False + Anchors = [akLeft, akTop, akRight, akBottom] + Color = clBtnFace ParentColor = False - ParentFont = False - end - object LabelTitreDebug: TLabel - Left = 463 - Top = -15 - Width = 131 - Height = 18 - Anchors = [akTop, akRight] - Caption = 'Fen'#234'tre de d'#233'bug' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Arial' - Font.Style = [fsBold, fsItalic] - ParentFont = False - end - object EditNivDebug: TEdit - Left = 774 - Top = -15 - Width = 49 - Height = 21 - Anchors = [akTop, akRight] - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlue - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False TabOrder = 0 - Text = 'EditNivDebug' - OnKeyPress = EditNivDebugKeyPress - end - object ButtonEcrLog: TButton - Left = 462 - Top = 311 - Width = 97 - Height = 29 - Anchors = [akTop, akRight] - Caption = 'Sauvegarder le log' - TabOrder = 1 - OnClick = ButtonEcrLogClick - end - object ButtonRazTampon: TButton - Left = 462 - Top = 343 - Width = 97 - Height = 33 - Anchors = [akTop, akRight] - Caption = 'Raz Tampon Ev'#232'nements ---->' - TabOrder = 2 - WordWrap = True - OnClick = ButtonRazTamponClick - end - object ButtonCherche: TButton - Left = 462 - Top = 279 - Width = 97 - Height = 25 - Hint = 'Cherche la cha'#238'ne "erreur"' - Anchors = [akTop, akRight] - Caption = 'Chercher erreurs' - ParentShowHint = False - ShowHint = True - TabOrder = 3 - OnClick = ButtonChercheClick - end - object ButtonAffEvtChrono: TButton - Left = 462 - Top = 239 - Width = 97 - Height = 33 - Anchors = [akTop, akRight] - Caption = 'Affiche Evts d'#233'tecteurs et aig' - TabOrder = 4 - WordWrap = True - OnClick = ButtonAffEvtChronoClick - end - object ButtonCop: TButton - Left = 462 - Top = 191 - Width = 97 - Height = 41 - Anchors = [akTop, akRight] - Caption = 'Copie fen'#234'te principale dans debug' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWhite - Font.Height = -9 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 5 - WordWrap = True - OnClick = ButtonCopClick - end - object ButtonRazLog: TButton - Left = 462 - Top = 383 - Width = 97 - Height = 33 - Anchors = [akTop, akRight] - Caption = 'Raz Tampon Log <-----' - TabOrder = 6 - WordWrap = True - OnClick = ButtonRazLogClick - end - object GroupBox1: TGroupBox - Left = 468 - Top = 583 - Width = 369 - Height = 185 - Anchors = [akTop, akRight] - Caption = 'Fonctions primitives' - Color = cl3DLight - Font.Charset = DEFAULT_CHARSET - Font.Color = clNavy - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentColor = False - ParentFont = False - TabOrder = 7 - object GroupBox3: TGroupBox - Left = 8 - Top = 16 - Width = 353 - Height = 73 - Caption = 'Signal' + DesignSize = ( + 919 + 768) + object LabelTitreDebug: TLabel + Left = 543 + Top = 8 + Width = 131 + Height = 18 + Anchors = [akTop, akRight] + Caption = 'Fen'#234'tre de d'#233'bug' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold, fsItalic] + ParentFont = False + end + object Label1: TLabel + Left = 695 + Top = 10 + Width = 108 + Height = 13 + Anchors = [akTop, akRight] + Caption = 'Niveau du Debug (0-3)' + Color = clWhite + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + end + object RichDebug: TRichEdit + Left = 0 + Top = 0 + Width = 522 + Height = 753 + Anchors = [akLeft, akTop, akRight] + Color = clMaroon + Lines.Strings = ( + 'RichDebug') + PopupMenu = PopupMenuRD + ScrollBars = ssBoth TabOrder = 0 - object Label4: TLabel - Left = 313 - Top = 10 - Width = 32 + OnChange = RichDebugChange + end + object ButtonRazTout: TButton + Left = 533 + Top = 216 + Width = 97 + Height = 25 + Hint = + 'Supprime les trains d'#233'tect'#233's ou en cas de nouveau RUN, permet de' + + ' partir de 0' + Anchors = [akTop, akRight] + Caption = 'RAZ tous trains' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnClick = ButtonRazToutClick + end + object ButtonCop: TButton + Left = 533 + Top = 248 + Width = 97 + Height = 41 + Anchors = [akTop, akRight] + Caption = 'Copie fen'#234'te principale dans debug' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWhite + Font.Height = -9 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 2 + WordWrap = True + OnClick = ButtonCopClick + end + object ButtonAffEvtChrono: TButton + Left = 533 + Top = 296 + Width = 97 + Height = 33 + Anchors = [akTop, akRight] + Caption = 'Affiche Evts d'#233'tecteurs et aig' + TabOrder = 3 + WordWrap = True + OnClick = ButtonAffEvtChronoClick + end + object ButtonCherche: TButton + Left = 533 + Top = 336 + Width = 97 + Height = 25 + Hint = 'Cherche la cha'#238'ne "erreur"' + Anchors = [akTop, akRight] + Caption = 'Chercher erreurs' + ParentShowHint = False + ShowHint = True + TabOrder = 4 + OnClick = ButtonChercheClick + end + object ButtonEcrLog: TButton + Left = 533 + Top = 184 + Width = 97 + Height = 29 + Anchors = [akTop, akRight] + Caption = 'Sauvegarder le log' + TabOrder = 5 + OnClick = ButtonEcrLogClick + end + object ButtonRazTampon: TButton + Left = 533 + Top = 368 + Width = 97 + Height = 33 + Anchors = [akTop, akRight] + Caption = 'Raz Tampon Ev'#232'nements ---->' + TabOrder = 6 + WordWrap = True + OnClick = ButtonRazTamponClick + end + object ButtonRazLog: TButton + Left = 533 + Top = 408 + Width = 97 + Height = 33 + Anchors = [akTop, akRight] + Caption = 'Raz Tampon Log <-----' + TabOrder = 7 + WordWrap = True + OnClick = ButtonRazLogClick + end + object MemoEvtDet: TRichEdit + Left = 638 + Top = 186 + Width = 272 + Height = 263 + Anchors = [akTop, akRight] + Color = clBlack + ScrollBars = ssVertical + TabOrder = 8 + OnChange = MemoEvtDetChange + end + object GroupBox5: TGroupBox + Left = 530 + Top = 456 + Width = 380 + Height = 57 + Anchors = [akTop, akRight] + Caption = 'Simulation d'#233'tecteur / actionneur' + Color = cl3DLight + Font.Charset = DEFAULT_CHARSET + Font.Color = clNavy + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 9 + object EditSimuDet: TEdit + Left = 16 + Top = 24 + Width = 33 + Height = 21 + Hint = 'Adresse d'#39'un d'#233'tecteur' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + end + object ButtonSimuDet0: TButton + Left = 72 + Top = 16 + Width = 65 + Height = 33 + Caption = 'D'#233'tecteur '#224' 0' + TabOrder = 1 + WordWrap = True + OnClick = ButtonSimuDet0Click + end + object ButtonSimuDet1: TButton + Left = 152 + Top = 16 + Width = 65 + Height = 33 + Caption = 'D'#233'tecteur '#224' 1' + TabOrder = 2 + WordWrap = True + OnClick = ButtonSimuDet1Click + end + object ButtonSimuAct0: TButton + Left = 224 + Top = 16 + Width = 65 + Height = 33 + Caption = 'Actionneur '#224' 0' + TabOrder = 3 + WordWrap = True + OnClick = ButtonSimuAct0Click + end + object ButtonSimuAct1: TButton + Left = 296 + Top = 16 + Width = 65 + Height = 33 + Caption = 'Actionneur '#224' 1' + TabOrder = 4 + WordWrap = True + OnClick = ButtonSimuAct1Click + end + end + object GroupBox6: TGroupBox + Left = 530 + Top = 520 + Width = 380 + Height = 52 + Anchors = [akTop, akRight] + Caption = 'Sorties' + Color = cl3DLight + Font.Charset = DEFAULT_CHARSET + Font.Color = clNavy + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 10 + object Label3: TLabel + Left = 16 + Top = 24 + Width = 38 Height = 13 - Caption = 'Signal:' + Caption = 'Adresse' + end + object Label5: TLabel + Left = 104 + Top = 24 + Width = 27 + Height = 13 + Caption = 'Sortie' + end + object EditAdresse: TEdit + Left = 64 + Top = 18 + Width = 33 + Height = 21 + Hint = 'Adresse d'#39'accessoire' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + end + object EditSortie: TEdit + Left = 136 + Top = 18 + Width = 25 + Height = 21 + Hint = 'Sortie 1 ou 2' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object Button1: TButton + Left = 224 + Top = 16 + Width = 49 + Height = 25 + Hint = + 'Mise '#224' 1 de la sortie - attention peut d'#233'truire les moteurs '#224' bo' + + 'bine' + Caption = 'Mise '#224' 1' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnClick = Button1Click + end + object Button0: TButton + Left = 280 + Top = 16 + Width = 49 + Height = 25 + Hint = 'Mise '#224' 0 de la sortie' + Caption = 'Mise '#224' 0' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnClick = Button0Click + end + end + object GroupBoxPrim: TGroupBox + Left = 532 + Top = 584 + Width = 378 + Height = 185 + Anchors = [akTop, akRight] + Caption = 'Fonctions primitives' + Color = cl3DLight + Font.Charset = DEFAULT_CHARSET + Font.Color = clNavy + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 11 + object GroupBox3: TGroupBox + Left = 8 + Top = 16 + Width = 353 + Height = 73 + Caption = 'Signal' + TabOrder = 0 + object Label4: TLabel + Left = 313 + Top = 10 + Width = 32 + Height = 13 + Caption = 'Signal:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + end + object ButtonSigSuiv: TButton + Left = 0 + Top = 16 + Width = 49 + Height = 49 + Hint = 'Etat du signal suivant' + Caption = 'Etat signal suivant' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + WordWrap = True + OnClick = ButtonSigSuivClick + end + object ButtonCanSuivSig: TButton + Left = 48 + Top = 16 + Width = 65 + Height = 49 + Hint = 'Renvoie l'#39'occupation du canton suivant le signal' + Caption = 'Etat canton suivant signal' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + WordWrap = True + OnClick = ButtonCanSuivSigClick + end + object EditSigSuiv: TEdit + Left = 312 + Top = 32 + Width = 33 + Height = 21 + Hint = 'Indiquer l'#39'adresse du signal ' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object ButtonCP: TButton + Left = 112 + Top = 16 + Width = 81 + Height = 49 + Hint = 'Renvoie l'#39#233'tat des 3 cantons pr'#233'c'#233'dents au signal' + Caption = 'Etat 3 cantons pr'#233'c'#233'dents signal' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + WordWrap = True + OnClick = ButtonCPClick + end + object Button2: TButton + Left = 192 + Top = 16 + Width = 57 + Height = 49 + Hint = + 'Teste si la position des aiguillages en aval du signal doivent i' + + 'nsiquer un carr'#233' sur le signal' + Caption = 'Cond Carr'#233' aiguillages' + ParentShowHint = False + ShowHint = True + TabOrder = 4 + WordWrap = True + OnClick = Button2Click + end + object ButtonAigDevie: TButton + Left = 248 + Top = 16 + Width = 57 + Height = 49 + Hint = 'Test si des aiguillages sont d'#233'vi'#233's apr'#232's le signal' + Caption = 'Aig d'#233'vi'#233' apr'#232's signal' + ParentShowHint = False + ShowHint = True + TabOrder = 5 + WordWrap = True + OnClick = ButtonAigDevieClick + end + end + object GroupBox4: TGroupBox + Left = 8 + Top = 96 + Width = 353 + Height = 81 + Caption = 'D'#233'tecteur/'#233'l'#233'ment suivant' + TabOrder = 1 + object ButtonDetSuiv: TButton + Left = 16 + Top = 16 + Width = 185 + Height = 25 + Hint = + 'Renvoie le d'#233'tecteur suivant aux deux '#233'l'#233'ments (d'#233'tecteurs ou ai' + + 'guillages) ' + Caption = 'D'#233'tecteur suivant aux '#233'l'#233'ments' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = ButtonDetSuivClick + end + object EditPrec: TEdit + Left = 208 + Top = 34 + Width = 49 + Height = 21 + Hint = 'Element pr'#233'c'#233'dent' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object EditActuel: TEdit + Left = 264 + Top = 34 + Width = 49 + Height = 21 + Hint = 'Element actuel' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object ButtonElSuiv: TButton + Left = 16 + Top = 48 + Width = 185 + Height = 25 + Hint = + 'Renvoie l'#39#233'l'#233'ment suivant aux deux '#233'l'#233'ments contigus (d'#233'tecteurs' + + ' ou aiguillages) ' + Caption = 'Element suivant aux '#233'l'#233'ments' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + OnClick = ButtonElSuivClick + end + end + end + object GroupBox2: TGroupBox + Left = 534 + Top = 28 + Width = 376 + Height = 149 + Anchors = [akTop, akRight] + Caption = 'S'#233'lections d'#39'affichage' + Color = cl3DLight + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 12 + object CheckAffSig: TCheckBox + Left = 8 + Top = 16 + Width = 161 + Height = 17 + Caption = 'Fonctionnement des signaux' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - end - object ButtonSigSuiv: TButton - Left = 8 - Top = 16 - Width = 49 - Height = 49 - Hint = 'Etat du signal suivant' - Caption = 'Etat signal suivant' - ParentShowHint = False - ShowHint = True TabOrder = 0 - WordWrap = True - OnClick = ButtonSigSuivClick + OnClick = CheckAffSigClick end - object ButtonCanSuivSig: TButton - Left = 72 - Top = 16 - Width = 65 - Height = 49 - Hint = 'Renvoie l'#39'occupation du canton suivant le signal' - Caption = 'Etat canton suivant signal' + object CheckBoxEvtDetAig: TCheckBox + Left = 8 + Top = 32 + Width = 289 + Height = 17 + Caption = 'Ev'#232'nements d'#233'tecteurs, aiguillages et actionneurs' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 1 + OnClick = CheckBoxEvtDetAigClick + end + object CheckBoxTraceLIste: TCheckBox + Left = 8 + Top = 128 + Width = 185 + Height = 17 + Caption = 'Evaluations des routes des trains' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 2 + OnClick = CheckBoxTraceLIsteClick + end + object CheckTrame: TCheckBox + Left = 8 + Top = 96 + Width = 233 + Height = 17 + Hint = + 'Affiche les trames de la centrale XpressNet ou les trames CDM-Ra' + + 'il (COM_IP)' + Caption = 'Trames '#233'chang'#233'es avec l'#39'interface ou CDM' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False ParentShowHint = False ShowHint = True - TabOrder = 1 - WordWrap = True - OnClick = ButtonCanSuivSigClick + TabOrder = 3 + OnClick = CheckTrameClick end - object EditSigSuiv: TEdit - Left = 312 - Top = 32 + object CheckBoxAffFD: TCheckBox + Left = 8 + Top = 112 + Width = 193 + Height = 17 + Caption = 'Fronts descendants des d'#233'tecteurs' + Color = cl3DLight + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 4 + OnClick = CheckBoxAffFDClick + end + object CheckBoxAffDebDecSig: TCheckBox + Left = 8 + Top = 80 + Width = 193 + Height = 17 + Caption = 'Pilotage des d'#233'codeurs de signaux' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 5 + OnClick = CheckBoxAffDebDecSigClick + end + object EditDebugSignal: TEdit + Left = 168 + Top = 12 Width = 33 Height = 21 - Hint = 'Indiquer l'#39'adresse du signal ' - ParentShowHint = False - ShowHint = True - TabOrder = 2 - end - object ButtonCP: TButton - Left = 152 - Top = 16 - Width = 81 - Height = 49 - Caption = 'Etat 3 cantons pr'#233'c'#233'dents signal' - TabOrder = 3 - WordWrap = True - OnClick = ButtonCPClick - end - object Button2: TButton - Left = 248 - Top = 16 - Width = 57 - Height = 49 - Caption = 'Cond Carr'#233' aiguillages' - TabOrder = 4 - WordWrap = True - OnClick = Button2Click - end - end - object GroupBox4: TGroupBox - Left = 8 - Top = 96 - Width = 353 - Height = 81 - Caption = 'D'#233'tecteur/'#233'l'#233'ment suivant' - TabOrder = 1 - object ButtonDetSuiv: TButton - Left = 16 - Top = 16 - Width = 185 - Height = 25 Hint = - 'Renvoie le d'#233'tecteur suivant aux deux '#233'l'#233'ments (d'#233'tecteurs ou ai' + - 'guillages) ' - Caption = 'D'#233'tecteur suivant aux '#233'l'#233'ments' + 'Adresse du signal seul '#224' surveiller ou si 0 surveille tous les s' + + 'ignaux' ParentShowHint = False ShowHint = True - TabOrder = 0 - OnClick = ButtonDetSuivClick + TabOrder = 6 + OnChange = EditDebugSignalChange end - object EditPrec: TEdit - Left = 208 - Top = 34 - Width = 49 - Height = 21 - Hint = 'Element pr'#233'c'#233'dent' + object CheckBoxTiers: TCheckBox + Left = 8 + Top = 64 + Width = 273 + Height = 17 + Hint = + 'N'#233'cessite d'#39'activer les services "signaux" et "position des trai' + + 'ns" dans la configuration g'#233'n'#233'rale' + Caption = 'Ev'#232'vements tiers (signaux et position des trains)' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False ParentShowHint = False ShowHint = True - TabOrder = 1 + TabOrder = 7 + OnClick = CheckBoxTiersClick end - object EditActuel: TEdit - Left = 264 - Top = 34 - Width = 49 - Height = 21 - Hint = 'Element actuel' - ParentShowHint = False - ShowHint = True - TabOrder = 2 - end - object ButtonElSuiv: TButton - Left = 16 + object CheckBox1: TCheckBox + Left = 8 Top = 48 - Width = 185 - Height = 25 - Hint = - 'Renvoie l'#39#233'l'#233'ment suivant aux deux '#233'l'#233'ments contigus (d'#233'tecteurs' + - ' ou aiguillages) ' - Caption = 'Element suivant aux '#233'l'#233'ments' + Width = 177 + Height = 17 + Caption = 'Duplication Fen'#234'tre evts vers log' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 8 + OnClick = CheckBox1Click + end + object CheckDebugTCO: TCheckBox + Left = 248 + Top = 128 + Width = 121 + Height = 17 + Alignment = taLeftJustify + Caption = 'Debug TCO' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 9 + OnClick = CheckDebugTCOClick + end + object CheckDetSIg: TCheckBox + Left = 248 + Top = 112 + Width = 121 + Height = 17 + Hint = 'Affichage des '#233'v'#232'nements d'#233'tecteurs et signaux avec tick' + Alignment = taLeftJustify + Caption = 'Det et signaux' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False ParentShowHint = False ShowHint = True - TabOrder = 3 - OnClick = ButtonElSuivClick + TabOrder = 10 + OnClick = CheckDetSIgClick + end + object CheckBoxPrinc: TCheckBox + Left = 248 + Top = 96 + Width = 121 + Height = 17 + Alignment = taLeftJustify + Caption = 'Proc Principales' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 11 + OnClick = CheckBoxPrincClick end end - end - object GroupBox2: TGroupBox - Left = 460 - Top = 3 - Width = 384 - Height = 149 - Anchors = [akTop, akRight] - Caption = 'S'#233'lections d'#39'affichage' - Color = cl3DLight - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlue - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentColor = False - ParentFont = False - TabOrder = 8 - object CheckAffSig: TCheckBox - Left = 8 - Top = 16 - Width = 161 - Height = 17 - Caption = 'Fonctionnement des signaux' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 0 - OnClick = CheckAffSigClick - end - object CheckBoxEvtDetAig: TCheckBox - Left = 8 - Top = 32 - Width = 289 - Height = 17 - Caption = 'Ev'#232'nements d'#233'tecteurs, aiguillages et actionneurs' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 1 - OnClick = CheckBoxEvtDetAigClick - end - object CheckBoxTraceLIste: TCheckBox - Left = 8 - Top = 128 - Width = 185 - Height = 17 - Caption = 'Evaluations des routes des trains' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 2 - OnClick = CheckBoxTraceLIsteClick - end - object CheckTrame: TCheckBox - Left = 8 - Top = 96 - Width = 233 - Height = 17 - Hint = - 'Affiche les trames de la centrale XpressNet ou les trames CDM-Ra' + - 'il (COM_IP)' - Caption = 'Trames '#233'chang'#233'es avec l'#39'interface ou CDM' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 3 - OnClick = CheckTrameClick - end - object CheckBoxAffFD: TCheckBox - Left = 8 - Top = 112 - Width = 193 - Height = 17 - Caption = 'Fronts descendants des d'#233'tecteurs' - Color = cl3DLight - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentColor = False - ParentFont = False - TabOrder = 4 - OnClick = CheckBoxAffFDClick - end - object CheckBoxAffDebDecSig: TCheckBox - Left = 8 - Top = 80 - Width = 193 - Height = 17 - Caption = 'Pilotage des d'#233'codeurs de signaux' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 5 - OnClick = CheckBoxAffDebDecSigClick - end - object EditDebugSignal: TEdit - Left = 168 - Top = 12 - Width = 33 - Height = 21 - Hint = - 'Adresse du signal seul '#224' surveiller ou si 0 surveille tous les s' + - 'ignaux' - ParentShowHint = False - ShowHint = True - TabOrder = 6 - OnChange = EditDebugSignalChange - end - object CheckBoxTiers: TCheckBox - Left = 8 - Top = 64 - Width = 273 - Height = 17 - Hint = - 'N'#233'cessite d'#39'activer les services "signaux" et "position des trai' + - 'ns" dans la configuration g'#233'n'#233'rale' - Caption = 'Ev'#232'vements tiers (signaux et position des trains)' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 7 - OnClick = CheckBoxTiersClick - end - object CheckBox1: TCheckBox - Left = 8 - Top = 48 - Width = 177 - Height = 17 - Caption = 'Duplication Fen'#234'tre evts vers log' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 8 - OnClick = CheckBox1Click - end - object CheckDebugTCO: TCheckBox - Left = 256 - Top = 128 - Width = 121 - Height = 17 - Alignment = taLeftJustify - Caption = 'Debug TCO' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 9 - OnClick = CheckDebugTCOClick - end - object CheckDetSIg: TCheckBox - Left = 256 - Top = 112 - Width = 121 - Height = 17 - Hint = 'Affichage des '#233'v'#232'nements d'#233'tecteurs et signaux avec tick' - Alignment = taLeftJustify - Caption = 'Det et signaux' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 10 - OnClick = CheckDetSIgClick - end - object CheckBoxPrinc: TCheckBox - Left = 256 - Top = 96 - Width = 121 - Height = 17 - Alignment = taLeftJustify - Caption = 'Proc Principales' - Font.Charset = DEFAULT_CHARSET - Font.Color = clBlack - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - TabOrder = 11 - OnClick = CheckBoxPrincClick - end - end - object RichDebug: TRichEdit - Left = 8 - Top = -9 - Width = 445 - Height = 685 - Anchors = [akLeft, akTop, akRight, akBottom] - Lines.Strings = ( - 'RichDebug') - PopupMenu = PopupMenuRD - ScrollBars = ssBoth - TabOrder = 9 - OnChange = RichDebugChange - end - object GroupBox5: TGroupBox - Left = 468 - Top = 471 - Width = 372 - Height = 57 - Anchors = [akTop, akRight] - Caption = 'Simulation d'#233'tecteur / actionneur' - Color = cl3DLight - Font.Charset = DEFAULT_CHARSET - Font.Color = clNavy - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentColor = False - ParentFont = False - TabOrder = 10 - object EditSimuDet: TEdit - Left = 16 - Top = 24 - Width = 33 - Height = 21 - Hint = 'Adresse d'#39'un d'#233'tecteur' - ParentShowHint = False - ShowHint = True - TabOrder = 0 - end - object ButtonSimuDet0: TButton - Left = 72 - Top = 16 - Width = 65 - Height = 33 - Caption = 'D'#233'tecteur '#224' 0' - TabOrder = 1 - WordWrap = True - OnClick = ButtonSimuDet0Click - end - object ButtonSimuDet1: TButton - Left = 152 - Top = 16 - Width = 65 - Height = 33 - Caption = 'D'#233'tecteur '#224' 1' - TabOrder = 2 - WordWrap = True - OnClick = ButtonSimuDet1Click - end - object ButtonSimuAct0: TButton - Left = 224 - Top = 16 - Width = 65 - Height = 33 - Caption = 'Actionneur '#224' 0' - TabOrder = 3 - WordWrap = True - OnClick = ButtonSimuAct0Click - end - object ButtonSimuAct1: TButton - Left = 296 - Top = 16 - Width = 65 - Height = 33 - Caption = 'Actionneur '#224' 1' - TabOrder = 4 - WordWrap = True - OnClick = ButtonSimuAct1Click - end - end - object ButtonRazTout: TButton - Left = 463 - Top = 159 - Width = 97 - Height = 25 - Hint = - 'Supprime les trains d'#233'tect'#233's ou en cas de nouveau RUN, permet de' + - ' partir de 0' - Anchors = [akTop, akRight] - Caption = 'RAZ tous trains' - ParentShowHint = False - ShowHint = True - TabOrder = 11 - OnClick = ButtonRazToutClick - end - object GroupBox6: TGroupBox - Left = 468 - Top = 535 - Width = 372 - Height = 41 - Anchors = [akTop, akRight] - Caption = 'Sorties' - Color = cl3DLight - Font.Charset = DEFAULT_CHARSET - Font.Color = clNavy - Font.Height = -11 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentColor = False - ParentFont = False - TabOrder = 12 - object Label3: TLabel - Left = 16 - Top = 16 - Width = 38 - Height = 13 - Caption = 'Adresse' - end - object Label5: TLabel - Left = 104 - Top = 16 - Width = 27 - Height = 13 - Caption = 'Sortie' - end - object EditAdresse: TEdit - Left = 64 - Top = 10 - Width = 33 - Height = 21 - Hint = 'Adresse d'#39'accessoire' - ParentShowHint = False - ShowHint = True - TabOrder = 0 - end - object EditSortie: TEdit - Left = 136 - Top = 10 - Width = 25 - Height = 21 - Hint = 'Sortie 1 ou 2' - ParentShowHint = False - ShowHint = True - TabOrder = 1 - end - object Button1: TButton - Left = 224 + object EditNivDebug: TEdit + Left = 819 Top = 8 Width = 49 - Height = 25 - Hint = - 'Mise '#224' 1 de la sortie - attention peut d'#233'truire les moteurs '#224' bo' + - 'bine' - Caption = 'Mise '#224' 1' - ParentShowHint = False - ShowHint = True - TabOrder = 2 - OnClick = Button1Click + Height = 21 + Anchors = [akTop, akRight] + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 13 + Text = 'EditNivDebug' + OnKeyPress = EditNivDebugKeyPress end - object Button0: TButton - Left = 280 - Top = 8 - Width = 49 - Height = 25 - Hint = 'Mise '#224' 0 de la sortie' - Caption = 'Mise '#224' 0' - ParentShowHint = False - ShowHint = True - TabOrder = 3 - OnClick = Button0Click - end - end - object MemoEvtDet: TRichEdit - Left = 565 - Top = 157 - Width = 280 - Height = 307 - Anchors = [akTop, akRight] - Color = clBlack - ScrollBars = ssVertical - TabOrder = 13 - OnChange = MemoEvtDetChange end object SaveDialog: TSaveDialog - Left = 760 - Top = 472 + Left = 752 + Top = 72 end object PopupMenuRE: TPopupMenu - Left = 768 - Top = 432 + Left = 752 + Top = 32 object copier1: TMenuItem Caption = 'copier' end end object PopupMenuRD: TPopupMenu - Left = 808 - Top = 360 + Left = 752 + Top = 104 object Copier2: TMenuItem Caption = 'Copier' OnClick = Copier2Click diff --git a/UnitDebug.pas b/UnitDebug.pas index 5a3fbfc..db2ed19 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -8,19 +8,47 @@ uses type TFormDebug = class(TForm) - EditNivDebug: TEdit; - Label1: TLabel; - LabelTitreDebug: TLabel; SaveDialog: TSaveDialog; - ButtonEcrLog: TButton; - ButtonRazTampon: TButton; - ButtonCherche: TButton; - ButtonAffEvtChrono: TButton; - ButtonCop: TButton; PopupMenuRE: TPopupMenu; copier1: TMenuItem; + PopupMenuRD: TPopupMenu; + Copier2: TMenuItem; + ScrollBoxDebug: TScrollBox; + RichDebug: TRichEdit; + ButtonRazTout: TButton; + ButtonCop: TButton; + ButtonAffEvtChrono: TButton; + ButtonCherche: TButton; + ButtonEcrLog: TButton; + ButtonRazTampon: TButton; ButtonRazLog: TButton; - GroupBox1: TGroupBox; + MemoEvtDet: TRichEdit; + GroupBox5: TGroupBox; + EditSimuDet: TEdit; + ButtonSimuDet0: TButton; + ButtonSimuDet1: TButton; + ButtonSimuAct0: TButton; + ButtonSimuAct1: TButton; + GroupBox6: TGroupBox; + Label3: TLabel; + Label5: TLabel; + EditAdresse: TEdit; + EditSortie: TEdit; + Button1: TButton; + Button0: TButton; + GroupBoxPrim: TGroupBox; + GroupBox3: TGroupBox; + Label4: TLabel; + ButtonSigSuiv: TButton; + ButtonCanSuivSig: TButton; + EditSigSuiv: TEdit; + ButtonCP: TButton; + Button2: TButton; + GroupBox4: TGroupBox; + ButtonDetSuiv: TButton; + EditPrec: TEdit; + EditActuel: TEdit; + ButtonElSuiv: TButton; GroupBox2: TGroupBox; CheckAffSig: TCheckBox; CheckBoxEvtDetAig: TCheckBox; @@ -28,42 +56,16 @@ type CheckTrame: TCheckBox; CheckBoxAffFD: TCheckBox; CheckBoxAffDebDecSig: TCheckBox; - GroupBox3: TGroupBox; - ButtonSigSuiv: TButton; - ButtonCanSuivSig: TButton; - EditSigSuiv: TEdit; - Label4: TLabel; - GroupBox4: TGroupBox; - ButtonDetSuiv: TButton; - EditPrec: TEdit; - EditActuel: TEdit; - ButtonCP: TButton; - Button2: TButton; - RichDebug: TRichEdit; - PopupMenuRD: TPopupMenu; - Copier2: TMenuItem; - GroupBox5: TGroupBox; - ButtonSimuDet0: TButton; - ButtonSimuDet1: TButton; - EditSimuDet: TEdit; - ButtonRazTout: TButton; EditDebugSignal: TEdit; CheckBoxTiers: TCheckBox; - ButtonSimuAct0: TButton; - ButtonSimuAct1: TButton; - ButtonElSuiv: TButton; CheckBox1: TCheckBox; CheckDebugTCO: TCheckBox; - GroupBox6: TGroupBox; - EditAdresse: TEdit; - Label3: TLabel; - Label5: TLabel; - EditSortie: TEdit; - Button1: TButton; - Button0: TButton; - MemoEvtDet: TRichEdit; CheckDetSIg: TCheckBox; CheckBoxPrinc: TCheckBox; + LabelTitreDebug: TLabel; + Label1: TLabel; + EditNivDebug: TEdit; + ButtonAigDevie: TButton; procedure FormCreate(Sender: TObject); procedure ButtonEcrLogClick(Sender: TObject); procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char); @@ -103,6 +105,8 @@ type procedure MemoEvtDetChange(Sender: TObject); procedure CheckDetSIgClick(Sender: TObject); procedure CheckBoxPrincClick(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure ButtonAigDevieClick(Sender: TObject); private { Déclarations privées } public @@ -172,7 +176,10 @@ begin for i:=0 to ComponentCount-1 do begin c:=Components[i]; - composant(c,couleurFond,couleurTexte); + if c is tScrollBox then + begin + (c as tScrollBox).Color:=color; + end; end; end; end; @@ -193,16 +200,38 @@ end; procedure TFormDebug.FormCreate(Sender: TObject); var s: string; begin - if affevt then affiche('FormDebug create',clLime); - if debug=1 then Affiche('Création fenêtre debug',clLime); + if affevt or (debug=1) then affiche('FormDebug create',clLime); EditNivDebug.Text:='0'; RichDebug.WordWrap:=false; // interdit la coupure des chaînes en limite du composant RichDebug.color:=$33; + //constraints.MaxHeight:=800; // taille Y maxi initform:=false; + visible:=false; RichDebug.clear; s:=DateToStr(date)+' '+TimeToStr(Time)+' '; - Autoscroll:=true; // permet l'affichage de l'ascenseur dans radstudio + // l'ascenseur de la fenetre dans D11 ------------ + // ne fonctionne que si le style est windows !!! (bug du VCL) + // obligé d'utiliser une scrollBox + DebugAffiche:=true; + + RichDebug.Height:=scrollBoxdebug.Height-30; + RichDebug.Anchors:=[akLeft,akTop,akRight,akBottom]; + + with scrollBoxdebug do + begin + Anchors:=[akLeft,akTop,akRight,akBottom]; + VertScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si on clique sur la trackbar!! + VertScrollBar.Tracking:=true; + HorzScrollBar.Visible:=false; + autoScroll:=true; + autoSize:=false; + end; + + checkTrame.hint:='Affiche les trames de la centrale XpressNet'+#13+'ou les trames CDM-Rail (COM_IP)'; + checkBoxTiers.hint:='Nécessite d''activer les services'+#13+'"signaux" et "position des trains"'+#13+ + 'dans la configuration générale'; + compt_erreur:=0; LigneErreur:=0; if debug=1 then Affiche('Fin création fenêtre debug',clLime); @@ -213,6 +242,13 @@ begin couleurs_debug; end; +procedure TFormDebug.FormActivate(Sender: TObject); +begin + if affevt then affiche('FormDebug activate',clLime); + formDebug.buttonCP.Caption:='Etat '+intToSTR(Nb_cantons_Sig)+' cantons précédents signal'; +end; + + procedure TFormDebug.ButtonEcrLogClick(Sender: TObject); var s : string; i : integer; @@ -377,10 +413,11 @@ end; procedure TFormDebug.ButtonSigSuivClick(Sender: TObject); var adr,erreur,ancdebug,AdrSigSuivant : integer ; begin + Val(EditSigSuiv.Text,adr,erreur); + if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; - Val(EditSigSuiv.Text,adr,erreur); - if (erreur<>0) and (adr>0) then etat_signal_suivant(Adr,1,AdrSigSuivant) ; + etat_signal_suivant(Adr,1,AdrSigSuivant) ; NivDebug:=AncDebug; end; @@ -393,26 +430,26 @@ begin NivDebug:=3; s1:=EditPrec.Text; s2:=EditActuel.Text; - if (s1='') or (s2='') then exit; + if (s1='') or (s2='') then begin NivDebug:=AncDebug;exit;end; if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det; if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det; Val(s1,prec,erreur); - if (erreur<>0) or (prec<1) then exit; + if (erreur<>0) or (prec<1) then begin NivDebug:=AncDebug;exit;end; Val(s2,Actuel,erreur); - if (erreur<>0) or (actuel<1) then exit; + if (erreur<>0) or (actuel<1) then begin NivDebug:=AncDebug;exit;end; Adr:=detecteur_suivant_El(prec,type1,actuel,type2,1); if Adr<9996 then AfficheDebug('Le détecteur suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel)+' est '+IntToSTR(Adr),clyellow) - else AfficheDebug('Pas trouvé de détecteur suvant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); + else AfficheDebug('Pas trouvé de détecteur suvant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); NivDebug:=AncDebug; end; procedure TFormDebug.ButtonCanSuivSigClick(Sender: TObject); var Adr,erreur,ancdebug : integer ; begin + Val(EditSigSuiv.Text,Adr,erreur); + if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; - Val(EditSigSuiv.Text,Adr,erreur); - if (erreur=0) or (adr<1) then exit; if test_memoire_zones(Adr) then AfficheDebug('Présence train',clYellow) else AfficheDebug('Absence train',clyellow); NivDebug:=AncDebug; @@ -516,13 +553,13 @@ begin NivDebug:=3; s1:=EditPrec.Text; s2:=EditActuel.Text; - if (s1='') or (s2='') then exit; + if (s1='') or (s2='') then begin NivDebug:=AncDebug;exit;end; if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det; if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det; Val(s1,prec,erreur); - if (erreur<>0) or (prec<1) then exit; + if (erreur<>0) or (prec<1) then begin NivDebug:=AncDebug;exit;end;; Val(s2,Actuel,erreur); - if (erreur<>0) or (actuel<1) then exit; + if (erreur<>0) or (actuel<1) then begin NivDebug:=AncDebug;exit;end;; Adr:=suivant_Alg3(prec,type1,actuel,type2,1); if Adr<9995 then begin @@ -548,8 +585,8 @@ procedure TFormDebug.Button1Click(Sender: TObject); var adr,sortie,erreur,groupe : integer; fonction : byte; s : string; -begin - val(EditAdresse.text,adr,erreur); +begin + val(EditAdresse.text,adr,erreur); if (erreur<>0) or (adr<1) or (adr>2048) then begin EditAdresse.text:='1'; @@ -587,15 +624,15 @@ begin if protocole=2 then AfficheDebug('D10: Commande DCC++ pas encore implantée',clred); end; - Self.ActiveControl:=nil; -end; - + Self.ActiveControl:=nil; +end; + procedure TFormDebug.Button0Click(Sender: TObject); -var adr,sortie,erreur,groupe : integer; +var adr,sortie,erreur,groupe : integer; fonction : byte; s : string; -begin - val(EditAdresse.text,adr,erreur); +begin + val(EditAdresse.text,adr,erreur); if (erreur<>0) or (adr<1) or (adr>2048) then begin EditAdresse.text:='1'; @@ -633,35 +670,49 @@ begin if protocole=2 then AfficheDebug('D11: Commande DCC++ pas encore implantée',clred) end; - Self.ActiveControl:=nil; -end; - + Self.ActiveControl:=nil; +end; + procedure TFormDebug.FormKeyPress(Sender: TObject; var Key: Char); -begin - if key=chr(27) then close; -end; - -procedure TFormDebug.FormActivate(Sender: TObject); -begin - if affevt then affiche('FormConfig activate',clLime); - formDebug.buttonCP.Caption:='Etat '+intToSTR(Nb_cantons_Sig)+' cantons précédents signal'; -end; - +begin + if key=chr(27) then close; +end; + procedure TFormDebug.MemoEvtDetChange(Sender: TObject); -begin - SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0); -end; - +begin + SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0); +end; + procedure TFormDebug.CheckDetSIgClick(Sender: TObject); -begin - AFfDetSIg:=checkDetSig.checked; -end; - +begin + AFfDetSIg:=checkDetSig.checked; +end; + procedure TFormDebug.CheckBoxPrincClick(Sender: TObject); -begin - ProcPrinc:=checkBoxPrinc.checked; -end; +begin + ProcPrinc:=checkBoxPrinc.checked; +end; + + + +procedure TFormDebug.Button3Click(Sender: TObject); +begin + ScrollBoxDebug.VertScrollBar.Position:=0; +end; + + +procedure TFormDebug.ButtonAigDevieClick(Sender: TObject); +var Adr,erreur,ancDebug : integer; +begin + Val(EditSigSuiv.Text,Adr,erreur); + if (erreur<>0) or (Adr<1) then exit; + ancdebug:=NivDebug; + NivDebug:=3; + Aiguille_deviee(Adr); + NivDebug:=AncDebug; + end; + end. diff --git a/UnitPilote.pas b/UnitPilote.pas index 387ba3e..421fec4 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -289,6 +289,7 @@ end; procedure TFormPilote.FormCreate(Sender: TObject); begin + if affevt then affiche('FormPilote create',clLime); position:=poMainFormCenter; couleurs_pilote; end; @@ -331,6 +332,7 @@ procedure TFormPilote.FormActivate(Sender: TObject); var n,i,d : integer; begin // mise à jour du champ décodeur + if affevt then affiche('FormPilote activate',clLime); i:=Index_Signal(AdrPilote); d:=Signaux[i].decodeur; n:=Signaux[i].aspect; diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index aad98c0..478466b 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,11 +1,10 @@ object FormPrinc: TFormPrinc - Left = 27 - Top = 202 + Left = 180 + Top = 135 + Width = 1148 + Height = 618 Anchors = [akLeft, akTop, akRight] - BorderStyle = bsSingle - Caption = 'Signaux complexes' - ClientHeight = 648 - ClientWidth = 1133 + Caption = 'SIgnaux complexes' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -21,13 +20,13 @@ object FormPrinc: TFormPrinc OnCreate = FormCreate OnResize = FormResize DesignSize = ( - 1133 - 648) + 1132 + 560) PixelsPerInch = 96 TextHeight = 13 object LabelTitre: TLabel Left = 8 - Top = 10 + Top = 2 Width = 173 Height = 18 Caption = 'Signaux complexes GL' @@ -1431,8 +1430,8 @@ object FormPrinc: TFormPrinc end object StatusBar1: TStatusBar Left = 0 - Top = 626 - Width = 1133 + Top = 538 + Width = 1132 Height = 22 Panels = < item @@ -1458,24 +1457,14 @@ object FormPrinc: TFormPrinc end> OnDrawPanel = StatusBar1DrawPanel end - object MSCommUSBInterface: TMSComm - Left = 1064 - Top = 200 - Width = 32 - Height = 32 - OnComm = MSCommUSBInterfaceComm - ControlData = { - 2143341208000000ED030000ED03000001568A64000006000000010000040000 - 00020000802500000000080000000000000000003F00000011000000} - end object Button1: TButton - Left = 744 + Left = 751 Top = 16 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = 'Button1' - TabOrder = 2 + TabOrder = 1 Visible = False OnClick = Button1Click end @@ -1484,7 +1473,7 @@ object FormPrinc: TFormPrinc Top = 56 Width = 1057 Height = 476 - TabOrder = 3 + TabOrder = 2 DesignSize = ( 1057 476) @@ -1982,8 +1971,8 @@ object FormPrinc: TFormPrinc end end object GroupBoxCV: TGroupBox - Left = 481 - Top = -8 + Left = 665 + Top = -24 Width = 265 Height = 129 Anchors = [akTop, akRight] @@ -2044,26 +2033,6 @@ object FormPrinc: TFormPrinc end end end - object MSCommCde1: TMSComm - Left = 1064 - Top = 280 - Width = 32 - Height = 32 - OnComm = MSCommCde1Comm - ControlData = { - 2143341208000000ED030000ED03000001568A64000006000000010000040000 - 00020000802500000000080000000000000000003F00000001000000} - end - object MSCommCde2: TMSComm - Left = 1064 - Top = 312 - Width = 32 - Height = 32 - OnComm = MSCommCde2Comm - ControlData = { - 2143341208000000ED030000ED03000001568A64000006000000010000040000 - 00020000802500000000080000000000000000003F00000001000000} - end object Timer1: TTimer Interval = 100 OnTimer = Timer1Timer diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 2ff5669..c32a670 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,5 +1,5 @@ Unit UnitPrinc; -// 16/2 16h +// 04/3 20h (******************************************** Programme signaux complexes Graphique Lenz Delphi 7 + activeX Tmscomm + clientSocket @@ -8,7 +8,10 @@ Unit UnitPrinc; sinon une exception surgira au moment de l'ouverture du com Dans projet/option/fiches : fiches disponibles : formtco uniquement ******************************************** - Pour tmscomm : impossible de générer une instance dynamiquement (avec CreateOleObject) à cause de la licence + + Pour 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) Attention si le répertoire d'install n'est pas autorisé, windows10-11 va sauver les fichiers dans C:\Users\moi\AppData\Local\VirtualStore\Program Files (x86)\Signaux_complexes @@ -63,7 +66,7 @@ uses Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB, MMSystem , Buttons, NB30, comObj, activeX - {$IF CompilerVersion >= 28.0} + {$IF CompilerVersion >= 28.0} // si delphi>=11 ,Vcl.Themes {$IFEND} ; @@ -81,7 +84,6 @@ type MenuConnecterEthernet: TMenuItem; MenuDeconnecterEthernet: TMenuItem; StatusBar1: TStatusBar; - MSCommUSBInterface: TMSComm; Afficher1: TMenuItem; Etatdesdtecteurs1: TMenuItem; Etatdesaiguillages1: TMenuItem; @@ -219,8 +221,6 @@ type Affichagenormal1: TMenuItem; N14: TMenuItem; Sauvegarderla1: TMenuItem; - MSCommCde1: TMSComm; - MSCommCde2: TMSComm; ClientSocketCde1: TClientSocket; ClientSocketCde2: TClientSocket; EditEnvoi: TEdit; @@ -231,8 +231,9 @@ type ServerSocket: TServerSocket; Listedesclientsconnects1: TMenuItem; procedure FormCreate(Sender: TObject); - procedure MSCommUSBInterfaceComm(Sender: TObject); - + procedure RecuInterface(Sender: TObject); + procedure RecuPeriph1(Sender: TObject); + procedure RecuPeriph2(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure ButtonDroitClick(Sender: TObject); @@ -345,9 +346,7 @@ type procedure Sauvegarderla1Click(Sender: TObject); procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); - procedure MSCommCde1Comm(Sender: TObject); - procedure MSCommCde2Comm(Sender: TObject); - procedure ClientSocketCde1Connect(Sender: TObject; + procedure ClientSocketCde1Connect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocketCde1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; @@ -375,7 +374,7 @@ type { Déclarations privées } procedure DoHint(Sender : Tobject); public - { Déclarations publiques } + { Déclarations publiques des composants dynamiques} Procedure ImageOnClick(Sender : TObject); procedure ProcOnMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure proc_checkBoxFB(Sender : Tobject); @@ -460,6 +459,7 @@ EtatSignBelge: array[0..9] of string[30]= type +Tinterface = (_interface,periph1,periph2); // interface USB : interface vers centrale, périphérique 1 ou 2 Taccessoire = (aigP,signal); // aiguillage ou signal TEquipement = (rien,aig,tjd,tjs,triple,det,buttoir,voie,crois,act); // voie uniquement pour le tco TBranche = record @@ -551,19 +551,19 @@ TSignal = record SR : array[1..19] of record // configuration des sorties du décodeur Stéphane Ravaut ou digikeijs ou cdf pour chacun des 19 états sortie1,sortie0 : integer; // ex SR[1]=[carre] (voir tableau Etats) end; - Na : integer; // nombre d'adresses du feu occupées par le décodeur CDF/digikeijs/Belge + Na : integer; // nombre d'adresses du signal occupées par le décodeur CDF/SR/digikeijs/Belge DetAmont : TtabloDet; // tableau des détecteurs amonts, calculés à la lecture du fichier de config end; - TPeripherique = record - nom : string; - NumCom : integer; // numéro de port COM si c'est une liaison com usb - numComposant : integer ; // numéro de composant MSCOM ou clientSocket - ScvAig,ScvDet,ScvAct,ScvVis,cr : boolean ; // services, visible, avecCR - protocole: string; +TPeripherique = record + nom : string; // nom du périphérique + NumCom : integer; // numéro de port COM si c'est une liaison com usb + portouvert : boolean; // si le port COM est ouvert + numComposant : integer ; // numéro de composant MSCOM ou clientSocket + ScvAig,ScvDet,ScvAct,ScvVis,cr,dtr,rts : boolean ; // services, visible, avecCR ... + protocole,tamponRX : string; // protocole COM ou socket, tanpon de réception end; - var maxaiguillage,detecteur_chgt,Temps,Tempo_init,Suivant,ntrains,MaxPortCom, N_Cv,index_simule,NDetecteurs,N_Trains,N_routes,espY,Tps_affiche_retour_dcc, @@ -591,6 +591,8 @@ var tick,Premier_tick : longint; + MSCommUSBInterface,MsCommCde1,MsCommCde2 : TMSComm; + CDMhd : THandle; FormPrinc: TFormPrinc; @@ -614,13 +616,6 @@ var x0,y0,larg,haut : integer; end; - // tableau des ports COM des périphériqies - Tablo_com_cde : array[1..NbMaxi_Periph] of record - portOuvert: boolean; - NumPeriph: integer; // numéro périphérique USB - tamponRx : string; - end; - Liste_clients : array[0..IdClients] of record adresse : string; PortDistant,PortLocal : integer; @@ -814,7 +809,7 @@ procedure Affiche(s : string;lacouleur : TColor); procedure envoi_signal(Adr : integer); procedure pilote_direction(Adr,nbre : integer); procedure connecte_USB; -function connecte_port_usb_periph(index : integer) : boolean; +function connecte_usb_periph(index : integer) : boolean; procedure deconnecte_usb_periph(index : integer); function connecte_socket_periph(index : integer) : boolean; procedure deconnecte_socket_periph(index : integer); @@ -880,6 +875,7 @@ procedure AffTexteIncliBordeTexture(c : TCanvas; x,y : integer; Fonte : tFont; procedure change_style; function isDirectionnel(index : integer) : boolean; procedure stop_trains; +function Aiguille_deviee(adresse : integer) : integer ; implementation @@ -934,6 +930,49 @@ begin {$IFEND} end; +// envoi une chaine à un périphérique COM/USB en fonction de l'interface +// non utilisé +procedure envoi_usb(interf : Tinterface;s : string); +begin + case interf of + _interface : MSCommUSBInterface.Output:=s; + periph1 : MSCommCde1.Output:=s; + periph2 : MSCommCde2.Output:=s; + end; +end; + +// envoie une chaine s à un périphérique COM/USB en fonction du composant comp +// contrôle si le pointeur comp est valide par traitement de l'exception +procedure envoi_usb_comp(comp : Tmscomm;s : string); +var i : integer; +begin + if comp=nil then + begin + Affiche('Erreur 600X: le composant périphérique n''est pas créé',clred); + exit; + end; + + try + comp.output:=s; + except + on e : exception do + begin + Affiche(e.message+' COM'+intToSTR(comp.CommPort)+': déconnecté. Fermeture du port ',clred); + // passe à faux les indicateurs d'ouverture du port + if comp=MSCommUSBInterface then portCommOuvert:=false; + for i:=1 to NbMaxi_Periph do + begin + if (tablo_periph[i].numComposant=1) and (comp=MSCommCde1) then tablo_periph[i].portouvert:=false; + if (tablo_periph[i].numComposant=2) and (comp=MSCommCde2) then tablo_periph[i].portouvert:=false; + end; + // ferme le port + comp.PortOpen:=false; + Formprinc.StatusBar1.Panels[3].Text:=''; + end; + end; +end; + + procedure procetape(s : string); begin if debug<>2 then exit; @@ -2616,12 +2655,12 @@ begin //Application.ProcessMessages; inc(timeout); Sleep(20); - until (Formprinc.MSCommUSBInterface.CTSHolding=true) or (timeout>valto); + until (MSCommUSBInterface.CTSHolding=true) or (timeout>valto); if timeout<=valto then begin //if formprinc.MSCommUSBLenz.CTSHolding then sa:='CTS=1 ' else sa:='CTS=0 '; - FormPrinc.MSCommUSBInterface.Output:=s[i]; + envoi_usb_comp(MSCommUSBInterface,s[i]); if terminal then Affiche(chaine_hex(s[i]),clyellow); inc(i); end; @@ -2632,7 +2671,7 @@ begin // protocole Rts Cts ou sans temporisation if (prot_serie=2) or (tempoOctet=0) then begin - FormPrinc.MSCommUSBInterface.Output:=s; + envoi_usb_comp(MSCommUSBInterface,s); exit; end; @@ -2641,14 +2680,14 @@ begin begin for i:=1 to length(s) do begin - FormPrinc.MSCommUSBInterface.Output:=s[i]; + envoi_usb_comp(MSCommUSBInterface,s[i]); //Affiche(s[i],clyellow);// else Affiche(chaine_hex(s[i]),clyellow); Sleep(TempoOctet); end; end; if (prot_serie=0) then begin - FormPrinc.MSCommUSBInterface.Output:=s; + envoi_usb_comp(MSCommUSBInterface,s); Sleep(TempoOctet); end; end; @@ -3481,7 +3520,8 @@ envoie les donn procedure envoi_SR(adresse : integer); var code : word; - index,i,etat : integer; + index,i,etat,nAdr : integer; + s0,s1 : boolean; s : string; begin index:=Index_Signal(adresse); @@ -3499,27 +3539,56 @@ begin end; etat:=code_to_etat(code); - - //Affiche('Code a chercher='+IntToSTR(etat),clyellow); + nAdr:=Signaux[index].Na; if index<>0 then begin + { i:=0; // trouve l'index dans la configuration du signal correspondant à son état demandé repeat inc(i); - until (Signaux[index].SR[i].sortie1=etat) or (Signaux[index].SR[i].sortie0=etat) or (i=8); + s0:=etatsDefSR[i]=etat; + s1:=false; + // s1:=Signaux[index].SR[i].sortie1=etat; + // s0:=Signaux[index].SR[i].sortie0=etat; + until s0 or s1 or (i=8) or (i=nAdr); - if (Signaux[index].SR[i].sortie1=etat) then + if s0 then begin - //affiche('trouvé en sortie1 index '+IntToSTR(i),clyellow); - Pilote_acc(adresse+i-1,2,signal); + affiche('trouvé index '+IntToSTR(i-1),clyellow); + if index mod 2 = 0 then Pilote_acc(adresse+i-1,2,signal) else Pilote_acc(adresse+i-1,1,signal); end; - if (Signaux[index].SR[i].sortie0=etat) then + if s1 then begin - //affiche('trouvé en sortie0 index '+IntToSTR(i),clyellow); + affiche('trouvé en sortie1 index '+IntToSTR(i-1),clyellow); 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é dans sa configuration',clOrange); + } + + i:=0; + // trouve l'index dans la configuration du signal correspondant à son état demandé + repeat + inc(i); + s0:=Signaux[index].SR[i].sortie0=etat; + s1:=Signaux[index].SR[i].sortie1=etat; + until s1 or s0 or (i=8) or (i=nAdr); + + if s1 then + begin + //affiche('trouvé en sortie1 index '+IntToSTR(i),clyellow); + Pilote_acc(adresse+i-1,2,signal); + end; + if s0 then + begin + //affiche('trouvé en sortie0 index '+IntToSTR(i),clyellow); + 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); + end; end; end; @@ -4835,11 +4904,12 @@ begin // com USB v:=Tablo_periph[numacc].NumCom; // numéro de com if v=0 then exit; - if Tablo_com_cde[numacc].PortOuvert then + if tablo_periph[numacc].PortOuvert then begin cmd:=Tablo_periph[numacc].numComposant; - if cmd=1 then Formprinc.MSCommCde1.Output:=s; - if cmd=2 then Formprinc.MSCommCde2.Output:=s; + if cmd=1 then envoi_usb_comp(MSCommCde1,s); + if cmd=2 then envoi_usb_comp(MSCommCde2,s); + if Tablo_periph[numacc].ScvVis then Affiche('Envoi COM'+intToSTR(v)+': '+s,clYellow); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -4910,11 +4980,12 @@ begin // com USB v:=Tablo_periph[numacc].NumCom; // numéro de com if v=0 then exit; - if Tablo_com_cde[numacc].PortOuvert then + if tablo_periph[numacc].PortOuvert then begin cmd:=Tablo_periph[numacc].numComposant; - if cmd=1 then Formprinc.MSCommCde1.Output:=s; - if cmd=2 then Formprinc.MSCommCde2.Output:=s; + if cmd=1 then envoi_usb_comp(MSCommCde1,s); + if cmd=2 then envoi_usb_comp(MsCommCde2,s); + if Tablo_periph[numacc].ScvVis then Affiche('Envoi COM'+intToSTR(v)+': '+s,clYellow); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -5094,44 +5165,41 @@ begin Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adr,1); // allume les feux du signal dans le TCO - if TCOActive then + for indexTCO:=1 to NbreTCO do begin - for indexTCO:=1 to NbreTCO do + if PcanvasTCO[indexTCO]<>nil then begin - if formTCO[indexTCO]<>nil then + for y:=1 to NbreCellY[indexTCO] do + for x:=1 to NbreCellX[indexTCO] do begin - for y:=1 to NbreCellY[indexTCO] do - for x:=1 to NbreCellX[indexTCO] do + if TCO[indexTCO,x,y].Bimage=Id_signal then begin - if TCO[indexTCO,x,y].Bimage=Id_signal then + adresse:=TCO[IndexTCO,x,y].adresse; // vérifie si le signal existe dans le TCO + if adresse=adr then begin - adresse:=TCO[IndexTCO,x,y].adresse; // vérifie si le signal existe dans le TCO - if adresse=adr then - begin - aspect:=Signaux[Index_Signal(adresse)].Aspect; - case aspect of - 2 : ImageSignal:=Formprinc.Image2feux; - 3 : ImageSignal:=Formprinc.Image3feux; - 4 : ImageSignal:=Formprinc.Image4feux; - 5 : ImageSignal:=Formprinc.Image5feux; - 7 : ImageSignal:=Formprinc.Image7feux; - 9 : ImageSignal:=Formprinc.Image9feux; - 12 : ImageSignal:=Formprinc.Image2Dir; - 13 : ImageSignal:=Formprinc.Image3Dir; - 14 : ImageSignal:=Formprinc.Image4Dir; - 15 : ImageSignal:=Formprinc.Image5Dir; - 16 : ImageSignal:=Formprinc.Image6Dir; - 20 : ImageSignal:=formprinc.ImageSignal20; - else ImageSignal:=Formprinc.Image3feux; - end; - TailleY:=ImageSignal.picture.BitMap.Height; // taille du signal d'origine - TailleX:=ImageSignal.picture.BitMap.Width; - Orientation:=tco[indextco,x,y].FeuOriente; - // réduction variable en fonction de la taille des cellules - calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]); - // décalage en X pour mettre la tete du signal alignée sur le bord droit de la cellule pour les signaux tournés à 90G - Dessine_signal_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indextco,x,y].y,frx,fry,adresse,orientation); + aspect:=Signaux[Index_Signal(adresse)].Aspect; + case aspect of + 2 : ImageSignal:=Formprinc.Image2feux; + 3 : ImageSignal:=Formprinc.Image3feux; + 4 : ImageSignal:=Formprinc.Image4feux; + 5 : ImageSignal:=Formprinc.Image5feux; + 7 : ImageSignal:=Formprinc.Image7feux; + 9 : ImageSignal:=Formprinc.Image9feux; + 12 : ImageSignal:=Formprinc.Image2Dir; + 13 : ImageSignal:=Formprinc.Image3Dir; + 14 : ImageSignal:=Formprinc.Image4Dir; + 15 : ImageSignal:=Formprinc.Image5Dir; + 16 : ImageSignal:=Formprinc.Image6Dir; + 20 : ImageSignal:=formprinc.ImageSignal20; + else ImageSignal:=Formprinc.Image3feux; end; + TailleY:=ImageSignal.picture.BitMap.Height; // taille du signal d'origine + TailleX:=ImageSignal.picture.BitMap.Width; + Orientation:=tco[indextco,x,y].FeuOriente; + // réduction variable en fonction de la taille des cellules + calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]); + // décalage en X pour mettre la tete du signal alignée sur le bord droit de la cellule pour les signaux tournés à 90G + Dessine_signal_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indextco,x,y].y,frx,fry,adresse,orientation); end; end; end; @@ -5552,7 +5620,7 @@ begin if (alg and $4=$4) and (aiguillage[index].AdrTrain<>0) then begin if NivDebug=3 then AfficheDebug('230 - aiguillage '+intToSTR(adr)+' réservé par train @'+intToSTR(aiguillage[index].AdrTrain),clyellow); - suivant_alg3:=9997; + suivant_alg3:=9997; //. attention code incorrect devrait être 9994 exit; end; @@ -5820,6 +5888,13 @@ begin if aiguillage[index].position=const_devie then begin + if (alg and 8)=8 then + begin + typeGen:=rien; + AdrDevie:=Adr; + suivant_alg3:=9997; + exit; + end; if BtypePrec=Aig then begin if (aiguillage[index].Ddroit=prec) and @@ -5936,6 +6011,14 @@ begin if (aiguillage[index].position=const_devie) and (aiguillage[index2].position=const_droit) and tjdC then begin + if (alg and 8)=8 then + begin + typeGen:=rien; + AdrDevie:=Adr; + suivant_alg3:=9997; + exit; + end; + // d'où vient ton sur la tjd if BtypePrec=Aig then begin @@ -5971,7 +6054,8 @@ begin begin typeGen:=rien; AdrDevie:=Adr; - suivant_alg3:=9997;exit; + suivant_alg3:=9997; + exit; end; end else @@ -6004,9 +6088,15 @@ begin end; // cas 3 TJD - if (aiguillage[index].position=const_droit) - and (aiguillage[index2].position=const_devie) and tjdC then + if (aiguillage[index].position=const_droit) and (aiguillage[index2].position=const_devie) and tjdC then begin + if (alg and 8)=8 then + begin + typeGen:=rien; + AdrDevie:=Adr; + suivant_alg3:=9997; + exit; + end; // d'où vient t-on sur la tjd if BtypePrec=Aig then begin @@ -6448,7 +6538,7 @@ var suiv1,indexBranche_det1,indexBranche_det2,branche_det2,branche_det1, // prec=adresse de det ou aig ; suiv soit être une adresse d'aig // aig_suiv(527,7) : renvoie 520 dans suiv_2 // procédure récursive - procedure aig_suiv(prec,suiv : integer) ; + procedure aig_suiv(prec,suiv : integer); var adr2,index : integer; typ : Tequipement; begin @@ -6534,7 +6624,7 @@ var suiv1,indexBranche_det1,indexBranche_det2,branche_det2,branche_det1, begin dernier:=suiv; if afdeb then afficheDebug('trouvé ',clLime); - exit; + exit; end; if afdeb then afficheDebug('trouvé '+intToSTR(suiv_2)+' mais pas attendu('+intToSTR(det2)+')',clyellow) end; @@ -6624,7 +6714,7 @@ var suiv1,indexBranche_det1,indexBranche_det2,branche_det2,branche_det1, end; end; end; - end; // fin de la procédure aig_suiv + end; // fin de la procédure récursive aig_suiv begin @@ -6881,7 +6971,8 @@ var el1,el2,i,i2,index,it,voie : integer; else begin //Affiche(IntToSTR(el2),clLime); - tabloDet[index]:=el2;inc(index); + tabloDet[index]:=el2; + inc(index); end; end else @@ -6899,7 +6990,8 @@ var el1,el2,i,i2,index,it,voie : integer; else begin //Affiche(IntToSTR(el2),clLime); - tabloDet[index]:=el2;inc(index); + tabloDet[index]:=el2; + inc(index); end; end; end; @@ -7674,8 +7766,9 @@ begin if index<>0 then begin if nivDebug=3 then AfficheDebug('Contrôle aiguillage '+IntToSTR(AdrAig),clyellow); - resultatET:=((aiguillage[index].position=const_devie) and (Signaux[i].condFeuBlanc[l][k].PosAig='S') or (aiguillage[index].position=const_droit) and (Signaux[i].condFeuBlanc[l][k].PosAig='D')) - and resultatET; + resultatET:=( (aiguillage[index].position=const_devie) and (Signaux[i].condFeuBlanc[l][k].PosAig='S') or + (aiguillage[index].position=const_droit) and (Signaux[i].condFeuBlanc[l][k].PosAig='D') ) + and resultatET; end; end; //if resultatET then Affiche('VRAI',clyellow) else affiche('FAUX',clred); @@ -7687,7 +7780,7 @@ begin if NivDebug=3 then begin s:='Conditions supp. de feu blanc suivant aiguillages: '; - if ResultatOU then s:=s+'vrai : le signal doit afficher blanc' else s:=s+' : le signal ne doit pas afficher de feu blanc'; + if ResultatOU then s:=s+'le signal doit afficher blanc' else s:=s+'le signal ne doit pas afficher de feu blanc'; AfficheDebug(s,clyellow); end; cond_feuBlanc:=ResultatOU; @@ -7740,7 +7833,7 @@ begin if NivDebug=3 then begin s:='Conditions supp. de carré suivant aiguillages: '; - if ResultatOU then s:=s+'vrai : le signal doit afficher carré' else s:=s+'faux : le signal ne doit pas afficher de carré'; + if ResultatOU then s:=s+'le signal doit afficher carré' else s:=s+'le signal ne doit pas afficher de carré'; AfficheDebug(s,clyellow); end; cond_carre:=ResultatOU; @@ -8079,7 +8172,7 @@ begin else begin if NivDebug=3 then AfficheDebug('Sur même détecteur, trouvé signal2 '+intToSTR(AdrSignal)+' mais dans le mauvais sens',clOrange); - AdrSignal:=0; + AdrSignal:=0; end; end; end; @@ -8104,7 +8197,6 @@ begin end; - // renvoie l'état du signal suivant du signal "adresse". Si renvoie 0, pas trouvé le signal suivant. // adresse : adresse du signal // rang=1 pour signal suivant, 2 pour signal suivant le 1, etc @@ -8298,7 +8390,7 @@ var AdrSignal,i,j,prec,AdrSuiv,Actuel,index,index2,voie : integer; TypePrec,TypeActuel : TEquipement; s : string; begin - if NivDebug>=2 then AfficheDebug('Test si aiguille déviée après signal '+IntToSTR(Adresse),clyellow); + if NivDebug>=2 then AfficheDebug('Test si aiguille déviée après signal '+IntToSTR(Adresse),clOrange); j:=0; i:=Index_Signal(adresse); if i=0 then @@ -8343,16 +8435,16 @@ begin until (j=10) or (AdrSuiv>=9990) or (AdrSignal<>0) or (AdrSuiv=0) ; if (AdrSuiv=9997) then begin - s:='le signal '+intToSTR(adresse)+' doit afficher un rappel car l''aiguillage '+intToSTR(AdrDevie); + s:='Le signal '+intToSTR(adresse)+' doit afficher un rappel car l''aiguillage '+intToSTR(AdrDevie); s:=s+' est dévié'; - if NivDebug=3 then AfficheDebug(s,clYellow); + if NivDebug=3 then AfficheDebug(s,clWhite); end; if ((AdrSuiv<>9997) or (j=10)) and (NivDebug=3) then begin - S:='le signal '+intToSTR(adresse)+' ne doit pas afficher de rappel car '; - if j<>10 then s:=s+'trouvé un autre signal suivant et pas d''aiguillage dévié' + S:='Le signal '+intToSTR(adresse)+' ne doit pas afficher de rappel car '; + if j<>10 then s:=s+'trouvé un signal suivant ('+intToSTR(AdrSignal)+') et pas d''aiguillage dévié' else s:=s+' signal trop éloigné'; - AfficheDebug(s,clYellow); + AfficheDebug(s,clWhite); end; Aiguille_deviee:=AdrDevie; end; @@ -8913,7 +9005,7 @@ begin k:=1; repeat d:=Signaux[i].DetAmont[k]; - if d<>0 then + if (d>0) and (dnil then begin // désactivation Zone_TCO(tco,det1,det3,i,0); @@ -10048,15 +10140,12 @@ begin end; s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i); Affiche_Evt(s,clWhite); - if TCOActive then - begin - // activation - for tco:=1 to nbreTCO do - begin - if ModeCouleurCanton=0 then zone_TCO(tco,det1,det3,i,1) - else zone_TCO(tco,det1,det3,i,2); // affichage avec la couleur de index_couleur du train - end; - end; + // activation + for tco:=1 to nbreTCO do + begin + if ModeCouleurCanton=0 then zone_TCO(tco,det1,det3,i,1) + else zone_TCO(tco,det1,det3,i,2); // affichage avec la couleur de index_couleur du train + end; end; end; @@ -10198,7 +10287,7 @@ begin Affiche(s,clred); end; - // supprimer le 1er et décaler + // supprimer le 1er evt et décaler with event_det_train[i] do begin det[1].adresse:=event_det_train[i].det[2].adresse; @@ -10234,9 +10323,9 @@ begin AfficheDebug(intToSTR(event_det_train[i].det[1].adresse),couleur); AfficheDebug(intToSTR(event_det_train[i].det[2].adresse),couleur); end; - if TCOActive then + for tco:=1 to nbreTCO do begin - for tco:=1 to nbreTCO do + if PcanvasTCO[tco]<>nil then begin Maj_Aig_TCO(tco); zone_TCO(tco,det2,det3,i,0); // désactivation @@ -10308,9 +10397,6 @@ begin if det_suiv=9996 then affiche_evt('Erreur 2-1 position inconnue aiguillage ',clred) else Affiche_evt('Erreur 2-1 '+intToSTR(Det_Suiv)+' : pas de suivant detecteur_suivant_el '+intToSTR(det2)+' '+intToSTR(det3),clred); end; - // libère canton - // libere_canton(det2,det3); - // if TCOActive then for tco:=1 to nbreTCO do Maj_Aig_TCO(tco); // rafraichit les aiguillages déreservés end else begin @@ -10342,13 +10428,10 @@ begin Affiche_evt(s,couleur); if traceListe then AfficheDebug(s,Couleur); if AffAigDet then AfficheDebug(s,couleur); - if TCOActive then + for tco:=1 to nbreTCO do begin - for tco:=1 to nbreTCO do - begin - // désactivation du morceau avant l'aiguillage - efface_trajet(det3,i); - end; + // désactivation du morceau avant l'aiguillage + efface_trajet(det3,i); end; exit; // sortir absolument end @@ -10668,13 +10751,14 @@ begin end; v:=Tablo_periph[numacc].NumCom; // numéro de com if v=0 then exit; - if Tablo_com_cde[numacc].PortOuvert then + if tablo_periph[numacc].PortOuvert then begin s:=Tablo_PN[i].CommandeF; if Tablo_periph[numacc].cr then s:=s+#13; cmd:=Tablo_periph[numacc].numComposant; - if cmd=1 then Formprinc.MSCommCde1.Output:=s; - if cmd=2 then Formprinc.MSCommCde2.Output:=s; + if cmd=1 then envoi_usb_comp(MSCommCde1,s); + if cmd=2 then envoi_usb_comp(MSCommCde2,s); + Affiche('Envoie port COM'+intToSTR(v)+' commande: '+s,clWhite); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -10693,13 +10777,14 @@ begin end; v:=Tablo_periph[numacc].NumCom; // numéro de com if v=0 then exit; - if Tablo_com_cde[numacc].PortOuvert then + if tablo_periph[numacc].PortOuvert then begin s:=Tablo_PN[i].CommandeO; if Tablo_periph[numacc].cr then s:=s+#13; cmd:=Tablo_periph[numacc].numComposant; - if cmd=1 then Formprinc.MSCommCde1.Output:=s; - if cmd=2 then Formprinc.MSCommCde2.Output:=s; + if cmd=1 then envoi_usb_comp(MSCommCde1,s); + if cmd=2 then envoi_usb_comp(MSCommCde2,s); + Affiche('Envoie port COM'+intToSTR(v)+' commande: '+s,clWhite); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -10749,13 +10834,14 @@ begin end; v:=Tablo_periph[numacc].NumCom; // numéro de com if v=0 then exit; - if Tablo_com_cde[numacc].PortOuvert then + if tablo_periph[numacc].PortOuvert then begin s:=Tablo_actionneur[i].trainDest; if Tablo_periph[numacc].cr then s:=s+#13; cmd:=Tablo_periph[numacc].numComposant; - if numacc=1 then Formprinc.MSCommCde1.Output:=s; - if numacc=2 then Formprinc.MSCommCde2.Output:=s; + if numacc=1 then envoi_usb_comp(MSCommCde1,s); + if numacc=2 then envoi_usb_comp(MSCommCde2,s); + if Tablo_periph[numacc].ScvVis then Affiche('Envoi COM'+intToSTR(v)+': '+s,clYellow); end else Affiche('Envoi commande impossible ; COM'+intToSTR(v)+' non détecté',clred); @@ -11047,13 +11133,13 @@ begin v:=com_socket(i); if v=1 then begin - if tablo_com_cde[i].portOuvert then + if tablo_periph[i].portOuvert then begin if Tablo_periph[i].ScvVis then Affiche(sDecl,clWhite); if Tablo_periph[i].cr then sDecl:=sDecl+#13; typ:=Tablo_periph[i].numComposant; - if typ=1 then Formprinc.MSCommCde1.Output:=sDecl; - if typ=2 then Formprinc.MSCommCde2.Output:=sDecl; + if typ=1 then envoi_usb_comp(MSCommCde1,sDecl); + if typ=2 then envoi_usb_comp(MSCommCde2,sDecl); end; end; @@ -11076,7 +11162,8 @@ Procedure affiche_memoire; var s: string; begin s:='Mém evt: '+IntToSTR(100*N_Event_tick div Max_Event_det_tick)+' %'; - FormPrinc.StatusBar1.Panels[2].text:=s; + FormPrinc.StatusBar1.Panels[3].Style:=psText; // sans event + FormPrinc.StatusBar1.Panels[2].text:=s; end; procedure evalue; @@ -11262,14 +11349,15 @@ begin // envoyer event act au périphérique if dr=1 then begin - if (tablo_com_cde[i].portOuvert) and (Tablo_periph[i].ScvDet) then + if (tablo_periph[i].portOuvert) and (Tablo_periph[i].ScvDet) then begin s:='D'+intToSTR(adresse)+','+intToSTR(etat01)+','+train; if Tablo_periph[i].ScvVis then Affiche(s,clWhite); if Tablo_periph[i].cr then s:=s+#13; index:=Tablo_periph[i].NumComposant; - if index=1 then Formprinc.MSCommCde1.Output:=s; - if index=2 then Formprinc.MSCommCde2.Output:=s; + if index=1 then envoi_usb_comp(MSCommCde1,s); + if index=2 then envoi_usb_comp(MSCommCde2,s); + end; end; if dr=2 then @@ -11290,7 +11378,10 @@ begin Envoi_serveur('D'+intToSTR(adresse)+','+intToSTR(etat01)+','+train); // Maj TCOs - for i:=1 to nbreTCO do Maj_TCO(i,Adresse); + for i:=1 to nbreTCO do + begin + if PCanvasTCO[i]<>nil then Maj_TCO(i,Adresse); + end; end; @@ -11372,7 +11463,7 @@ begin typ:=com_socket(i); if typ=1 then begin - if tablo_com_cde[i].portOuvert then + if tablo_periph[i].portOuvert then begin if Tablo_periph[i].ScvAig then begin @@ -11380,8 +11471,11 @@ begin if Tablo_periph[i].ScvVis then Affiche(s,clWhite); if Tablo_periph[i].cr then s:=s+#13; id:=Tablo_periph[i].NumComposant; - if id=1 then Formprinc.MSCommCde1.Output:=s; - if id=2 then Formprinc.MSCommCde2.Output:=s; + //jeans if id=1 then envoi_usb(periph1,s); + // if id=2 then envoi_usb(periph2,s); + if id=1 then envoi_usb_comp(MSCommCde1,s); + if id=2 then envoi_usb_comp(MSCommCde2,s); + end; end; end; @@ -11417,8 +11511,7 @@ begin end; // Mettre à jour les TCOs - if TCOActive then - for i:=1 to NbreTCO do Maj_TCO(i,Adresse); + for i:=1 to NbreTCO do Maj_TCO(i,Adresse); end; // pilote une sortie à 0 à l'interface dont l'adresse est à 1 ou 2 (octet) @@ -12119,10 +12212,11 @@ begin end else - if (ord(chaineINT[1]) and $F0)=$40 then // accessory decodeur information response $40+N 40 N=1 à 14 + // accessory decodeur information response $40+N 40 N=1 à 14 + if (ord(chaineINT[1]) and $F0)=$40 then begin connu:=true; - n:=ord(chaineINT[1]) and $0F; // nombre d'octets + n:=ord(chaineINT[1]) and $0F; // nombre d'octets (doit être pair) nOctets:=n+2; if (l>=nOctets) then begin @@ -12331,6 +12425,7 @@ begin // E6 8 // spécifique Z21 : E7 0C 89 00 00 00 00 00 62 + // on n'en fait rien, c'est un genre d'ack à la réponse de stop loco ? if (chaineINT[1]=#$E7) then begin connu:=true; @@ -12439,7 +12534,7 @@ begin end; Affiche('CDM rail déconnecté',clCyan); AfficheDebug('CDM rail déconnecté',clCyan); - Formprinc.StatusBar1.Panels[2].text:='CDM déconnecté'; + Formprinc.StatusBar1.Panels[2].text:=''; filtrageDet0:=SauvefiltrageDet0; end; end; @@ -12509,6 +12604,8 @@ begin Application.processmessages; until (version_Interface<>'') or (temp>15); + // result:=true; + // exit; if (temp>15) then begin @@ -12545,7 +12642,7 @@ begin end; // connecte un port usb pour la comm périphériques. Si le port n'est pas ouvert, renvoie false -function connecte_port_usb_periph(index : integer) : boolean; +function connecte_usb_periph(index : integer) : boolean; var i,j,nc,numport,vitesse,erreur : integer; s,sc,portComCde : string; com : TMSComm; @@ -12565,9 +12662,23 @@ begin portComCde:=Tablo_periph[index].protocole; nc:=Tablo_periph[index].NumComposant; + // voir si le composant est valide + if MsCommCde1=nil then + begin + Affiche('Erreur 6001: le composant périphérique 1 n''est pas créé',clred); + result:=false; + exit; + end; + if MsCommCde2=nil then + begin + Affiche('Erreur 6002: le composant périphérique 2 n''est pas créé',clred); + result:=false; + exit; + end; + case nc of - 1 : com:=formprinc.MSCommCde1; - 2 : com:=formprinc.MSCommCde2; + 1 : com:=MSCommCde1; + 2 : com:=MSCommCde2; end; if nc>MaxComUSBPeriph then @@ -12586,15 +12697,15 @@ begin sc:=copy(portComCde,i+1,j-i+1); val(sc,vitesse,erreur); if (vitesse<>300) and (vitesse<>1200) and (vitesse<>2400) and (vitesse<>4800) and (vitesse<>9600) and - (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) then + (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) and (vitesse<>128000) and (vitesse<>256000) then begin Affiche('Vitesse périphérique COM ('+intToSTR(vitesse)+') incorrecte',clred); - tablo_com_cde[index].PortOuvert:=false; + tablo_periph[index].PortOuvert:=false; result:=false; exit; end; - tablo_com_cde[index].PortOuvert:=true; + tablo_periph[index].PortOuvert:=true; With com do begin Settings:=sc; // vitesse,n,8,1 @@ -12603,24 +12714,26 @@ begin RThreshold:=1; InputLen:=0; CommPort:=numport; - DTREnable:=false; // évite de reset de l'arduino à la connexion - RTSEnable:=false; // pour la genli + DTREnable:=Tablo_periph[index].dtr; + RTSEnable:=Tablo_periph[index].rts; + InputMode:=comInputModeBinary; + end; try com.portopen:=true; except - tablo_com_cde[index].PortOuvert:=false; + tablo_periph[index].PortOuvert:=false; end; FormPrinc.StatusBar1.Panels[3].Style:=psOwnerDraw; // permet de déclencher l'event onDrawPanel - if tablo_com_cde[index].PortOuvert then + if tablo_periph[index].PortOuvert then begin s:='COM'+intToSTR(numport)+':'+sc; Formprinc.StatusBar1.Panels[3].Text:=s; end; - result:=tablo_com_cde[index].PortOuvert; + result:=tablo_periph[index].PortOuvert; end; // détermine si le périphérique i est un comusb ou un socket @@ -12638,7 +12751,7 @@ begin end; function connecte_socket_periph(index :integer) : boolean; -var s: string; +var s,sc,ip: string; i,erreur,NumSocket : integer; com : TClientSocket; begin @@ -12665,10 +12778,25 @@ begin end; s:=Tablo_periph[index].protocole; + sc:=s; + i:=pos(':',s); - com.address:=copy(s,1,i-1); + ip:=copy(s,1,i-1); + if Ipok(ip)=false then + begin + Affiche('Erreur 538 : Adresse IP '+sc+' incorrecte',clred); + result:=false; + exit; + end; + com.address:=ip; delete(s,1,i); val(s,i,erreur); + if (i<1) or (i>65535) then + begin + Affiche('Erreur 539 : port de l''adresse ip '+sc+' incorrect',clred); + result:=false; + exit; + end; com.port:=i; com.open; result:=true; @@ -12676,6 +12804,7 @@ end; // connecte un port usb interface. 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; var i,j : integer; trouve,portOK : boolean; @@ -12683,7 +12812,15 @@ var i,j : integer; begin result:=0; trouve:=false; - With Formprinc.MSCommUSBInterface do + + if MSCommUSBInterface=nil then + begin + Affiche('Erreur 6000: le composant interface n''est pas créé',clred); + result:=0; + exit; + end; + + With MSCommUSBInterface do begin //if debug=1 then Affiche('Test port com'+intToSTR(port),clLime); version_interface:=''; @@ -12719,7 +12856,7 @@ begin begin portCommOuvert:=true; try - Formprinc.MSCommUSBInterface.portopen:=true; + MSCommUSBInterface.portopen:=true; except portCommOuvert:=false; end; @@ -12738,7 +12875,7 @@ begin if not(trouve) then begin portCommOuvert:=false; - Formprinc.MSCommUSBInterface.portopen:=false; + MSCommUSBInterface.portopen:=false; end; end; if trouve then result:=port else result:=0; @@ -12816,7 +12953,7 @@ begin begin numport:=1; repeat - With Formprinc.MSCommUSBInterface do + With MSCommUSBInterface do begin //Affiche('Test port com'+intToSTR(numport),clyellow); port:=connecte_port_usb(numport); @@ -12845,11 +12982,6 @@ begin LireunfichierdeCV1.enabled:=true; ButtonLitCV.Enabled:=true; end; - if protocole=1 then - begin - etat_init_interface:=20; // interface protocole reconnue - parSocketLenz:=true; - end; if (protocole=2) then begin init_dccpp; @@ -12984,7 +13116,7 @@ begin s:=''; if lay<>'' then s:='-f '+lay; // lay - if not(serveurIPCDM_Touche) and avecSocket then s:=s+' -COMIPC'; // démarre serveur comipc + if not(serveurIPCDM_Touche) and avecSocket then s:=s+' -COMIPC'; // démarre serveur comipc de CDM par ligne de commande cdm_lanceLoc:=false; // lancement depuis le répertoire 32 bits d'un OS64 @@ -13023,6 +13155,7 @@ begin Application.ProcessMessages; if serveurIPCDM_Touche then sleep(1000); + // démarre le serveur IP de CDM par simulation de touches if serveurIPCDM_Touche then begin // démarre le serveur IP : il faut avoir chargé un réseau sinon le permier menu est fermé------------------------------------ @@ -13099,6 +13232,7 @@ begin KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); KeybdInput(VK_TAB,0);KeybdInput(VK_TAB,KEYEVENTF_KEYUP); + // cocher Z21 if Z21 and (ServeurInterfaceCDM=1) then begin // 1x monte @@ -13206,7 +13340,7 @@ begin for j:=1 to NbreCelly[index] do tco[index,i,j].mode:=0; - if TCOActive then affiche_TCO(index); + if pCanvasTCO[index]<>nil then affiche_TCO(index); end; Maj_signaux(false); @@ -13222,7 +13356,7 @@ begin // faire en 2 fois pour plus de rapidité // 1 fois pour initialiser la position dans le tableau // 2eme fois pour positionner physiquement les aiguillages - // pour générer les evts de position + // et générer les evts de position // Affiche('Positionnement aiguillages',cyan); init_aig_cours:=true; for i:=1 to maxaiguillage do @@ -13573,6 +13707,7 @@ begin formTCO[index]:=nil; end; + BorderStyle:=bsSizeable; Caption:=af; TraceSign:=True; configPrete:=false; // form config prete @@ -13669,6 +13804,45 @@ begin cheminWin:=GetCurrentProcessEnvVar('windir')+'\System32'; 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; + // création des composants MSCom (USB COM) ----------------- + // interface centrale + 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; + + // 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; + + //s:=GetCurrentDir; //Affiche(s,clLime); if FindFirst('*.*', faAnyFile, SR) = 0 then @@ -13703,10 +13877,6 @@ begin MainMenu1.Items[i-1].Items[0].OnClick:=ProcAide; end; - // vérifier ocx tmscomm - i:=filesize(cheminwin+'\mscomm32.ocx'); - if (i<>103744) and (i<>-1) then Affiche('Version fichier '+cheminwin+'\mscomm32.ocx incorrecte',clred); - // version d'OS pour info application.ProcessMessages; @@ -13822,10 +13992,6 @@ begin Tempo_init:=5; // démarre les initialisation des signaux et des aiguillages dans 0,5 s - - // il faut afficher la fenetre TCO pour l'init aiguillage sinon violation - - OrgMilieu:=formprinc.width div 2; with statusbar1 do begin @@ -13838,13 +14004,38 @@ begin //Panels[3].Style:=psOwnerDraw; // pour déclencher l'évenement onDraw end; + // positionnement de la fenêtre principale + position:=poDefault; + + if AffMemoFenetre=1 then + begin + if largeurF>0 then formPrinc.width:=LargeurF; + if HauteurF>0 then formPrinc.Height:=hauteurF; + formPrinc.left:=offsetXF; + formPrinc.top:=offsetYF; + + if (PosSplitter>0) and (PosSPlitter0 then formPrinc.width:=LargeurF; - if HauteurF>0 then formPrinc.Height:=hauteurF; - formPrinc.left:=offsetXF; - formPrinc.top:=offsetYF; - if (PosSplitter>0) and (PosSPlitternil) then begin // parcourir les signaux du TCO for y:=1 to NbreCellY[indexTCO] do @@ -14311,7 +14481,7 @@ begin // signal belge if TestBit(a,clignote) or Signaux[0].contrevoie then dessine_signal_pilote; end; - + end; // fenetre de config du signal CDF @@ -14651,7 +14821,7 @@ begin if portCommOuvert then begin portCommOuvert:=false; - Formprinc.MSCommUSBInterface.Portopen:=false; + MSCommUSBInterface.Portopen:=false; Affiche('Port USB déconnecté',clyellow); Formprinc.StatusBar1.Panels[3].Text:=''; end; @@ -14667,18 +14837,21 @@ begin end; end; +// déconnecte le périphérique n°index procedure deconnecte_usb_periph(index : integer); +var n : integer; begin if (index>NbMaxi_Periph) or (index=0) then begin Affiche('Erreur 61 : numéro de périphérique hors limite ',clred); exit; end; - if tablo_com_cde[index].PortOuvert then + if tablo_periph[index].PortOuvert then begin - tablo_com_cde[index].PortOuvert:=false; - if index=1 then Formprinc.MscommCde1.Portopen:=false; - if index=2 then Formprinc.MscommCde2.Portopen:=false; + tablo_periph[index].PortOuvert:=false; + n:=Tablo_periph[index].numComposant; + if n=1 then MscommCde1.Portopen:=false; + if n=2 then MscommCde2.Portopen:=false; if debug>0 then Affiche('Port COM'+intToSTR(Tablo_periph[index].NumCom)+' périphérique déconnecté',clyellow); Formprinc.StatusBar1.Panels[3].Text:=''; @@ -14693,9 +14866,9 @@ begin Affiche('Erreur 62 : numéro de périphérique hors limite ',clred); exit; end; - if tablo_com_cde[index].PortOuvert then + if tablo_periph[index].PortOuvert then begin - tablo_com_cde[index].PortOuvert:=false; + tablo_periph[index].PortOuvert:=false; if index=1 then Formprinc.ClientSocketCde1.close; if index=2 then Formprinc.ClientSocketCde1.close; if debug>0 then Affiche('Socket '+intToSTR(Tablo_periph[index].NumCom)+' périphérique déconnecté',clyellow); @@ -14722,6 +14895,7 @@ end; procedure TFormPrinc.MenuDeconnecterEthernetClick(Sender: TObject); begin + Affiche('Déconnexion interface ethernet',clyellow); ClientSocketInterface.Close; end; @@ -14862,7 +15036,7 @@ begin end; end; end; - +// connnecter le socket de interface vers la centrale procedure TFormPrinc.ClientSocketInterfaceConnect(Sender: TObject;Socket: TCustomWinSocket); var trouve : boolean; begin @@ -14909,13 +15083,15 @@ begin if not(trouve) then ClientSocketInterface.Close; end; +// CDM rail connecté procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket); var s : string; begin s:='Socket CDM rail connecté'; LabelTitre.caption:=titre+' '+s; Affiche(s,clYellow); - StatusBar1.Panels[2].text:='CDM connecté'; + StatusBar1.Panels[2].Style:=psOwnerDraw; // permet de déclencher l'event onDrawPanel + StatusBar1.Panels[2].text:=' CDM connecté'; CDM_connecte:=True; MenuConnecterUSB.enabled:=false; DeConnecterUSB.enabled:=false; @@ -16580,7 +16756,7 @@ end; procedure TFormPrinc.LancerCDMrail1Click(Sender: TObject); begin - Lance_CDM(true) ; + Lance_CDM(true); end; procedure TFormPrinc.TrackBarVitChange(Sender: TObject); @@ -16782,7 +16958,7 @@ begin Affiche(Format('EOleException %s %x', [E.Message,E.ErrorCode]),clyellow); on E:Exception do Affiche(E.Classname+ ':'+ E.Message,clyellow); - end; + end; end; procedure TFormPrinc.Evenementsdetecteurspartrain1Click(Sender: TObject); @@ -16809,7 +16985,7 @@ begin 1 : s:=s+'/S'; 2 : s:=s+'/A'; 3 : s:=s+'/R'; - 4 : s:=s+'/0'; + 4 : s:=s+'/0'; // non utilisé end; Affiche(s,couleur); end; @@ -17020,13 +17196,6 @@ begin if (ecranTCO[i]=e) or (NombreEcrans=1) then // si l'écran TCO doit aller sur e begin - with formtco[i] do - begin - windowState:=wsNormal; - show; - BringToFront; - end; - inc(CeTCO[e]); largEcran:=ecran[e].larg; hautEcran:=ecran[e].haut; @@ -17039,14 +17208,15 @@ begin with formtco[i] do begin + windowState:=wsNormal; + show; + BringToFront; + Top:=((CeTCO[e]-1)*HautTCO)+Topecran; //if i>1 then top:=formTCO[i-1].Top+formTCO[i-1].Height else top:=topEcran; Left:=leftECran; width:=largTCO; height:=HautTCO; - windowState:=wsNormal; - show; - BringToFront; end; end; end; @@ -17086,12 +17256,13 @@ begin with formtco[i] do begin windowState:=wsNormal; + show; + BringToFront; + Top:=Topecran; Left:=((CeTCO[e]-1)*largTCO)+leftECran; width:=largTCO+8; height:=HautTCO; - show; - BringToFront; end; end; end; @@ -17127,29 +17298,30 @@ begin HautTCO:=HautEcran div 2; with formtco[1] do begin - Top:=Topecran; Left:=0; - width:=largEcran+8; height:=HautTCO; windowState:=wsNormal; show; BringToFront; + + Top:=Topecran; Left:=0; + width:=largEcran+8; height:=HautTCO; end; largTCO:=largEcran div 2; with formtco[2] do begin - Top:=Topecran+HautTCO; Left:=0; - width:=largTCO+8; height:=HautTCO; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+HautTCO; Left:=0; + width:=largTCO+8; height:=HautTCO; end; with formtco[3] do begin - Top:=Topecran+HautTCO; Left:=largTCO; - width:=largTCO+8; height:=HautTCO; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+HautTCO; Left:=largTCO; + width:=largTCO+8; height:=HautTCO; end; end; 4 : begin @@ -17159,11 +17331,11 @@ begin begin with formtco[i] do begin - Top:=Topecran+((i-1) div 2)*HautTCO; Left:=((i-1) mod 2)*LargTCO; - width:=largTCO+8; height:=HautTCO+8; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+((i-1) div 2)*HautTCO; Left:=((i-1) mod 2)*LargTCO; + width:=largTCO+8; height:=HautTCO+8; end; end; end; @@ -17173,21 +17345,21 @@ begin largTCO:=largEcran div 2; with formtco[1] do begin - Top:=Topecran; Left:=0; - width:=largEcran+8; height:=HautTCO; windowState:=wsNormal; show; BringToFront; + Top:=Topecran; Left:=0; + width:=largEcran+8; height:=HautTCO; end; for i:=2 to 5 do begin with formtco[i] do begin - Top:=Topecran+HautTCO+((i-2) div 2)*HautTCO; Left:=((i-2) mod 2)*LargTCO; - width:=largTCO+8; height:=HautTCO+8; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+HautTCO+((i-2) div 2)*HautTCO; Left:=((i-2) mod 2)*LargTCO; + width:=largTCO+8; height:=HautTCO+8; end; end; end; @@ -17199,11 +17371,11 @@ begin begin with formtco[i] do begin - Top:=Topecran+((i-1) div 2)*HautTCO; Left:=((i-1) mod 2)*LargTCO; - width:=largTCO+8; height:=HautTCO+8; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+((i-1) div 2)*HautTCO; Left:=((i-1) mod 2)*LargTCO; + width:=largTCO+8; height:=HautTCO+8; end; end; end; @@ -17213,21 +17385,21 @@ begin largTCO:=largEcran div 2; with formtco[1] do begin - Top:=Topecran; Left:=0; - width:=largEcran+8; height:=HautTCO; windowState:=wsNormal; show; BringToFront; + Top:=Topecran; Left:=0; + width:=largEcran+8; height:=HautTCO; end; for i:=2 to 7 do begin with formtco[i] do begin - Top:=Topecran+HautTCO+((i-2) div 2)*HautTCO; Left:=((i-2) mod 2)*LargTCO; - width:=largTCO+8; height:=HautTCO+8; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+HautTCO+((i-2) div 2)*HautTCO; Left:=((i-2) mod 2)*LargTCO; + width:=largTCO+8; height:=HautTCO+8; end; end; end; @@ -17237,30 +17409,30 @@ begin largTCO:=largEcran div 2; with formtco[1] do begin - Top:=Topecran; Left:=0; - width:=largTCO+8; height:=HautTCO; - windowState:=wsNormal; + windowState:=wsNormal; show; BringToFront; + Top:=Topecran; Left:=0; + width:=largTCO+8; height:=HautTCO; end; with formtco[2] do begin - Top:=Topecran; Left:=largTCO; - width:=largTCO+8; height:=HautTCO; - windowState:=wsNormal; + windowState:=wsNormal; show; BringToFront; + Top:=Topecran; Left:=largTCO; + width:=largTCO+8; height:=HautTCO; end; largTCO:=largEcran div 3; for i:=3 to 8 do begin with formtco[i] do begin - Top:=Topecran+HautTCO+((i-3) div 3)*HautTCO; Left:=((i-3) mod 3)*LargTCO; - width:=largTCO+8; height:=HautTCO+8; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+HautTCO+((i-3) div 3)*HautTCO; Left:=((i-3) mod 3)*LargTCO; + width:=largTCO+8; height:=HautTCO+8; end; end; end; @@ -17272,11 +17444,11 @@ begin begin with formtco[i] do begin - Top:=Topecran+((i-1) div 3)*HautTCO; Left:=((i-1) mod 3)*LargTCO; - width:=largTCO+8; height:=HautTCO+8; windowState:=wsNormal; show; BringToFront; + Top:=Topecran+((i-1) div 3)*HautTCO; Left:=((i-1) mod 3)*LargTCO; + width:=largTCO+8; height:=HautTCO+8; end; end; end; @@ -17295,14 +17467,16 @@ begin formTCO[i].show; // on est obligé d'afficher la fenetre TCO pour provoquer OnActivate pour valider les pointeurs application.ProcessMessages; - formTCO[i].Left:=Ecran[e].x0; - formTCO[i].Top:=Ecran[e].y0; + if formTCO[i].Left<>Ecran[e].x0 then formTCO[i].Left:=Ecran[e].x0; + if formTCO[i].Top<>Ecran[e].y0 then formTCO[i].Top:=Ecran[e].y0; formTCO[i].BringToFront; // pour maximiser la fenêtre, obligé de faire wsnormal avant - formTCO[i].windowState:=wsNormal; - formTCO[i].windowState:=wsMaximized; - + if formTCO[i].windowState<>wsMaximized then + begin + formTCO[i].windowState:=wsNormal; + formTCO[i].windowState:=wsMaximized; + end; if not(laisseOuvert) then formTCO[i].Close; // .. et si on en veut pas, on la ferme. end; @@ -17706,6 +17880,7 @@ begin end; setlength(TCO[SauvNbreTCO],0); + PcanvasTCO[SauvNbreTCO]:=nil; dec(SauvNbreTCO); Menu_tco(SauvNbreTCO); config_modifie:=true; @@ -17716,6 +17891,7 @@ begin Affiche(IntToSTR(i)+' '+NomFichierTCO[i],clLime); end; NbreTCO:=SauvNbreTCO; + tcoActive:=true; end; procedure TFormPrinc.CO11Click(Sender: TObject); @@ -17804,7 +17980,7 @@ end; procedure TFormPrinc.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); var RectForText: TRect; begin - if Panel=StatusBar.Panels[3] then + if (Panel=StatusBar.Panels[2]) or (Panel=StatusBar.Panels[3]) then begin if Panel.Text<>'' then begin @@ -17815,6 +17991,7 @@ begin DrawText(StatusBar1.Canvas.Handle,PChar(Panel.Text),-1,RectForText,DT_SINGLELINE or DT_VCENTER or DT_LEFT); end; end; + end; // télécommande de signaux complexes par les clients @@ -17873,7 +18050,7 @@ begin end; // réception COM/USB du périphérique 1 -procedure TFormPrinc.MSCommCde1Comm(Sender: TObject); +procedure TFormPrinc.RecuPeriph1(Sender: TObject); var s : string; tablo : array of byte; // tableau rx usb c : char; @@ -17889,18 +18066,18 @@ begin //Affiche(intToSTR(ord(c)),clorange); if c=#13 then begin - s:=tablo_com_cde[1].tamponrx; + s:=tablo_periph[1].tamponrx; affiche(s,clyellow); - tablo_com_cde[1].tamponrx:=''; + tablo_periph[1].tamponrx:=''; telecommande(s); end; - if (c>#31) and (c<#128) then tablo_com_cde[1].tamponrx:=tablo_com_cde[1].tamponrx+c;; + if (c>#31) and (c<#128) then tablo_periph[1].tamponrx:=tablo_periph[1].tamponrx+c;; end; end; end; // réception COM/USB du périphérique 2 -procedure TFormPrinc.MSCommCde2Comm(Sender: TObject); +procedure TFormPrinc.RecuPeriph2(Sender: TObject); var s : string; tablo : array of byte; // tableau rx usb c : char; @@ -17915,12 +18092,12 @@ begin //Affiche(intToSTR(ord(c)),clorange); if c=#13 then begin - s:=tablo_com_cde[2].tamponrx; + s:=tablo_periph[2].tamponrx; affiche(s,clyellow); - tablo_com_cde[2].tamponrx:=''; + tablo_periph[2].tamponrx:=''; telecommande(s); end; - if (c>#31) and (c<#128) then tablo_com_cde[2].tamponrx:=tablo_com_cde[2].tamponrx+c;; + if (c>#31) and (c<#128) then tablo_periph[2].tamponrx:=tablo_periph[2].tamponrx+c;; end; end; end; diff --git a/UnitSR.dfm b/UnitSR.dfm index 4c9b9e0..5cb0f40 100644 --- a/UnitSR.dfm +++ b/UnitSR.dfm @@ -1,9 +1,9 @@ object FormSR: TFormSR - Left = 425 - Top = 73 + Left = 405 + Top = 89 BorderStyle = bsDialog Caption = 'Configuration du d'#233'codeur du signal St'#233'phane Ravaut' - ClientHeight = 540 + ClientHeight = 575 ClientWidth = 475 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -18,7 +18,7 @@ object FormSR: TFormSR TextHeight = 13 object LabelAdrSR1: TLabel Left = 24 - Top = 72 + Top = 64 Width = 63 Height = 13 Caption = 'LabelAdrSR1' @@ -37,9 +37,9 @@ object FormSR: TFormSR Height = 13 Caption = '- 1' end - object Label3: TLabel + object Label300: TLabel Left = 24 - Top = 24 + Top = 8 Width = 59 Height = 16 Caption = 'Adresse' @@ -50,9 +50,9 @@ object FormSR: TFormSR Font.Style = [fsBold] ParentFont = False end - object Label4: TLabel + object Label301: TLabel Left = 112 - Top = 24 + Top = 8 Width = 28 Height = 16 Caption = 'Etat' @@ -63,9 +63,9 @@ object FormSR: TFormSR Font.Style = [fsBold] ParentFont = False end - object Label5: TLabel + object Label302: TLabel Left = 200 - Top = 24 + Top = 8 Width = 49 Height = 16 Caption = 'Aspect' @@ -78,7 +78,7 @@ object FormSR: TFormSR end object Shape1: TShape Left = 16 - Top = 104 + Top = 97 Width = 409 Height = 1 end @@ -89,23 +89,23 @@ object FormSR: TFormSR Height = 13 Caption = 'LabelAdrSR2' end - object Label7: TLabel + object Label3: TLabel Left = 120 Top = 112 Width = 15 Height = 13 Caption = '+ 2' end - object Label8: TLabel + object Label4: TLabel Left = 120 Top = 136 Width = 12 Height = 13 Caption = '- 1' end - object Label6: TLabel + object Label303: TLabel Left = 344 - Top = 24 + Top = 8 Width = 21 Height = 16 Caption = 'CV' @@ -118,14 +118,14 @@ object FormSR: TFormSR end object LabelCV1: TLabel Left = 320 - Top = 56 + Top = 48 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV2: TLabel Left = 384 - Top = 56 + Top = 48 Width = 20 Height = 13 Caption = 'CV=' @@ -146,53 +146,53 @@ object FormSR: TFormSR end object LabelCV5: TLabel Left = 320 - Top = 118 + Top = 110 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV6: TLabel Left = 384 - Top = 118 + Top = 110 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV7: TLabel Left = 320 - Top = 142 + Top = 134 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV8: TLabel Left = 384 - Top = 142 + Top = 134 Width = 20 Height = 13 Caption = 'CV=' end object Shape2: TShape Left = 16 - Top = 160 + Top = 150 Width = 409 Height = 1 end object LabelAdrSR3: TLabel Left = 24 - Top = 184 + Top = 176 Width = 63 Height = 13 Caption = 'LabelAdrSR2' end - object Label10: TLabel + object Label5: TLabel Left = 120 Top = 168 Width = 15 Height = 13 Caption = '+ 2' end - object Label11: TLabel + object Label6: TLabel Left = 120 Top = 192 Width = 12 @@ -201,14 +201,14 @@ object FormSR: TFormSR end object LabelCV9: TLabel Left = 320 - Top = 172 + Top = 164 Width = 20 Height = 13 Caption = 'CV=' end object LabelCV10: TLabel Left = 384 - Top = 172 + Top = 164 Width = 20 Height = 13 Caption = 'CV=' @@ -229,7 +229,7 @@ object FormSR: TFormSR end object Shape3: TShape Left = 16 - Top = 216 + Top = 219 Width = 409 Height = 1 end @@ -240,16 +240,16 @@ object FormSR: TFormSR Height = 13 Caption = 'LabelAdrSR2' end - object Label12: TLabel + object Label7: TLabel Left = 120 - Top = 224 + Top = 232 Width = 15 Height = 13 Caption = '+ 2' end - object Label13: TLabel + object Label8: TLabel Left = 120 - Top = 248 + Top = 256 Width = 12 Height = 13 Caption = '- 1' @@ -284,7 +284,7 @@ object FormSR: TFormSR end object Shape4: TShape Left = 16 - Top = 272 + Top = 276 Width = 409 Height = 1 end @@ -295,16 +295,16 @@ object FormSR: TFormSR Height = 13 Caption = 'LabelAdrSR2' end - object Label14: TLabel + object Label9: TLabel Left = 120 - Top = 280 + Top = 288 Width = 15 Height = 13 Caption = '+ 2' end - object Label15: TLabel + object Label10: TLabel Left = 120 - Top = 304 + Top = 312 Width = 12 Height = 13 Caption = '- 1' @@ -339,27 +339,27 @@ object FormSR: TFormSR end object Shape5: TShape Left = 16 - Top = 328 + Top = 333 Width = 409 Height = 1 end object LabelAdrSR6: TLabel Left = 24 - Top = 352 + Top = 360 Width = 63 Height = 13 Caption = 'LabelAdrSR2' end - object Label16: TLabel + object Label11: TLabel Left = 120 - Top = 336 + Top = 344 Width = 15 Height = 13 Caption = '+ 2' end - object Label17: TLabel + object Label12: TLabel Left = 120 - Top = 360 + Top = 368 Width = 12 Height = 13 Caption = '- 1' @@ -394,7 +394,7 @@ object FormSR: TFormSR end object Shape6: TShape Left = 16 - Top = 384 + Top = 385 Width = 409 Height = 1 end @@ -405,16 +405,16 @@ object FormSR: TFormSR Height = 13 Caption = 'LabelAdrSR2' end - object Label18: TLabel + object Label13: TLabel Left = 120 - Top = 392 + Top = 400 Width = 15 Height = 13 Caption = '+ 2' end - object Label19: TLabel + object Label14: TLabel Left = 120 - Top = 416 + Top = 424 Width = 12 Height = 13 Caption = '- 1' @@ -449,7 +449,7 @@ object FormSR: TFormSR end object Shape7: TShape Left = 16 - Top = 440 + Top = 438 Width = 409 Height = 1 end @@ -460,16 +460,16 @@ object FormSR: TFormSR Height = 13 Caption = 'LabelAdrSR2' end - object Label20: TLabel + object Label15: TLabel Left = 120 Top = 448 Width = 15 Height = 13 Caption = '+ 2' end - object Label21: TLabel + object Label16: TLabel Left = 120 - Top = 472 + Top = 480 Width = 12 Height = 13 Caption = '- 1' @@ -490,7 +490,7 @@ object FormSR: TFormSR end object LabelCV31: TLabel Left = 320 - Top = 476 + Top = 484 Width = 20 Height = 13 Caption = 'CV=' @@ -503,15 +503,40 @@ object FormSR: TFormSR Caption = 'CV=' end object LabelErreur: TLabel - Left = 224 - Top = 528 + Left = 152 + Top = 512 Width = 3 Height = 13 Caption = ':' end + object Label900: TLabel + Left = 212 + Top = 532 + Width = 205 + Height = 26 + Alignment = taRightJustify + Caption = 'Nombre d'#39'adresses occup'#233'es par le signal : (1 '#224' 8)' + WordWrap = True + end + object Shape8: TShape + Left = 16 + Top = 502 + Width = 409 + Height = 1 + end + object ComboBoxAdr15: TComboBox + Left = 160 + Top = 448 + Width = 145 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 14 + OnChange = ComboBoxAdr15Change + end object ComboBoxAdr1: TComboBox Left = 160 - Top = 56 + Top = 48 Width = 145 Height = 21 Style = csDropDownList @@ -521,7 +546,7 @@ object FormSR: TFormSR end object ComboBoxAdr2: TComboBox Left = 160 - Top = 80 + Top = 72 Width = 145 Height = 21 Style = csDropDownList @@ -531,7 +556,7 @@ object FormSR: TFormSR end object ComboBoxAdr3: TComboBox Left = 160 - Top = 112 + Top = 104 Width = 145 Height = 21 Style = csDropDownList @@ -541,7 +566,7 @@ object FormSR: TFormSR end object ComboBoxAdr4: TComboBox Left = 160 - Top = 136 + Top = 128 Width = 145 Height = 21 Style = csDropDownList @@ -551,7 +576,7 @@ object FormSR: TFormSR end object ComboBoxAdr5: TComboBox Left = 160 - Top = 168 + Top = 160 Width = 145 Height = 21 Style = csDropDownList @@ -649,16 +674,6 @@ object FormSR: TFormSR TabOrder = 13 OnChange = ComboBoxAdr14Change end - object ComboBoxAdr15: TComboBox - Left = 160 - Top = 448 - Width = 145 - Height = 21 - Style = csDropDownList - ItemHeight = 13 - TabOrder = 14 - OnChange = ComboBoxAdr15Change - end object ComboBoxAdr16: TComboBox Left = 160 Top = 472 @@ -669,13 +684,21 @@ object FormSR: TFormSR TabOrder = 15 OnChange = ComboBoxAdr16Change end - object BitBtnok: TBitBtn - Left = 24 - Top = 504 + object EditNEsignal: TEdit + Left = 424 + Top = 536 + Width = 17 + Height = 21 + TabOrder = 16 + OnChange = EditNEsignalChange + end + object Button1: TButton + Left = 32 + Top = 536 Width = 75 Height = 25 - TabOrder = 16 - OnClick = BitBtnokClick - Kind = bkOK + Caption = 'Ok' + TabOrder = 17 + OnClick = Button1Click end end diff --git a/UnitSR.pas b/UnitSR.pas index 8209891..c5b500a 100644 --- a/UnitSR.pas +++ b/UnitSR.pas @@ -1,8 +1,8 @@ // Unité pour la configuration du décodeur Stéphane Ravaux +// http://stephane.ravaut.free.fr/Train_miniature/Decodeurs/Decodeur_DCC_Signaux_complexes_SNCF.html unit UnitSR; - interface uses @@ -17,14 +17,14 @@ type Label1: TLabel; Label2: TLabel; ComboBoxAdr2: TComboBox; - Label3: TLabel; - Label4: TLabel; - Label5: TLabel; + Label300: TLabel; + Label301: TLabel; + Label302: TLabel; Shape1: TShape; LabelAdrSR2: TLabel; - Label7: TLabel; - Label8: TLabel; - Label6: TLabel; + Label3: TLabel; + Label4: TLabel; + Label303: TLabel; LabelCV1: TLabel; LabelCV2: TLabel; LabelCV3: TLabel; @@ -37,8 +37,8 @@ type LabelCV8: TLabel; Shape2: TShape; LabelAdrSR3: TLabel; - Label10: TLabel; - Label11: TLabel; + Label5: TLabel; + Label6: TLabel; ComboBoxAdr5: TComboBox; ComboBoxAdr6: TComboBox; LabelCV9: TLabel; @@ -47,8 +47,8 @@ type LabelCV12: TLabel; Shape3: TShape; LabelAdrSR4: TLabel; - Label12: TLabel; - Label13: TLabel; + Label7: TLabel; + Label8: TLabel; ComboBoxAdr7: TComboBox; ComboBoxAdr8: TComboBox; LabelCV13: TLabel; @@ -57,8 +57,8 @@ type LabelCV16: TLabel; Shape4: TShape; LabelAdrSR5: TLabel; - Label14: TLabel; - Label15: TLabel; + Label9: TLabel; + Label10: TLabel; ComboBoxAdr9: TComboBox; ComboBoxAdr10: TComboBox; LabelCV17: TLabel; @@ -67,8 +67,8 @@ type LabelCV20: TLabel; Shape5: TShape; LabelAdrSR6: TLabel; - Label16: TLabel; - Label17: TLabel; + Label11: TLabel; + Label12: TLabel; ComboBoxAdr11: TComboBox; ComboBoxAdr12: TComboBox; LabelCV21: TLabel; @@ -77,8 +77,8 @@ type LabelCV24: TLabel; Shape6: TShape; LabelAdrSR7: TLabel; - Label18: TLabel; - Label19: TLabel; + Label13: TLabel; + Label14: TLabel; LabelCV25: TLabel; LabelCV26: TLabel; LabelCV27: TLabel; @@ -87,8 +87,8 @@ type ComboBoxAdr14: TComboBox; Shape7: TShape; LabelAdrSR8: TLabel; - Label20: TLabel; - Label21: TLabel; + Label15: TLabel; + Label16: TLabel; LabelCV29: TLabel; LabelCV30: TLabel; LabelCV31: TLabel; @@ -96,7 +96,10 @@ type ComboBoxAdr15: TComboBox; ComboBoxAdr16: TComboBox; LabelErreur: TLabel; - BitBtnok: TBitBtn; + Label900: TLabel; + EditNEsignal: TEdit; + Button1: TButton; + Shape8: TShape; procedure FormActivate(Sender: TObject); procedure ComboBoxAdr1Change(Sender: TObject); procedure ComboBoxAdr2Change(Sender: TObject); @@ -115,7 +118,8 @@ type procedure ComboBoxAdr15Change(Sender: TObject); procedure ComboBoxAdr16Change(Sender: TObject); procedure FormCreate(Sender: TObject); - procedure BitBtnokClick(Sender: TObject); + procedure EditNEsignalChange(Sender: TObject); + procedure Button1Click(Sender: TObject); private { Déclarations privées } public @@ -125,7 +129,7 @@ type var FormSR: TFormSR; Adr,IndexSig : integer; - + //etatsDefSR : array[1..16] of integer; // états par défaut du décodeur SR procedure couleurs_SR; implementation @@ -133,10 +137,47 @@ implementation {$R *.dfm} +// efface/affiche les composants en fonction du nombre d'adresses (de 1 à 8) +procedure efface(nadr : integer); +var i : integer; + c : tComboBox; + Lb : tLabel; + s : string; +begin + for i:=1 to 16 do + begin + s:='ComboBoxAdr'+intToSTR(i); + c:=formSR.findComponent(s) as tComboBox; + c.Visible:=(i-1)<2*nadr ; + + s:='Label'+intToSTR(i); + Lb:=formSR.findComponent(s) as tLabel; + Lb.Visible:=i-1<2*nadr; + + s:='LabelCV'+intToSTR(i*2-1); + Lb:=formSR.findComponent(s) as tLabel; + Lb.Visible:=i-1<2*nadr; + s:='LabelCV'+intToSTR(i*2); + Lb:=formSR.findComponent(s) as tLabel; + Lb.Visible:=i-1<2*nadr; + end; + + for i:=1 to 8 do + begin + s:='LabelAdrSR'+intToSTR(i); + Lb:=formSR.findComponent(s) as tLabel; + Lb.visible:=(i-1)0) or (i<1) or (i>8) then exit; + Signaux[ligneClicSig+1].na:=i; + maj_db; + efface(i); +end; + +procedure TFormSR.Button1Click(Sender: TObject); begin close; end; diff --git a/UnitTCO.dfm b/UnitTCO.dfm index e8540b1..be4632f 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,6 +1,6 @@ object FormTCO: TFormTCO - Left = 114 - Top = 116 + Left = 113 + Top = 72 Width = 1218 Height = 594 VertScrollBar.Visible = False @@ -1322,6 +1322,10 @@ object FormTCO: TFormTCO Top = 8 object MenuTCO: TMenuItem Caption = 'TCO' + object RechargerleTCOdepuislefichier1: TMenuItem + Caption = 'Recharger le TCO depuis le fichier' + OnClick = RechargerleTCOdepuislefichier1Click + end object SauvegarderleTCO1: TMenuItem Caption = 'Sauvegarder le TCO' OnClick = SauvegarderleTCO1Click diff --git a/UnitTCO.pas b/UnitTCO.pas index a246ac6..08e30e6 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -150,6 +150,7 @@ type AfficherSignauxComplexes1: TMenuItem; Signalvertical180: TMenuItem; RafrachirleTCO1: TMenuItem; + RechargerleTCOdepuislefichier1: TMenuItem; //TimerTCO: TTimer; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -419,6 +420,7 @@ type procedure Mosaqueverticale1Click(Sender: TObject); procedure AfficherSignauxComplexes1Click(Sender: TObject); procedure Signalvertical180Click(Sender: TObject); + procedure RechargerleTCOdepuislefichier1Click(Sender: TObject); private { Déclarations privées } @@ -492,7 +494,7 @@ type sortie : integer; // si action sortie : état end; - // Outil graphique de sélection + // rectangle graphique de sélection Trect_Select= record NumTCO : integer; // affectation du rectangle à ce tco Gd, // grand rectangle @@ -507,9 +509,9 @@ var TamponAffecte,TCO_modifie,clicsouris,prise_N, clicTCO,piloteAig,BandeauMasque,eval_format,sauve_tco,prise_droit,prise_haut, prise_bas,prise_gauche,prise_NE,prise_NO,prise_SE,prise_SO,ligneAffiche,colonneAffiche, - drag,TCOActive,TCOCree,ancienok,dbleClicTCO,auto_tcurs,EvtClicDet : boolean; + drag,TCOActive,TCOCree,ancienok,dbleClicTCO,auto_tcurs,EvtClicDet,SelecBouge : boolean; - HtImageTCO,LargImageTCO,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris,ligne_supprime, + HtImageTCO,LargImageTCO,XminiSel,YminiSel,Temposouris,ligne_supprime, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel,AncienYMiniSel,AncienYMaxiSel, Xclic,Yclic,XClicCellInserer,YClicCellInserer,RatioC,ModeCouleurCanton, AncienXClicCell,AncienYClicCell,TCODrag,epaisseur_voies,Ax,Ay,TpsBougeSouris, @@ -533,10 +535,13 @@ var // pour copier coller TamponTCO : array of array of TTco ; TamponTCO_Org : record - numTCO,x1,y1,x2,y2,NbreCellX,NbreCellY : integer; + numTCO, + x1,y1,x2,y2, // coordoonnées rectangulaires de la sélection + NbreCellX,NbreCellY, + Xorg,Yorg : integer; // point d'origine de la sélection end; - Rect_select : Trect_Select; + Rect_select : Trect_Select; // rectangle de sélection graphique Sauv_rect_select : Trect; // tracé du train dans les TCO @@ -741,16 +746,20 @@ begin end; // Accroche les poignées et bouge le rectangle de sélection graphique +// ici, la souris est enfoncée et est entrain de bouger en x,y procedure Accroche_Rectangle_selection(indexTCO,x,y : integer); -var dx,dy : integer; +var dx,dy,maxX,maxY : integer; r : Trect; rien : boolean; begin rien:=not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_haut) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO); + maxX:=LargeurCell[indexTCO]*NbreCellX[indexTCO]; + maxY:=HauteurCell[indexTCO]*NbreCellY[indexTCO]; + // poignée haut r:=Rect_Select.rN; - if ((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_haut then + if ( ((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_haut) and (y>0) then begin screen.cursor:=crSizeNS; //if (not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then @@ -776,7 +785,7 @@ begin // poignée droite r:=Rect_Select.re; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_droit) then + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_droit) then //and (x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_bas) then + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_bas) then //and (y=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_gauche) then + r:=Rect_Select.rO; // rectangle ouest=poignée gauche + // si x est dans le rectangle + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_gauche) then //and (x>0) then begin screen.cursor:=crSizeWE; if (rien and clicsouris) or prise_gauche then @@ -835,7 +845,7 @@ begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_gauche:=true; - if x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NE) then + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NE) then //and (x0) then begin screen.cursor:=crSizeNESW; if (rien and clicsouris) or prise_NE then @@ -870,7 +880,7 @@ begin // poignée NO r:=Rect_Select.rNO; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NO) then + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NO) then //and (x>0) and (y>0) then begin screen.cursor:=crSizeNWSE; if (rien and clicsouris) or prise_NO then @@ -888,7 +898,7 @@ begin // poignée SE r:=Rect_Select.rSE; - if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SE) then + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SE) then //and (x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SO) then + if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SO) then //and (x>0) and (yr.top) and (yr.Left) and (xr.top) and (yr.Left) and (x0) and (x0) and (ynil then With PcanvasTCO[indexTCO] do begin Pen.Color:=clGrille[IndexTCO]; Pen.mode:=PmCopy; - Pen.width:=1; + Pen.width:=3; MoveTo(Xorg,YOrg); LineTo(Xorg+LargeurCell[indexTCO],YOrg); LineTo(Xorg+LargeurCell[indexTCO],YOrg+HauteurCell[indexTCO]); @@ -1666,15 +1677,22 @@ end; // affiche la sélection bleue des cellules procedure affiche_selection(indexTCO : integer); var r : Trect; + larg,haut : integer; begin -with PImageTCO[indexTCO].Canvas do + if FormTCO[indexTCO].RadioGroupSel.ItemIndex=0 then begin - Pen.Mode:=PmXor; - Pen.color:=clGrille[IndexTCO]; - Brush.Color:=clblue; - //FillRect(r); - r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]); - Rectangle(r); + larg:=largeurCell[indexTCO]; + haut:=HauteurCell[indexTCO]; + + with PImageTCO[indexTCO].Canvas do + begin + Pen.Mode:=PmXor; + Pen.color:=clGrille[IndexTCO]; + Brush.Color:=clblue; + //FillRect(r); + r:=Rect((xminiSel-1)*Larg,(YminiSel-1)*Haut,(XmaxiSel)*larg,(yMaxiSel)*haut); + Rectangle(r); + end; end; end; @@ -1857,14 +1875,14 @@ var b,x0,y0,xt,yt,repr,taillefont,tf : integer; ss,s,nf : string; c : Tcanvas; begin + c:=PcanvasTCO[indextco]; + if c=nil then exit; x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; //PCanvasTCO.Brush.Style:=bsSolid; s:=tco[indextco,x,y].Texte; - c:=PcanvasTCO[indextco]; - b:=tco[indextco,x,y].BImage; if (b=51) then PCanvasTCO[indextco].Brush.Color:=clQuai[indexTCO] else PCanvasTCO[indextco].Brush.Color:=tco[indextco,x,y].CouleurFond; c.Font.Color:=tco[indextco,x,y].CoulFonte; @@ -5071,6 +5089,8 @@ var x0,y0,xf,yf,act : integer; r : Trect; s : string; begin + if PcanvasTCO[indexTCO]=nil then exit; + x0:=(x-1)*LargeurCell[indexTCO]+2; y0:=(y-1)*hauteurCell[indexTCO]+2; xf:=x0+LargeurCell[indexTCO]-4; @@ -5086,59 +5106,54 @@ begin r:=rect(x0,y0,xf,yf); rectangle(r); - if TCOActive then + s:=tco[indexTCO,x,y].Fonte; + if s='' then tco[indexTCO,x,y].Fonte:='Arial'; + //s:=tco[indexTCO,x,y].texte; + s:=''; + if s='' then tco[indexTCO,x,y].repr:=5; // centré en X et Y + act:=tco[indexTCO,x,y].PiedFeu; + if act=1 then begin - s:=tco[indexTCO,x,y].Fonte; - if s='' then tco[indexTCO,x,y].Fonte:='Arial'; - //s:=tco[indexTCO,x,y].texte; - s:=''; - if s='' then tco[indexTCO,x,y].repr:=5; // centré en X et Y - act:=tco[indexTCO,x,y].PiedFeu; - if act=1 then - begin - if s='' then s:='TCO'+intToSTR(tco[indexTCO,x,y].FeuOriente); // feuoriente contient le numéro du TCO + if s='' then s:='TCO'+intToSTR(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'; + end; + if act=2 then + begin + if s='' then s:='SC'; tco[indexTCO,x,y].texte:=s; tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; - end; - if act=2 then - begin - if s='' then s:='SC'; - tco[indexTCO,x,y].texte:=s; - tco[indexTCO,x,y].TailleFonte:=8; - tco[indexTCO,x,y].FontStyle:='G'; - end; - if act=3 then - begin - if s='' then s:='CDM'; - tco[indexTCO,x,y].texte:=s; - tco[indexTCO,x,y].TailleFonte:=8; - tco[indexTCO,x,y].FontStyle:='G'; - end; - if act=4 then - begin - if s='' then s:=intToSTR(tco[indexTCO,x,y].adresse); - tco[indexTCO,x,y].texte:=s; - tco[indexTCO,x,y].TailleFonte:=8; - tco[indexTCO,x,y].FontStyle:='G'; - end; - if act=5 then - begin - if s='' then s:='STOP'; - tco[indexTCO,x,y].texte:=s; - tco[indexTCO,x,y].TailleFonte:=8; - tco[indexTCO,x,y].FontStyle:='G'; - end; - - //tf:=(tco[indexTCO,x,y].TailleFonte*LargeurCell[indexTCO]) div 40; - //tf:=(8*LargeurCell[indexTCO]) div 40;; + end; + if act=3 then + begin + if s='' then s:='CDM'; + tco[indexTCO,x,y].texte:=s; + tco[indexTCO,x,y].TailleFonte:=8; + tco[indexTCO,x,y].FontStyle:='G'; + end; + if act=4 then + begin + if s='' then s:=intToSTR(tco[indexTCO,x,y].adresse); + tco[indexTCO,x,y].texte:=s; + tco[indexTCO,x,y].TailleFonte:=8; + tco[indexTCO,x,y].FontStyle:='G'; + end; + if act=5 then + begin + if s='' then s:='STOP'; + tco[indexTCO,x,y].texte:=s; + tco[indexTCO,x,y].TailleFonte:=8; + tco[indexTCO,x,y].FontStyle:='G'; + end; + //tf:=(tco[indexTCO,x,y].TailleFonte*LargeurCell[indexTCO]) div 40; + //tf:=(8*LargeurCell[indexTCO]) div 40;; //Font.Color:=clwhite; //font.Name:='Arial'; //texte_reparti(s,indexTCO,x,y,tf); - affiche_texte(indextco,x,y); - end; - + affiche_texte(indextco,x,y); end; end; @@ -7548,7 +7563,6 @@ begin end else PlgBlt(PImageTemp[index].Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); - //PimageTemp.Visible:=true; // copie l'image du signal retournée depuis image temporaire vers tco avec une réduction en mode transparennt TransparentBlt(PcanvasTCO[index].Handle,x,y,round(TailleY*FrY),round(TailleX*FrX), // destination PImageTemp[index].Canvas.Handle,0,0,TailleY,TailleX,clBlue); // source - clblue est la couleur de transparence @@ -8657,8 +8671,8 @@ procedure Entoure_cell(indexTCO,x,y : integer); var r : Trect; x0,y0 : integer; begin - x0:=(x-1)*LargeurCell[indexTCO]+1; - y0:=(y-1)*hauteurCell[indexTCO]+1; + x0:=(x-1)*LargeurCell[indexTCO]; + y0:=(y-1)*hauteurCell[indexTCO]; with PcanvasTCO[indexTCO] do begin Pen.width:=3; @@ -8808,7 +8822,7 @@ begin // afficher les sélections si elles sont présentes if entoure[indexTCO] then Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]); - if rect_select.NumTCO<>0 then Affiche_Rectangle(IndexTCO,Rect_select); + if (rect_select.NumTCO<>0) and (IndexTCO=rect_select.NumTCO) then Affiche_Rectangle(IndexTCO,Rect_select); // rectangle graphique if selectionaffichee[indexTCO] then Affiche_selection(indexTCO); end; @@ -8819,7 +8833,7 @@ begin if affevt or (debug=1) then Affiche('FormTCO'+intToSTR(indexTCOCreate)+' create',clLime); //Screen.OnActiveControlChange := ActiveControlChanged; visible:=false; // ne s'affiche pas par défaut et évite l'effet fenetre fantome. - + PCanvasTCO[indexTCOCreate]:=nil; offsetSourisY:=-10; // permet de tenir l'icone au milieu quand on fait un glisser offsetSourisX:=-10; RadioGroupSel.ItemIndex:=0; @@ -8831,7 +8845,8 @@ begin epaisseur_voies:=5; XclicCell[indexTCOCreate]:=1; YclicCell[indexTCOCreate]:=1; - xCoupe:=0;yCoupe:=0; + TamponTCO_org.Xorg:=0; + TamponTCO_org.Yorg:=0; indexTrace:=0; KeyPreview:=true; // valide les évènements clavier TrackBarZoom.Tabstop:=false; // permet d'avoir les evts curseurs @@ -8839,10 +8854,11 @@ begin ButtonConfigTCO.TabStop:=false; ButtonRaz.TabStop:=false; ButtonDessiner.TabStop:=false; + SelecBouge:=false; //TrackBarZoom.position:=78; couleurAdresse:=clCyan; - xMiniSel:=99999;yMiniSel:=99999; + xMiniSel:=99999;yMiniSel:=99999; // coordonnées cellules xMaxiSel:=0;yMaxiSel:=0; SelectionAffichee[indexTCOCreate]:=false; //ImageTCO.Canvas.font.Name:='Arial'; //<--- peut générer exception out of ressource!! @@ -8982,27 +8998,30 @@ begin for t:=1 to NbreTCO do begin - n:=Trace_Train[t].train[train].nombre; - if n=0 then exit; - i:=n; - repeat - x:=Trace_Train[t].train[train].route[i].x; - y:=Trace_Train[t].train[train].route[i].y; - Bimage:=tco[t,x,y].BImage; - trouve:=isAigTCO(Bimage); - dec(i); - until trouve or (i=0); - - if trouve then + if PcanvasTCO[t]<>nil then begin - for j:=i+1 downto 1 do + n:=Trace_Train[t].train[train].nombre; + if n=0 then exit; + i:=n; + repeat + x:=Trace_Train[t].train[train].route[i].x; + y:=Trace_Train[t].train[train].route[i].y; + Bimage:=tco[t,x,y].BImage; + trouve:=isAigTCO(Bimage); + dec(i); + until trouve or (i=0); + + if trouve then begin - x:=Trace_Train[t].train[train].route[j].x; - y:=Trace_Train[t].train[train].route[j].y; - tco[t,x,y].mode:=0; - Affiche_cellule(t,x,y); + for j:=i+1 downto 1 do + begin + x:=Trace_Train[t].train[train].route[j].x; + y:=Trace_Train[t].train[train].route[j].y; + tco[t,x,y].mode:=0; + Affiche_cellule(t,x,y); + end; end; - end; + end; end; end; @@ -9128,8 +9147,7 @@ end; // Ne nécessite pas que les aiguillages aoient bien positionnés entre det1 et det2 // procédure récursive quand on passe par un aiguillage en pointe pour explorer les éléments opposés procedure zone_tco(indexTCO,det1,det2,train,mode: integer); -var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteration,indexIr, - sx,sy,position : integer; +var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteration,indexIr : integer; memtrouve,sortir,casok,indextrouve : boolean; s : string; @@ -9166,8 +9184,8 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio // récursivité suivante leur valeur, mais elles reprennent leur valeurs initiales à la remontée vers la résursivité appellante. Procedure El_tco(x,y,train : integer; ir : integer); var mdl : Tequipement; - i,j,index :integer; - posAig : boolean; + i,j,index,position : integer; + posAig,SortirBoucle : boolean; begin posAig:=true; // répète la route depuis un aiguillage @@ -9176,6 +9194,7 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio i:=0; repeat + sortirBoucle:=false; maj_route(indextco,x,y,train,ir); adresse:=tco[indextco,x,y].Adresse ; index:=index_aig(adresse); @@ -9851,10 +9870,10 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio inc(i); if (adresse=det2) and (adresse<>0) then memTrouve:=true; if (adresse=0) and (det2=0) and (tco[indexTCO,x,y].buttoir<>0) then memTrouve:=true; - if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and ((adresse<>det2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; + if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and ((adresse<>det2) and (adresse<>det1) and (adresse<>0)) then sortirBoucle:=true; if (i>200) or (iteration>200) then sortir:=true; Maj_coords(AncienX,AncienY,x,y); - until sortir or memtrouve; + until sortir or memtrouve or SortirBoucle; if DebugTCO and not(memtrouve) then AfficheDebug('Fin de boucle dét '+intToSTR(det2)+' non trouvé',clOrange); //mémoriser l'index de route si on a trouvé det2, et uniquement sur la première itération quand on l'a trouvé @@ -9872,6 +9891,7 @@ var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteratio // Début de la procédure zone_tco begin if debugTCO then AfficheDebug('Zone_TCO'+intToSTR(indexTCO)+' det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' Train'+intToSTR(Train)+' mode='+intToSTR(mode),clWhite); + if PcanvasTCO[indexTCO]=nil then exit; trouve_det(indexTCO,det1,Xdet1,Ydet1); if (Xdet1=0) or (Ydet1=0) then exit; @@ -10180,7 +10200,7 @@ var indextco : integer; begin indextco:=index_TCO(sender); IndexTCOCourant:=indexTCO; - if affevt then Affiche('Form TCO'+intToSTR(indexTCO)+' activate',clyellow); + if affevt or (debug=1) then Affiche('Form TCO'+intToSTR(indexTCO)+' activate',clyellow); Caption:='TCO'+intToSTR(indexTCO)+' : '+NomFichierTCO[indexTCO]; if indexTCO=0 then exit; {initalisation des dimensions du tco - à ne faire qu'une fois} @@ -10196,7 +10216,6 @@ begin LargeurCelld2[indexTCO]:=LargeurCell[indexTCO] div 2;hauteurCelld2[indexTCO]:=hauteurCell[indexTCO] div 2; calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]); - dessine_icones(indexTCO); NbCellulesTCO[indexTCO]:=NbreCellX[indexTCO]*NbreCellY[indexTCO]; ImageTCO.Width:=LargeurCell[indexTCO]*NbreCellX[indexTCO]; @@ -10213,19 +10232,8 @@ begin // initialiser le pointeur image temporaire du TCO PImageTemp[indextco]:=FormTCO[indextco].ImageTemp; - // peindre l'image en bleu pour la transparence , nécessaire en cas de décalage des signaux à 180° mais correction apportée dans feu_180 - with PImageTemp[indextco].Canvas do - begin - Pen.Color:=ClBlue; - Brush.Color:=CLBlue; - // FillRect(Rect(0,0,100,100)); - end; - - //PImageTemp[indextco].Canvas.Rectangle(0,0,PImageTemp[indextco].Width,PimageTemp[indextco].Height); - //PImageTemp[indextco].Picture.Bitmap.TransparentMode:=tmAuto; - //PImageTemp[indextco].Picture.Bitmap.TransparentColor:=clblue; - //PImageTemp[indextco].Transparent:=true; + dessine_icones(indexTCO); //déclenche l'Affiche_tco if ZoomInit[indexTCO]<>0 then FormTCO[indexTCO].TrackBarZoom.Position:=ZoomInit[indexTCO] else TrackBarZoom.position:=34; @@ -10460,13 +10468,13 @@ begin if TamponAffecte then begin - if (xCoupe<>0) and (ycoupe<>0) then + if (TamponTCO_org.Xorg<>0) and (TamponTCO_org.Yorg<>0) then begin for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do // rectangle de la sélection for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do begin - xPlace:=xCoupe+x-TamponTCO_Org.x1; // destination - yPlace:=yCoupe+y-TamponTCO_Org.y1; + xPlace:=TamponTCO_org.Xorg+x-TamponTCO_Org.x1; // destination + yPlace:=TamponTCO_org.Yorg+y-TamponTCO_Org.y1; if (xPlace<=NbreCellX[indexTCO]) and (yPlace<=NbreCellY[indexTCO]) then begin @@ -10542,31 +10550,69 @@ end; procedure copier(indexTCO : integer); -var x,y : integer; +var x,y,xmax,ymax,larg,haut : integer; begin if SelectionAffichee[indexTCO] then begin + if FormTCO[indexTCO].RadioGroupSel.ItemIndex=1 then + begin + larg:=largeurCell[indexTCO]; + haut:=hauteurCell[indexTCO]; + xMax:=larg*NbreCellX[indexTCO]; + yMax:=haut*NbreCellY[indexTCO]; + + xMiniSel:=(Rect_select.Gd.Left div larg)+1; + yMiniSel:=(Rect_select.Gd.top div haut)+1; + xMaxiSel:=(Rect_select.Gd.right div larg)+1; + yMaxiSel:=(Rect_select.Gd.bottom div haut)+1; + if xminiSel>xMaxiSel then echange(xminiSel,xMaxiSel); + if yminiSel>yMaxiSel then echange(yminiSel,yMaxiSel); + if xMiniSel<1 then xMiniSel:=1; + if xMiniSel>xMax then xMiniSel:=xMax; + if yMiniSel<1 then yMiniSel:=1; + if yMiniSel>yMax then yMiniSel:=yMax; + if xMaxiSel>xMax then xmaxiSel:=xMax; + if yMaxiSel>yMax then ymaxiSel:=yMax; + end; + TamponTCO_org.numTCO:=indexTCO; - TamponTCO_Org.x1:=XminiSel div LargeurCell[indexTCO] +1; - TamponTCO_Org.x2:=XmaxiSel div LargeurCell[indexTCO] +1; - TamponTCO_Org.y1:=yminiSel div hauteurCell[indexTCO] +1; - TamponTCO_Org.y2:=ymaxiSel div hauteurCell[indexTCO] +1; + tamponTCO_Org.Xorg:=xMiniSel; + tamponTCO_Org.Yorg:=yMiniSel; + TamponTCO_Org.x1:=XminiSel ; + TamponTCO_Org.x2:=XmaxiSel ; + TamponTCO_Org.y1:=yminiSel ; + TamponTCO_Org.y2:=ymaxiSel ; for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do begin - //Affiche(intToSTR(x)+' '+intToSTR(y),clred); tampontco[x,y]:=tco[indextco,x,y]; end; TamponAffecte:=true; + end + + else + + // copie sans sélection : on coupe une seule cellule + begin + tampontco[XclicCell[indexTCO],YclicCell[indexTCO]]:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]]; // pour pouvoir faire annuler couper + TamponTCO_org.x1:=XclicCell[indexTCO];TamponTCO_org.y1:=YclicCell[indexTCO]; + TamponTCO_org.x2:=XclicCell[indexTCO];TamponTCO_org.y2:=YclicCell[indexTCO]; + TamponTCO_org.numTCO:=indexTCO; + TamponAffecte:=true; + TamponTCO_org.xOrg:=XclicCell[indexTCO]; + TamponTCO_org.yOrg:=YclicCell[indexTCO]; end; end; procedure couper(indexTCO: integer); -var x,y,XCell1,YCell1,xCell2,yCell2 : integer; +var x,y,xMax,Ymax,XCell1,YCell1,xCell2,yCell2,haut,larg : integer; begin + larg:=largeurCell[indexTCO]; + haut:=hauteurCell[indexTCO]; + if (XclicCell[indexTCO]=0) or (YclicCell[indexTCO]=0) then exit; //Affiche(intToSTR(ancienXclic)+' '+intToSTR(XclicCell[indexTCO]),clred); - if (AncienXclic=XclicCell[indexTCO]) and (AncienYclic=YclicCell[indexTCO]) then exit; + //if (AncienXclic=XclicCell[indexTCO]) and (AncienYclic=YclicCell[indexTCO]) then exit; AncienXclic:=XclicCell[indexTCO]; AncienYclic:=YclicCell[indexTCO]; @@ -10580,12 +10626,27 @@ begin // couper par la fenetre graphique if FormTCO[indexTCO].RadioGroupSel.ItemIndex=1 then begin - xMiniSel:=Rect_select.Gd.Left; - yMiniSel:=Rect_select.Gd.top; - xMaxiSel:=Rect_select.Gd.right; - yMaxiSel:=Rect_select.Gd.bottom; + xMax:=larg*NbreCellX[indexTCO]; + yMax:=haut*NbreCellY[indexTCO]; + + xMiniSel:=(Rect_select.Gd.Left div larg)+1; + yMiniSel:=(Rect_select.Gd.top div haut)+1; + xMaxiSel:=(Rect_select.Gd.right div larg)+1; + yMaxiSel:=(Rect_select.Gd.bottom div haut)+1; if xminiSel>xMaxiSel then echange(xminiSel,xMaxiSel); if yminiSel>yMaxiSel then echange(yminiSel,yMaxiSel); + if xMiniSel<1 then xMiniSel:=1; + if xMiniSel>xMax then xMiniSel:=xMax; + if yMiniSel<1 then yMiniSel:=1; + if yMiniSel>yMax then yMiniSel:=yMax; + if xMaxiSel>xMax then xmaxiSel:=xMax; + if yMaxiSel>yMax then ymaxiSel:=yMax; + TamponTCO_org.xOrg:=xminiSel; + TamponTCO_org.yOrg:=yminiSel; + + //Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange); + //Affiche('xcoupe'+intToSTR(xcoupe),clyellow); + // effacer le rectangle Affiche_Rectangle(IndexTCO,Rect_select); Rect_select.NumTCO:=0; // indicateur de non affichage @@ -10599,46 +10660,51 @@ begin TamponTCO_org.x2:=XclicCell[indexTCO];TamponTCO_org.y2:=YclicCell[indexTCO]; raz_cellule(indextco,XclicCell[indexTCO],YClicCell[indexTCO]); - + TamponTCO_org.numTCO:=indexTCO; efface_entoure(indexTCO); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XclicCell[indexTCO],YClicCell[indexTCO],PmCopy); TamponAffecte:=true; - xCoupe:=XclicCell[indexTCO];yCoupe:=YclicCell[indexTCO]; + TamponTCO_org.xOrg:=XclicCell[indexTCO]; + TamponTCO_org.yOrg:=YclicCell[indexTCO]; Affiche_tco(indexTCO); exit; end; TCO_modifie:=true; + copier(indexTCO); SelectionAffichee[indexTCO]:=false; - xCell1:=XminiSel div LargeurCell[indexTCO] +1; - xCell2:=XmaxiSel div LargeurCell[indexTCO] +1; - yCell1:=yminiSel div hauteurCell[indexTCO] +1; - yCell2:=ymaxiSel div hauteurCell[indexTCO] +1; + xCell1:=XminiSel; + xCell2:=XmaxiSel; + yCell1:=yminiSel; + yCell2:=ymaxiSel; - xCoupe:=XCell1;yCoupe:=yCell1; for y:=yCell1 to yCell2 do for x:=xCell1 to xCell2 do begin raz_cellule(indextco,x,y); - //Affiche('Efface cellules '+IntToSTR(X)+' '+intToSTR(y),clyellow); + //Affiche('Efface cellules '+IntToSTR(x)+' '+intToSTR(y),clyellow); efface_entoure(indexTCO); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,X,Y,PmCopy); if avecGrille[indexTCO] then grille(indexTCO); end; end; +// coordonnées cellules procedure selection_bleue(indexTCO,cellX,cellY : integer); -var xMiniSelP,yminiSelP,xMaxiSelP,ymaxiSelP : integer; +var xMiniSelP,yminiSelP,xMaxiSelP,ymaxiSelP,larg,haut : integer; r : Trect; begin -// zone de sélection bleue en coords pixels - xMiniSel:=(Xentoure[indexTCO]-1)*LargeurCell[indexTCO];; - yMiniSel:=(Yentoure[indexTCO]-1)*HauteurCell[indexTCO];; - xMaxiSel:=(cellX-1)*LargeurCell[indexTCO]; - yMaxiSel:=(cellY-1)*hauteurCell[indexTCO]; + larg:=largeurCell[indexTCO]; + haut:=hauteurCell[indexTCO]; + +// zone de sélection bleue en cellules + xMiniSel:=(Xentoure[indexTCO]); + yMiniSel:=(Yentoure[indexTCO]); + xMaxiSel:=(cellX); + yMaxiSel:=(cellY); xminiSelP:=min(xminiSel,xMaxiSel); yminiSelP:=min(yminiSel,yMaxiSel); @@ -10651,6 +10717,7 @@ begin yMaxiSel:=yMaxiSelP; //Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange); + //Affiche('xcoupe'+intToSTR(xcoupe),clyellow); // efface l'ancien rectangle de sélection if SelectionAffichee[indexTCO] then @@ -10664,7 +10731,7 @@ begin if piloteAig then begin SelectionAffichee[indexTCO]:=false;piloteAig:=false;exit;end; - r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]); + r:=Rect((xminiSel-1)*larg,(YminiSel-1)*haut,(XmaxiSel)*larg,(yMaxiSel*haut)); // Affiche le nouveau rectangle de sélection Rancien:=r; @@ -10682,11 +10749,11 @@ end; procedure selec_tout(indexTCO : integer); begin if indexTCO<0 then exit; - xminiSel:=0; - yminiSel:=0; - xMaxiSel:=(NbreCellX[indexTCO]-1)*LargeurCell[indexTCO]; - yMaxiSel:=(NbreCellY[indexTCO]-1)*hauteurCell[indexTCO]; - rAncien:=rect(xminiSel,YminiSel,xmaxiSel+LargeurCell[indexTCO],YMaxiSel+hauteurCell[indexTCO]); + xminiSel:=1; + yminiSel:=1; + xMaxiSel:=NbreCellX[indexTCO]; + yMaxiSel:=NbreCellY[indexTCO]; + rAncien:=rect(xminiSel,YminiSel,xmaxiSel*LargeurCell[indexTCO],YMaxiSel*hauteurCell[indexTCO]); SelectionAffichee[indexTCO]:=true; with formTCO[indexTCO].imageTCO.Canvas do @@ -10696,6 +10763,8 @@ begin Brush.Color:=clblue; Rectangle(rAncien); end; + TamponTCO_org.xOrg:=1; + TamponTCO_org.yOrg:=1; end; @@ -11014,11 +11083,11 @@ begin stocke_undo(indexTCO,1,XClic,YClic); maj_undo(1); - tco[indextco,XClic,YClic].BImage:=icone; - tco[indextco,XClic,YClic].liaisons:=liaisons[icone]; + tco[indextco,XClic,YClic].BImage:=icone; // Image de la cellule + tco[indextco,XClic,YClic].liaisons:=liaisons[icone]; // liaisons des voies tco[indextco,xClic,YClic].CoulFonte:=clYellow; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Repr:=2; - formTCO[indexTCO].EditAdrElement.Text:=IntToSTR( tco[indextco,XClic,YClic].Adresse); + formTCO[indexTCO].EditAdrElement.Text:=IntToSTR(tco[indextco,XClic,YClic].Adresse); formTCO[indexTCO].EdittypeImage.Text:=IntToSTR(tco[indextco,XClic,YClic].BImage); end; @@ -11261,6 +11330,12 @@ begin TCO_modifie:=true; ligne_supprime:=0; colonne_supprime:=0; + + // efface rectangle graphique + if Rect_select.NumTCO=indexTCO then affiche_rectangle(IndexTCO,Rect_select); + Rect_select.NumTCO:=0; + selectionAffichee[indexTCO]:=false; + end; end; @@ -11756,7 +11831,6 @@ begin if button=mbLeft then begin - // zizi //Affiche('TCO'+intToSTR(indexTCO)+' souris clicG enfoncée',clYellow); if affEvt then Affiche('TCO'+intToSTR(i)+' souris clicG enfoncée',clYellow); if dbleClicTCO then begin dbleClicTCO:=false;exit;end; @@ -11932,15 +12006,36 @@ begin exit; end; - // si clic souris en mode fenetre graphique: initialisation + // si clic souris en mode fenetre graphique: initialisation du rectangle bleu de sélection graphique if (RadioGroupSel.ItemIndex=1) then begin - if rect_select.NumTCO<>indexTCO then - begin - affiche_rectangle(rect_select.NumTCO,Rect_select); // effacer sur l'autre tco - end; if not(selectionAffichee[indexTCO]) then begin + // si une zone de sélection est affichée annuler toutes + for n:=1 to NbreTCO do + begin + // mode cellule + if SelectionAffichee[n] then + begin + //Affiche('efface sélection',clOrange); + with formTCO[n].imageTCO.Canvas do + begin + Pen.Mode:=PmXor; + Pen.color:=clGrille[n]; + Brush.Color:=clblue; + Rectangle(rAncien); + end; + end; + // mode graphique + if (n<>indexTCO) and (rect_select.NumTCO=n) then + begin + Affiche('Efface sur TCO'+intToSTR(n),clred); + affiche_rectangle(rect_select.NumTCO,Rect_select); // effacer sur l'autre tco + rect_select.NumTCO:=0; + end; + end; + + // créer nouveau rectangle graphique rect_select.NumTCO:=indexTCO; // indicateur d'affichage with Rect_select.Gd do begin @@ -11956,8 +12051,9 @@ begin end else begin - xMiniSel:=99999;yMiniSel:=99999; - xMaxiSel:=0;yMaxiSel:=0; + // Affiche('HAHA',clred); + // xMiniSel:=99999;yMiniSel:=99999; + // xMaxiSel:=0;yMaxiSel:=0; // si une zone de sélection est affichée sur un des TCO, annuler toutes for n:=1 to NbreTCO do @@ -12068,7 +12164,7 @@ end; procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer); var r : Trect; - indexTCO,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer; + indexTCO,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP,larg,haut : integer; ok : boolean; begin if affevt then Affiche('ImageTCOMouseMove',clLime); @@ -12076,14 +12172,46 @@ begin //Affiche(IntToSTR(tempoSouris),clred); indexTCO:=index_tco(sender); - // exécuté uniquement si souris enfoncée et changement position souris - if (radioGroupSel.ItemIndex=1) and ((ax<>x) or (ay<>y)) and selectionAffichee[indexTCO] then + //Affiche(intToSTR(x)+','+intToSTR(y),clYellow); + + // exécuté uniquement si changement position souris + if (ax<>x) or (ay<>y) then begin - //Affiche(IntToSTR(tick),clred); - Accroche_Rectangle_selection(indexTCO,x,y); - exit; + if (radioGroupSel.ItemIndex=1) then + begin + //Affiche(IntToSTR(tick),clred); + Accroche_Rectangle_selection(indexTCO,x,y); + exit; + end; + { + if (radioGroupSel.ItemIndex=0) then + begin + //if not(clicsouris) then affiche('non',clred); + if clicsouris and SelecBouge then + begin + //zizi + x0:=(xMiniSel-1)*LargeurCell[indexTCO]; + y0:=(yMiniSel-1)*hauteurCell[indexTCO]; + larg:=((xMaxiSel-xMiniSel)+1)*LargeurCell[indexTCO]; + haut:=((yMaxiSel-yMiniSel)+1)*HauteurCell[indexTCO]; + //Affiche(intToSTR(xMiniSel)+',BUBU'+intToSTR(xMaxiSel),clred); + BitBlt(formTCO[indexTCO].ImageTCO.canvas.Handle,ax,ay,larg,haut,oldbmp.canvas.handle,0,0,SRCCOPY); // restitue l'ancien + BitBlt(oldbmp.canvas.handle,0,0,larg,haut,FormTCO[IndexTCO].ImageTCO.Canvas.Handle,x,y,SRCCOPY); //copier le nouveau + formTCO[indexTCO].ImageTCO.Repaint; + + //bitBlt(FormTCO[IndexTCO].ImageTemp.canvas.handle,0,0,larg,haut,FormTCO[IndexTCO].ImageTCO.Canvas.Handle,x,y,SRCCOPY); + //formTCO[indexTCO].ImageTemp.Repaint; + + ax:=x; + ay:=y; + + exit; + end; } end; + ax:=x; + ay:=y; + if selecBouge then exit; if Temposouris>0 then exit; // Affiche('*',cllime); //affiche(intToSTR(y),clorange); @@ -12145,11 +12273,15 @@ begin TpsBougeSouris:=5; if not(clicsouris) or (temposouris>0) then exit; - // zone de sélection bleue en coordonnées souris - xMiniSel:=(XclicCell[indexTCO]-1)*LargeurCell[indexTCO]; - yMiniSel:=(YclicCell[indexTCO]-1)*hauteurCell[indexTCO]; - xMaxiSel:=(cellX-1)*LargeurCell[indexTCO]; - yMaxiSel:=(cellY-1)*hauteurCell[indexTCO]; + //Affiche('ajuste rect',clWhite); + larg:=largeurCell[indexTCO]; + haut:=hauteurCell[indexTCO]; + + // zone de sélection bleue en coordonnées cellules + xMiniSel:=XclicCell[indexTCO]; + yMiniSel:=YclicCell[indexTCO]; + xMaxiSel:=cellX; // cellX = position cellule souris actuelle + yMaxiSel:=cellY; xminiSelP:=min(xminiSel,xMaxiSel); yminiSelP:=min(yminiSel,yMaxiSel); @@ -12161,8 +12293,8 @@ begin xMaxiSel:=xMaxiSelP; yMaxiSel:=yMaxiSelP; - //Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange); - //Affiche('XclicCell='+intToSTR(XclicCell[indexTCO])+' YclicCell='+intToSTR(XclicCell[indexTCO]),clorange); + // Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange); + // Affiche('XclicCell='+intToSTR(XclicCell[indexTCO])+' YclicCell='+intToSTR(XclicCell[indexTCO]),clorange); // efface l'ancien rectangle de sélection if SelectionAffichee[indexTCO] then @@ -12176,7 +12308,7 @@ begin if piloteAig then begin SelectionAffichee[indexTCO]:=false;piloteAig:=false;exit;end; - r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]); + r:=Rect((xminiSel-1)*larg,(YminiSel-1)*haut,XmaxiSel*larg,yMaxiSel*haut); Rancien:=r; Affiche_selection(indexTCO); @@ -12186,12 +12318,14 @@ begin if entoure[indexTCO] then begin Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]);entoure[indexTCO]:=false;end; // efface end; -procedure TFormTCO.ImageTCOMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); +procedure TFormTCO.ImageTCOMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); +var indexTCO,lg,ht,xo,yo : integer; begin if affevt then Affiche('Souris clic relachée',clyellow); clicsouris:=false; - + SelecBouge:=false; + indextco:=index_TCO(sender); + prise_droit:=false; prise_gauche:=false; prise_bas:=false; @@ -12201,6 +12335,21 @@ begin prise_SE:=false; prise_NO:=false; prise_N:=false; + + // on relache la souris après avoir tiré un rectange de séection + if selectionAffichee[indexTCO] and (FormTCO[indexTCO].RadioGroupSel.ItemIndex=0) then + // + begin + xo:=(xMiniSel-1)*LargeurCell[indexTCO]; + yo:=(yMiniSel-1)*hauteurCell[indexTCO]; + lg:=((xMaxiSel-xMiniSel)+1)*LargeurCell[indexTCO]; + ht:=((yMaxiSel-yMiniSel)+1)*HauteurCell[indexTCO]; + //affiche('relache carré',clWhite); + SelecBouge:=true; + + // poubouge dynamique BitBlt(oldbmp.canvas.handle,0,0,lg,ht,FormTCO[IndexTCO].ImageTCO.Canvas.Handle,xo,yo,SRCCOPY); + + end; end; procedure TFormTCO.ButtonRedessineClick(Sender: TObject); @@ -12223,7 +12372,7 @@ begin s:=formTCO[indexTCO].EditAdrElement.Text; if length(s)>1 then begin - if (s[1]='A') or (s[1]='a') then delete(s,1,1); + if (s[1]='A') or (s[1]='a') then delete(s,1,1); EditAdrElement.Text:=s; end; @@ -12259,6 +12408,7 @@ end; procedure Maj_TCO(indexTCO,Adresse : integer); var x,y: integer; begin + if PcanvasTCO[indexTCO]=nil then exit; for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin @@ -12274,6 +12424,7 @@ end; procedure Maj_Aig_TCO(indexTCO :integer); var x,y: integer; begin + if PcanvasTCO[indexTCO]=nil then exit; for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin @@ -12291,18 +12442,21 @@ begin for ntco:=1 to NbreTCO do begin // trouver les cellules comportant l'aiguillage adresse - for y:=1 to NbreCellY[ntco] do - for x:=1 to NbreCellX[ntco] do - begin - Bim:=TCO[ntco,x,y].BImage; - if IsAigTCO(Bim) then + if PcanvasTCO[ntco]<>nil then + begin + for y:=1 to NbreCellY[ntco] do + for x:=1 to NbreCellX[ntco] do begin - if TCO[ntco,x,y].Adresse=adresse then + Bim:=TCO[ntco,x,y].BImage; + if IsAigTCO(Bim) then begin - affiche_cellule(ntco,x,y); + if TCO[ntco,x,y].Adresse=adresse then + begin + affiche_cellule(ntco,x,y); + end; end; end; - end; + end; end; end; @@ -13340,8 +13494,8 @@ begin TamponTCO_Org.y2:=ligne_supprime; // case de destination - xcoupe:=1; - ycoupe:=ligne_supprime; + TamponTCO_org.xOrg:=1; + TamponTCO_org.yOrg:=ligne_supprime; // remplir tempon de sauvegarde for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do @@ -13391,8 +13545,8 @@ begin TamponTCO_Org.y2:=NbreCellY[indexTCO]; // cellule de destination - xcoupe:=colonne_supprime; - ycoupe:=1; + TamponTCO_org.xOrg:=colonne_supprime; + TamponTCO_org.yOrg:=1; for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do @@ -13580,7 +13734,7 @@ begin //formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage); //actualise(indexTCO); // pour mise à jour de l'image de la fenetre FormConfCellTCO efface_entoure(indexTCO); - affiche_cellule(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); + affiche_cellule(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); end; @@ -13592,6 +13746,15 @@ begin c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); + if indexTCO<1 then exit; + // si le rectangle de sélection graphique est affiché dans ce tco, l'effacer + if Rect_select.NumTCO=indexTCO then + begin + affiche_rectangle(IndexTCO,Rect_select); + Rect_select.NumTCO:=0; + selectionAffichee[indexTCO]:=false; + end; + RadioGroupSel.ItemIndex:=0; // repasser en mode sélection par cellules selec_tout(indexTCO); end; @@ -13809,9 +13972,13 @@ begin // sélection par cellules if RadioGroupSel.ItemIndex=0 then begin - // si le rectangle est affiché dans ce tco, l'effacer - if Rect_select.NumTCO=indexTCO then affiche_rectangle(IndexTCO,Rect_select); - Rect_select.NumTCO:=0; + screen.cursor:=crDefault; + // efface le rectabgle graphique du TCO courant + if Rect_select.NumTCO=indexTCO then + begin + affiche_rectangle(IndexTCO,Rect_select); + Rect_select.NumTCO:=0; + end; selectionAffichee[indexTCO]:=false; end; // sélection par outil graphique @@ -13825,12 +13992,13 @@ begin defocusControl(RadioGroupSel,true); end; +// renvoie le numéro de TCO à l'origine de l'evt du mainmenutco function TformTCO.index_TCOMainMenu : integer; var t : Tcontrol; s : string; begin t:=FindControl(mainmenuTCO.WindowHandle); // on ne peut pas remonter au parent d'un mainmenu avec getparentcomponent - s:=t.name; + s:=t.name; // nom de la form TCOx result:=extract_int(s); end; @@ -13843,7 +14011,7 @@ procedure TFormTCO.DessinerleTCO1Click(Sender: TObject); var indexTCO : integer; begin - indexTCO:=index_TCOMainMenu; + indexTCO:=index_TCOMainMenu; // renvoie le numéro du TCO qui est à l'origine de l'evt menu dessinerTCO(indexTCO); end; @@ -13903,6 +14071,21 @@ begin end; end; +procedure TFormTCO.RechargerleTCOdepuislefichier1Click(Sender: TObject); +var indexTCO,res : integer; +begin + indexTCO:=index_TCOMainMenu; + if TCO_modifie then + begin + res:=MessageDlg('Un des TCO a été modifié. '+#13+'Voulez-vous recharger le TCO : '+nomfichierTCO[indexTCO],mtConfirmation,[mbYes,mbNo,mbCancel],0); + if res=mrYes then + begin + lire_fichier_tco(indexTCO); + Affiche_TCO(indexTCO); + end; + if res=mrCancel then abort; + end; +end; end. diff --git a/Unit_Pilote_aig.pas b/Unit_Pilote_aig.pas index 614be14..b10be06 100644 --- a/Unit_Pilote_aig.pas +++ b/Unit_Pilote_aig.pas @@ -176,4 +176,8 @@ begin end; begin + + + + end. diff --git a/Unitplace.pas b/Unitplace.pas index dffc0df..c25ddec 100644 --- a/Unitplace.pas +++ b/Unitplace.pas @@ -107,6 +107,7 @@ end; procedure TFormPlace.FormActivate(Sender: TObject); begin + if affevt then affiche('FormPlace activate',clLime); LabelTrain1.Caption:=trains[1].nom_train; Edit1.text:=intToSTR(placement[1].detecteur); EditDir1.Text:=IntToSTR(placement[1].detdir); @@ -570,6 +571,7 @@ end; procedure TFormPlace.FormCreate(Sender: TObject); begin + if affevt then affiche('FormPlace Create',clLime); if debug=1 then Affiche('Début création fenetre Place',clLime); position:=poMainFormCenter; PlaceAffiche:=true; diff --git a/verif_version.pas b/verif_version.pas index 8dc9cf2..3d79017 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -25,7 +25,7 @@ var verifVersion,notificationVersion,essai : boolean; chemin_Dest,chemin_src,date_creation,nombre_tel : string; -Const Version='8.5'; // sert à la comparaison de la version publiée +Const Version='8.51'; // 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; @@ -590,7 +590,6 @@ begin SHFileOperation(FileFolderOperation); end; -// https://github.com/sx2008/Delphi-Test-Apps/blob/master/ShellZipTest/ShellZipTool.pas function Unzip(zipfile : oleVariant): boolean; var shellobj,srcfldr, destfldr, shellfldritems,repertoire: Olevariant; @@ -617,7 +616,6 @@ begin exit; end; - repertoire:=filtre; // mettre dans olevariant filtre:=''; diff --git a/versions.txt b/versions.txt index d21d48f..0bc6724 100644 --- a/versions.txt +++ b/versions.txt @@ -233,15 +233,15 @@ version 8.41 : Am version 8.42 : Création d'un onglet de paramètres avancés. Fichier d'aide affichable depuis le menu. version 8.43 : Correction d'un bug sur l'importation des détecteurs depuis CDM rail. -version 8.44 : Gestion de la centrale Z21 en mode autonome en Xpressnet. +version 8.5 : Gestion de la centrale Z21 en mode autonome en Xpressnet. Amélioration des réservations des aiguillages. Amélioration affichages des trajets dans les TCOs. Amélioration des réceptions des trames XpressNet. Ajout d'une action "arrêt des trains" pour les TCOs - - - +version 8.51 : Améliorations sur l'affichage des fenêtres aux démarrage. + Création commandes des lignes DTR et RTS sur les périphériques COM/USB. + Gestion des déconnexions matérielles des ports COM/USB. + -