diff --git a/Notice d'utilisation des signaux_complexes_GL_V5.6.pdf b/Notice d'utilisation des signaux_complexes_GL_V5.7.pdf similarity index 78% rename from Notice d'utilisation des signaux_complexes_GL_V5.6.pdf rename to Notice d'utilisation des signaux_complexes_GL_V5.7.pdf index bf0247c..6107e0e 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V5.6.pdf and b/Notice d'utilisation des signaux_complexes_GL_V5.7.pdf differ diff --git a/Signaux_complexes_GL.cfg b/Signaux_complexes_GL.cfg index 69e7fa7..acb7715 100644 --- a/Signaux_complexes_GL.cfg +++ b/Signaux_complexes_GL.cfg @@ -14,8 +14,8 @@ -$N+ -$O+ -$P+ --$Q- --$R- +-$Q+ +-$R+ -$S- -$T- -$U- diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index 5573344..d5ff374 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -17,8 +17,8 @@ M=0 N=1 O=1 P=1 -Q=0 -R=0 +Q=1 +R=1 S=0 T=0 U=0 diff --git a/UnitCDF.dcu b/UnitCDF.dcu index 2df17c1..8c8d6c2 100644 Binary files a/UnitCDF.dcu and b/UnitCDF.dcu differ diff --git a/UnitCDF.dfm b/UnitCDF.dfm index 860606b..73eeb41 100644 --- a/UnitCDF.dfm +++ b/UnitCDF.dfm @@ -223,21 +223,12 @@ object FormCDF: TFormCDF Height = 13 Caption = '1 '#224' 4' end - object Button1: TButton - Left = 128 - Top = 432 - Width = 75 - Height = 25 - Caption = 'Ok' - TabOrder = 0 - OnClick = Button1Click - end object Edit1: TEdit Left = 120 Top = 176 Width = 25 Height = 21 - TabOrder = 1 + TabOrder = 0 OnChange = Edit1Change end object Edit2: TEdit @@ -245,7 +236,7 @@ object FormCDF: TFormCDF Top = 200 Width = 25 Height = 21 - TabOrder = 2 + TabOrder = 1 OnChange = Edit2Change end object Edit3: TEdit @@ -253,7 +244,7 @@ object FormCDF: TFormCDF Top = 224 Width = 25 Height = 21 - TabOrder = 3 + TabOrder = 2 OnChange = Edit3Change end object Edit4: TEdit @@ -261,7 +252,7 @@ object FormCDF: TFormCDF Top = 248 Width = 25 Height = 21 - TabOrder = 4 + TabOrder = 3 OnChange = Edit4Change end object Edit5: TEdit @@ -269,7 +260,7 @@ object FormCDF: TFormCDF Top = 272 Width = 25 Height = 21 - TabOrder = 5 + TabOrder = 4 OnChange = Edit5Change end object Edit6: TEdit @@ -277,7 +268,7 @@ object FormCDF: TFormCDF Top = 296 Width = 25 Height = 21 - TabOrder = 6 + TabOrder = 5 OnChange = Edit6Change end object Edit7: TEdit @@ -285,7 +276,7 @@ object FormCDF: TFormCDF Top = 320 Width = 25 Height = 21 - TabOrder = 7 + TabOrder = 6 OnChange = Edit7Change end object Edit8: TEdit @@ -293,7 +284,7 @@ object FormCDF: TFormCDF Top = 344 Width = 25 Height = 21 - TabOrder = 8 + TabOrder = 7 OnChange = Edit8Change end object Edit9: TEdit @@ -301,7 +292,7 @@ object FormCDF: TFormCDF Top = 368 Width = 25 Height = 21 - TabOrder = 9 + TabOrder = 8 OnChange = Edit9Change end object Edit10: TEdit @@ -309,7 +300,7 @@ object FormCDF: TFormCDF Top = 392 Width = 25 Height = 21 - TabOrder = 10 + TabOrder = 9 OnChange = Edit10Change end object Edit11: TEdit @@ -317,7 +308,7 @@ object FormCDF: TFormCDF Top = 200 Width = 25 Height = 21 - TabOrder = 11 + TabOrder = 10 OnChange = Edit11Change end object Edit12: TEdit @@ -325,7 +316,7 @@ object FormCDF: TFormCDF Top = 224 Width = 25 Height = 21 - TabOrder = 12 + TabOrder = 11 OnChange = Edit12Change end object Edit13: TEdit @@ -333,7 +324,7 @@ object FormCDF: TFormCDF Top = 248 Width = 25 Height = 21 - TabOrder = 13 + TabOrder = 12 OnChange = Edit13Change end object Edit14: TEdit @@ -341,7 +332,7 @@ object FormCDF: TFormCDF Top = 272 Width = 25 Height = 21 - TabOrder = 14 + TabOrder = 13 OnChange = Edit14Change end object Edit15: TEdit @@ -349,7 +340,7 @@ object FormCDF: TFormCDF Top = 296 Width = 25 Height = 21 - TabOrder = 15 + TabOrder = 14 OnChange = Edit15Change end object Edit16: TEdit @@ -357,7 +348,7 @@ object FormCDF: TFormCDF Top = 320 Width = 25 Height = 21 - TabOrder = 16 + TabOrder = 15 OnChange = Edit16Change end object Edit17: TEdit @@ -365,7 +356,7 @@ object FormCDF: TFormCDF Top = 344 Width = 25 Height = 21 - TabOrder = 17 + TabOrder = 16 OnChange = Edit17Change end object Edit18: TEdit @@ -373,7 +364,7 @@ object FormCDF: TFormCDF Top = 368 Width = 25 Height = 21 - TabOrder = 18 + TabOrder = 17 OnChange = Edit18Change end object Edit19: TEdit @@ -381,7 +372,7 @@ object FormCDF: TFormCDF Top = 392 Width = 25 Height = 21 - TabOrder = 19 + TabOrder = 18 OnChange = Edit19Change end object EditNAdresses: TEdit @@ -389,8 +380,17 @@ object FormCDF: TFormCDF Top = 120 Width = 25 Height = 21 - TabOrder = 20 + TabOrder = 19 Text = '1' OnChange = EditNAdressesChange end + object BitBtnOk: TBitBtn + Left = 136 + Top = 432 + Width = 75 + Height = 25 + TabOrder = 20 + OnClick = BitBtnOkClick + Kind = bkOK + end end diff --git a/UnitCDF.pas b/UnitCDF.pas index 65feb15..eecc5c0 100644 --- a/UnitCDF.pas +++ b/UnitCDF.pas @@ -4,11 +4,10 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ExtCtrls , unitconfig, UnitPrinc; + Dialogs, StdCtrls, ExtCtrls , unitconfig, UnitPrinc, Buttons; type TFormCDF = class(TForm) - Button1: TButton; Label20: TLabel; Label1: TLabel; Label2: TLabel; @@ -56,7 +55,7 @@ type EditNAdresses: TEdit; LabelTitre: TLabel; Label24: TLabel; - procedure Button1Click(Sender: TObject); + BitBtnOk: TBitBtn; procedure FormActivate(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure Edit2Change(Sender: TObject); @@ -78,6 +77,7 @@ type procedure Edit19Change(Sender: TObject); procedure Edit17Change(Sender: TObject); procedure EditNAdressesChange(Sender: TObject); + procedure BitBtnOkClick(Sender: TObject); private { Déclarations privées } public @@ -92,10 +92,7 @@ implementation {$R *.dfm} -procedure TFormCDF.Button1Click(Sender: TObject); -begin - close; -end; + procedure TFormCDF.FormActivate(Sender: TObject); var erreur : integer; @@ -380,4 +377,9 @@ begin end; end; +procedure TFormCDF.BitBtnOkClick(Sender: TObject); +begin + close; +end; + end. diff --git a/UnitConfig.dcu b/UnitConfig.dcu index 17c7045..6bb531b 100644 Binary files a/UnitConfig.dcu and b/UnitConfig.dcu differ diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 0419b0d..3187bf0 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -2102,7 +2102,7 @@ object FormConfig: TFormConfig Top = 200 Width = 297 Height = 73 - Caption = 'Acc'#232's Ethernet '#224' l'#39'interface' + Caption = 'Acc'#232's Ethernet '#224' l'#39'interface vers la centrale' TabOrder = 2 object Label7: TLabel Left = 14 @@ -2382,7 +2382,7 @@ object FormConfig: TFormConfig object LabelCrois: TLabel Left = 32 Top = 320 - Width = 193 + Width = 187 Height = 26 Caption = 'Les croisements re'#231'oivent une adresse m'#234'me s'#39'ils ne sont pas pil' + @@ -3793,8 +3793,8 @@ object FormConfig: TFormConfig end end object GroupBoxRadio: TGroupBox - Left = 120 - Top = 8 + Left = 56 + Top = 16 Width = 225 Height = 73 Caption = 'Type d'#39'action' @@ -3828,8 +3828,8 @@ object FormConfig: TFormConfig end end object GroupBoxAct: TGroupBox - Left = 120 - Top = 44 + Left = 64 + Top = 60 Width = 233 Height = 341 Caption = 'Action fonction de locomotive ' @@ -4146,7 +4146,7 @@ object FormConfig: TFormConfig Left = 0 Top = 32 Width = 345 - Height = 185 + Height = 225 Caption = 'Actionneurs/d'#233'tecteurs locomotives ou accessoires' TabOrder = 1 object ButtonNouvAcc: TButton @@ -4174,24 +4174,26 @@ object FormConfig: TFormConfig Left = 8 Top = 48 Width = 329 - Height = 129 + Height = 161 Color = clBlack Font.Charset = DEFAULT_CHARSET Font.Color = clYellow Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] + HideSelection = False ParentFont = False ReadOnly = True ScrollBars = ssBoth TabOrder = 2 WordWrap = False + OnKeyDown = RichActKeyDown OnMouseDown = RichActMouseDown end end object GroupBox17: TGroupBox Left = 0 - Top = 224 + Top = 272 Width = 345 Height = 193 Caption = 'Actionneurs passage '#224' niveau' @@ -4228,11 +4230,13 @@ object FormConfig: TFormConfig Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] + HideSelection = False ParentFont = False ReadOnly = True ScrollBars = ssBoth TabOrder = 2 WordWrap = False + OnKeyDown = RichPNKeyDown OnMouseDown = RichPNMouseDown end end @@ -4607,9 +4611,11 @@ object FormConfig: TFormConfig Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] + HideSelection = False ParentFont = False ReadOnly = True TabOrder = 0 + OnKeyDown = RichEditTrainsKeyDown OnMouseDown = RichEditTrainsMouseDown end object GroupBox24: TGroupBox @@ -4643,9 +4649,9 @@ object FormConfig: TFormConfig object Label56: TLabel Left = 16 Top = 72 - Width = 115 + Width = 215 Height = 13 - Caption = 'Vitesse '#224' l'#39'avertissement' + Caption = 'Vitesse '#224' l'#39'avertissement ou au ralentissement' end object Label57: TLabel Left = 16 @@ -4659,13 +4665,16 @@ object FormConfig: TFormConfig Top = 24 Width = 145 Height = 21 + Hint = 'Nom du train' + ParentShowHint = False + ShowHint = True TabOrder = 0 OnChange = EditNomTrainChange end object EditAdresseTrain: TEdit - Left = 136 + Left = 240 Top = 48 - Width = 65 + Width = 41 Height = 21 Hint = 'Adresse du d'#233'codeur du train' ParentShowHint = False @@ -4674,26 +4683,35 @@ object FormConfig: TFormConfig OnChange = EditAdresseTrainChange end object EditVitesseMaxi: TEdit - Left = 136 + Left = 240 Top = 120 - Width = 65 + Width = 41 Height = 21 + Hint = 'Vitesse maximale autoris'#233'e par le d'#233'codeur' + ParentShowHint = False + ShowHint = True TabOrder = 2 OnChange = EditVitesseMaxiChange end object EditVitRalenti: TEdit - Left = 136 + Left = 240 Top = 72 - Width = 65 + Width = 41 Height = 21 + Hint = 'Vitesse apr'#232's l'#39'avertissement' + ParentShowHint = False + ShowHint = True TabOrder = 3 OnChange = EditVitRalentiChange end object EditVitNom: TEdit - Left = 136 + Left = 240 Top = 96 - Width = 65 + Width = 41 Height = 21 + Hint = 'Vitesse si voie libre' + ParentShowHint = False + ShowHint = True TabOrder = 4 OnChange = EditVitNomChange end diff --git a/UnitConfig.pas b/UnitConfig.pas index 622ba79..f296d4a 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -466,6 +466,12 @@ type procedure EditVitNomChange(Sender: TObject); procedure EditVitRalentiChange(Sender: TObject); procedure CheckBoxVerifXpressNetClick(Sender: TObject); + procedure RichActKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure RichPNKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure RichEditTrainsKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); private { Déclarations privées } public @@ -476,6 +482,7 @@ const // constantes du fichier de configuration NomConfig='ConfigGenerale.cfg'; Debug_ch='Debug'; +AntiTimeoutEthLenz_ch='AntiTimeoutEthLenz'; Verif_AdrXpressNet_ch='Verif_AdrXpressNet'; Filtrage_det_ch='Filtrage_det'; Algo_localisation_ch='Algo_localisation'; @@ -510,6 +517,7 @@ Protocole_ch='Protocole'; Raz_signaux_ch='RazSignaux'; EnvAigDccpp_ch='EnvAigDccpp'; AdrBaseDetDccpp_ch='AdrBaseDetDccpp'; +AvecVerifIconesTCO_ch='AvecVerifIconesTCO'; // sections de config section_aig_ch='[section_aig]'; @@ -527,13 +535,14 @@ var AdresseIPCDM,AdresseIP,PortCom,recuCDM,residuCDM,trainsauve : string; portCDM,TempoOctet,TimoutMaxInterface,Valeur_entete,PortInterface,prot_serie,NumPort,debug, - LigneCliqueePN,AncLigneCliqueePN,clicMemo,Nb_cantons_Sig,protocole,Port,clicListeTrain, + LigneCliqueePN,AncLigneCliqueePN,clicMemo,Nb_cantons_Sig,protocole,Port, ligneclicAig,AncLigneClicAig,ligneClicSig,AncligneClicSig,EnvAigDccpp,AdrBaseDetDccpp, ligneClicBr,AncligneClicBr,ligneClicAct,AncLigneClicAct,Adressefeuclic,NumTrameCDM, - Algo_localisation,Verif_AdrXpressNet : integer; + Algo_localisation,Verif_AdrXpressNet,ligneclicTrain,AncligneclicTrain,AntiTimeoutEthLenz : integer; ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort, - modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains : boolean; + modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains, + trouveAvecVerifIconesTCO : boolean; fichier : text; function config_com(s : string) : boolean; @@ -1084,9 +1093,12 @@ begin // feu de signalisation--------------------------------- begin val(sa,asp,erreur); //aspect + if (asp<2) or (asp=6) or (asp=8) or (asp>9) then + begin + Affiche('Erreur 676: configuration aspect ('+intToSTR(asp)+') signal incorrect à la ligne '+chaine_signal,clRed); + asp:=2; + end; feux[i].aspect:=asp;Delete(s,1,j); - if (asp=0) or (asp=6) or (asp>9) then - Affiche('Erreur 676: configuration aspect ('+intToSTR(asp)+') signal incorrect à la ligne '+chaine_signal,clRed); j:=pos(',',s); if j>1 then begin Feux[i].FeuBlanc:=(copy(s,1,j-1))='1';delete(s,1,j);end; j:=pos(',',s); @@ -1107,6 +1119,7 @@ begin delete(s,1,1); j:=0; repeat + adr:=0; k:=pos(',',s); if k>1 then begin @@ -1399,10 +1412,12 @@ begin // entête // copie_commentaire; writeln(fichierN,'/ Fichier de configuration de signaux_complexes_GL'); + writeln(fichierN,AvecVerifIconesTCO_ch+'=',AvecVerifIconesTCO); writeln(fichierN,Algo_localisation_ch+'=',Algo_localisation); writeln(fichierN,Avec_roulage_ch+'=',avecRoulage); writeln(fichierN,debug_ch+'=',debug); writeln(fichierN,Filtrage_det_ch+'=',filtrageDet0); + writeln(fichierN,AntiTimeoutEthLenz_ch+'=',AntiTimeoutEthLenz); // taille de la fonte writeln(fichierN,Fonte_ch+'=',TailleFonte); FormPrinc.FenRich.Font.Size:=TailleFonte; @@ -1603,7 +1618,7 @@ var s,sa,SOrigine: string; trouve_section_branche,trouve_section_sig,trouve_section_act,trouve_tempo_feu, trouve_algo_uni,croi,trouve_Nb_cantons_Sig,trouve_dem_aig,trouve_demcnxCOMUSB,trouve_demcnxEth : boolean; virgule,i_detect,i,erreur,aig2,detect,offset,j,position, - ComptEl,Compt_IT,Num_Element,k,modele,adr,adr2,erreur2,l,t,Nligne,postriple,itl, + ComptEl,Compt_IT,Num_Element,k,adr,erreur2,l,t,Nligne,postriple,itl, postjd,postjs,nv,it,Num_Champ,asp,adraig,poscroi : integer; function lit_ligne : string ; @@ -1916,7 +1931,7 @@ begin i:=pos(')',s);Delete(S,1,i); i:=pos(',',s);Delete(S,1,i); - Tablo_PN[NbrePN].voie[NbreVoies].PresTrain:=false; + Tablo_PN[NbrePN].compteur:=0; until (copy(s,1,2)='PN') or (NbreVoies=4); Tablo_PN[NbrePN].NbVoies:=NbreVoies; @@ -2359,12 +2374,21 @@ begin val(s,filtrageDet0,erreur); end; + sa:=uppercase(AntiTimeoutEthLenz_ch)+'='; + i:=pos(sa,s); + if i=1 then + begin + delete(s,i,length(sa)); + val(s,AntiTimeoutEthLenz,erreur); + end; + sa:=uppercase(Algo_localisation_ch)+'='; i:=pos(sa,s); if i=1 then begin delete(s,i,length(sa)); val(s,Algo_localisation,erreur); + if Algo_localisation<>1 then Affiche('Avertissement: Algo_localisation='+intToSTR(algo_localisation)+' est expérimental et non garanti',clorange); end; sa:=uppercase(Avec_roulage_ch)+'='; @@ -2630,6 +2654,17 @@ begin notificationVersion:=i=1; end; + sa:=uppercase(AvecVerifIconesTCO_ch); + i:=pos(sa,s); + if i<>0 then + begin + trouveAvecVerifIconesTCO:=true; + inc(nv); + delete(s,i,length(sa)+1); + val(s,AvecVerifIconesTCO,erreur); + s:=''; + end; + sa:=uppercase(TCO_ch)+'='; i:=pos(sa,s); if i=1 then @@ -2813,6 +2848,7 @@ end; begin debugConfig:=false; trouve_NbDetDist:=false; + trouveAvecVerifIconesTCO:=false; trouve_ipv4_PC:=false; trouve_retro:=false; trouve_sec_init:=false; @@ -2839,6 +2875,8 @@ begin trouve_demcnxEth:=false; trouve_Algo_Uni:=false; trouve_Nb_cantons_Sig:=false; + AvecVerifIconesTCO:=1; + //trouve_FVR:=false; if not(trouve_tempo_feu) then @@ -2851,6 +2889,7 @@ begin if not(trouve_verif_version) then s:=verif_version_ch; if not(trouve_fonte) then s:=fonte_ch; + Nb_Det_Dist:=3; // initialisation des aiguillages avec des valeurs par défaut for i:=1 to NbreMaxiAiguillages do @@ -2929,6 +2968,7 @@ begin if not(trouve_dem_aig) then s:=Init_dem_aig_ch; if not(trouve_demcnxCOMUSB) then s:=Init_dem_interfaceUSBCOM_ch; if not(trouve_demcnxEth) then s:=Init_dem_interfaceEth_ch; + if not(trouveAvecVerifIconesTCO) then confasauver:=true; if not(trouve_tempo_feu) then begin @@ -4000,13 +4040,16 @@ begin l:=1; repeat nc:=Length(feux[i].condcarre[l])-1 ; - s:=''; - for k:=1 to nc do + if nc<>-1 then begin - s:=s+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig; - if k6); // scrolle le MemoCarre sur la première ligne @@ -4049,17 +4092,16 @@ begin end; -// mise à jour des champs graphiques des actionneurs d'après l'index du richAct +// mise à jour des champs graphiques des actionneurs d'après l'index du tableau Procedure aff_champs_act(i : integer); var etatact, adresse,sortie,fonction,tempo,access,typ : integer; s,s2,adr : string; det : boolean; begin if affevt then affiche('Aff_champs_act('+intToSTR(i)+')',clyellow); - if i<0 then exit; - s:=Uppercase(FormConfig.RichAct.Lines[i]); + if i<1 then exit; + s:=Uppercase(FormConfig.RichAct.Lines[i-1]); if s='' then exit; - inc(i); // passer en index tablo fonction:=Tablo_actionneur[i].fonction; Access:=Tablo_actionneur[i].accessoire; @@ -4194,17 +4236,40 @@ begin end; end; -// affiche les champs de l'actionneur PN en fonction du tableau en fonction de l'index du richedit +procedure raz_champs_pn; +begin + with formconfig do + begin + editAdrFerme.Text:='';EditCmdFerme.text:=''; + editAdrOuvre.Text:='';EditCdeOuvre.text:=''; + editV1F.Text:='';editV1O.Text:=''; + editV2F.Text:='';editV2O.Text:=''; + editV3F.Text:='';editV3O.Text:=''; + editV4F.Text:='';editV4O.Text:=''; + EditZdet1V1F.text:='';EditZdet2V1F.text:='';EditZdet1V1O.text:='';EditZdet2V1O.text:=''; + EditZdet1V2F.text:='';EditZdet2V2F.text:='';EditZdet1V2O.text:='';EditZdet2V2O.text:=''; + EditZdet1V3F.text:='';EditZdet2V3F.text:='';EditZdet1V3O.text:='';EditZdet2V3O.text:=''; + EditZdet1V4F.text:='';EditZdet2V4F.text:='';EditZdet1V4O.text:='';EditZdet2V4O.text:=''; + end; +end; + +// affiche les champs de l'actionneur PN en fonction de l'index du tableau procedure aff_champs_PN(i : integer); var adresse,erreur,j,v : integer; trouve : boolean; s : string; begin if affevt then affiche('Aff_champs_PN('+intToSTR(i)+')',clyellow); - if i<0 then exit; - s:=Uppercase(FormConfig.RichPN.Lines[i]); + if i<1 then exit; + s:=Uppercase(FormConfig.RichPN.Lines[i-1]); if s='' then exit; + with formconfig do + begin + LabelInfo.caption:=''; + raz_champs_pn; + end; + // actionneur passage à niveau if s[1]='(' then begin @@ -4292,13 +4357,15 @@ procedure raz_champs_act; begin with formConfig do begin - editAct.Text:=''; + editAct.Text:='';EditAct2.Text:=''; EditEtatActionneur.Text:=''; EditTrainDecl.Text:=''; EditFonctionAccess.Text:=''; EditEtatFoncSortie.Text:=''; EditTempo.Text:=''; CheckRaz.Checked:=false; + editson.Text:=''; + EditTrainDest.text:=''; end; end; @@ -4337,6 +4404,7 @@ begin end; end; + // cliqué sur liste aiguillages procedure TFormConfig.RichAigMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i,lc,adresse,erreur : integer; @@ -4410,7 +4478,7 @@ begin Aiguillage[index].Adroit:=adr; Aiguillage[index].AdroitB:=B; Edit_HG.Hint:=TypeElAIg_to_char(adr,B); - + // réencoder la ligne s:=encode_aig(index); formconfig.RichAig.Lines[ligneclicAig]:=s; @@ -4860,7 +4928,6 @@ begin begin i:=Selstart; lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée - //Affiche('numéro de la ligne cliquée '+intToStr(lc),clyellow); clicListeFeu(feux[lc+1].adresse); end; @@ -5286,7 +5353,7 @@ begin AncligneClicAct:=Ligne; ligneClicAct:=ligne; RE_ColorLine(Formconfig.RichAct,ligneClicAct,ClYellow); - Aff_champs_Act(ligneClicAct); + Aff_champs_Act(ligneClicAct+1); end else begin @@ -5809,22 +5876,7 @@ procedure TFormConfig.RichPNMouseDown(Sender: TObject; var i,ligne : integer; begin clicliste:=true; - LabelInfo.caption:=''; - editV1F.Text:='';editV1O.Text:=''; - editV2F.Text:='';editV2O.Text:=''; - editV3F.Text:='';editV3O.Text:=''; - editV4F.Text:='';editV4O.Text:=''; - EditZdet1V1F.text:='';EditZdet2V1F.text:=''; - EditZdet1V1O.text:='';EditZdet2V1O.text:=''; - EditZdet1V2F.text:='';EditZdet2V2F.text:=''; - EditZdet1V2O.text:='';EditZdet2V2O.text:=''; - EditZdet1V3F.text:='';EditZdet2V3F.text:=''; - EditZdet1V3O.text:='';EditZdet2V3O.text:=''; - EditZdet1V4F.text:='';EditZdet2V4F.text:=''; - EditZdet1V4O.text:='';EditZdet2V4O.text:=''; - editAdrFerme.Text:='';EditCmdFerme.text:=''; - editAdrOuvre.Text:='';EditCdeOuvre.text:=''; // désactive la sélection des actionneurs RE_ColorLine(Formconfig.RichAct,ligneclicAct,ClAqua); @@ -5840,16 +5892,16 @@ begin AncLigneCliqueePN:=Ligne; ligneCliqueePN:=ligne; RE_ColorLine(RichPN,LigneCliqueePN,ClYellow); - Aff_champs_PN(lignecliqueePN); + Aff_champs_PN(lignecliqueePN+1); end else begin RE_ColorLine(Formconfig.RichPN,lignecliqueePN,ClAqua); lignecliqueePN:=-1; exit; - end; - end; - clicliste:=false; + end; + end; + clicliste:=false; end; procedure TFormConfig.EditAdrFermeChange(Sender: TObject); @@ -6145,7 +6197,7 @@ begin LabelInfo.caption:=''; LigneClicAct:=i-1; AncligneClicAct:=ligneClicAct; - Aff_champs_Act(maxTablo_act-1); + Aff_champs_Act(maxTablo_act); clicliste:=false; config_modifie:=true; end; @@ -6153,7 +6205,7 @@ end; procedure TFormConfig.ButtonNouvPNClick(Sender: TObject); var s: string; - i : integer; + i,j : integer; begin if affevt then affiche('Evt bouton nouveau PN',clyellow); if maxtablo_act>=Max_actionneurs then @@ -6169,10 +6221,27 @@ begin // désactive la sélection des actionneurs RE_ColorLine(Formconfig.RichAct,ligneclicAct,ClAqua); ligneclicAct:=-1; - - Tablo_PN[i].NbVoies:=1; - - s:=encode_act_pn(i); + + raz_champs_pn; + tablo_PN[NbrePN].AdresseFerme:=0; + tablo_PN[NbrePN].AdresseOuvre:=0; + tablo_PN[NbrePN].commandeFerme:=0; + tablo_PN[NbrePN].CommandeOuvre:=0; + tablo_PN[NbrePN].NbVoies:=1; + tablo_PN[NbrePN].Pulse:=0; + + for j:=1 to 4 do + begin + tablo_PN[NbrePN].Voie[j].ActFerme:=0; + tablo_PN[NbrePN].Voie[j].ActOuvre:=0; + tablo_PN[NbrePN].Voie[j].detZ1F:=0; + tablo_PN[NbrePN].Voie[j].detZ1O:=0; + tablo_PN[NbrePN].Voie[j].detZ2F:=0; + tablo_PN[NbrePN].Voie[j].detZ2O:=0; + tablo_PN[NbrePN].compteur:=0; + end; + + s:=encode_act_pn(i); if LigneCliqueePN<>-1 then RE_ColorLine(RichPN,ligneCliqueePN,ClAqua); // ajouter et scroller en fin @@ -6184,71 +6253,91 @@ begin Perform(EM_SCROLLCARET,0,0); end; - editV1F.Text:='';editV1O.Text:=''; - editV2F.Text:='';editV2O.Text:=''; - editV3F.Text:='';editV3O.Text:=''; - editV4F.Text:='';editV4O.Text:=''; - EditZdet1V1F.text:='';EditZdet2V1F.text:=''; - EditZdet1V1O.text:='';EditZdet2V1O.text:=''; - EditZdet1V2F.text:='';EditZdet2V2F.text:=''; - EditZdet1V2O.text:='';EditZdet2V2O.text:=''; - EditZdet1V3F.text:='';EditZdet2V3F.text:=''; - EditZdet1V3O.text:='';EditZdet2V3O.text:=''; - EditZdet1V4F.text:='';EditZdet2V4F.text:=''; - EditZdet1V4O.text:='';EditZdet2V4O.text:=''; - GroupBoxRadio.Visible:=false; LabelInfo.caption:=''; LigneCliqueePN:=i-1; AncLigneCliqueePN:=LigneCliqueePN; tablo_PN[lignecliqueePN+1].Pulse:=1; - Aff_champs_PN(nbrePN-1); + Aff_champs_PN(nbrePN); clicliste:=false; config_modifie:=true; end; -procedure TFormConfig.ButtonSupAccClick(Sender: TObject); -var i,index,adr : integer; +procedure supprime_act; +var i,debut,longueur,fin,ltot,lignedeb,lignefin,l : integer; s: string; begin - if affevt then affiche('Evt bouton Sup acc',clyellow); - i:=ligneClicAct; if (i=-1) then exit; - index:=i+1; // passe en index tableau - - adr:=tablo_actionneur[index].adresse; - s:='Voulez-vous supprimer l''actionneur '+IntToSTR(adr)+'?'; - if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; - Affiche('Suppression de l''actionneur index='+IntToSTR(index)+' adresse='+IntToSTR(adr),clOrange); - - clicliste:=true; - - // supprime l'actionneur du tableau - dec(maxTablo_act); - for i:=index to maxTablo_act do - begin - tablo_actionneur[i]:=tablo_actionneur[i+1]; - end; - - clicliste:=false; - config_modifie:=true; - RichAct.Clear; + debut:=FormConfig.RichAct.SelStart; + longueur:=FormConfig.RichAct.SelLength; + fin:=debut+longueur; + //Affiche(inttostr(debut)+' '+inttostr(longueur),clyellow); + // trouver les lignes sélectionnées + i:=0;ltot:=0;ligneDeb:=0;LigneFin:=0; + repeat + l:=length(FormConfig.RichAct.lines[i])+2; //+2 car CR LF + ltot:=ltot+l; + if (debut=fin) and (ligneFin=0) and (ligneDeb<>0) then ligneFin:=i+1; + //if (ltot=fin) and (ligneFin=0) then ligneFin:=i; + inc(i); + until (i>=NbreFeux) or (ligneFin>0); + if lignefin>maxTablo_act then lignefin:=maxTablo_act; + if ligneDeb=0 then begin ligneDeb:=ligneclicAct+1;ligneFin:=ligneclicAct+1;end; + if (lignedeb<1) or (lignefin<1) or (lignefin>maxTablo_act) then exit; + + if ligneDeb=LigneFin then s:='Voulez-vous supprimer l''actionneur '+IntToSTR(tablo_actionneur[lignedeb].adresse)+'?' + else s:='Voulez-vous supprimer les actionneurs de '+ + IntToSTR(tablo_actionneur[ligneDeb].adresse)+' à '+IntToSTR(tablo_actionneur[ligneFin].adresse)+' ?'; + + if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; + + if ligneDeb=LigneFin then s:='Suppression de l''actionneur '+intToSTR(tablo_actionneur[lignedeb].adresse) + else s:='Suppression des actionneurs de '+ + IntToSTR(tablo_actionneur[lignedeb].adresse)+' à '+IntToSTR(tablo_actionneur[lignefin].adresse); + Affiche(s,clOrange); + + clicliste:=true; + + for i:=lignedeb to lignefin do + begin + Affiche('Suppression actionneur '+intToSTR(tablo_actionneur[i].Adresse),clorange); + end; + + for i:=1 to maxTablo_act-ligneFin do + begin + index:=i+lignefin; //index de l'aiguillage de remplacement + tablo_actionneur[lignedeb+i-1]:=tablo_actionneur[index]; + end; + + maxTablo_act:=maxTablo_act-(ligneFin-LigneDeb)-1; + config_modifie:=true; + formConfig.RichAct.Clear; + raz_champs_act; + for i:=1 to maxTablo_act do begin s:=encode_act_loc_son(i); if s<>'' then - begin + with formconfig do begin RichAct.Lines.Add(s); RE_ColorLine(RichAct,RichAct.lines.count-1,ClAqua); end; end; AncligneClicAct:=-1; ligneClicAct:=-1; + clicliste:=false; end; -procedure TFormConfig.ButtonSupPNClick(Sender: TObject); +procedure TFormConfig.ButtonSupAccClick(Sender: TObject); +begin + if affevt then affiche('Evt bouton Sup acc',clyellow); + supprime_act; +end; + +procedure supprime_pn; var i,index,adr : integer; ac,pn : boolean; s: string; @@ -6271,7 +6360,7 @@ begin if ac then s:='Voulez-vous supprimer l''actionneur '+IntToSTR(adr)+'?'; if pn then s:='Voulez-vous supprimer l''actionneur de zone '+IntToSTR(adr)+'-'+inttostr(tablo_PN[index].voie[1].DetZ1O)+'?'; if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; - Affiche('Suppression de l''actionneur index='+IntToSTR(index)+' adresse='+IntToSTR(adr),clOrange); + Affiche('Suppression de l''actionneur '+IntToSTR(adr),clOrange); clicliste:=true; @@ -6282,21 +6371,28 @@ begin tablo_PN[i]:=tablo_PN[i+1]; end; - clicliste:=false; config_modifie:=true; - RichPN.Clear; + formConfig.RichPN.Clear; + raz_champs_pn; + for i:=1 to NbrePN do begin s:=encode_act_PN(i); if s<>'' then - begin + with formConfig do begin RichPN.Lines.Add(s); RE_ColorLine(RichPN,RichPN.lines.count-1,ClAqua); - end; - end; + end; + end; lignecliqueePN:=-1; AncLigneCliqueePN:=-1; + clicliste:=false; +end; + +procedure TFormConfig.ButtonSupPNClick(Sender: TObject); +begin + supprime_pn; end; procedure TFormConfig.ButtonNouvFeuClick(Sender: TObject); @@ -6349,7 +6445,7 @@ end; procedure supprime_sig; -var adresse,i,indexFeu,index,debut,fin,longueur,ltot,lignedeb,lignefin,l : integer; +var adresse,i,indexFeu,debut,fin,longueur,ltot,lignedeb,lignefin,l : integer; s : string; begin if affevt then affiche('Evt bouton Sup Feu',clyellow); @@ -6367,15 +6463,13 @@ begin if (ltot>=fin) and (ligneFin=0) and (ligneDeb<>0) then ligneFin:=i+1; //if (ltot=fin) and (ligneFin=0) then ligneFin:=i; inc(i); - until (i>=NbreFeux) or (ligneFin>0); - if lignefin=0 then if fin>ltot then ligneFin:=NbreFeux; + until (ltot>=fin); + if lignefin>NbreFeux then lignefin:=NbreFeux; + if ligneDeb=0 then begin ligneDeb:=ligneclicSig+1;ligneFin:=ligneclicSig+1;end; + if (lignedeb<1) or (lignefin<1) or (lignefin>NbreFeux) then exit; //Affiche(inttostr(ligneDeb)+' '+inttostr(LigneFin),clyellow); - i:=ligneClicSig; - if (i<0) then exit; - index:=i+1; // passe en index tableau - - if ligneDeb=LigneFin then s:='Voulez-vous supprimer le signal '+IntToSTR(feux[index].adresse)+'?' + if ligneDeb=LigneFin then s:='Voulez-vous supprimer le signal '+IntToSTR(feux[lignedeb].adresse)+'?' else s:='Voulez-vous supprimer les signaux de '+ IntToSTR(feux[ligneDeb].adresse)+' à '+IntToSTR(feux[ligneFin].adresse)+' ?'; @@ -6398,6 +6492,7 @@ begin // d'abord supprimer les images des feux for i:=LigneDeb to LigneFin do begin + Affiche('Suppression signal '+intToSTR(feux[i].Adresse),clorange); feux[i].Img.free; // supprime l'image, ce qui efface le feu du tableau graphique Feux[i].Lbl.free; // supprime le label, ... if Feux[i].checkFB<>nil then begin Feux[i].checkFB.Free;Feux[i].CheckFB:=nil;end; // supprime le check du feu blanc s'il existait @@ -6405,13 +6500,13 @@ begin for i:=1 to NbreFeux-ligneFin do begin - index:=i+lignefin; //index ddu feu de remplacement + index:=i+lignefin; //index du feu de remplacement indexFeu:=lignedeb+i-1; - //Affiche('Suppresion feu '+intToSTR(feux[i+lignedeb].Adresse),clorange); + //Affiche('Suppression signal '+intToSTR(feux[i+lignedeb].Adresse),clorange); //Affiche('remplacement par index '+intToSTR(index),clorange); - feux[indexFeu]:=feux[index]; - adresse:=feux[indexFeu].adresse; + feux[indexFeu]:=feux[index]; + adresse:=feux[indexFeu].adresse; with feux[IndexFeu].Img do begin @@ -7034,7 +7129,7 @@ begin if c='S' then begin extr:=aiguillage[index2].ADevie; - if adr<>extr then Affiche('Erreur 10.24: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'S différent de '+intToSTR(extr),clred); + if adr<>extr then Affiche('Erreur 10.24: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'S différent de '+intToSTR(extr),clred); end; if c='P' then begin @@ -7085,7 +7180,7 @@ begin if (model2=aig) or (model2=triple) then begin - if c='D' then + if c='D' then begin extr:=aiguillage[index2].ADroit; if adr<>extr then Affiche('Erreur 10.33: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'D différent de '+intToSTR(extr),clred); @@ -7124,7 +7219,7 @@ begin if (adr<>aiguillage[index2].Adevie) and (adr<>aiguillage[index2].ADroit) and (adr<>aiguillage[index2].DDevie) and (adr<>aiguillage[index2].Ddroit) then begin - Affiche('Erreur 10.41: Discordance de déclaration aiguillage '+intToSTR(adr)+': '+intToSTR(adr2),clred); + Affiche('Erreur 10.41: Discordance de déclaration aiguillage '+intToSTR(adr)+': '+intToSTR(adr2),clred); ok:=false; end; @@ -7151,7 +7246,7 @@ begin if c='S' then begin extr:=aiguillage[index2].ADevie; - if adr<>extr then Affiche('Erreur 10.44: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'S différent de '+intToSTR(extr),clred); + if adr<>extr then Affiche('Erreur 10.44: Discordance de déclaration aiguillages '+intToSTR(adr)+'S: '+intToSTR(adr2)+'S différent de '+intToSTR(extr),clred); end; if c='P' then begin @@ -7184,93 +7279,96 @@ begin begin k:=index_aig(detect); // comparer au précédent - if j=1 then trouvePrec:=true; - if (j>1) then + if k<>0 then begin - if aiguillage[k].modele=Aig then + if j=1 then trouvePrec:=true; + if (j>1) then begin - if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; - if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; - if aiguillage[k].APointe=AncAdr then trouvePrec:=true; - end; - if (aiguillage[k].modele=Tjd) or (aiguillage[k].modele=TjS) then - begin - if aiguillage[k].EtatTJD=2 then + if aiguillage[k].modele=Aig then + begin + if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; + if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; + if aiguillage[k].APointe=AncAdr then trouvePrec:=true; + end; + if (aiguillage[k].modele=Tjd) or (aiguillage[k].modele=TjS) then + begin + if aiguillage[k].EtatTJD=2 then + begin + if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; + if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; + if aiguillage[k].Ddroit=AncAdr then trouvePrec:=true; + if aiguillage[k].Ddevie=AncAdr then trouvePrec:=true; + end; + if aiguillage[k].EtatTJD=4 then + begin + l:=index_aig(aiguillage[k].Ddroit); // 2eme adresse de la TJD + if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; + if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; + if aiguillage[k].Ddroit=AncAdr then trouvePrec:=true; + if aiguillage[l].Adroit=AncAdr then trouvePrec:=true; + if aiguillage[l].Adevie=AncAdr then trouvePrec:=true; + if aiguillage[l].Ddevie=AncAdr then trouvePrec:=true; + end; + end; + if aiguillage[k].modele=crois then begin if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; if aiguillage[k].Ddroit=AncAdr then trouvePrec:=true; if aiguillage[k].Ddevie=AncAdr then trouvePrec:=true; end; - if aiguillage[k].EtatTJD=4 then + + if not(trouvePrec) then begin - l:=index_aig(aiguillage[k].Ddroit); // 2eme adresse de la TJD - if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; - if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; - if aiguillage[k].Ddroit=AncAdr then trouvePrec:=true; - if aiguillage[l].Adroit=AncAdr then trouvePrec:=true; - if aiguillage[l].Adevie=AncAdr then trouvePrec:=true; - if aiguillage[l].Ddevie=AncAdr then trouvePrec:=true; + Affiche('Erreur 11: La description de l''aiguillage '+intToSTR(detect)+' ne correspond pas à son élément contigu ('+intToStr(AncAdr)+') en branche '+intToSTR(i),clred); + ok:=false; end; end; - if aiguillage[k].modele=crois then - begin - if aiguillage[k].ADroit=AncAdr then trouvePrec:=true; - if aiguillage[k].ADevie=AncAdr then trouvePrec:=true; - if aiguillage[k].Ddroit=AncAdr then trouvePrec:=true; - if aiguillage[k].Ddevie=AncAdr then trouvePrec:=true; - end; - - if not(trouvePrec) then - begin - Affiche('Erreur 11: La description de l''aiguillage '+intToSTR(detect)+' ne correspond pas à son élément contigu ('+intToStr(AncAdr)+') en branche '+intToSTR(i),clred); - ok:=false; - end; - end; - TrouveSuiv:=false; - // comparer au suivant - if SuivModel<>rien then - begin - if aiguillage[k].modele=Aig then + TrouveSuiv:=false; + // comparer au suivant + if SuivModel<>rien then begin - if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; - if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; - if aiguillage[k].APointe=SuivAdr then trouveSuiv:=true; - end; - if (aiguillage[k].modele=Tjd) or (aiguillage[k].modele=TjS) then - begin - if aiguillage[k].EtatTJD=2 then + if aiguillage[k].modele=Aig then + begin + if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; + if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; + if aiguillage[k].APointe=SuivAdr then trouveSuiv:=true; + end; + if (aiguillage[k].modele=Tjd) or (aiguillage[k].modele=TjS) then + begin + if aiguillage[k].EtatTJD=2 then + begin + if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; + if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; + if aiguillage[k].Ddroit=SuivAdr then trouveSuiv:=true; + if aiguillage[k].Ddevie=SuivAdr then trouveSuiv:=true; + end; + if aiguillage[k].EtatTJD=4 then + begin + l:=index_aig(aiguillage[k].Ddroit); // 2eme adresse de la TJD + if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; + if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; + if aiguillage[k].Ddroit=SuivAdr then trouveSuiv:=true; + if aiguillage[l].Adroit=SuivAdr then trouveSuiv:=true; + if aiguillage[l].Adevie=SuivAdr then trouveSuiv:=true; + if aiguillage[l].Ddevie=SuivAdr then trouveSuiv:=true; + end; + end; + if aiguillage[k].modele=crois then begin if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; if aiguillage[k].Ddroit=SuivAdr then trouveSuiv:=true; if aiguillage[k].Ddevie=SuivAdr then trouveSuiv:=true; end; - if aiguillage[k].EtatTJD=4 then - begin - l:=index_aig(aiguillage[k].Ddroit); // 2eme adresse de la TJD - if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; - if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; - if aiguillage[k].Ddroit=SuivAdr then trouveSuiv:=true; - if aiguillage[l].Adroit=SuivAdr then trouveSuiv:=true; - if aiguillage[l].Adevie=SuivAdr then trouveSuiv:=true; - if aiguillage[l].Ddevie=SuivAdr then trouveSuiv:=true; - end; - end; - if aiguillage[k].modele=crois then - begin - if aiguillage[k].ADroit=SuivAdr then trouveSuiv:=true; - if aiguillage[k].ADevie=SuivAdr then trouveSuiv:=true; - if aiguillage[k].Ddroit=SuivAdr then trouveSuiv:=true; - if aiguillage[k].Ddevie=SuivAdr then trouveSuiv:=true; - end; - if not(trouveSuiv) then - begin - Affiche('Erreur 12: La description de l''aiguillage '+intToSTR(detect)+' ne correspond pas à son élément contigu ('+intToStr(SuivAdr)+') en branche '+intToSTR(i),clred); - ok:=false; - end; + if not(trouveSuiv) then + begin + Affiche('Erreur 12: La description de l''aiguillage '+intToSTR(detect)+' ne correspond pas à son élément contigu ('+intToStr(SuivAdr)+') en branche '+intToSTR(i),clred); + ok:=false; + end; + end; end; end; inc(j); @@ -7319,6 +7417,11 @@ begin end; end; end; + if not(verif_cellule(x,y,i)) then + begin + Affiche('TCO: Erreur de proximité composants incompatibles: cellules TCO['+intToSTR(x)+','+intToSTR(y)+'] ',clred); + ok:=false; + end; end; end; @@ -7438,7 +7541,7 @@ end; // supprime le ou les aiguillages sélectionnés dans le richEdit procedure supprime_aig; -var ligneDeb,LigneFin,i,index,debut,longueur,fin,l,ltot : integer; +var ligneDeb,LigneFin,i,debut,longueur,fin,l,ltot : integer; s : string; begin //trouver ligne de début et de fin sélectionner. @@ -7446,7 +7549,7 @@ begin begin debut:=RichAig.SelStart; longueur:=RichAig.SelLength; - end; + end; fin:=debut+longueur; //Affiche(inttostr(debut)+' '+inttostr(longueur),clyellow); // trouver les lignes sélectionnées @@ -7458,21 +7561,18 @@ begin if (ltot>=fin) and (ligneFin=0) and (ligneDeb<>0) then ligneFin:=i+1; //if (ltot=fin) and (ligneFin=0) then ligneFin:=i; inc(i); - until (i>=MaxAiguillage) or (ligneFin>0); - if lignefin=0 then if fin>ltot then ligneFin:=MaxAiguillage; + until (ltot>=fin); + if lignefin>maxAiguillage then lignefin:=maxAiguillage; + if ligneDeb=0 then begin ligneDeb:=ligneclicAig+1;ligneFin:=ligneclicAig+1;end; + if (lignedeb<1) or (lignefin<1) or (lignefin>maxAiguillage) then exit; //Affiche(inttostr(Ltot)+' '+inttostr(Fin),clyellow); - - - i:=ligneClicAig; - if (i<0) then exit; - index:=i+1; // passe en index tableau - if ligneDeb=LigneFin then s:='Voulez-vous supprimer l''aiguillage '+IntToSTR(aiguillage[index].adresse)+'?' + if ligneDeb=LigneFin then s:='Voulez-vous supprimer l''aiguillage '+IntToSTR(aiguillage[lignedeb].adresse)+'?' else s:='Voulez-vous supprimer les aiguillages de '+ IntToSTR(aiguillage[ligneDeb].adresse)+' à '+IntToSTR(aiguillage[ligneFin].adresse)+' ?'; - + if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; - + FormConfig.ButtonAjSup.Caption:='Ajouter l''aig '+intToSTR(aiguillage[index].adresse)+' supprimé'; clicliste:=true; raz_champs_aig; @@ -7486,12 +7586,16 @@ begin IntToSTR(aiguillage[ligneDeb].adresse)+' à '+IntToSTR(aiguillage[ligneFin].adresse); Affiche(s,clOrange); + for i:=lignedeb to lignefin do + begin + Affiche('Suppression aiguillage '+intToSTR(aiguillage[i].Adresse),clorange); + end; + //Affiche('Boucle de '+intToSTR(ligneDeb)+' N='+intToSTR(MaxAiguillage-ligneFin),clyellow); for i:=1 to MaxAiguillage-ligneFin do begin index:=i+lignefin; //index de l'aiguillage de remplacement - //Affiche('Suppresion aiguillage '+intToSTR(aiguillage[i+lignedeb].Adresse),clorange); //Affiche('remplacement par index '+intToSTR(index),clorange); Aiguillage[lignedeb+i-1]:=Aiguillage[index]; @@ -7505,10 +7609,10 @@ begin aiguillage[index].modifie:=false; end; MaxAiguillage:=maxAiguillage-(ligneFin-LigneDeb)-1; - + config_modifie:=true; FormConfig.RichAig.Clear; - + // réafficher le richsig for i:=1 to MaxAiguillage do begin @@ -7523,7 +7627,7 @@ begin begin SelStart:=0; Perform(EM_SCROLLCARET,0,0); - end; + end; ligneClicAig:=-1; AncligneClicAig:=-1; clicliste:=false; @@ -8161,7 +8265,6 @@ var s,sO: string; dir : boolean; begin if (ligneClicSig<0) or clicListe then exit; - if affevt then affiche('Evt MemoCarre change',clyellow); j:=MemoCarre.Selstart; clicMemo:=MemoCarre.Perform(EM_LINEFROMCHAR,j,0); // numéro de la ligne du curseur @@ -8225,7 +8328,10 @@ begin // boucle de ligne for ligne:=1 to 6 do begin - s:=MemoCarre.Lines[ligne-1]; + s:=uppercase(MemoCarre.Lines[ligne-1]); + clicListe:=true; + MemoCarre.Lines[ligne-1]:=s; + clicListe:=false; sO:=s; j:=1; if s<>'' then @@ -8249,9 +8355,10 @@ begin end; end; - s:=encode_sig_feux(ligneClicSig+1); - RichSig.Lines[ligneClicSig]:=s; - LabelInfo.Caption:=''; + s:=encode_sig_feux(ligneClicSig+1); + RichSig.Lines[ligneClicSig]:=s; + LabelInfo.Caption:=''; + clicListe:=false; end; @@ -8702,16 +8809,136 @@ begin end; -procedure TFormConfig.RichAigKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); +procedure TFormConfig.RichAigKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); +var lc,curseur,i : integer; begin if key=VK_delete then supprime_aig; + + if ord(Key)=VK_UP then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichAig keydown',clyellow); + with Formconfig.RichAig do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lc>0 then + begin + dec(lc); + AncligneClicAig:=ligneClicAig; + ligneClicAig:=lc; + curseur:=SelStart; // position initiale du curseur + if AncligneClicAig<>ligneClicAig then + begin + if AncligneClicAig<>-1 then + begin + RE_ColorLine(RichAig,AncligneClicAig,ClAqua); + end; + RE_ColorLine(RichAig,ligneClicAig,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_Aig_tablo(lc+1); + end; + end; + end; + end; + + if ord(Key)=VK_DOWN then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichAig keydown',clyellow); + with Formconfig.RichAig do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lcligneClicAig then + begin + if AncligneClicAig<>-1 then + begin + RE_ColorLine(RichAig,AncligneClicAig,ClAqua); + end; + RE_ColorLine(RichAig,ligneClicAig,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_Aig_tablo(lc+1); + end; + end; + end; + end; + clicListe:=false; + end; procedure TFormConfig.RichSigKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + var lc,curseur,i : integer; begin if key=VK_delete then supprime_sig; + + if ord(Key)=VK_UP then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichSig keydown',clyellow); + with Formconfig.RichSig do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lc>0 then + begin + dec(lc); + AncligneClicSig:=ligneClicSig; + ligneClicSig:=lc; + curseur:=SelStart; // position initiale du curseur + if AncligneClicSig<>ligneClicSig then + begin + if AncligneClicSig<>-1 then + begin + RE_ColorLine(RichSig,AncligneClicSig,ClAqua); + end; + RE_ColorLine(RichSig,ligneClicSig,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_sig_feux(lc+1); + end; + end; + end; + end; + + if ord(Key)=VK_DOWN then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichSig keydown',clyellow); + with Formconfig.RichSig do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lcligneClicSig then + begin + if AncligneClicSig<>-1 then + begin + RE_ColorLine(RichSig,AncligneClicSig,ClAqua); + end; + RE_ColorLine(RichSig,ligneClicSig,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_sig_feux(lc+1); + end; + end; + end; + end; + clicListe:=false; end; procedure TFormConfig.ButtonEnregistreClick(Sender: TObject); @@ -9240,6 +9467,8 @@ end; procedure clicListeTrains(index : integer); begin + if index<1 then exit; + if Trains[index].nom_train='' then exit; with formconfig do begin editNomTrain.text:=Trains[index].nom_train; @@ -9257,25 +9486,26 @@ var j : integer; begin //affiche('RichEditTrainChange',clyellow); clicListe:=true; + AncligneclicTrain:=ligneclicTrain; with richeditTrains do begin j:=Selstart; - RE_ColorLine(Formconfig.richeditTrains,clicListeTrain,ClAqua); - clicListeTrain:=Perform(EM_LINEFROMCHAR,j,0); // numéro de la lignée cliquée + RE_ColorLine(Formconfig.richeditTrains,ligneclicTrain,ClAqua); + ligneclicTrain:=Perform(EM_LINEFROMCHAR,j,0); // numéro de la lignée cliquée end; //Affiche(intToSTR(lc),clyellow); - if clicListeTrain+1>Max_Trains then + if ligneclicTrain+1>ntrains then begin - ligneclicAig:=Max_Trains-1; + ligneclicTrain:=ntrains-1; end; - s:=RichEditTrains.Lines[clicListeTrain]; + s:=RichEditTrains.Lines[ligneclicTrain]; if s='' then exit; - RE_ColorLine(Formconfig.richeditTrains,clicListeTrain,ClYellow); + RE_ColorLine(Formconfig.richeditTrains,ligneclicTrain,ClYellow); - clicListeTrains(clicListeTrain+1); + clicListeTrains(ligneclicTrain+1); clicliste:=false; end; @@ -9286,16 +9516,16 @@ var i : integer; begin if clicliste then exit; if affevt then affiche('Evt change nom train',clyellow); - if (clicListeTrain<0) or (clicListeTrain>=Max_Trains) or (ntrains<1) then exit; + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then - RE_ColorLine(RichEditTrains,clicListeTrain,ClYellow); - trains[clicListeTrain+1].Nom_train:=EditNomTrain.text; - RichEditTrains.Lines[clicListeTrain]:=Train_tablo(clicListeTrain+1); + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + trains[ligneclicTrain+1].Nom_train:=EditNomTrain.text; + RichEditTrains.Lines[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); i:=formprinc.ComboTrains.ItemIndex; if i<0 then exit; - formprinc.ComboTrains.Items[clicListeTrain]:=EditNomTrain.text; - if i=clicListeTrain then formprinc.ComboTrains.Text:=EditNomTrain.text; + formprinc.ComboTrains.Items[ligneclicTrain]:=EditNomTrain.text; + if i=ligneclicTrain then formprinc.ComboTrains.Text:=EditNomTrain.text; end; @@ -9304,11 +9534,11 @@ var erreur :integer; begin if clicliste then exit; if affevt then affiche('Evt change adresse train',clyellow); - if (clicListeTrain<0) or (clicListeTrain>=Max_Trains) or (ntrains<1) then exit; + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then - RE_ColorLine(RichEditTrains,clicListeTrain,ClYellow); - val(EditAdresseTrain.text,trains[clicListeTrain+1].adresse,erreur); - formconfig.RichEditTrains.Lines[clicListeTrain]:=Train_tablo(clicListeTrain+1); + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + val(EditAdresseTrain.text,trains[ligneclicTrain+1].adresse,erreur); + formconfig.RichEditTrains.Lines[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); end; procedure TFormConfig.EditVitesseMaxiChange(Sender: TObject); @@ -9316,11 +9546,11 @@ var erreur :integer; begin if clicliste then exit; if affevt then affiche('Evt change adresse train',clyellow); - if (clicListeTrain<0) or (clicListeTrain>=Max_Trains) or (ntrains<1) then exit; + if (ligneclicTrain<0) or (ntrains>=ntrains) or (ntrains<1) then exit; if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then - RE_ColorLine(RichEditTrains,clicListeTrain,ClYellow); - val(EditVitesseMaxi.text,trains[clicListeTrain+1].vitmax,erreur); - formconfig.RichEditTrains.Lines[clicListeTrain]:=Train_tablo(clicListeTrain+1); + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + val(EditVitesseMaxi.text,trains[ligneclicTrain+1].vitmax,erreur); + formconfig.RichEditTrains.Lines[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); end; procedure TFormConfig.EditVitNomChange(Sender: TObject); @@ -9328,13 +9558,13 @@ procedure TFormConfig.EditVitNomChange(Sender: TObject); begin if clicliste then exit; if affevt then affiche('Evt change vitesse nominale train',clyellow); - if (clicListeTrain<0) or (clicListeTrain>=Max_Trains) or (ntrains<1) then exit; + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then with Formconfig do begin - RE_ColorLine(RichEditTrains,clicListeTrain,ClYellow); - val(EditVitNom.text,trains[clicListeTrain+1].vitNominale,erreur); - formconfig.RichEditTrains.Lines[clicListeTrain]:=Train_tablo(clicListeTrain+1); + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + val(EditVitNom.text,trains[ligneclicTrain+1].vitNominale,erreur); + formconfig.RichEditTrains.Lines[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); end; end; @@ -9343,13 +9573,13 @@ end; begin if clicliste then exit; if affevt then affiche('Evt change vitesse ralenti train',clyellow); - if (clicListeTrain<0) or (clicListeTrain>=Max_Trains) then exit; + if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) then exit; if FormConfig.PageControl.ActivePage=FormConfig.TabSheetTrains then with Formconfig do begin - RE_ColorLine(RichEditTrains,clicListeTrain,ClYellow); - val(EditVitRalenti.text,trains[clicListeTrain+1].vitRalenti,erreur); - formconfig.RichEditTrains.Lines[clicListeTrain]:=Train_tablo(clicListeTrain+1); + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + val(EditVitRalenti.text,trains[ligneclicTrain+1].vitRalenti,erreur); + formconfig.RichEditTrains.Lines[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); end; end; @@ -9366,27 +9596,34 @@ begin trains[ntrains].vitmax:=120; clicListeTrains(ntrains); j:=richEditTrains.Selstart; - RE_ColorLine(Formconfig.richeditTrains,clicListeTrain,ClAqua); - clicListeTrain:=ntrains-1; - RE_ColorLine(Formconfig.richeditTrains,clicListeTrain,ClYellow); + RE_ColorLine(Formconfig.richeditTrains,ligneclicTrain,ClAqua); + ligneclicTrain:=ntrains-1; + RE_ColorLine(Formconfig.richeditTrains,ligneclicTrain,ClYellow); formconfig.RichEditTrains.Lines.Add(Train_tablo(ntrains)); + with formconfig.richEdittrains do + begin + SetFocus; + Selstart:=RichEdittrains.GetTextLen-1; + Perform(EM_SCROLLCARET,0,0); + end; clicListe:=false; end; // supprime le ou les train sélectionnés dans le richEdit procedure supprime_train; -var ligneDeb,LigneFin,i,index,debut,longueur,fin,l,ltot : integer; +var ligneDeb,LigneFin,i,debut,longueur,fin,l,ltot : integer; s : string; begin - //trouver ligne de début et de fin sélectionner. + //trouver ligne de début et de fin sélectionnées. with formConfig do begin debut:=RichEditTrains.SelStart; longueur:=RichEditTrains.SelLength; end; fin:=debut+longueur; - //Affiche(inttostr(debut)+' '+inttostr(longueur),clyellow); + //Affiche(inttostr(debut)+' '+inttostr(longueur),clorange); // trouver les lignes sélectionnées + i:=0;ltot:=0;ligneDeb:=0;LigneFin:=0; repeat l:=length(FormConfig.RichEditTrains.lines[i])+2; //+2 car CR LF @@ -9395,27 +9632,20 @@ begin if (ltot>=fin) and (ligneFin=0) and (ligneDeb<>0) then ligneFin:=i+1; //if (ltot=fin) and (ligneFin=0) then ligneFin:=i; inc(i); - until (i>=ntrains) or (ligneFin>0); - if lignefin=0 then if fin>ltot then ligneFin:=clicListeTrain; - //Affiche(inttostr(Ltot)+' '+inttostr(Fin),clyellow); + until (ltot>=fin); + if lignefin>nTrains then lignefin:=nTrains; + if ligneDeb=0 then begin ligneDeb:=ligneclictrain+1;ligneFin:=ligneclictrain+1;end; + if (lignedeb<1) or (lignefin<1) or (lignefin>ntrains) then exit; + //Affiche(inttostr(Lignedeb)+' '+inttostr(LigneFin),clyellow); - i:=clicListeTrain; - if (i<0) then exit; - index:=i+1; // passe en index tableau - - if ligneDeb=LigneFin then s:='Voulez-vous supprimer le train '+trains[index].nom_train+'?' + if ligneDeb=LigneFin then s:='Voulez-vous supprimer le train '+trains[lignedeb].nom_train+'?' else s:='Voulez-vous supprimer les trains de '+ - trains[index].nom_train+' à '+trains[lignefin].nom_train+' ?'; + trains[lignedeb].nom_train+' à '+trains[lignefin].nom_train+' ?'; if Application.MessageBox(pchar(s),pchar('confirm'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then exit; - //FormConfig.ButtonAjSup.Caption:='Ajouter l''aig '+intToSTR(aiguillage[index].adresse)+' supprimé'; clicliste:=true; - //raz_champs_aig; - //Aig_supprime:=aiguillage[index]; // sauvegarde le supprimé - //Aig_sauve.adresse:=0; // dévalider sa définition - index:=ligneDeb; if ligneDeb=LigneFin then s:='Suppression du train '+trains[index].nom_train @@ -9423,14 +9653,15 @@ begin trains[ligneDeb].nom_train+' à '+trains[ligneFin].nom_train; Affiche(s,clOrange); - //Affiche('Boucle de '+intToSTR(ligneDeb)+' N='+intToSTR(MaxAiguillage-ligneFin),clyellow); + for i:=lignedeb to lignefin do + begin + Affiche('Suppression du train '+trains[i].nom_train+' @'+intToSTR(trains[i].Adresse),clorange); + end; + for i:=1 to ntrains-ligneFin do begin - index:=i+lignefin; //index de l'aiguillage de remplacement - //Affiche('Suppresion aiguillage '+intToSTR(aiguillage[i+lignedeb].Adresse),clorange); - //Affiche('remplacement par index '+intToSTR(index),clorange); - + index:=i+lignefin; //index de remplacement trains[lignedeb+i-1]:=trains[index]; trains[index].Adresse:=0; trains[index].nom_train:=''; @@ -9456,14 +9687,14 @@ begin SelStart:=0; Perform(EM_SCROLLCARET,0,0); end; - clicListeTrain:=-1; + ligneclicTrain:=-1; clicliste:=false; end; procedure TFormConfig.ButtonSupprimeClick(Sender: TObject); begin - supprime_train; + supprime_train; end; procedure TFormConfig.CheckBoxVerifXpressNetClick(Sender: TObject); @@ -9471,6 +9702,203 @@ procedure TFormConfig.CheckBoxVerifXpressNetClick(Sender: TObject); if CheckBoxVerifXpressNet.checked then Verif_AdrXpressNet:=1 else Verif_AdrXpressNet:=0; end; + +procedure TFormConfig.RichActKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var lc,curseur,i : integer; +begin + if key=VK_delete then supprime_act; + + if ord(Key)=VK_UP then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichAct keyup',clyellow); + with Formconfig.RichAct do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lc>0 then + begin + dec(lc); + AncligneClicAct:=ligneClicAct; + ligneClicAct:=lc; + curseur:=SelStart; // position initiale du curseur + if AncligneClicAct<>ligneClicAct then + begin + if AncligneClicAct<>-1 then + begin + RE_ColorLine(RichAct,AncligneClicAct,ClAqua); + end; + RE_ColorLine(RichAct,ligneClicAct,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_Act(lc+1); + end; + end; + end; + end; + + if ord(Key)=VK_DOWN then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichAct keydown',clyellow); + with Formconfig.RichAct do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lcligneClicAct then + begin + if AncligneClicAct<>-1 then + begin + RE_ColorLine(RichAct,AncligneClicAct,ClAqua); + end; + RE_ColorLine(RichAct,ligneClicAct,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_Act(lc+1); + end; + end; + end; + end; + clicListe:=false; +end; + +procedure TFormConfig.RichPNKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var lc,curseur,i : integer; +begin + if ord(Key)=VK_DELETE then supprime_pn; + if ord(Key)=VK_UP then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichPN keyup',clyellow); + with Formconfig.RichPN do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lc>0 then + begin + dec(lc); + AncLigneCliqueePN:=LigneCliqueePN; + LigneCliqueePN:=lc; + curseur:=SelStart; // position initiale du curseur + if AncLigneCliqueePN<>LigneCliqueePN then + begin + if AncLigneCliqueePN<>-1 then + begin + RE_ColorLine(RichPN,AncLigneCliqueePN,ClAqua); + end; + RE_ColorLine(RichPN,LigneCliqueePN,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_PN(lc+1); + end; + end; + end; + end; + + if ord(Key)=VK_DOWN then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichPN keydown',clyellow); + with Formconfig.RichPN do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lcLigneCliqueePN then + begin + if AncLigneCliqueePN<>-1 then + begin + RE_ColorLine(RichPN,AncLigneCliqueePN,ClAqua); + end; + RE_ColorLine(RichPN,LigneCliqueePN,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + aff_champs_PN(lc+1); + end; + end; + end; + end; + clicListe:=false; +end; + +procedure TFormConfig.RichEditTrainsKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var lc,curseur,i : integer; +begin + if ord(key)=VK_DELETE then supprime_train; + if ord(Key)=VK_UP then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichEditTrains keyup',clyellow); + with Formconfig.RichEditTrains do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lc>0 then + begin + dec(lc); + AncligneclicTrain:=ligneclicTrain; + ligneclicTrain:=lc; + curseur:=SelStart; // position initiale du curseur + if AncligneclicTrain<>ligneclicTrain then + begin + if AncligneclicTrain<>-1 then + begin + RE_ColorLine(RichEditTrains,AncligneclicTrain,ClAqua); + end; + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + clicListeTrains(lc+1); + end; + end; + end; + end; + + if ord(Key)=VK_DOWN then + begin + if clicListe then exit; + clicListe:=true; + if affevt then affiche('Evt RichEditTrains keydown',clyellow); + with Formconfig.RichEditTrains do + begin + i:=Selstart; + lc:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée + if lcligneclicTrain then + begin + if AncligneclicTrain<>-1 then + begin + RE_ColorLine(RichEditTrains,AncligneclicTrain,ClAqua); + end; + RE_ColorLine(RichEditTrains,ligneclicTrain,ClYellow); + selStart:=curseur; // remettre le curseur en position initiale + clicListeTrains(lc+1); + end; + end; + end; + end; + clicListe:=false; +end; + end. diff --git a/UnitConfigCellTCO.dcu b/UnitConfigCellTCO.dcu index 311fc31..8c1e0d5 100644 Binary files a/UnitConfigCellTCO.dcu and b/UnitConfigCellTCO.dcu differ diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index 7b88106..b1451f3 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -14,17 +14,9 @@ object FormConfCellTCO: TFormConfCellTCO OldCreateOrder = False OnActivate = FormActivate OnCreate = FormCreate + OnKeyPress = FormKeyPress PixelsPerInch = 96 TextHeight = 13 - object ButtonOk: TButton - Left = 168 - Top = 368 - Width = 75 - Height = 25 - Caption = 'Ok' - TabOrder = 0 - OnClick = ButtonOkClick - end object GroupBox1: TGroupBox Left = 8 Top = 264 @@ -37,7 +29,7 @@ object FormConfCellTCO: TFormConfCellTCO Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - TabOrder = 1 + TabOrder = 0 object Label1: TLabel Left = 8 Top = 41 @@ -96,7 +88,7 @@ object FormConfCellTCO: TFormConfCellTCO Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - TabOrder = 2 + TabOrder = 1 object Label15: TLabel Left = 8 Top = 22 @@ -297,7 +289,16 @@ object FormConfCellTCO: TFormConfCellTCO ParentFont = False ParentShowHint = False ShowHint = True - TabOrder = 3 + TabOrder = 2 OnClick = CheckPinvClick end + object BitBtnOk: TBitBtn + Left = 152 + Top = 368 + Width = 75 + Height = 25 + TabOrder = 3 + OnClick = BitBtnOkClick + Kind = bkOK + end end diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index cfec1b4..f5cee6d 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -4,11 +4,11 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, UnitTCO, ExtCtrls; + Dialogs, StdCtrls, UnitTCO, ExtCtrls, + Buttons; type TFormConfCellTCO = class(TForm) - ButtonOk: TButton; GroupBox1: TGroupBox; ComboRepr: TComboBox; Label1: TLabel; @@ -29,7 +29,7 @@ type RadioButtonD: TRadioButton; EditAdrElement: TEdit; ButtonFond: TButton; - procedure ButtonOkClick(Sender: TObject); + BitBtnOk: TBitBtn; procedure EditTypeImageKeyPress(Sender: TObject; var Key: Char); procedure EditAdrElementChange(Sender: TObject); procedure EditTexteCCTCOChange(Sender: TObject); @@ -45,6 +45,8 @@ type procedure EditAdrElementKeyPress(Sender: TObject; var Key: Char); procedure ButtonFondClick(Sender: TObject); procedure FormActivate(Sender: TObject); + procedure FormKeyPress(Sender: TObject; var Key: Char); + procedure BitBtnOkClick(Sender: TObject); private { Déclarations privées } public @@ -68,6 +70,7 @@ procedure actualise; var Bimage : integer; oriente,piedFeu : integer; begin + if not(formConfCellTCOAff) then exit; actualize:=true; // évite les évènements parasites FormConfCellTCO.caption:='Propriétés de la cellule '+IntToSTR(XClicCell)+','+intToSTR(YClicCell); Bimage:=TCO[XClicCell,YClicCell].Bimage; @@ -118,7 +121,7 @@ begin 20: Assign(FormTCO.ImagePalette20.Picture); 21: Assign(FormTCO.ImagePalette21.Picture); 22: Assign(FormTCO.ImagePalette22.Picture); - 23: Assign(FormTCO.ImagePalette23.Picture); + 23,31: Assign(FormTCO.ImagePalette31.Picture); 30: begin With formConfCellTCO.ImagePalette do begin @@ -194,10 +197,7 @@ begin actualize:=false; end; -procedure TFormConfCellTCO.ButtonOkClick(Sender: TObject); -begin - close; -end; + procedure TFormConfCellTCO.EditTypeImageKeyPress(Sender: TObject; var Key: Char); var Bimage,erreur : integer; @@ -207,7 +207,7 @@ begin Key:=#0; // évite beeping Val(EditTypeImage.Text,Bimage,erreur); //Affiche('Keypressed / Bimage='+IntToSTR(bimage),clyellow); - if (erreur<>0) or not(Bimage in[0..23,30]) then + if (erreur<>0) or not(Bimage in[0..23,30,31]) then begin EditTypeImage.text:=intToSTR(tco[XClicCell,YClicCell].BImage); exit; @@ -279,6 +279,7 @@ var i,x,y : integer; begin // fenetre toujours dessus actualize:=false; + formConfCellTCOAff:=true; SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); exit; @@ -319,7 +320,7 @@ begin 20 : ImageSRC:=FormTCO.ImagePalette20; 21 : ImageSRC:=FormTCO.ImagePalette21; 22 : ImageSRC:=FormTCO.ImagePalette22; - 23 : ImageSRC:=FormTCO.ImagePalette23; + 23,31 : ImageSRC:=FormTCO.ImagePalette31; 24 : ImageSRC:=FormTCO.ImagePalette30; end; picture.Bitmap:=ImageSRC.picture.BitMap; @@ -337,8 +338,6 @@ begin end; end; - - procedure TFormConfCellTCO.ComboReprChange(Sender: TObject); begin tco[XClicCell,YClicCell].Repr:=comborepr.ItemIndex; @@ -355,7 +354,7 @@ begin if (xClicCell=0) or (xClicCell>NbreCellX) or (yClicCell=0) or (yClicCell>NbreCelly) then exit; Bimage:=Tco[xClicCell,yClicCell].Bimage; if (bimage=2) or (bimage=3) or (bimage=4) or (bimage=5) or (bimage=12) or (bimage=13) - or (bimage=14) or (bimage=15) then + or (bimage=14) or (bimage=15) or (bimage=24) then begin TCO[xClicCell,yClicCell].inverse:=CheckPinv.checked; TCO_modifie:=true; @@ -423,4 +422,14 @@ begin else ButtonFond.caption:='Couleur de fond de la cellule'; end; +procedure TFormConfCellTCO.FormKeyPress(Sender: TObject; var Key: Char); +begin + if key=chr(27) then close; +end; + +procedure TFormConfCellTCO.BitBtnOkClick(Sender: TObject); +begin + close +end; + end. diff --git a/UnitConfigTCO.dcu b/UnitConfigTCO.dcu index dfe51a5..ff295d0 100644 Binary files a/UnitConfigTCO.dcu and b/UnitConfigTCO.dcu differ diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index 70d15bf..03eea1b 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -63,38 +63,29 @@ object FormConfigTCO: TFormConfigTCO Height = 13 Caption = '/10' end - object ButtonOK: TButton - Left = 216 - Top = 240 - Width = 75 - Height = 25 - Caption = 'OK' - TabOrder = 0 - OnClick = ButtonOKClick - end object ButtonDessine: TButton Left = 16 Top = 240 Width = 75 Height = 25 Caption = 'Redessine' - TabOrder = 1 + TabOrder = 0 OnClick = ButtonDessineClick end object CheckDessineGrille: TCheckBox Left = 16 - Top = 88 + Top = 96 Width = 105 Height = 17 Caption = 'dessine grille' - TabOrder = 2 + TabOrder = 1 end object EditNbCellX: TEdit Left = 184 Top = 40 Width = 49 Height = 21 - TabOrder = 3 + TabOrder = 2 Text = 'EditNbCellX' end object EditNbCellY: TEdit @@ -102,7 +93,7 @@ object FormConfigTCO: TFormConfigTCO Top = 64 Width = 49 Height = 21 - TabOrder = 4 + TabOrder = 3 Text = 'EditNbCellY' end object GroupBox1: TGroupBox @@ -111,7 +102,7 @@ object FormConfigTCO: TFormConfigTCO Width = 353 Height = 265 Caption = 'Couleurs ' - TabOrder = 5 + TabOrder = 4 object Label5: TLabel Left = 21 Top = 32 @@ -134,9 +125,9 @@ object FormConfigTCO: TFormConfigTCO OnClick = ImageFondClick end object Label6: TLabel - Left = 32 + Left = 33 Top = 72 - Width = 76 + Width = 75 Height = 26 Alignment = taRightJustify Caption = 'Couleur de fond par d'#233'faut' @@ -247,26 +238,25 @@ object FormConfigTCO: TFormConfigTCO Top = 208 Width = 281 Height = 17 - Caption = 'Couleur du cantons activ'#233' par la couleur du train' + Caption = 'Couleur du canton activ'#233' par la couleur du train' TabOrder = 0 end end object Memo1: TMemo Left = 16 - Top = 120 + Top = 136 Width = 273 - Height = 81 + Height = 65 BevelInner = bvLowered BevelKind = bkFlat BorderStyle = bsNone Lines.Strings = ( 'Si vous d'#233'finissez un nombre de cellules en ' - 'horizontal ou en vertical plus petit(s) que l'#39'actuel' - '(s), alors le TCO sera tronqu'#233', et les '#233'l'#233'ments ' - 'tronqu'#233's seront perdus '#224' la prochaine ' - 'sauvegarde.') + 'horizontal ou en vertical plus petit(s) que l'#39'actuel(s), ' + 'alors le TCO sera tronqu'#233', et les '#233'l'#233'ments tronqu'#233's ' + 'seront perdus '#224' la prochaine sauvegarde.') ReadOnly = True - TabOrder = 6 + TabOrder = 5 end object EditRatio: TEdit Left = 48 @@ -276,9 +266,18 @@ object FormConfigTCO: TFormConfigTCO Hint = 'Rapport X/Y d'#39'affichage des cellules' ParentShowHint = False ShowHint = True - TabOrder = 7 + TabOrder = 6 Text = 'EditRatio' end + object BitBtnOk: TBitBtn + Left = 208 + Top = 240 + Width = 75 + Height = 25 + TabOrder = 7 + OnClick = BitBtnOkClick + Kind = bkOK + end object ColorDialog1: TColorDialog OnShow = ColorDialog1Show Left = 248 diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index 0546105..735a6c4 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -4,11 +4,11 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls , UnitTCO, ExtCtrls, Menus; + Dialogs, StdCtrls , UnitTCO, ExtCtrls, Menus, + Buttons; type TFormConfigTCO = class(TForm) - ButtonOK: TButton; Label3: TLabel; Label4: TLabel; ButtonDessine: TButton; @@ -43,7 +43,7 @@ type CheckCouleur: TCheckBox; Label1: TLabel; ImagePiedFeu: TImage; - procedure ButtonOKClick(Sender: TObject); + BitBtnOk: TBitBtn; procedure ButtonDessineClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ImageAigClick(Sender: TObject); @@ -55,6 +55,7 @@ type procedure ImageTexteClick(Sender: TObject); procedure ImageQuaiClick(Sender: TObject); procedure ImagePiedFeuClick(Sender: TObject); + procedure BitBtnOkClick(Sender: TObject); private { Déclarations privées } public @@ -76,25 +77,24 @@ procedure icone_aig; var r : Trect; x1,y1,x2,y2,x3,y3,x4,y4 : integer; begin - with FormConfigTCO.ImageAig do - begin - canvas.Pen.color:=clfond; - canvas.Brush.Color:=clfond; - canvas.Rectangle(0,0,Width,Height); + with FormConfigTCO.ImageAig do + begin + canvas.Pen.color:=clfond; + canvas.Brush.Color:=clfond; + canvas.Rectangle(0,0,Width,Height); - canvas.pen.color:=clVoies; - canvas.brush.color:=clvoies; - // bande horizontale - r:=Rect(0,(height div 2)-3,width,(height div 2)+3); - canvas.FillRect(r); - - x1:=(width div 2); y1:=(height div 2)-3; - x2:=3; y2:=0; - x3:=0; y3:=3; - x4:=0+(width div 2)-1; y4:=(height div 2)+3-1; - canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; + canvas.pen.color:=clVoies; + canvas.brush.color:=clvoies; + // bande horizontale + r:=Rect(0,(height div 2)-3,width,(height div 2)+3); + canvas.FillRect(r); + x1:=(width div 2); y1:=(height div 2)-3; + x2:=3; y2:=0; + x3:=0; y3:=3; + x4:=0+(width div 2)-1; y4:=(height div 2)+3-1; + canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; end; procedure dessine_icones; @@ -156,7 +156,7 @@ begin canvas.FillRect(r); end; - //6 texte + // 6 texte with formCOnfigTCO.ImageTexte do begin canvas.Pen.color:=clfond; @@ -167,7 +167,7 @@ begin canvas.Textout(5,10,'Voie 1'); end; - //Quai + // Quai with formconfigTCO.ImageQuai do begin canvas.Pen.color:=clfond; @@ -260,48 +260,6 @@ begin NbCellulesTCO:=NbreCellX*NbreCellY; end; -procedure TFormConfigTCO.ButtonOKClick(Sender: TObject); -var ok : boolean; -begin - ok:=true; - - if verif_config_TCO then - begin - with FormTCO.ImageTCO do - begin - Width:=LargeurCell*NbreCellX; - Height:=HauteurCell*NbreCellY; - end; - - try - SetLength(TCO,NbreCellX+1,NbreCellY+1); - except - LabelErreur.caption:='TCO Mémoire insuffisante'; - NbreCellX:=20;NbreCellY:=12; - SetLength(TCO,NbreCellX+1,NbreCellY+1); - ok:=false; - end; - - try - SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); - except - LabelErreur.caption:='TamponTCO Mémoire insuffisante'; - NbreCellX:=20;NbreCellY:=12; - SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); - ok:=false; - end; - - - AvecGrille:=checkDessineGrille.Checked; - if ok then - begin - calcul_cellules; - affiche_TCO; - LabelErreur.caption:=''; - close; - end; - end; -end; procedure TFormConfigTCO.ButtonDessineClick(Sender: TObject); begin @@ -434,9 +392,50 @@ end; // change le titre de la fenêtre de choix des couleurs à son ouverture procedure TFormConfigTCO.ColorDialog1Show(Sender: TObject); begin - SetWindowText(ColorDialog1.Handle,pchar(titre_couleur)); + SetWindowText(ColorDialog1.Handle,pchar(titre_couleur)); end; +procedure TFormConfigTCO.BitBtnOkClick(Sender: TObject); +var ok : boolean; +begin + ok:=true; + if verif_config_TCO then + begin + with FormTCO.ImageTCO do + begin + Width:=LargeurCell*NbreCellX; + Height:=HauteurCell*NbreCellY; + end; + + try + SetLength(TCO,NbreCellX+1,NbreCellY+1); + except + LabelErreur.caption:='TCO Mémoire insuffisante'; + NbreCellX:=20;NbreCellY:=12; + SetLength(TCO,NbreCellX+1,NbreCellY+1); + ok:=false; + end; + + try + SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); + except + LabelErreur.caption:='TamponTCO Mémoire insuffisante'; + NbreCellX:=20;NbreCellY:=12; + SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); + ok:=false; + end; + + + AvecGrille:=checkDessineGrille.Checked; + if ok then + begin + calcul_cellules; + affiche_TCO; + LabelErreur.caption:=''; + close; + end; + end; +end; end. diff --git a/UnitDebug.dcu b/UnitDebug.dcu index 0979f28..7807582 100644 Binary files a/UnitDebug.dcu and b/UnitDebug.dcu differ diff --git a/UnitDebug.dfm b/UnitDebug.dfm index 839c516..7155b9d 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -3,8 +3,7 @@ object FormDebug: TFormDebug Top = 21 Width = 864 Height = 788 - VertScrollBar.Position = 28 - VertScrollBar.Smooth = True + VertScrollBar.Increment = 67 VertScrollBar.Tracking = True Caption = 'Fen'#234'tre de d'#233'bug' Color = clWindow @@ -21,13 +20,13 @@ object FormDebug: TFormDebug OnCreate = FormCreate OnKeyPress = FormKeyPress DesignSize = ( - 839 - 757) + 831 + 749) PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 595 - Top = -24 + Top = 4 Width = 108 Height = 13 Anchors = [akTop, akRight] @@ -43,7 +42,7 @@ object FormDebug: TFormDebug end object Label2: TLabel Left = 443 - Top = -26 + Top = 2 Width = 131 Height = 18 Anchors = [akTop, akRight] @@ -57,7 +56,7 @@ object FormDebug: TFormDebug end object EditNivDebug: TEdit Left = 754 - Top = -26 + Top = 2 Width = 49 Height = 21 Anchors = [akTop, akRight] @@ -73,7 +72,7 @@ object FormDebug: TFormDebug end object ButtonEcrLog: TButton Left = 442 - Top = 300 + Top = 328 Width = 97 Height = 29 Anchors = [akTop, akRight] @@ -83,7 +82,7 @@ object FormDebug: TFormDebug end object ButtonRazTampon: TButton Left = 442 - Top = 332 + Top = 360 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -94,17 +93,20 @@ object FormDebug: TFormDebug end object ButtonCherche: TButton Left = 442 - Top = 268 + Top = 296 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 = 442 - Top = 228 + Top = 256 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -115,7 +117,7 @@ object FormDebug: TFormDebug end object ButtonCop: TButton Left = 442 - Top = 180 + Top = 208 Width = 97 Height = 41 Anchors = [akTop, akRight] @@ -132,7 +134,7 @@ object FormDebug: TFormDebug end object ButtonRazLog: TButton Left = 442 - Top = 372 + Top = 400 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -143,7 +145,7 @@ object FormDebug: TFormDebug end object GroupBox1: TGroupBox Left = 448 - Top = 572 + Top = 600 Width = 369 Height = 185 Anchors = [akTop, akRight] @@ -291,7 +293,7 @@ object FormDebug: TFormDebug end object GroupBox2: TGroupBox Left = 440 - Top = -8 + Top = 20 Width = 401 Height = 149 Anchors = [akTop, akRight] @@ -483,7 +485,7 @@ object FormDebug: TFormDebug end object RichDebug: TRichEdit Left = 8 - Top = -20 + Top = 8 Width = 425 Height = 741 Anchors = [akLeft, akTop, akRight, akBottom] @@ -496,7 +498,7 @@ object FormDebug: TFormDebug end object GroupBox5: TGroupBox Left = 448 - Top = 460 + Top = 488 Width = 372 Height = 57 Anchors = [akTop, akRight] @@ -563,7 +565,7 @@ object FormDebug: TFormDebug end object ButtonRazTout: TButton Left = 443 - Top = 148 + Top = 176 Width = 97 Height = 25 Hint = @@ -578,7 +580,7 @@ object FormDebug: TFormDebug end object GroupBox6: TGroupBox Left = 448 - Top = 524 + Top = 552 Width = 372 Height = 41 Anchors = [akTop, akRight] @@ -655,7 +657,7 @@ object FormDebug: TFormDebug end object MemoEvtDet: TRichEdit Left = 544 - Top = 146 + Top = 174 Width = 281 Height = 307 Anchors = [akTop, akRight] diff --git a/UnitDebug.pas b/UnitDebug.pas index 1b6cb70..c9d465a 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -109,7 +109,7 @@ type var FormDebug: TFormDebug; - NivDebug,signalDebug : integer; + NivDebug,signalDebug,compt_erreur,positionErreur,LigneErreur : integer; AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg : boolean; N_event_det : integer; // index du dernier évènement (de 1 à 20) N_Event_tick : integer ; // dernier index @@ -183,6 +183,8 @@ begin s:=DateToStr(date)+' '+TimeToStr(Time)+' '; Autoscroll:=true; // permet l'affichage de l'ascenseur dans radstudio DebugAffiche:=true; + compt_erreur:=0; + LigneErreur:=0; end; procedure TFormDebug.ButtonEcrLogClick(Sender: TObject); @@ -240,28 +242,37 @@ begin end; procedure TFormDebug.ButtonChercheClick(Sender: TObject); -var ligne,l,position : integer; +var i,l,positionErreur : integer; s : string; trouve : boolean; begin // faire avec with RichDebug do begin - ligne:=0; - l:=0; repeat - s:=lowercase(Lines[ligne]); - l:=l+length(s)+2; - position:=pos('erreur',s); - trouve:=position<>0; - inc(ligne); - until (ligne>=Lines.Count) or trouve; + s:=lowercase(Lines[ligneErreur]); + positionErreur:=pos('erreur',s); + trouve:=positionErreur<>0; + inc(LigneErreur); + until (LigneErreur>=Lines.Count) or trouve; + if trouve then begin - //Affiche('trouvé en '+intToSTR(ligne),clyellow); - SelStart:= l-length(s)+position-3; + inc(compt_erreur); + //Affiche('trouvé en '+Lines[ligneErreur-1],clred); + l:=0; + for i:=0 to ligneErreur-1 do + begin + l:=l+length(Lines[i])+2; + end; + SelStart:= l-length(s)+positionErreur-3; SelLength:=6; - SetFocus; + SetFocus; // afficher la sélection + Perform(EM_SCROLLCARET,0,0); // et scroller à l'endroit de la sélection + end + else + begin + LigneErreur:=0; end; end; end; @@ -380,7 +391,6 @@ begin end; - procedure TFormDebug.ButtonCPClick(Sender: TObject); var Adr,erreur,ancdebug,adrtrain,voie : integer ; begin @@ -447,12 +457,13 @@ end; procedure TFormDebug.ButtonRazToutClick(Sender: TObject); begin + AfficheDebug('Raz tous trains et routes',clLime); Raz_tout; end; procedure TFormDebug.MemoEvtDet1Change(Sender: TObject); begin - SendMessage(MemoEvtDet.handle, WM_VSCROLL, SB_BOTTOM, 0); + SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TFormDebug.EditDebugSignalChange(Sender: TObject); diff --git a/UnitFrame1.dcu b/UnitFrame1.dcu new file mode 100644 index 0000000..9dc338b Binary files /dev/null and b/UnitFrame1.dcu differ diff --git a/UnitFrame1.dfm b/UnitFrame1.dfm new file mode 100644 index 0000000..90d0e3a --- /dev/null +++ b/UnitFrame1.dfm @@ -0,0 +1,14 @@ +object Frame1: TFrame1 + Left = 0 + Top = 0 + Width = 289 + Height = 86 + TabOrder = 0 + object Label1: TLabel + Left = 104 + Top = 16 + Width = 60 + Height = 13 + Caption = 'Cadre Frame' + end +end diff --git a/UnitFrame1.pas b/UnitFrame1.pas new file mode 100644 index 0000000..4f2da0e --- /dev/null +++ b/UnitFrame1.pas @@ -0,0 +1,22 @@ +unit UnitFrame1; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls; + +type + TFrame1 = class(TFrame) + Label1: TLabel; + private + { Déclarations privées } + public + { Déclarations publiques } + end; + +implementation + +{$R *.dfm} + +end. diff --git a/UnitPilote.dcu b/UnitPilote.dcu index 758bc3b..1b65452 100644 Binary files a/UnitPilote.dcu and b/UnitPilote.dcu differ diff --git a/UnitPilote.pas b/UnitPilote.pas index 36a4e1f..bc1351c 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -61,9 +61,6 @@ type { Déclarations publiques } end; -// définition des adresses normalisées du décodeur de leds de digitalBahn -// l'ordre des adresses est à respecter dans la programation des signaux. -// L'oeilleton est cablé sur la sortie 4, il est géré directement par le décodeur. **/ // code des aspects des signaux const @@ -258,14 +255,20 @@ if ord(Key) = VK_RETURN then end; procedure TFormPilote.FormActivate(Sender: TObject); -var i,d : integer; +var n,i,d : integer; begin // mise à jour du champ décodeur i:=index_feu(AdrPilote); d:=feux[i].decodeur; + n:=feux[i].aspect; LabelDec.Caption:=decodeur[d]; - // check - checkVerrouCarre.Checked:=feux[i].VerrouilleCarre; + // checkcarré + if (n<4) or (n>10) then checkVerrouCarre.Visible:=false else + begin + checkVerrouCarre.Visible:=true; + checkVerrouCarre.Checked:=feux[i].VerrouilleCarre; + end; + end; procedure TFormPilote.CheckVerrouCarreClick(Sender: TObject); diff --git a/UnitPrinc.dcu b/UnitPrinc.dcu index 5d91a14..ee97e07 100644 Binary files a/UnitPrinc.dcu and b/UnitPrinc.dcu differ diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index c3247b2..4dc521b 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,6 +1,6 @@ object FormPrinc: TFormPrinc - Left = 59 - Top = 174 + Left = 66 + Top = 209 Width = 1213 Height = 670 Caption = 'Signaux complexes' @@ -225,8 +225,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image7feux: TImage - Left = 504 - Top = 8 + Left = 144 + Top = 0 Width = 57 Height = 105 Picture.Data = { @@ -666,8 +666,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image2feux: TImage - Left = 896 - Top = 88 + Left = 904 + Top = 136 Width = 33 Height = 57 Picture.Data = { @@ -740,8 +740,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image2Dir: TImage - Left = 936 - Top = 144 + Left = 984 + Top = 120 Width = 41 Height = 25 Picture.Data = { @@ -815,8 +815,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image3Dir: TImage - Left = 840 - Top = 136 + Left = 968 + Top = 168 Width = 49 Height = 25 Picture.Data = { @@ -893,7 +893,7 @@ object FormPrinc: TFormPrinc Visible = False end object Image4Dir: TImage - Left = 1064 + Left = 1032 Top = 120 Width = 57 Height = 25 @@ -981,8 +981,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image5Dir: TImage - Left = 464 - Top = 0 + Left = 1096 + Top = 120 Width = 65 Height = 25 Picture.Data = { @@ -1079,8 +1079,8 @@ object FormPrinc: TFormPrinc Visible = False end object Image6Dir: TImage - Left = 872 - Top = 136 + Left = 896 + Top = 120 Width = 81 Height = 25 Picture.Data = { @@ -1200,22 +1200,17 @@ object FormPrinc: TFormPrinc Font.Style = [] ParentFont = False end - object Splitter: TSplitter + object SplitterH: TSplitter Left = 0 Top = 0 - Width = 5 Height = 589 - Color = clWindowFrame - ParentColor = False - Visible = False - OnMoved = SplitterMoved end object ScrollBox1: TScrollBox Left = 632 - Top = 192 + Top = 200 Width = 546 - Height = 399 - HorzScrollBar.Smooth = True + Height = 391 + HorzScrollBar.Increment = 48 HorzScrollBar.Tracking = True VertScrollBar.Smooth = True VertScrollBar.Tracking = True @@ -1291,20 +1286,20 @@ object FormPrinc: TFormPrinc end object Panel1: TPanel Left = 904 - Top = 5 + Top = 13 Width = 282 Height = 108 Anchors = [akTop, akRight] TabOrder = 4 object Label1: TLabel - Left = 136 + Left = 56 Top = 88 Width = 89 Height = 13 Caption = 'Nombre de trains : ' end object LabelNbTrains: TLabel - Left = 256 + Left = 240 Top = 84 Width = 9 Height = 19 @@ -1391,27 +1386,6 @@ object FormPrinc: TFormPrinc Caption = 'xx' TabOrder = 5 end - object FenRich: TRichEdit - Left = 8 - Top = 32 - Width = 601 - Height = 513 - Anchors = [akLeft, akTop, akRight, akBottom] - Color = clBlack - Font.Charset = DEFAULT_CHARSET - Font.Color = clYellow - Font.Height = -13 - Font.Name = 'MS Sans Serif' - Font.Style = [] - ParentFont = False - PopupMenu = PopupMenuFenRich - ReadOnly = True - ScrollBars = ssBoth - TabOrder = 6 - WordWrap = False - OnChange = FenRichChange - OnMouseDown = FenRichMouseDown - end object GroupBox2: TGroupBox Left = 633 Top = 64 @@ -1419,7 +1393,7 @@ object FormPrinc: TFormPrinc Height = 105 Anchors = [akTop, akRight] Caption = 'Variables CV' - TabOrder = 7 + TabOrder = 6 object Label3: TLabel Left = 208 Top = 34 @@ -1481,7 +1455,7 @@ object FormPrinc: TFormPrinc Height = 129 Anchors = [akTop, akRight] Caption = 'Commande aux trains' - TabOrder = 8 + TabOrder = 7 object Label4: TLabel Left = 8 Top = 22 @@ -1698,7 +1672,7 @@ object FormPrinc: TFormPrinc TabOrder = 5 end object TrackBarVit: TTrackBar - Left = 16 + Left = 24 Top = 64 Width = 233 Height = 21 @@ -1717,7 +1691,7 @@ object FormPrinc: TFormPrinc Height = 33 Anchors = [akTop, akRight] Caption = 'Envoi vers centrale DCC++' - TabOrder = 9 + TabOrder = 8 WordWrap = True OnClick = ButtonEnvClick end @@ -1727,7 +1701,7 @@ object FormPrinc: TFormPrinc Width = 121 Height = 21 Anchors = [akTop, akRight] - TabOrder = 10 + TabOrder = 9 Text = '<1>' end object Button1: TButton @@ -1737,10 +1711,45 @@ object FormPrinc: TFormPrinc Height = 25 Anchors = [akTop, akRight] Caption = 'Button1' - TabOrder = 11 + TabOrder = 10 Visible = False OnClick = Button1Click end + object Panel2: TPanel + Left = 8 + Top = 32 + Width = 609 + Height = 497 + TabOrder = 11 + object SplitterV: TSplitter + Left = 1 + Top = 1 + Width = 8 + Height = 495 + Beveled = True + OnMoved = SplitterVMoved + end + object FenRich: TRichEdit + Left = 8 + Top = 16 + Width = 593 + Height = 505 + Color = clBlack + Font.Charset = DEFAULT_CHARSET + Font.Color = clYellow + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + PopupMenu = PopupMenuFenRich + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + WordWrap = False + OnChange = FenRichChange + OnMouseDown = FenRichMouseDown + end + end object Timer1: TTimer Interval = 100 OnTimer = Timer1Timer @@ -1959,6 +1968,7 @@ object FormPrinc: TFormPrinc end end object PopupMenuFeu: TPopupMenu + OnPopup = PopupMenuFeuPopup Left = 896 object Proprits1: TMenuItem Caption = 'Propri'#233't'#233's du signal' diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 7aa1b59..c4fcce5 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -13,7 +13,7 @@ Unit UnitPrinc; + 2 = aiguillage droit = sortie 2 de l'adresse d'accessoire - 1 = aiguillage dévié = sortie 1 de l'adresse d'accessoire -port com lenz=57600 + vitesse port com lenz=57600 *) // en mode simulation run: @@ -44,7 +44,7 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ShellAPI, TlHelp32, ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB, MMSystem , registry, - Buttons ; + Buttons; type TFormPrinc = class(TForm) @@ -105,7 +105,6 @@ type ButtonLanceCDM: TButton; Affichefentredebug1: TMenuItem; StaticText: TStaticText; - FenRich: TRichEdit; PopupMenuFenRich: TPopupMenu; Copier1: TMenuItem; Etatdessignaux1: TMenuItem; @@ -157,7 +156,10 @@ type SBMarcheArretLoco: TSpeedButton; Label1: TLabel; LabelNbTrains: TLabel; - Splitter: TSplitter; + SplitterH: TSplitter; + Panel2: TPanel; + FenRich: TRichEdit; + SplitterV: TSplitter; procedure FormCreate(Sender: TObject); procedure MSCommUSBLenzComm(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); @@ -234,13 +236,15 @@ type procedure RazResaClick(Sender: TObject); procedure SBMarcheArretLocoClick(Sender: TObject); procedure EditAdrTrainChange(Sender: TObject); - procedure SplitterMoved(Sender: TObject); - private + procedure SplitterVMoved(Sender: TObject); + procedure PopupMenuFeuPopup(Sender: TObject); + private { Déclarations privées } procedure DoHint(Sender : Tobject); public { Déclarations publiques } Procedure ImageOnClick(Sender : TObject); + procedure ProcOnMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure proc_checkBoxFB(Sender : Tobject); procedure proc_checkBoxFV(Sender : Tobject); procedure proc_checkBoxFR(Sender : Tobject); @@ -389,16 +393,18 @@ var NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur, ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB, - etape,idEl,avecRoulage,intervalle_courant,filtrageDet0,SauvefiltrageDet0 : integer; + etape,idEl,avecRoulage,intervalle_courant,filtrageDet0,SauvefiltrageDet0, + TpsTimeoutSL : integer; ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc, Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO, Srvc_PosTrain,Srvc_Sig,debugtrames,LayParParam,AvecFVR,InverseMotif, Hors_tension,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,doubleclic, - NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,Option_demarrage,AffTiers,AvecDemandeAiguillages, + NackCDM,MsgSim,StopSimu,succes,recu_cv,AffAigDet,AffTiers,AvecDemandeAiguillages, TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM,AvecInitAiguillages, AvecDemandeInterfaceUSB,AvecDemandeInterfaceEth,aff_acc,affiche_aigdcc,modeStkRetro, - retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain : boolean; + retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain, + avec_splitter : boolean; tick,Premier_tick : longint; @@ -465,7 +471,7 @@ var ,AdrTrain : integer; end; - Tablo_actionneur : array[1..Max_actionneurs] of + Tablo_actionneur : array[0..Max_actionneurs] of record loco,act,son: boolean; // destinataire loco acessoire ou son adresse,adresse2, // adresse: adresse de base ; adresse2=cas d'une Zone @@ -478,7 +484,7 @@ var end; KeyInputs: array of TInput; - Tablo_PN : array[1..Max_actionneurs] of + Tablo_PN : array[0..Max_actionneurs] of record AdresseFerme : integer; // adresse de pilotage DCC pour la fermeture commandeFerme : integer; // commande de fermeture (1 ou 2) @@ -486,10 +492,10 @@ var commandeOuvre : integer; // commande d'ouverture (1 ou 2) NbVoies : integer; // Nombre de voies du PN Pulse : integer; // 0=commande maintenue 1=Impulsionnel + compteur : integer; // comptage actionneurs fermeture et décomptage actionneurs ouverturef Voie : array [1..4] of record ActFerme,ActOuvre : integer ; // actionneurs provoquant la fermeture et l'ouverture detZ1F,detZ2F,detZ1O,detZ2O : integer; // Zones de détection - PresTrain : boolean; // mémoire de présence de train sur la voie end; end; @@ -606,8 +612,9 @@ procedure Maj_Feux(detect : boolean); procedure Det_Adj(adresse : integer); procedure reserve_canton(detecteur1,detecteur2,adrtrain : integer); function signal_detecteur(detecteur : integer) : integer; -function det_suiv_cont(det1,det2 : integer) : integer; +function det_suiv_cont(det1,det2,alg : integer) : integer; function BTypeToChaine(BT : TEquipement) : string; +function testBit(n : word;position : integer) : boolean; implementation @@ -741,7 +748,8 @@ begin with Acanvas do begin brush.Color:=couleur; - Pen.Color:=clBlack; + pen.Color:=clBlack; + pen.Width:=1; Ellipse(x-rayon,y-rayon,x+rayon,y+rayon); end; end; @@ -1172,6 +1180,7 @@ var rayon,x1,x2,x3,y1,y2,y3,x4,y4,x5,y5,x6,y6,LgImage,HtImage,temp : integer; ech : real; begin if (n<2) or (n>6) then n:=2; + if (orientation<1) or (orientation>3) then orientation:=1; rayon:=round(6*frX); if n=2 then x2:=25 else x2:=22; x1:=11;x3:=33;x4:=43;x5:=53;x6:=63; @@ -1417,7 +1426,25 @@ begin end; end; -// procédure activée quand on clique gauche sur l'image d'un feu +// procédure activée si on clique G ou D sur une image d'un signal +procedure TFormPrinc.ProcOnMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var s : string; + P_image_pilote : Timage; + i,erreur : integer; +begin + if button=mbRight then + begin + P_image_pilote:=Sender as TImage; // récupérer l'objet image du feu qu'on a cliqué de la forme pilote + s:=P_Image_pilote.Hint; // récupérer son hint qui contient l'adresse du feu cliqué + i:=pos('@',s); if i<>0 then delete(s,1,i); + i:=pos('=',s); if i<>0 then delete(s,i,1); + i:=pos(' ',s); + if i<>0 then s:=copy(s,1,i-1); + val(s,AdrPilote,erreur); + end; +end; + +// procédure activée quand on clique gauche sur l'image d'un signal Procedure TFormprinc.ImageOnClick(Sender : Tobject); var s : string; P_image_pilote : Timage; @@ -1480,6 +1507,7 @@ begin 14 : Bm:=Formprinc.Image4Dir.picture.Bitmap; 15 : Bm:=Formprinc.Image5Dir.picture.Bitmap; 16 : Bm:=Formprinc.Image6Dir.picture.Bitmap; + else Bm:=nil; end; Select_dessin_feu:=bm; end; @@ -1500,6 +1528,8 @@ begin begin if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime); //canvas.Create; + Autosize:=true; + align:=alNone; Parent:=Formprinc.ScrollBox1; // dire que l'image est dans la scrollBox1 //formprinc.ScrollBox1.Color:=ClGreen; Name:='ImageFeu'+IntToSTR(adresse); // nom de l'image - sert à identifier le composant si on fait clic droit. @@ -1515,10 +1545,16 @@ begin Hint:=s; onClick:=Formprinc.Imageonclick; // affectation procédure clique sur image + onMouseDown:=Formprinc.ProcOnMouseDown; PopUpMenu:=Formprinc.PopupMenuFeu; // affectation popupmenu sur clic droit // affecter le type d'image de feu dans l'image créée T_BP:=Select_dessin_feu(TypeFeu); + if T_BP=nil then + begin + Affiche('Erreur 418 : sélection type signal incorrecte pour signal '+intToSTR(adresse),clred); + exit; + end; picture.Bitmap:=T_Bp; picture.BitMap.TransparentMode:=tmfixed; // tmauto (la couleur transparente est déterminée par pixel le plus en haut à gauche du bitmap) @@ -3489,11 +3525,12 @@ begin 7 : envoi_SR(Adr); end; - // Gestion démarrage temporisé des trains si on quitte le rouge : ne fonctionne qu'avec CDM rail connecté ou roulage - if (Option_demarrage and cdm_connecte) or roulage then + // Gestion démarrage temporisé des trains si on quitte le rouge : ne fonctionne qu'en roulage + if roulage then begin a:=feux[i].AncienEtat; b:=feux[i].EtatSignal; + // si l'ancien état était au rouge/violet et on quitte le rouge/violet if ((a=semaphore_F) or (a=carre_F) or (a=violet_F)) and ((b<>semaphore_F) and (b<>carre_F) and (b<>violet_F)) then begin // y a t il un train en face du signal @@ -3783,7 +3820,7 @@ end; // bits1 et 2: (2+4)=6= arret sur aiguillage en talon mal positionnée ou aiguillage réservé // bit3 (8)=arret sur un aiguillage pris en pointe dévié et AdrDevie contient l'adresse de l'aiguillage dévié ainsi que typeGen // code de sortie : élément suivant ou: -// 9999: erreur fatale ou itération trop longue +// 9999: erreur fatale: élément non trouvé ou itération trop longue // 9998: arret sur aiguillage en talon mal positionnée // 9997: arrêt sur aiguillage dévié // 9996: arrêt sur position inconnue d'aiguillage @@ -4764,6 +4801,7 @@ end; // renvoie l'élément avant det2 si det1 et det2 sont contigus ou ne sont séparés que par des aiguillages // si det1 et det2 sont contigus sans aiguillages entre eux, çà renvoie det1 sinon renvoie l'aiguillage entre les 2 // s'ils ne sont pas contigus, renvoie 0 +// Si un élément est inconnu, renvoie 9999 // det_contigu(527,520: renvoie 7 dans suivant // det_contigu(514,522: renvoie 514 dans suivant // det_contigu(517,524: renvoie 30 @@ -4971,6 +5009,7 @@ begin begin if NivDebug=3 then AfficheDebug('Element '+intToSTR(det1)+' non trouvé',clred); if debug=3 then formprinc.Caption:=''; + suivant:=9999; exit; end; indexBranche_det1:=IndexBranche_trouve; @@ -4981,8 +5020,9 @@ begin trouve_element(det2,tp,1); // branche_trouve IndexBranche_trouve if IndexBranche_trouve=0 then begin - if NivDebug=3 then AfficheDebug('Element '+intToSTR(actuel)+' non trouvé',clred); + if NivDebug=3 then AfficheDebug('Element '+intToSTR(det2)+' non trouvé',clred); if debug=3 then formprinc.Caption:=''; + suivant:=9999; exit; end; @@ -5066,16 +5106,16 @@ end; // les aiguillages n'ont pas besoin d'être positionnés entre 1 et 2. // par contre pour le suivant au det2, les aiguillages doivent être positionnés // si on ne trouve pas le suivant, renvoie 9999 -function det_suiv_cont(det1,det2 : integer) : integer; +function det_suiv_cont(det1,det2,alg : integer) : integer; var dernier: integer; derniertyp : Tequipement; begin // si un aiguilage est entre det1 et det2 renvoie l'aig, sinon renvoie det1 si det1 et det2 sont contigus det_contigu(det1,det2,dernier,dernierTyp); - if dernier<>0 then + if (dernier<>0) and (dernier<>9999) then begin // détecteur suivant - det_suiv_cont:=detecteur_suivant(dernier,dernierTyp,det2,det,1); + det_suiv_cont:=detecteur_suivant(dernier,dernierTyp,det2,det,alg); //Affiche(intToSTR(suivant),clorange); end else det_suiv_cont:=9999; @@ -5286,6 +5326,7 @@ end; // renvoie le nombre de croisements entre les détecteurs el1 et el2 +// jamais utilisée ! function Test_croisement(el1,el2,alg: integer) : integer ; var IndexBranche_det1,IndexBranche_det2,branche_trouve_det1,branche_trouve_det2,i, j,AdrPrec,Adr,AdrFonc,i1,N_det : integer; @@ -5364,7 +5405,7 @@ begin begin Adr:=9999; end; - + //AfficheDebug('Sortie Alg3: '+IntToSTR(Adr)+'/'+intToSTR(typeGen),clyellow); if TypeGen=det then inc(N_Det); if NivDebug=3 then @@ -5789,8 +5830,8 @@ begin if (NivDebug=3) and (adrFeu=0) then AfficheDebug('Pas Trouvé de signal suivant au signal Adr='+IntToSTR(det1),clOrange); end; -// renvoie l'état du signal suivant. Si renvoie 0, pas trouvé le signal suivant. -// adresse : adresse du feu +// renvoie l'état du signal suivant du signal "adresse". Si renvoie 0, pas trouvé le signal suivant. +// adresse : adresse du signal // rang=1 pour feu suivant, 2 pour feu suivant le 1, etc // retour dans AdrSignalsuivant : adresse du feu suivant // stocke les éléments trouvés dans Elements @@ -5961,7 +6002,7 @@ begin exit; end; -// renvoie l'adresse de l'aiguille si elle est déviée après le signal et ce jusqu'au prochain signal +// renvoie l'adresse de la première aiguille déviée après le signal "adresse" et ce jusqu'au prochain signal // sinon renvoie 0 // adresse=adresse du signal function Aiguille_deviee(adresse : integer) : integer ; @@ -6075,7 +6116,7 @@ begin end; -// renvoie vrai si une mémoire de zone est occupée après le signal courant au signal suivant +// renvoie vrai si une mémoire de zone est occupée après le signal "adresse" jusqu'au signal suivant // sort de suite si on trouve un train // adresse=adresse du signal function test_memoire_zones(adresse : integer) : boolean; @@ -6103,7 +6144,7 @@ begin ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu repeat Nfeux:=0; - if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange); + if NivDebug=3 then AfficheDebug('Boucle de test signal '+intToSTR(ife)+'/4',clOrange); if (ife=1) then begin prec:=feux[i].Adr_det1; @@ -6626,7 +6667,7 @@ end; // AdrFeu: adresse du signal // detect: si true, tient compte de la présence des trains par détecteurs dans la fonction signalPrec procedure Maj_Feu(Adrfeu : integer;detect : boolean); -var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,trainreserve,AdrTrainLoc,voie : integer ; +var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie : integer ; PresTrain,Aff_semaphore,car,reserveTrainTiers : boolean; code,combine,AdrSignalsuivant : integer; Btype_el_suivant : TEquipement; @@ -6711,6 +6752,7 @@ begin // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal // verrouillable au carré, afficher un carré car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers); // si reserveTrainTiers, réservé par un autre train + if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train',clYellow); if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); // En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré if roulage then car:=reserveTrainTiers or car; @@ -6720,7 +6762,8 @@ begin //if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); if AffSignal and feux[index].VerrouilleCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); - if (modele>=4) and ( (not(PresTrain) and Feux[index].VerrouCarre) or (car and feux[index].VerrouilleCarre) ) then Maj_Etat_Signal(AdrFeu,carre) + if (modele>=4) and Feux[index].VerrouCarre and + ( (not(PresTrain) or car or feux[index].Verrouillecarre) ) then Maj_Etat_Signal(AdrFeu,carre) else begin // si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation @@ -6835,6 +6878,8 @@ begin if debug=3 then formprinc.Caption:=''; end; +// mise à jour des signaux +// detect: si true, tient compte de la présence des trains sur les détecteurs dans la fonction signalPrec Procedure Maj_feux(detect : boolean); var i : integer; begin @@ -7134,7 +7179,7 @@ begin if TraceListe or (NivDebug=3) then AfficheDebug('2-0 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur); // test si det1, det2 et det3 sont contigus malgré aig mal positionnés - det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) + det_suiv:=det_suiv_cont(det1,det2,1); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),couleur); SuivOk:=det_suiv=det3; CasAig:=false; @@ -7541,7 +7586,7 @@ begin MemZone[det3,det1].etat:=False; // on dévalide la zone inverse // test si on peut réserver le canton suivant - det_suiv:=det_suiv_cont(det1,det3); + det_suiv:=det_suiv_cont(det1,det3,1); if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i); Affiche_Evt(s,clWhite); @@ -7580,7 +7625,7 @@ begin begin if TraceListe or (NivDebug=3) then AfficheDebug('2-0 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur); // test si det1, det2 et det3 sont contigus malgré aig mal positionnés - det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) + det_suiv:=det_suiv_cont(det1,det2,1); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),couleur); SuivOk:=det_suiv=det3; CasAig:=false; @@ -7779,9 +7824,9 @@ begin if (nbre=2) and etat then begin - if TraceListe or (NivDebug=3) then AfficheDebug('2-1 traitement Train n°'+intToSTR(i)+' 2 détecteurs',clwhite); + if TraceListe or (NivDebug=3) then AfficheDebug('2-1 traitement Train n°'+intToSTR(i)+' 2 détecteurs',couleur); // front descendant sur détecteur 2 - det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) + det_suiv:=det_suiv_cont(det1,det2,1); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),clWhite); if (det_suiv=det3) then begin @@ -7809,7 +7854,7 @@ begin pilote_train(det2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant - det_suiv:=det_suiv_cont(det2,det3); + det_suiv:=det_suiv_cont(det2,det3,1); if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); // libère canton libere_canton(det2,det3); @@ -7907,7 +7952,7 @@ begin pilote_train(i2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant - det_suiv:=det_suiv_cont(i2,det3); + det_suiv:=det_suiv_cont(i2,det3,1); if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); // libère canton libere_canton(i2,det3); @@ -8220,7 +8265,7 @@ begin MemZone[det3,det1].etat:=False; // on dévalide la zone inverse // test si on peut réserver le canton suivant - det_suiv:=det_suiv_cont(det1,det3); + det_suiv:=det_suiv_cont(det1,det3,1); if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); s:='route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i); Affiche_Evt(s,clWhite); @@ -8281,7 +8326,7 @@ begin if TraceListe then AfficheDebug('Route est valide, dét '+intToSTR(det2)+' '+intToSTR(det3)+' contigus',couleur); // ici on cherche le suivant à det2 det3, algo=1 event_det_tick[N_event_tick].train:=i; - Adrsuiv:=det_suiv_cont(det1,det2); + Adrsuiv:=det_suiv_cont(det1,det2,1); //if not(casAig) then AdrSuiv:=detecteur_suivant_el(det2,det,det3,det,0); // dans le cas de CasAig, alors adrSuiv=9996 donc AdrSuiv est calculé plus haut event_det_train[i].suivant:=AdrSuiv; if TraceListe then AfficheDebug('le sursuivant est '+intToSTR(adrsuiv),couleur); @@ -8446,7 +8491,7 @@ begin begin if TraceListe or (NivDebug=3) then AfficheDebug('2-1 traitement Train n°'+intToSTR(i)+' 2 détecteurs',clwhite); // front descendant sur détecteur 2 - det_suiv:=det_suiv_cont(det1,det2); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) + det_suiv:=det_suiv_cont(det1,det2,1); // test si le suivant de det1 à det2 est bien le nouveau détecteur (det3) if traceliste then affichedebug('Le suivant aux '+intToSTR(det1)+' '+intToSTR(det2)+' est '+intToSTR(det_suiv),clWhite); if (det_suiv=det3) then begin @@ -8486,7 +8531,7 @@ begin pilote_train(det2,det3,adrtrainLoc,i); // pilote le train sur det3 // test si on peut réserver le canton suivant - det_suiv:=det_suiv_cont(det2,det3); + det_suiv:=det_suiv_cont(det2,det3,1); if det_suiv<9990 then reserve_canton(det3,det_suiv,AdrTrainLoc); // libère canton libere_canton(det2,det3); @@ -8679,6 +8724,7 @@ begin end; +// affecte le détecteur "adresse" au train et met sa route à jour procedure calcul_zones(adresse: integer;front : boolean); begin if debug=3 then formprinc.Caption:='Calcul_zones '+intToSTR(adresse); @@ -8892,35 +8938,32 @@ begin if (aO=adr) and (etat=0) then // actionneur d'ouverture begin - Tablo_PN[i].voie[v].PresTrain:=false; - // vérifier les présences train sur les autres voies du PN - presTrain_PN:=false; - for va:=1 to Tablo_PN[i].nbvoies do - begin - presTrain_PN:=presTrain_PN or Tablo_PN[i].voie[va].PresTrain; - end; - if not(presTrain_PN) then + if tablo_pn[i].compteur=1 then // compteur du nombre de trains sur le PN begin Affiche('Ouverture PN'+intToSTR(i)+' par act '+intToSTr(adr)+' (train voie '+IntToSTR(v)+')',clOrange); if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu; pilote_acc(Tablo_PN[i].AdresseOuvre,Tablo_PN[i].CommandeOuvre,ts); end; + if tablo_pn[i].compteur>0 then dec(tablo_pn[i].compteur); end; if (aF=adr) and (etat=1) then // actionneur de fermeture begin - Tablo_PN[i].voie[v].PresTrain:=true; - s:='Fermeture PN'+IntToSTR(i)+' par act '+intToSTr(adr)+' (train voie '+IntToSTR(v)+')'; - Affiche(s,clOrange); - if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu; - pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,ts); + inc(tablo_pn[i].compteur); + if tablo_pn[i].compteur=1 then + begin + s:='Fermeture PN'+IntToSTR(i)+' par act '+intToSTr(adr)+' (train voie '+IntToSTR(v)+')'; + Affiche(s,clOrange); + if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu; + pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,ts); + end; end; end end else begin // PN par zone de détection - //Affiche(intToSTR(adr)+'/'+intToSTR(adr2)+' '+intToSTR(etat),clyellow); + // Affiche(intToSTR(adr)+'/'+intToSTR(adr2)+' '+intToSTR(etat),clyellow); if Tablo_PN[i].nbvoies>4 then Tablo_PN[i].nbvoies:=4; for v:=1 to Tablo_PN[i].nbvoies do begin @@ -8930,31 +8973,28 @@ begin dZ2O:=Tablo_PN[i].voie[v].detZ2O; if (dZ1O=adr) and (dZ2O=adr2) and (etat=0) then // zone d'ouverture begin - Tablo_PN[i].voie[v].PresTrain:=false; - // vérifier les présences train sur les autres voies du PN - presTrain_PN:=false; - for va:=1 to Tablo_PN[i].nbvoies do - begin - presTrain_PN:=presTrain_PN or Tablo_PN[i].voie[va].PresTrain; - end; - if not(presTrain_PN) then + if Tablo_PN[i].compteur=1 then begin s:='Ouverture PN'+intToSTR(i)+' par zone '+intToSTr(adr)+' '+intToSTR(adr2); Affiche(s,clorange); //if AffAigDet then AfficheDebug(s,clorange); if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu; pilote_acc(Tablo_PN[i].AdresseOuvre,Tablo_PN[i].CommandeOuvre,ts); + if tablo_pn[i].compteur>0 then dec(tablo_pn[i].compteur); end; end; if (dZ1F=adr) and (dZ2F=adr2) and (etat=1) then // zone de fermeture begin - Tablo_PN[i].voie[v].PresTrain:=true; - s:='Fermeture PN'+IntToSTR(i)+' par zone '+intToSTr(adr)+' '+intToSTR(adr2)+' (train voie '+IntToSTR(v)+')'; - affiche(s,clorange); - //if AffAigDet then AfficheDebug(s,clorange); - if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu; - pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,ts); + inc(Tablo_PN[i].compteur); + if tablo_pn[i].compteur=1 then + begin + s:='Fermeture PN'+IntToSTR(i)+' par zone '+intToSTr(adr)+' '+intToSTR(adr2)+' (train voie '+IntToSTR(v)+')'; + affiche(s,clorange); + //if AffAigDet then AfficheDebug(s,clorange); + if Tablo_PN[i].pulse=1 then ts:=aigP else ts:=feu; + pilote_acc(Tablo_PN[i].AdresseFerme,Tablo_PN[i].CommandeFerme,ts); + end; end; end; end; @@ -10453,7 +10493,7 @@ begin Formprinc.caption:=af+' - '+lay; // On a lancé CDM, déconnecter l'USB deconnecte_USB; - Affiche('lance les fonctions automatiques de CDM',clyellow); + Affiche('Lance les fonctions automatiques de CDM',clyellow); Sleep(3000); ProcessRunning(s); // récupérer le handle de CDM SetForegroundWindow(CDMhd); @@ -10614,6 +10654,12 @@ begin end; roulage:=false; + // raz compteurs de trains des PN + for i:=1 to NbrePN do + begin + Tablo_Pn[i].compteur:=0; + end; + { ralentit au démarrage for i:=1 to NbreFeux do begin @@ -10686,26 +10732,29 @@ procedure TFormPrinc.FormCreate(Sender: TObject); var i : integer; s : string; begin + AF:='Client TCP-IP CDM Rail ou USB - système XpressNet DCC++ Version '+Version+sousVersion; + Caption:=AF; TraceSign:=True; configPrete:=false; // form config prete PremierFD:=false; sauve_tco:=false; - // services commIP CDM par défaut ntrains:=0; ntrains_cdm:=0; protocole:=1; filtrageDet0:=3; + + // services commIP CDM par défaut Srvc_Aig:=true; Srvc_Det:=true; Srvc_Act:=true; - DebugAffiche:=false; Srvc_PosTrain:=false; Srvc_sig:=false; + + DebugAffiche:=false; + formConfCellTCOAff:=false; confasauver:=false; config_modifie:=false; - AF:='Client TCP-IP CDM Rail ou USB - système XpressNet DCC++ Version '+Version+sousVersion; chaine_recue:=''; - Caption:=AF; Application.onHint:=doHint; // box2=CV @@ -10737,35 +10786,111 @@ begin debug:=0; etape:=1; affevt:=false; + avec_splitter:=false; DebugAffiche:=false; Algo_localisation:=1; // normal + AntiTimeoutEthLenz:=0; Verif_AdrXpressNet:=1; avecRoulage:=0; AvecInit:=true; // &&&& avec initialisation des aiguillages ou pas - Option_demarrage:=false; // démarrage des trains après tempo, pas encore au point Diffusion:=AvecInit; // mode diffusion publique roulage1.visible:=false; + + With ScrollBox1 do + begin + HorzScrollBar.Tracking:=true; + HorzScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si onclique sur la trackbar!! + VertScrollBar.Tracking:=true; + VertScrollBar.Smooth:=false; + end; + + with panel2 do + begin + Panel2.Top:=32; + Panel2.Left:=8; + Width:=610; + Height:=520; + Anchors:=[akLeft,akTop,akRight,akBottom]; + end; + + if avec_splitter then + begin + with Fenrich do + begin + parent:=panel2; + Align:=alLeft; + left:=0; + top:=0; + width:=panel2.Width-20; + height:=520; + Anchors:=[akLeft,akTop,akRight,akBottom]; + end; + + with splitterV do + begin + Parent:=panel2; + Left:=FenRich.left+FenRich.Width+1; + //Align:=Fenrich.Align; + //MinSize:=200; + Visible:=true; + end; + + with panel2 do + begin + //align:=alLeft; + //Left:=SplitterV.left+10; + end; + + with ScrollBox1 do + begin + //Parent:=formprinc; + //align:=alclient; + Anchors:=[]; + top:=200; + end; + + splitterH.Visible:=false; + { with splitterH do + begin + Parent:=formprinc; + //top:=FenRich.top+FenRich.height+1; + Width:=FenRich.width; + Align:=alBottom; + MinSize:=200; + Visible:=true; + end; + } + + end + else + begin + splitterV.Visible:=false; + splitterH.Visible:=false; + with panel2 do + begin + Anchors:=[akLeft,akTop,akRight,akBottom]; + end; + with Fenrich do + begin + parent:=panel2; + Align:=alLeft; + left:=0; + top:=0; + width:=panel2.Width; + height:=panel2.Height; + Anchors:=[akLeft,akTop,akRight,akBottom]; + end; + end; + // pour Rad studio------------------------ FenRich.Height:=Height-150; ScrollBox1.Height:=Height-280; StaticText.AutoSize:=true; - StaticText.Top:=FenRich.Height+FenRich.Top+10; + StaticText.Top:=panel2.Height+Panel2.Top+10; //---------------------------------------- - { - FenRich.Align := alLeft; - FenRich.Width := FormPrinc.ClientWidth div 3; - Splitter.Parent := FormPrinc; - // Make sure the splitter is to the right of the directory list box. - Splitter.Left := FenRich.Left + FenRich.Width + 1; - Splitter.Align := FenRich.Align; // Give it the same alignment as the directory. - // Each pane must be at least one quarter of the form?s width. - Splitter.MinSize := Formprinc.ClientWidth div 4; - //ScrollBox1.Align:=alclient; - } - ferme:=false; CDM_connecte:=false; pasreponse:=0; @@ -10814,6 +10939,7 @@ begin // Initialisation des images des signaux procetape('Création des signaux'); NbreImagePLigne:=Formprinc.ScrollBox1.Width div (largImg+5); + if NbreImagePLigne=0 then NbreImagePLigne:=1; // ajoute les images des feux dynamiquement for i:=1 to NbreFeux do @@ -10849,7 +10975,7 @@ begin modeStkRetro:=false; - // lancer CDM rail et le connecte si on le demande à faire après la création des feux et du tco + // lancer CDM rail et le connecte si on le demande ; à faire après la création des feux et du tco procetape('Test CDM et son lancement'); if LanceCDM then Lance_CDM; procetape('Fin cdm'); @@ -10860,7 +10986,7 @@ begin procetape('Test connexion CDM'); if not(CDM_connecte) then connecte_CDM; - // si CDM n'est pas connecté, on ouvre la liaison vers la centrale + // si CDM n'est pas connecté, on regarde si on ouvre la liaison vers la centrale if not(CDM_connecte) then begin procetape('Ouvertures COM/USB'); @@ -10907,7 +11033,7 @@ begin //Menu_interface(valide); end; - DoubleBuffered:=true; + //DoubleBuffered:=true; { aiguillage[index_aig(1)].position:=const_droit; aiguillage[index_aig(3)].position:=const_devie; @@ -10985,7 +11111,6 @@ begin end; //if terminal then Affiche(chaine_recue,clLime); chaine_recue:=interprete_reponse(chaine_recue); - //interprete_reponse(chaine_recue); end; end; @@ -10998,7 +11123,6 @@ begin portCommOuvert:=false; MSCommUSBLenz.Portopen:=false; end; - portCommOuvert:=false; ClientSocketCDM.close; ClientSocketInterface.close; timer1.Enabled:=false; @@ -11021,6 +11145,16 @@ var aspect,i,a,x,y,Bimage,adresse,TailleX,TailleY,orientation : integer; s : string; begin inc(tick); + // envoi timeout + if parSocketLenz and (AntiTimeoutEthLenz=1) then + begin + dec(TpsTimeoutSL); + if TpsTimeoutSL<=0 then + begin + TpsTimeoutSL:=450; // envoyer caractère toutes les 45 secondes + ClientSocketInterface.Socket.SendText(' '); + end; + end; if sourisclic then inc(Temposouris); if Tdoubleclic>0 then dec(Tdoubleclic); if Tempo_init>0 then dec(Tempo_init); @@ -11046,9 +11180,8 @@ begin adresse:=feux[i].adresse; if TestBit(a,jaune_cli) or TestBit(a,ral_60) or TestBit(a,rappel_60) or testBit(a,semaphore_cli) or - testBit(a,vert_cli) or testbit(a,blanc_cli) then + testBit(a,vert_cli) or testbit(a,blanc_cli) then begin - //Affiche(IntToSTR(adresse),clOrange); Dessine_feu_mx(Feux[i].Img.Canvas,0,0,1,1,adresse,1); //Affiche('Clignote feu '+IntToSTR(adresse),clyellow); end; @@ -11123,7 +11256,7 @@ begin // arret loco sur n secondes // démarrage loco temporisé - for i:=1 to 20 do + for i:=1 to ntrains do begin a:=trains[i].TempoArret; if a<>0 then @@ -11193,7 +11326,7 @@ begin end; // temporisation détecteur à 0 - for i:=1 to NbMemZone do + for i:=1 to NbMemZone do // i=index détecteur begin a:=detecteur[i].tempo0; if a<>0 then @@ -11308,7 +11441,7 @@ begin ErrorCode:=0; end; -// lecture depuis socket +// lecture depuis socket interface procedure TFormPrinc.ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); var s : string; @@ -11456,11 +11589,17 @@ var j,adr,adrTrain : integer; s : string; begin Affiche('Etat des détecteurs:',ClLime); + nbDet1:=0; for j:=1 to NDetecteurs do begin adr:=Adresse_detecteur[j]; s:='Dét '+intToSTR(adr)+'='; - if Detecteur[adr].etat then s:=s+'1 ' else s:=s+'0 '; + if Detecteur[adr].etat then + begin + s:=s+'1 '; + inc(NbDet1); + end + else s:=s+'0 '; s:=s+detecteur[adr].train; AdrTrain:=detecteur[adr].AdrTrain; @@ -11518,10 +11657,9 @@ begin if aiguillage[index_aig(j)].position=1 then s:=s+' (dévié)' else s:=s+' (droit)'; end; + if (model=Crois) then s:='Croisement '+IntToSTR(aiguillage[i].Adresse); r:=aiguillage[i].AdrTrain; - if (r<>0) and (model=Crois) then s:='Croisement '+IntToSTR(aiguillage[i].Adresse)+' : '; - - if r<>0 then s:=s+' réservé par train @'+intToSTR(r); + if r<>0 then s:=s+': réservé par train @'+intToSTR(r); if s<>'' then Affiche(s,clWhite); end; end; @@ -12085,7 +12223,7 @@ begin // évènement actionneur // attention un actionneur qui repasse à 0 ne contient pas de nom de train - //S-E-03-0157-CMDACC-ST_AC|049|05|NAME=0;OBJ=7101;AD=815;TRAIN=CC406526;STATE=1; + // S-E-03-0157-CMDACC-ST_AC|049|05|NAME=0;OBJ=7101;AD=815;TRAIN=CC406526;STATE=1; i:=pos('CMDACC-ST_AC',commandeCDM); if i<>0 then begin @@ -12201,7 +12339,7 @@ begin val(ss,y2,erreur); s:=s+' Y2='+IntTostr(y2); Delete(commandeCDM,i,l-i+1); - end; + end; if afftiers then afficheDebug(s,clAqua); end; @@ -12719,6 +12857,8 @@ begin s:=s+' Commande ouverture='+intToSTR(Tablo_PN[i].commandeOuvre); s:=s+' Nbre de voies='+intToSTR(Tablo_PN[i].nbVoies); Affiche(s,clyellow); + s:=' Compteur trains engagés sur PN='+intToSTR(tablo_PN[i].compteur); + Affiche(s,clyellow); if tablo_PN[i].Voie[1].ActFerme<>0 then // par actionneur @@ -12736,7 +12876,7 @@ begin begin s:=' Voie '+IntToSTR(v)+': Zones de fermeture='+intToSTR(tablo_PN[i].Voie[v].detZ1F)+'-'+intToSTR(tablo_PN[i].Voie[v].detZ2F); s:=s+' Zones d''ouverture='+intToSTR(tablo_PN[i].Voie[v].detZ1O)+'-'+intToSTR(tablo_PN[i].Voie[v].detZ2O); - Affiche(s,clyellow); + Affiche(s,clyellow); end; end; end; @@ -12933,7 +13073,7 @@ end; procedure TFormPrinc.Apropos1Click(Sender: TObject); begin Affiche(' ',clyellow); - Affiche('Signaux complexes GL version '+version+sousVersion+' (C) 2022 F1IWQ Gily TDR',clWhite); + Affiche('Signaux complexes GL version '+version+sousVersion+' (C) 2022-23 F1IWQ Gily TDR',clWhite); FenRich.SelStart:=length(FenRich.Text); FenRich.SelAttributes.Style:=[fsUnderline]; @@ -12945,7 +13085,7 @@ begin FenRich.lines.add('http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906'); RE_ColorLine(FenRich,FenRich.lines.count-1,clAqua); - Affiche('Ce programme pilote des signaux complexes de façon autonome ou avec CDM rail ',ClYellow); + Affiche('Ce programme pilote des signaux complexes et les trains de façon autonome ou avec CDM rail ',ClYellow); Affiche('En fonction des détecteurs mis à 1 ou 0 par des locomotives',ClYellow); Affiche('en circulation sur le réseau',ClYellow); Affiche('En vert : Trames envoyées à l''interface',ClWhite); @@ -13001,8 +13141,8 @@ begin // carré if aspect=0 then begin - Affiche('Le signal est au carré car ',clyellow); - if carre_signal(Adresse,trainreserve,reserveTrainTiers) then affiche('les aiguillages en aval du signal sont mal positionnées ou leur positions inconnues',clyellow) ; + Affiche('Le signal '+intToSTR(adresse)+' est au carré car ',clyellow); + if carre_signal(Adresse,trainreserve,reserveTrainTiers) then affiche('les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues',clyellow) ; if reserveTrainTiers then affiche('un aiguillage ou un croisement en aval du signal sont réservés par un autre train ',clyellow); if Cond_Carre(Adresse) then affiche_suivi('les aiguillages déclarés dans la définition du signal sont mal positionnés',clyellow); if feux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,false,TrainReserve,voie)) then affiche('le signal est verrouillable au carré et aucun train n''est présent avant le signal',clyellow); @@ -13011,37 +13151,37 @@ begin end; if aspect=1 then begin - Affiche('Le signal est au sémaphore car ',clyellow); - if test_memoire_zones(Adresse) then affiche_suivi('Présence train dans canton après le signal',clyellow); + Affiche('Le signal '+intToSTR(adresse)+' est au sémaphore car ',clyellow); + if test_memoire_zones(Adresse) then affiche_suivi('présence train dans canton après le signal',clyellow); end; // avertissement if aspect=8 then begin i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant); - Affiche('Le signal est à l''avertissement car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); + Affiche('Le signal '+intToSTR(adresse)+' est à l''avertissement car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); end; // avertissement cli if aspect=9 then begin i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant); - Affiche('Le signal est au jaune cli car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); + Affiche('Le signal '+intToSTR(adresse)+' est au jaune cli car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); end; // ralen 30 if combine=10 then begin i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant); - Affiche('Le signal est au ralentissement 30 car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); + Affiche('Le signal '+intToSTR(adresse)+' est au ralentissement 30 car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); end; if combine=11 then begin i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant); - Affiche('Le signal est au ralentissement 60 car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); + Affiche('Le signal '+intToSTR(adresse)+' est au ralentissement 60 car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i),clyellow); end; if (combine=12) or (combine=13) then begin Aig:=Aiguille_deviee(Adresse); // si aiguille locale déviée - if (aig<>0) then Affiche('Le signal est à rappel 30 car l''aiguillage suivant '+intToSTR(Aig)+' est dévié',clyellow); + if (aig<>0) then Affiche('Le signal '+intToSTR(adresse)+' est à rappel 30 car l''aiguillage suivant '+intToSTR(Aig)+' est dévié',clyellow); end; end; @@ -13368,12 +13508,34 @@ procedure TFormPrinc.EditAdrTrainChange(Sender: TObject); end; -procedure TFormPrinc.SplitterMoved(Sender: TObject); +procedure TFormPrinc.SplitterVMoved(Sender: TObject); +var pdroite : integer; begin - ScrollBox1.left:=Splitter.Left+10; - ScrollBox1.width:=width-scrollBox1.left-20; + Affiche(intToSTR(splitterV.Left),clred); + exit; + //fenrich.width:=splitterV.left; + + if not(avec_splitter) then exit; + //Affiche('splittermoved',clyellow); + + + pdroite:=SplitterV.Left+40; + + panel2.Width:=pdroite; end; - +procedure TFormPrinc.PopupMenuFeuPopup(Sender: TObject); +var s : string; + P_image_pilote : Timage; + adressefeuclic: integer; + ob : TPopupMenu; +begin + // AdrPilote est récupéré de l'event OnMouseDown de l'image du signal qui se produit avant + ob:=Sender as Tpopupmenu; + s:=ob.Items[0].Caption; + ob.Items[0].Caption:='Propriétés du signal '+intToSTR(AdrPilote); + ob.Items[1].Caption:='Informations du signal '+intToSTR(AdrPilote); +end; + end. diff --git a/UnitSR.dcu b/UnitSR.dcu index bcdc5be..a564806 100644 Binary files a/UnitSR.dcu and b/UnitSR.dcu differ diff --git a/UnitSR.dfm b/UnitSR.dfm index 94fe10b..8875f4e 100644 --- a/UnitSR.dfm +++ b/UnitSR.dfm @@ -505,7 +505,7 @@ object FormSR: TFormSR object LabelErreur: TLabel Left = 224 Top = 528 - Width = 3 + Width = 89 Height = 13 Caption = ':' end @@ -669,13 +669,13 @@ object FormSR: TFormSR TabOrder = 15 OnChange = ComboBoxAdr16Change end - object ButtonOK: TButton - Left = 56 + object BitBtnok: TBitBtn + Left = 16 Top = 520 Width = 75 Height = 25 - Caption = 'OK' TabOrder = 16 - OnClick = ButtonOKClick + OnClick = BitBtnokClick + Kind = bkOK end end diff --git a/UnitSR.pas b/UnitSR.pas index fad558b..5cc8999 100644 --- a/UnitSR.pas +++ b/UnitSR.pas @@ -7,7 +7,8 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ExtCtrls , UnitPrinc, UnitConfig; + Dialogs, StdCtrls, ExtCtrls , UnitPrinc, UnitConfig, + Buttons; type TFormSR = class(TForm) @@ -94,8 +95,8 @@ type LabelCV32: TLabel; ComboBoxAdr15: TComboBox; ComboBoxAdr16: TComboBox; - ButtonOK: TButton; LabelErreur: TLabel; + BitBtnok: TBitBtn; procedure FormActivate(Sender: TObject); procedure ComboBoxAdr1Change(Sender: TObject); procedure ComboBoxAdr2Change(Sender: TObject); @@ -113,8 +114,8 @@ type procedure ComboBoxAdr14Change(Sender: TObject); procedure ComboBoxAdr15Change(Sender: TObject); procedure ComboBoxAdr16Change(Sender: TObject); - procedure ButtonOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure BitBtnokClick(Sender: TObject); private { Déclarations privées } public @@ -464,10 +465,7 @@ begin maj_db; end; -procedure TFormSR.ButtonOKClick(Sender: TObject); -begin - close; -end; + procedure TFormSR.FormCreate(Sender: TObject); var i : integer; @@ -493,5 +491,10 @@ begin end; end; +procedure TFormSR.BitBtnokClick(Sender: TObject); +begin + close; +end; + end. diff --git a/UnitSimule.dcu b/UnitSimule.dcu index ac00a28..0203dda 100644 Binary files a/UnitSimule.dcu and b/UnitSimule.dcu differ diff --git a/UnitSimule.dfm b/UnitSimule.dfm index 004c710..7ca3413 100644 --- a/UnitSimule.dfm +++ b/UnitSimule.dfm @@ -1,10 +1,12 @@ object FormSimulation: TFormSimulation Left = 332 Top = 283 - Width = 447 - Height = 189 - Caption = 'Simulation' - Color = clBtnFace + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsDialog + Caption = 'Ouvrir un fichier de simulation' + ClientHeight = 150 + ClientWidth = 431 + Color = clActiveBorder Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 @@ -16,7 +18,7 @@ object FormSimulation: TFormSimulation TextHeight = 13 object Label1: TLabel Left = 8 - Top = 32 + Top = 24 Width = 369 Height = 16 Caption = 'Intervalle de temps entre deux '#233'v'#232'nements d'#233'tecteurs (x100ms)' @@ -29,7 +31,7 @@ object FormSimulation: TFormSimulation end object ButtonCharge: TButton Left = 160 - Top = 96 + Top = 104 Width = 105 Height = 41 Caption = 'Charger un fichier de simulation' @@ -39,7 +41,7 @@ object FormSimulation: TFormSimulation end object EditIntervalle: TEdit Left = 384 - Top = 32 + Top = 24 Width = 41 Height = 21 TabOrder = 1 @@ -49,12 +51,22 @@ object FormSimulation: TFormSimulation end object CheckAffTick: TCheckBox Left = 64 - Top = 64 + Top = 48 Width = 313 Height = 17 Caption = 'RAZ des trains et de leurs placements avant de d'#233'marrer' TabOrder = 2 end + object CheckEvalroutes: TCheckBox + Left = 64 + Top = 64 + Width = 345 + Height = 17 + Caption = + 'Affichage de l'#39#233'valuation des routes des trains dans la fen'#234'tre ' + + 'debug' + TabOrder = 3 + end object OpenDialog: TOpenDialog Left = 48 Top = 96 diff --git a/UnitSimule.pas b/UnitSimule.pas index 400c64a..5238f76 100644 --- a/UnitSimule.pas +++ b/UnitSimule.pas @@ -13,6 +13,7 @@ type EditIntervalle: TEdit; Label1: TLabel; CheckAffTick: TCheckBox; + CheckEvalroutes: TCheckBox; procedure ButtonChargeClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure EditIntervalleKeyPress(Sender: TObject; var Key: Char); @@ -136,6 +137,7 @@ begin if openDialog.Execute then begin if checkAffTick.Checked then raz_tout; + if checkEvalRoutes.Checked then TraceListe:=true; s:=openDialog.FileName; ouvre_simulation(s); end; diff --git a/UnitTCO.dcu b/UnitTCO.dcu index 6beab16..59e6fa1 100644 Binary files a/UnitTCO.dcu and b/UnitTCO.dcu differ diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 3e980b4..9290fc8 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,8 +1,8 @@ object FormTCO: TFormTCO - Left = 132 - Top = 127 - Width = 1132 - Height = 728 + Left = 217 + Top = 60 + Width = 1142 + Height = 678 VertScrollBar.Visible = False Caption = 'FormTCO' Color = clBtnFace @@ -17,12 +17,13 @@ object FormTCO: TFormTCO Position = poScreenCenter OnActivate = FormActivate OnCreate = FormCreate - OnDockOver = FormDockOver + OnDragOver = FormDragOver OnKeyDown = FormKeyDown + OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1124 - 697) + 1126 + 639) PixelsPerInch = 96 TextHeight = 13 object LabelCoord: TLabel @@ -65,15 +66,9 @@ object FormTCO: TFormTCO Height = 13 Caption = '0' end - object ImageTemp: TImage - Left = 24 - Top = 394 - Width = 97 - Height = 97 - end object Label19: TLabel - Left = 1068 - Top = 441 + Left = 1078 + Top = 391 Width = 32 Height = 13 Anchors = [akRight, akBottom] @@ -85,11 +80,23 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end + object ImageTemp: TImage + Left = 976 + Top = 96 + Width = 97 + Height = 97 + end + object ImageTemp2: TImage + Left = 976 + Top = 208 + Width = 97 + Height = 97 + end object ScrollBox: TScrollBox Left = 8 Top = 18 - Width = 1050 - Height = 409 + Width = 828 + Height = 351 HorzScrollBar.Smooth = True HorzScrollBar.Tracking = True VertScrollBar.Smooth = True @@ -100,14 +107,15 @@ object FormTCO: TFormTCO ParentColor = False TabOrder = 0 DesignSize = ( - 1046 - 405) + 824 + 347) object ImageTCO: TImage Left = 0 Top = 0 - Width = 1002 - Height = 379 + Width = 716 + Height = 305 Anchors = [akLeft, akTop, akRight, akBottom] + AutoSize = True ParentShowHint = False PopupMenu = PopupMenu1 ShowHint = True @@ -120,14 +128,16 @@ object FormTCO: TFormTCO end end object TrackBarZoom: TTrackBar - Left = 1068 + Left = 1078 Top = 18 Width = 41 - Height = 400 + Height = 350 Anchors = [akTop, akRight, akBottom] + Ctl3D = True Max = 50 Min = 20 Orientation = trVertical + ParentCtl3D = False Position = 20 TabOrder = 1 TickMarks = tmTopLeft @@ -135,8 +145,8 @@ object FormTCO: TFormTCO end object Panel1: TPanel Left = 0 - Top = 522 - Width = 1114 + Top = 472 + Width = 1124 Height = 165 Anchors = [akLeft, akRight, akBottom] Color = clActiveBorder @@ -149,18 +159,8 @@ object FormTCO: TFormTCO TabOrder = 2 OnDragOver = Panel1DragOver DesignSize = ( - 1114 + 1124 165) - object ImagePalette5: TImage - Left = 520 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette5DragOver - OnEndDrag = ImagePalette5EndDrag - OnMouseDown = ImagePalette5MouseDown - end object Label6: TLabel Left = 216 Top = 22 @@ -174,16 +174,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette2: TImage - Left = 304 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette2DragOver - OnEndDrag = ImagePalette2EndDrag - OnMouseDown = ImagePalette2MouseDown - end object Label7: TLabel Left = 288 Top = 22 @@ -210,59 +200,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette1: TImage - Left = 232 - Top = 8 - Width = 41 - Height = 41 - Hint = 'Voie pouvant porter un d'#233'tecteur' - DragMode = dmAutomatic - ParentShowHint = False - ShowHint = True - OnDragOver = ImagePalette1DragOver - OnEndDrag = ImagePalette1EndDrag - OnMouseDown = ImagePalette1MouseDown - end - object ImagePalette6: TImage - Left = 232 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette6DragOver - OnEndDrag = ImagePalette6EndDrag - OnMouseDown = ImagePalette6MouseDown - end - object ImagePalette7: TImage - Left = 304 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette7DragOver - OnEndDrag = ImagePalette7EndDrag - OnMouseDown = ImagePalette7MouseDown - end - object ImagePalette8: TImage - Left = 376 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette8DragOver - OnEndDrag = ImagePalette8EndDrag - OnMouseDown = ImagePalette8MouseDown - end - object ImagePalette9: TImage - Left = 448 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette9DragOver - OnEndDrag = ImagePalette9EndDrag - OnMouseDown = ImagePalette9MouseDown - end object Label11: TLabel Left = 216 Top = 70 @@ -315,25 +252,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette3: TImage - Left = 376 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette3DragOver - OnEndDrag = ImagePalette3EndDrag - OnMouseDown = ImagePalette3MouseDown - end - object ImagePalette4: TImage - Left = 448 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnEndDrag = ImagePalette4EndDrag - OnMouseDown = ImagePalette4MouseDown - end object Label8: TLabel Left = 360 Top = 22 @@ -360,16 +278,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette10: TImage - Left = 232 - Top = 104 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette10DragOver - OnEndDrag = ImageDiag10EndDrag - OnMouseDown = ImagePalette10MouseDown - end object Label16: TLabel Left = 208 Top = 118 @@ -383,16 +291,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette11: TImage - Left = 304 - Top = 104 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette11DragOver - OnEndDrag = ImageDiag11EndDrag - OnMouseDown = ImagePalette11MouseDown - end object Label17: TLabel Left = 280 Top = 118 @@ -406,22 +304,8 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette30: TImage - Left = 456 - Top = 104 - Width = 25 - Height = 41 - Hint = 'Signal' - DragMode = dmAutomatic - ParentShowHint = False - ShowHint = True - Stretch = True - OnDragOver = ImagePalette30DragOver - OnEndDrag = ImagePalette30EndDrag - OnMouseDown = ImagePalette30MouseDown - end object Label18: TLabel - Left = 424 + Left = 352 Top = 118 Width = 18 Height = 19 @@ -433,16 +317,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette12: TImage - Left = 592 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette12DragOver - OnEndDrag = ImagePalette12EndDrag - OnMouseDown = ImagePalette12MouseDown - end object Label20: TLabel Left = 568 Top = 22 @@ -469,16 +343,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette13: TImage - Left = 664 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette13DragOver - OnEndDrag = ImagePalette13EndDrag - OnMouseDown = ImagePalette13MouseDown - end object Label21: TLabel Left = 712 Top = 22 @@ -492,16 +356,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette14: TImage - Left = 736 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette14DragOver - OnEndDrag = ImagePalette14EndDrag - OnMouseDown = ImagePalette14MouseDown - end object Label22: TLabel Left = 784 Top = 22 @@ -515,26 +369,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette15: TImage - Left = 808 - Top = 8 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette15DragOver - OnEndDrag = ImagePalette15EndDrag - OnMouseDown = ImagePalette15MouseDown - end - object ImagePalette16: TImage - Left = 520 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette16DragOver - OnEndDrag = ImagePalette16EndDrag - OnMouseDown = ImagePalette16MouseDown - end object Label24: TLabel Left = 496 Top = 70 @@ -548,16 +382,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette17: TImage - Left = 592 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette17DragOver - OnEndDrag = ImagePalette17EndDrag - OnMouseDown = ImagePalette17MouseDown - end object Label25: TLabel Left = 568 Top = 70 @@ -571,16 +395,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette18: TImage - Left = 664 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette18DragOver - OnEndDrag = ImagePalette18EndDrag - OnMouseDown = ImagePalette18MouseDown - end object Label26: TLabel Left = 640 Top = 70 @@ -594,16 +408,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette19: TImage - Left = 736 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette19DragOver - OnEndDrag = ImagePalette19EndDrag - OnMouseDown = ImagePalette19MouseDown - end object Label27: TLabel Left = 712 Top = 70 @@ -617,16 +421,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette20: TImage - Left = 808 - Top = 56 - Width = 41 - Height = 41 - DragMode = dmAutomatic - OnDragOver = ImagePalette20DragOver - OnEndDrag = ImagePalette20EndDrag - OnMouseDown = ImagePalette20MouseDown - end object Label28: TLabel Left = 784 Top = 70 @@ -640,19 +434,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette21: TImage - Left = 880 - Top = 8 - Width = 41 - Height = 41 - Hint = 'Croisement ou TJD ou TJS' - DragMode = dmAutomatic - ParentShowHint = False - ShowHint = True - OnDragOver = ImagePalette21DragOver - OnEndDrag = ImagePalette21EndDrag - OnMouseDown = ImagePalette21MouseDown - end object Label29: TLabel Left = 856 Top = 22 @@ -666,19 +447,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette22: TImage - Left = 952 - Top = 8 - Width = 41 - Height = 41 - Hint = 'Croisement ou TJD ou TJS' - DragMode = dmAutomatic - ParentShowHint = False - ShowHint = True - OnDragOver = ImagePalette22DragOver - OnEndDrag = ImagePalette22EndDrag - OnMouseDown = ImagePalette22MouseDown - end object Label30: TLabel Left = 928 Top = 22 @@ -692,25 +460,12 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object ImagePalette23: TImage - Left = 376 - Top = 104 - Width = 41 - Height = 41 - Hint = 'Quai' - DragMode = dmAutomatic - ParentShowHint = False - ShowHint = True - OnDragOver = ImagePalette23DragOver - OnEndDrag = ImagePalette23EndDrag - OnMouseDown = ImagePalette23MouseDown - end object Label31: TLabel - Left = 352 + Left = 424 Top = 118 Width = 18 Height = 19 - Caption = '23' + Caption = '31' Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -16 @@ -718,8 +473,275 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end + object Label5: TLabel + Left = 856 + Top = 70 + Width = 18 + Height = 19 + Caption = '24' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label32: TLabel + Left = 928 + Top = 70 + Width = 18 + Height = 19 + Caption = '25' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ImagePalette1: TImage + Left = 232 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette1DragOver + OnEndDrag = ImagePalette1EndDrag + OnMouseDown = ImagePalette1MouseDown + end + object ImagePalette2: TImage + Left = 304 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette2DragOver + OnEndDrag = ImagePalette2EndDrag + OnMouseDown = ImagePalette2MouseDown + end + object ImagePalette3: TImage + Left = 376 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette3DragOver + OnEndDrag = ImagePalette3EndDrag + OnMouseDown = ImagePalette3MouseDown + end + object ImagePalette4: TImage + Left = 448 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette4DragOver + OnEndDrag = ImagePalette4EndDrag + OnMouseDown = ImagePalette4MouseDown + end + object ImagePalette5: TImage + Left = 520 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette5DragOver + OnEndDrag = ImagePalette5EndDrag + OnMouseDown = ImagePalette5MouseDown + end + object ImagePalette12: TImage + Left = 592 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette12DragOver + OnEndDrag = ImagePalette12EndDrag + OnMouseDown = ImagePalette12MouseDown + end + object ImagePalette13: TImage + Left = 664 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette13DragOver + OnEndDrag = ImagePalette13EndDrag + OnMouseDown = ImagePalette13MouseDown + end + object ImagePalette14: TImage + Left = 736 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette14DragOver + OnEndDrag = ImagePalette14EndDrag + OnMouseDown = ImagePalette14MouseDown + end + object ImagePalette15: TImage + Left = 808 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette15DragOver + OnEndDrag = ImagePalette15EndDrag + OnMouseDown = ImagePalette15MouseDown + end + object ImagePalette21: TImage + Left = 880 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette21DragOver + OnEndDrag = ImagePalette21EndDrag + OnMouseDown = ImagePalette21MouseDown + end + object ImagePalette22: TImage + Left = 952 + Top = 8 + Width = 41 + Height = 41 + OnDragOver = ImagePalette22DragOver + OnEndDrag = ImagePalette22EndDrag + OnMouseDown = ImagePalette22MouseDown + end + object ImagePalette6: TImage + Left = 232 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette6DragOver + OnEndDrag = ImagePalette6EndDrag + OnMouseDown = ImagePalette6MouseDown + end + object ImagePalette7: TImage + Left = 304 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette7DragOver + OnEndDrag = ImagePalette7EndDrag + OnMouseDown = ImagePalette7MouseDown + end + object ImagePalette9: TImage + Left = 448 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette9DragOver + OnEndDrag = ImagePalette9EndDrag + OnMouseDown = ImagePalette9MouseDown + end + object ImagePalette16: TImage + Left = 520 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette16DragOver + OnEndDrag = ImagePalette16EndDrag + OnMouseDown = ImagePalette16MouseDown + end + object ImagePalette17: TImage + Left = 592 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette17DragOver + OnEndDrag = ImagePalette17EndDrag + OnMouseDown = ImagePalette17MouseDown + end + object ImagePalette18: TImage + Left = 664 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette18DragOver + OnEndDrag = ImagePalette18EndDrag + OnMouseDown = ImagePalette18MouseDown + end + object ImagePalette19: TImage + Left = 736 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette19DragOver + OnEndDrag = ImagePalette19EndDrag + OnMouseDown = ImagePalette19MouseDown + end + object ImagePalette20: TImage + Left = 808 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette20DragOver + OnEndDrag = ImagePalette20EndDrag + OnMouseDown = ImagePalette20MouseDown + end + object ImagePalette24: TImage + Left = 880 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette24DragOver + OnEndDrag = ImagePalette24EndDrag + OnMouseDown = ImagePalette24MouseDown + end + object ImagePalette25: TImage + Left = 952 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette25DragOver + OnEndDrag = ImagePalette25EndDrag + OnMouseDown = ImagePalette25MouseDown + end + object ImagePalette10: TImage + Left = 232 + Top = 104 + Width = 41 + Height = 41 + OnDragOver = ImagePalette10DragOver + OnEndDrag = ImagePalette10EndDrag + OnMouseDown = ImagePalette10MouseDown + end + object ImagePalette11: TImage + Left = 304 + Top = 104 + Width = 41 + Height = 41 + OnDragOver = ImagePalette11DragOver + OnEndDrag = ImagePalette11EndDrag + OnMouseDown = ImagePalette11MouseDown + end + object ImagePalette31: TImage + Left = 448 + Top = 104 + Width = 41 + Height = 41 + Hint = 'Quai' + ParentShowHint = False + ShowHint = True + OnDragOver = ImagePalette31DragOver + OnEndDrag = ImagePalette31EndDrag + OnMouseDown = ImagePalette31MouseDown + end + object ImagePalette30: TImage + Left = 384 + Top = 104 + Width = 25 + Height = 41 + Hint = 'Signal' + ParentShowHint = False + ShowHint = True + Stretch = True + OnDragOver = ImagePalette30DragOver + OnEndDrag = ImagePalette30EndDrag + OnMouseDown = ImagePalette30MouseDown + end + object ImagePalette8: TImage + Left = 376 + Top = 56 + Width = 41 + Height = 41 + OnDragOver = ImagePalette8DragOver + OnEndDrag = ImagePalette8EndDrag + OnMouseDown = ImagePalette8MouseDown + end object ButtonSauveTCO: TButton - Left = 1006 + Left = 1016 Top = 48 Width = 92 Height = 33 @@ -730,7 +752,7 @@ object FormTCO: TFormTCO OnClick = ButtonSauveTCOClick end object ButtonRedessine: TButton - Left = 1006 + Left = 1016 Top = 8 Width = 92 Height = 33 @@ -758,7 +780,7 @@ object FormTCO: TFormTCO OnClick = Button2Click end object ButtonConfigTCO: TButton - Left = 1006 + Left = 1016 Top = 88 Width = 92 Height = 33 @@ -768,8 +790,8 @@ object FormTCO: TFormTCO OnClick = ButtonConfigTCOClick end object ButtonSimu: TButton - Left = 864 - Top = 80 + Left = 760 + Top = 136 Width = 113 Height = 25 Caption = 'Simu canton occup'#233 @@ -777,7 +799,7 @@ object FormTCO: TFormTCO OnClick = ButtonSimuClick end object ButtonMasquer: TButton - Left = 1006 + Left = 1016 Top = 128 Width = 92 Height = 33 @@ -948,7 +970,7 @@ object FormTCO: TFormTCO end end object buttonRaz: TButton - Left = 902 + Left = 912 Top = 128 Width = 92 Height = 33 @@ -969,8 +991,8 @@ object FormTCO: TFormTCO end end object ButtonAfficheBandeau: TButton - Left = 1060 - Top = 465 + Left = 1070 + Top = 415 Width = 57 Height = 33 Anchors = [akRight, akBottom] diff --git a/UnitTCO.pas b/UnitTCO.pas index 86d58e3..d217fdb 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -25,30 +25,17 @@ type Pos_vert: TMenuItem; TrackBarZoom: TTrackBar; Panel1: TPanel; - ImageTemp: TImage; - ImagePalette5: TImage; Label6: TLabel; - ImagePalette2: TImage; Label7: TLabel; Label10: TLabel; - ImagePalette1: TImage; - ImagePalette6: TImage; - ImagePalette7: TImage; - ImagePalette8: TImage; - ImagePalette9: TImage; Label11: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; - ImagePalette3: TImage; - ImagePalette4: TImage; Label8: TLabel; Label9: TLabel; - ImagePalette10: TImage; Label16: TLabel; - ImagePalette11: TImage; Label17: TLabel; - ImagePalette30: TImage; Label18: TLabel; ButtonSauveTCO: TButton; ButtonRedessine: TButton; @@ -58,32 +45,20 @@ type ButtonConfigTCO: TButton; Annulercouper: TMenuItem; N5: TMenuItem; - ImagePalette12: TImage; Label20: TLabel; Label3: TLabel; - ImagePalette13: TImage; Label21: TLabel; - ImagePalette14: TImage; Label22: TLabel; - ImagePalette15: TImage; ButtonSimu: TButton; - ImagePalette16: TImage; Label24: TLabel; - ImagePalette17: TImage; Label25: TLabel; - ImagePalette18: TImage; Label26: TLabel; - ImagePalette19: TImage; Label27: TLabel; - ImagePalette20: TImage; Label28: TLabel; ButtonMasquer: TButton; ButtonAfficheBandeau: TButton; - ImagePalette21: TImage; Label29: TLabel; - ImagePalette22: TImage; Label30: TLabel; - ImagePalette23: TImage; Label31: TLabel; FontDialog1: TFontDialog; N2: TMenuItem; @@ -118,6 +93,36 @@ type ButtonCoulFond: TButton; ColorDialog1: TColorDialog; ShapeCoulFond: TShape; + Label5: TLabel; + Label32: TLabel; + ImagePalette1: TImage; + ImagePalette2: TImage; + ImagePalette3: TImage; + ImagePalette4: TImage; + ImagePalette5: TImage; + ImagePalette12: TImage; + ImagePalette13: TImage; + ImagePalette14: TImage; + ImagePalette15: TImage; + ImagePalette21: TImage; + ImagePalette22: TImage; + ImagePalette6: TImage; + ImagePalette7: TImage; + ImagePalette9: TImage; + ImagePalette16: TImage; + ImagePalette17: TImage; + ImagePalette18: TImage; + ImagePalette19: TImage; + ImagePalette20: TImage; + ImagePalette24: TImage; + ImagePalette25: TImage; + ImagePalette10: TImage; + ImagePalette11: TImage; + ImagePalette31: TImage; + ImagePalette30: TImage; + ImagePalette8: TImage; + ImageTemp: TImage; + ImageTemp2: TImage; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; @@ -125,7 +130,6 @@ type procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ImageTCODragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure FormDockOver(Sender: TObject; Source: TDragDockObject; X,Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette5EndDrag(Sender, Target: TObject; X, Y: Integer); @@ -140,8 +144,6 @@ type Shift: TShiftState; X, Y: Integer); procedure ImagePalette1EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette1MouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette6EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette6MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -171,10 +173,10 @@ type procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Maj_TCO(Adresse : integer); - procedure ImageDiag10EndDrag(Sender, Target: TObject; X, Y: Integer); + procedure ImagePalette10EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette10MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure ImageDiag11EndDrag(Sender, Target: TObject; X, Y: Integer); + procedure ImagePalette11EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette11MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonConfigTCOClick(Sender: TObject); @@ -285,11 +287,11 @@ type Y: Integer; State: TDragState; var Accept: Boolean); procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette23DragOver(Sender, Source: TObject; X, + procedure ImagePalette31DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); - procedure ImagePalette23EndDrag(Sender, Target: TObject; X, + procedure ImagePalette31EndDrag(Sender, Target: TObject; X, Y: Integer); - procedure ImagePalette23MouseDown(Sender: TObject; + procedure ImagePalette31MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonFonteClick(Sender: TObject); procedure FontDialog1Show(Sender: TObject); @@ -309,6 +311,26 @@ type procedure ButtonCalibrageClick(Sender: TObject); procedure ButtonCoulFondClick(Sender: TObject); procedure ColorDialog1Show(Sender: TObject); + procedure ImagePalette24DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette24EndDrag(Sender, Target: TObject; X, + Y: Integer); + procedure ImagePalette24MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure ImagePalette25DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); + procedure ImagePalette25EndDrag(Sender, Target: TObject; X, + Y: Integer); + procedure ImagePalette25MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure FormKeyPress(Sender: TObject; var Key: Char); + procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + private { Déclarations privées } @@ -332,42 +354,48 @@ const Ratio_ch='Ratio'; AvecGrille_ch='AvecGrille'; ModeCouleurCanton_ch='ModeCouleurCanton'; - + // liaisons des voies pour chaque icone par bit (0=NO 1=Nors 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest) + Liaisons : array[0..29] of integer= + (0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$00,$23,$33,0,0,0,0) ; type // structure du TCO - TTCO = array of array of record - Adresse : integer ; // adresse du détecteur ou de l'aiguillage ou du feu - BImage : integer ; // 0=rien 1=voie 2=aiguillage gauche gauche ... 30=feu - mode : integer; // couleur de voie 0=éteint 1=ClVoies 2=couleur en fonction du train - trajet : integer; // décrit le trajet ouvert sur la voie (cas d'un croisement ou d'ue tjd/S) - inverse : boolean; // aiguillage piloté inversé - repr : integer; // position de la représentation texte 0 = rien 1=centrale 2=Haut 3=Bas - Texte : string; // texte de la cellule - Fonte : string; // fonte du texte - FontStyle : string; // GSIB (Gras Souligné Italique Barré) - coulFonte : Tcolor; - TailleFonte : integer; - CouleurFond : Tcolor; // couleur de fond - // pour les feux seulement - PiedFeu : integer; // type de pied au feu : signal à gauche=1 ou à droite=2 de la voie - x,y : integer ; // coordonnées pixels relativés du coin sup gauche du feu pour le décalage par rapport à la cellule - FeuOriente : integer; // orientation du feu : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit - end; + TTCO = record + Adresse : integer; // adresse du détecteur ou de l'aiguillage ou du feu + BImage : integer; // 0=rien 1=voie 2=aiguillage gauche gauche ... 30=feu + mode : integer; // couleur de voie 0=éteint 1=ClVoies 2=couleur en fonction du train + trajet : integer; // décrit le trajet ouvert sur la voie (cas d'un croisement ou d'ue tjd/S) + inverse : boolean; // aiguillage piloté inversé + repr : integer; // position de la représentation texte 0 = rien 1=centrale 2=Haut 3=Bas + Texte : string; // texte de la cellule + Fonte : string; // fonte du texte + FontStyle : string; // GSIB (Gras Souligné Italique Barré) + coulFonte : Tcolor; + TailleFonte : integer; + CouleurFond : Tcolor; // couleur de fond + // pour les signaux seulement + PiedFeu : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie + x,y : integer; // coordonnées pixels relativés du coin sup gauche du signal pour le décalage par rapport au 0,0 cellule + FeuOriente : integer; // orientation du signal : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit + end; var clAllume,clVoies,clFond,couleurAdresse,clGrille,cltexte,clQuai,CoulFonte,ClCanton,clPiedSignal : Tcolor; + FormTCO: TFormTCO; + Forminit,sourisclic,SelectionAffichee,TamponAffecte,entoure,Diffusion,TCO_modifie, - clicTCO,piloteAig,BandeauMasque,eval_format,TCOouvert,sauve_tco : boolean; + clicTCO,piloteAig,BandeauMasque,eval_format,TCOouvert,sauve_tco,formConfCellTCOAff, + drag : boolean; + HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel ,AncienYMiniSel,AncienYMaxiSel, Xclic,Yclic,XClicCellInserer,YClicCellInserer,Xentoure,Yentoure,RatioC,ModeCouleurCanton, AncienXClicCell,AncienYClicCell,LargeurCell,HauteurCell,NbreCellX,NbreCellY,NbCellulesTCO, - Epaisseur : integer; + Epaisseur,oldX,oldY,offsetSourisY,offsetSourisX,AvecVerifIconesTCO : integer; titre_Fonte : string; - TamponTCO,tco : TTco ; + TamponTCO,tco : array of array of TTco ; // pour copier coller TamponTCO_Org : record @@ -379,9 +407,9 @@ var rAncien : TRect; PCanvasTCO : Tcanvas; - PBitMapTCO : TBitMap; + PBitMapTCO,VBm,OldBmp : TBitMap; PScrollBoxTCO : TScrollBox; - PImageTCO,PImageTemp,attached : Timage; + PImageTCO,PImageTemp : Timage; frXGlob,frYGlob : real; procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer); @@ -402,6 +430,7 @@ procedure signalD; procedure lire_fichier_tco; procedure grise_ligne_tco; procedure change_couleur_fond; +function verif_cellule(x,y,Bim : integer) : boolean; implementation @@ -677,6 +706,7 @@ begin i:=pos(',',s); if i=0 then begin Affiche('ETCO6',clred);closefile(fichier);exit;end; val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin Affiche('ETCO7',clred);closefile(fichier);exit;end; + if valeur=23 then begin valeur:=31;sauve_tco:=true;end; // nouvelle version icone 23 passe à 31 tco[x,y].Bimage:=valeur; delete(s,1,i); @@ -699,7 +729,7 @@ begin val(s,PiedFeu,erreur); delete(s,1,i); - // si c'est un feu, remplir les paramètres du feu + // si c'est un signal, remplir les paramètres du signal if tco[x,y].Bimage=30 then begin i:=index_feu(adresse); @@ -811,7 +841,7 @@ begin writeln(fichier,Ratio_ch+'='+intToSTR(ratioC)); writeln(fichier,'/Matrice TCO'); writeln(fichier,'[Matrice]'); - writeln(fichier,'/ couleur fond,adresse,image,inversion aiguillage,Orientation du feu, pied du feu , [texte], representation, fonte, taille fonte, couleur fonte, style, réserve '); + writeln(fichier,'/ couleur fond,adresse,image,inversion aiguillage,Orientation du signal, pied du signal , [texte], representation, fonte, taille fonte, couleur fonte, style, réserve '); for y:=1 to NbreCellY do begin s:=''; @@ -954,7 +984,7 @@ begin // voie case mode of 0: couleur:=clVoies; - 1: couleur:=ClCanton; + 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=couleur; @@ -970,7 +1000,8 @@ end; procedure dessin_2(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,jy2,xf,yf,position : integer; r : Trect; - + fond : tcolor; + procedure trajet_droit; begin if mode=0 then @@ -1040,13 +1071,14 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin + fond:=TCO[x,y].CouleurFond; position:=positionTCO(x,y); with canvas do begin Pen.Width:=1; - Brush.Color:=TCO[x,y].CouleurFond; - Pen.Color:=TCO[x,y].CouleurFond;; + Brush.Color:=fond; + Pen.Color:=fond; r:=Rect(x0,y0,xf,yf); FillRect(r); // efface la cellule @@ -1068,8 +1100,8 @@ begin if (position=const_Devie) then begin // effacement du morceau - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; pen.width:=1; jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup pen.width:=1; @@ -1079,8 +1111,8 @@ begin if position=const_droit then begin // effacement du morceau - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; pen.Width:=1; jy2:=yc+(Epaisseur div 2); // pos Y de la bande inf r:=rect(x0+1,jy2+1,x0+largeurCell-1,jy2+epaisseur); @@ -1192,8 +1224,8 @@ begin if (position=const_Devie) then begin // effacement du morceau - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; pen.width:=1; pen.width:=1; Polygon([point(xc+epaisseur-4,yc+epaisseur-1),point(xc+2*epaisseur-1,yc-epaisseur),point(xc+3*epaisseur,yc-epaisseur),point(xc+2*epaisseur,yc+epaisseur-1)]); @@ -1202,8 +1234,8 @@ begin if position=const_droit then begin // effacement du morceau - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; pen.Width:=1; jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup r:=rect(x0+1,jy1,x0+largeurCell-1,jy1-epaisseur); @@ -1315,8 +1347,8 @@ begin if (position=const_Devie) then begin // effacement du morceau - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; pen.width:=1; x1:=xc+(epaisseur div 2);y1:=yc-(epaisseur div 2)-1; x2:=x1+8;y2:=y1; @@ -1328,8 +1360,8 @@ begin if position=const_droit then begin // effacement du morceau - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; pen.Width:=1; // efface le morceau x1:=xc-epaisseur-1;y1:=yc+(epaisseur div 2)+1; @@ -1448,8 +1480,8 @@ begin x2:=x1-epaisseur;y2:=y1; x3:=x2-epaisseur;y3:=y2-epaisseur-1; x4:=x3+epaisseur;y4:=y3; - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; @@ -1460,8 +1492,8 @@ begin // efface le morceau x1:=xc-(epaisseur div 2)-10;y1:=yc-(epaisseur div 2); x2:=x1+20;y2:=y1-epaisseur; - pen.color:=Clfond; - Brush.Color:=Clfond; + pen.color:=fond; + Brush.Color:=fond; r:=rect(x1,y1,x2,y2); rectangle(r); end; @@ -1603,7 +1635,8 @@ begin r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); - Adr:=TCO[x,y].adresse; + Adr:=TCO[x,y].adresse; + pen.color:=couleur; if (Adr<>0) and (detecteur[Adr].etat) then couleur:=clAllume else case mode of @@ -1611,12 +1644,21 @@ begin 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; + if (detecteur[Adr].etat) then + begin + Brush.Color:=couleur; + pen.color:=couleur; + Pen.Mode:=pmCopy; + Pen.Width:=epaisseur+3; + MoveTo(x0+largeurCell,y0);LineTo(x0,y0+hauteurCell); + pen.color:=clvoies; + end; Brush.Color:=couleur; - pen.color:=couleur; Pen.Mode:=pmCopy; - pen.Width:=epaisseur; + Pen.Width:=epaisseur; MoveTo(x0+largeurCell,y0);LineTo(x0,y0+hauteurCell); end; + end; // élément 11 @@ -1635,6 +1677,7 @@ begin FillRect(r); Adr:=TCO[x,y].adresse; + pen.color:=couleur; if (Adr<>0) and (detecteur[Adr].etat) then couleur:=clAllume else case mode of @@ -1642,8 +1685,16 @@ begin 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; + if (detecteur[Adr].etat) then + begin + Brush.Color:=couleur; + pen.color:=couleur; + Pen.Mode:=pmCopy; + Pen.Width:=epaisseur+3; + moveTo(x0,y0);LineTo(x0+largeurCell,y0+hauteurCell); + pen.color:=clvoies; + end; Brush.Color:=couleur; - pen.color:=couleur; Pen.Mode:=pmCopy; Pen.Width:=epaisseur; moveTo(x0,y0);LineTo(x0+largeurCell,y0+hauteurCell); @@ -1759,8 +1810,8 @@ begin x2:=x1+3*epaisseur;y2:=y1; x3:=x2;y3:=y2+epaisseur; x4:=x1;y4:=y3; - pen.color:=Clfond; - Brush.COlor:=Clfond; + pen.color:=fond; + Brush.COlor:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; @@ -1772,8 +1823,8 @@ begin x2:=x1+epaisseur;y2:=y1; x3:=x2+epaisseur+2;y3:=y2+epaisseur+2; x4:=x3-epaisseur;y4:=y3; - pen.color:=Clfond; - Brush.COlor:=Clfond; + pen.color:=fond; + Brush.COlor:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; end; @@ -2281,7 +2332,7 @@ end; // Element 20 procedure dessin_20(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,adr : integer; +var jx1,jx2,x0,y0,xc,adr : integer; r : Trect; begin x0:=(x-1)*LargeurCell; @@ -2290,14 +2341,28 @@ begin with canvas do begin - Pen.Width:=1; Brush.Color:=TCO[x,y].CouleurFond; + Pen.Mode:=pmCopy; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); + // détecteur à 1 Adr:=TCO[x,y].adresse; - if (Adr<>0) and (detecteur[Adr].etat) then couleur:=clAllume - else + if Adr<>0 then + begin + if detecteur[Adr].etat then + begin + Brush.Color:=clAllume; + pen.color:=clAllume; + jx1:=x0+(LargeurCell div 2)-round(6*frxGlob); // pos Y de la bande sup + jx2:=x0+(LargeurCell div 2)+round(6*frxGlob); // pos Y de la bande inf + if avecGrille then r:=Rect(jx1,y0+1,jx2,y0+HauteurCell-1) else + r:=Rect(jx1,y0,jx2,y0+HauteurCell) ; + FillRect(r); + end; + end; + + // voie case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; @@ -2305,8 +2370,10 @@ begin end; Brush.Color:=couleur; pen.color:=couleur; - Pen.Mode:=pmCopy; - Pen.width:=epaisseur; + + jx1:=y0+(HauteurCell div 2); + Pen.Width:=epaisseur; + MoveTo(xc,y0);LineTo(xc,y0+HauteurCell); end; end; @@ -2409,8 +2476,8 @@ begin end; end; -// Element 23 -procedure dessin_23(Canvas : Tcanvas;x,y,mode: integer); +// Element 23 (31) +procedure dessin_31(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,x1,x2,jy1,jy2 : integer; r : Trect; begin @@ -2436,15 +2503,197 @@ begin end; end; +// Element 24 +procedure dessin_24(Canvas : Tcanvas;x,y,mode: integer); +var x0,y0,xc,yc,jx1,jy1,jx2,xf,yf,position : integer; + r : Trect; + fond: tcolor; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,y0);lineto(xc,yf); // partie droite + moveto(x0,y0);lineto(xc,yc); // partie déviée + end; + + if (mode=1) or (mode=2) then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);lineto(xc,yc); // partie déviée éteinte + + if mode=1 then couleur:=ClCanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // 2eme partie droite toujours allumée + moveto(xc,yf);LineTo(xc,yc); + + // 1ere partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(xc,y0); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,y0);lineto(xc,yf); // verticale complete + moveTo(x0,y0);lineto(xc,yc); // partie déviée + end; + + if (mode=1) or (mode=2) then + with canvas do + begin + // partie horz g en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,y0);LineTo(xc,yc); + + if mode=1 then couleur:=ClCanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,y0);LineTo(xc,yc);LineTo(xc,yf); // trajet déviée + end; + end; + + +begin + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + position:=positionTCO(x,y); + fond:=TCO[x,y].CouleurFond; + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=Fond;; + r:=Rect(x0,y0,xf,yf); + FillRect(r); // efface la cellule + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if (position=const_Devie) or (position=const_inconnu) then + begin + trajet_devie; // affiche la position de la branche déviée + end; + + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + + if (position=const_Devie) then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.width:=1; + jy1:=yc - Epaisseur-1; + jx1:=xc-(Epaisseur div 2); + pen.width:=1; + Polygon([point(jx1,jy1),Point(jx1+epaisseur,jy1+epaisseur),Point(jx1+epaisseur,jy1-epaisseur),Point(jx1,jy1-epaisseur)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.Width:=1; + jx1:=xc-(Epaisseur div 2); // pos Y de la bande inf + r:=rect(jx1,yc-10,jx1-Epaisseur,yc+10); + FillRect(r); + end; + end; +end; + +// Element 25 +procedure dessin_25(Canvas : Tcanvas;x,y,mode: integer); +var x0,y0,xf,yf,xc,yc,trajet : integer; + r : Trect; +begin + x0:=(x-1)*LargeurCell; + y0:=(y-1)*HauteurCell; + xc:=x0+(LargeurCell div 2); + yc:=y0+(hauteurCell div 2); + xf:=x0+LargeurCell; + yf:=y0+HauteurCell; + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=TCO[x,y].CouleurFond; + r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); + FillRect(r); + + Brush.Color:=clvoies; + pen.color:=clvoies; + pen.width:=epaisseur; + + moveto(x0,y0);lineTo(xf,yf); // diagonale + moveTo(xc,y0);LineTo(xc,yf); // verticale + + // regarder d'ou on vient de la route du tco + if mode>0 then + begin + trajet:=tco[x,y].trajet; + case mode of + 0: couleur:=clVoies; + 1: couleur:=ClCanton; + 2: couleur:=couleurtrain[index_couleur]; + end; + Brush.Color:=couleur; + pen.color:=couleur; + if trajet=1 then begin moveTo(xc,y0);LineTo(xc,yf);end; // verticale + if trajet=2 then begin moveto(x0,y0);lineTo(xf,yf);end; // diagonale + if trajet=3 then + begin + moveto(x0,y0);LineTo(xc,yc);lineTo(xc,yc); // + end; + if trajet=4 then + begin + moveto(xc,y0);LineTo(xc,yc);lineTo(xf,yf); // -\ + end; + + end; + end; +end; + + + // calcul des facteurs de réductions X et Y pour l'adapter à l'image de destination procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer); begin - frX:=DimDestX/DimOrgX; + frX:=DimDestX/DimOrgX; frY:=DimDestY/DimOrgY; //Affiche(formatfloat('0.000000',frY),clyellow); end; -// Affiche dans le TCO en x,y un Feu à 90° d'après l'image transmise +// Affiche dans le TCO en x,y un signal à 90° d'après l'image transmise // x y en coordonnées pixels procedure Feu_90G(ImageSource : TImage;x,y : integer;FrX,FrY : real); var p : array[0..2] of TPoint; @@ -2460,16 +2709,16 @@ begin p[1].Y:=TailleX; //49; p[2].X:=0; //0; p[2].Y:=0; //0; - // copie l'image du feu depuis imagesource vers image temporaire à la même échelle mais retournée à 90° + // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 90° PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); - // copie l'image du feu retournée depuis image temporaire vers tco avec une réduction en mode transparennt + // copie l'image du signal retournée depuis image temporaire vers tco avec une réduction en mode transparennt TransparentBlt(PcanvasTCO.Handle,x,y,round(TailleY*FrY),round(TailleX*FrX), // destination PImageTemp.Canvas.Handle,0,0,TailleY,TailleX,clBlue); // source - clblue est la couleur de transparence PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; -// copie de l'image du feu à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire +// copie de l'image du signal à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire procedure Feu_90D(ImageSource : TImage;x,y : integer ; FrX,FrY : real); var p : array[0..2] of TPoint; TailleY,TailleX : integer; @@ -2484,7 +2733,7 @@ begin p[1].Y:=0; p[2].X:=TailleY; //90; p[2].Y:=TailleX; //49; - // copie l'image du feu depuis imagesource vers image temporaire à la même échelle mais retournée à 90° + // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 90° PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); // et copier l'image avec mise à l'échelle tournée sur le TCO @@ -2850,12 +3099,12 @@ begin Adresse:=TCO[x,y].Adresse; Orientation:=TCO[x,y].FeuOriente; - if Orientation=0 then Orientation:=1; // cas d'un feu non encore renseigné + if Orientation=0 then Orientation:=1; // cas d'un signal non encore renseigné aspect:=feux[index_feu(adresse)].aspect; if aspect=0 then aspect:=9; //if aspect>9 then exit; - // Affiche(IntToSTR(i)+' '+intToSTR(aspect),clred); + //Affiche(IntToSTR(i)+' '+intToSTR(aspect),clred); case aspect of 2 : ImageFeu:=Formprinc.Image2feux; @@ -2880,6 +3129,7 @@ begin // réduction variable en fonction de la taille des cellules. 50 est le Zoom Maxi calcul_reduction(frx,fry,round(TailleX*LargeurCell/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); + x0:=0;y0:=0; // pour les signaux directionnels if orientation=3 then //D begin if aspect=9 then begin x0:=round(10*frX); y0:=HauteurCell-round(tailleX*frY);end; @@ -2888,12 +3138,9 @@ begin if aspect=4 then begin x0:=0; y0:=round((tailleX/2)*frY);end; if aspect=3 then begin x0:=0; y0:=round((tailleX/2)*frY);end; if aspect=2 then begin x0:=0; y0:=round((tailleX/2)*frY);end; - x0:=x0+xp;y0:=y0+yp; - tco[x,y].x:=x0; - tco[x,y].y:=y0; end; - // décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G + // décalage en X pour mettre la tete du signal alignée sur le bord droit de la cellule pour les signaux tournés à 90G if orientation=2 then begin if aspect=9 then begin x0:=round(10*frX); y0:=HauteurCell-round(tailleX*frY);end; @@ -2902,12 +3149,9 @@ begin if aspect=4 then begin x0:=round(10*frX); y0:=round((tailleX/2)*frY);end; if aspect=3 then begin x0:=round(8*frX); y0:=round((tailleX/2)*frY);end; if aspect=2 then begin x0:=round(10*frX); y0:=round((tailleX/2)*frY);end; - x0:=x0+xp;y0:=y0+yp; - tco[x,y].x:=x0; - tco[x,y].y:=y0; end; - // décalage en X pour mettre rapprocher le feu du le bord droit de la cellule pour les feux verticaux + // décalage en X pour rapprocher le signal du le bord droit de la cellule pour les feux verticaux if orientation=1 then begin if aspect=9 then begin x0:=0; y0:=0; end; @@ -2916,15 +3160,16 @@ begin if aspect=4 then begin x0:=round(13*frx); y0:=0;end; if aspect=3 then begin x0:=round(13*frx); y0:=0;end; if aspect=2 then begin x0:=round(13*frx); y0:=0;end; - x0:=x0+xp;y0:=y0+yp; - tco[x,y].x:=x0; - tco[x,y].y:=y0; end; - // affichage du feu et du pied - orientation verticale + x0:=x0+xp;y0:=y0+yp; + tco[x,y].x:=x0; + tco[x,y].y:=y0; + + // affichage du signal et du pied - orientation verticale if (Orientation=1) then begin - // copie avec mise à l'échelle de l'image du feu + // copie avec mise à l'échelle de l'image du signal TransparentBlt(canvasDest.Handle,x0,y0,round(TailleX*frX),round(TailleY*frY), ImageFeu.Canvas.Handle,0,0,TailleX,TailleY,clBlue); PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. @@ -2941,7 +3186,7 @@ begin // affichage du feu et du pieds - orientation 90°G if Orientation=2 then begin - Feu_90G(ImageFeu,x0,y0,frX,frY); // ici on passe l'origine du feu + Feu_90G(ImageFeu,x0,y0,frX,frY); // ici on passe l'origine du signal // dessiner le pied case aspect of 9 : affiche_pied9G_90G(x0,y0,frX,frY,piedFeu); @@ -2951,10 +3196,9 @@ begin 3 : affiche_pied3G_90G(x0,y0,frX,frY,piedFeu); 2 : affiche_pied2G_90G(x0,y0,frX,frY,piedFeu); end; - end; - // affichage du feu et du pied - orientation 90°D + // affichage du signal et du pied - orientation 90°D if Orientation=3 then begin Feu_90D(ImageFeu,x0,y0,frX,frY); @@ -2989,7 +3233,6 @@ end; // index est utilisé pour accéder au tableau du tracé de la fonction zone_tco procedure affiche_cellule(x,y : integer); var i,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied : integer; - Bt : TEquipement; s : string; begin //Affiche('Affiche_cellule',clLime); @@ -3005,42 +3248,43 @@ begin // ------------- affichage de l'adresse ------------------ s:=IntToSTR(adresse); - // pourquoi ? ? if y>1 then if (tco[x,y-1].Bimage=30) then exit; // affiche d'abord l'icone de la cellule et colore la voie si zone ou détecteur actionnée selon valeur mode case Bimage of - 0 : efface_cellule(PCanvasTCO,x,y,pmcopy); - 1 : dessin_voie(PCanvasTCO,X,Y,mode); - 2 : dessin_2(PCanvasTCO,X,Y,mode); - 3 : dessin_3(PCanvasTCO,X,Y,mode); - 4 : dessin_4(PCanvasTCO,X,Y,Mode); - 5 : dessin_5(PCanvasTCO,X,Y,Mode); - 6 : dessin_6(PCanvasTCO,X,Y,Mode); - 7 : dessin_7(PCanvasTCO,X,Y,Mode); - 8 : dessin_8(PCanvasTCO,X,Y,Mode); - 9 : dessin_9(PCanvasTCO,X,Y,mode); - 10 : dessin_10(PCanvasTCO,X,Y,mode); - 11 : dessin_11(PCanvasTCO,X,Y,mode); - 12 : dessin_12(PCanvasTCO,X,Y,mode); - 13 : dessin_13(PCanvasTCO,X,Y,mode); - 14 : dessin_14(PCanvasTCO,X,Y,mode); - 15 : dessin_15(PCanvasTCO,X,Y,mode); - 16 : dessin_16(PCanvasTCO,X,Y,mode); - 17 : dessin_17(PCanvasTCO,X,Y,mode); - 18 : dessin_18(PCanvasTCO,X,Y,mode); - 19 : dessin_19(PCanvasTCO,X,Y,mode); - 20 : dessin_20(PCanvasTCO,X,Y,mode); - 21 : dessin_21(PCanvasTCO,X,Y,mode); - 22 : dessin_22(PCanvasTCO,X,Y,mode); - 23 : dessin_23(PCanvasTCO,X,Y,mode); - 30 : dessin_feu(PCanvasTCO,X,Y); - end; + 0 : efface_cellule(PCanvasTCO,x,y,pmcopy); + 1 : dessin_voie(PCanvasTCO,X,Y,mode); + 2 : dessin_2(PCanvasTCO,X,Y,mode); + 3 : dessin_3(PCanvasTCO,X,Y,mode); + 4 : dessin_4(PCanvasTCO,X,Y,Mode); + 5 : dessin_5(PCanvasTCO,X,Y,Mode); + 6 : dessin_6(PCanvasTCO,X,Y,Mode); + 7 : dessin_7(PCanvasTCO,X,Y,Mode); + 8 : dessin_8(PCanvasTCO,X,Y,Mode); + 9 : dessin_9(PCanvasTCO,X,Y,mode); + 10 : dessin_10(PCanvasTCO,X,Y,mode); + 11 : dessin_11(PCanvasTCO,X,Y,mode); + 12 : dessin_12(PCanvasTCO,X,Y,mode); + 13 : dessin_13(PCanvasTCO,X,Y,mode); + 14 : dessin_14(PCanvasTCO,X,Y,mode); + 15 : dessin_15(PCanvasTCO,X,Y,mode); + 16 : dessin_16(PCanvasTCO,X,Y,mode); + 17 : dessin_17(PCanvasTCO,X,Y,mode); + 18 : dessin_18(PCanvasTCO,X,Y,mode); + 19 : dessin_19(PCanvasTCO,X,Y,mode); + 20 : dessin_20(PCanvasTCO,X,Y,mode); + 21 : dessin_21(PCanvasTCO,X,Y,mode); + 22 : dessin_22(PCanvasTCO,X,Y,mode); + 23,31 : dessin_31(PCanvasTCO,X,Y,mode); + 24 : dessin_24(PCanvasTCO,X,Y,mode); + 25 : dessin_25(PCanvasTCO,X,Y,mode); + 30 : dessin_feu(PCanvasTCO,X,Y); + end; PCanvasTCO.font.Size:=(LargeurCell div 10)+4 ; //Affiche(intToSTR( (LargeurCell div 30)+6),clyellow); // affiche le texte des aiguillages if ((BImage=2) or (BImage=3) or (BImage=4) or (BImage=5) or (BImage=12) or (BImage=13) or (BImage=14) or - (BImage=15) or (BImage=21) or (BImage=22)) and (adresse<>0) then + (BImage=15) or (BImage=21) or (BImage=22) or (BImage=24) or (BImage=25)) and (adresse<>0) then begin s:='A'+s; with PCanvasTCO do @@ -3060,12 +3304,13 @@ begin if Bimage=15 then begin xt:=3;yt:=1;end; if Bimage=21 then begin xt:=3;yt:=1;end; if Bimage=22 then begin xt:=3;yt:=HauteurCell-round(15*frYGlob);end; + if Bimage=24 then begin xt:=3;yt:=HauteurCell-round(15*frYGlob);end; + if Bimage=25 then begin xt:=1;yt:=HauteurCell-round(15*frYGlob);end; TextOut(xOrg+xt,yOrg+yt,s); - //exit; end; end; - // détecteurs + // détecteurs voie horizontale if ((BImage=1) ) and (adresse<>0) then begin // Adresse de l'élément if repr<>0 then @@ -3100,6 +3345,7 @@ begin end; end; + // autres détecteurs if ((Bimage=7) or (Bimage=8) or (Bimage=9) or (Bimage=10) or (Bimage=17) or (Bimage=20)) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO do @@ -3112,6 +3358,7 @@ begin end; end; + // autres détecteurs if (Bimage=18) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO do @@ -3124,6 +3371,7 @@ begin end; end; + // autres détecteurs if ((Bimage=6) or (Bimage=11) or (Bimage=16)) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO do @@ -3164,6 +3412,10 @@ begin if (aspect=2) and (Oriente=1) and (pied=1) then begin xt:=round(45*frXglob);yt:=1;end; // signal à gauche if (aspect=2) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=HauteurCell;end; // orientation G if (aspect=2) and (Oriente=3) then begin xt:=round(10*frXGlob);yt:=HauteurCell;end; // orientation D + if (aspect>10) and (oriente=1) then begin xt:=1;yt:=HauteurCell-round(14*frYGlob);end; + if (aspect>10) and (oriente=2) then begin xt:=LargeurCell-round(15*frXGlob);yt:=0;end; + if (aspect>10) and (oriente=3) then begin xt:=LargeurCell-round(15*frXGlob);yt:=0;end; + with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; @@ -3237,7 +3489,7 @@ begin y0:=(y-1)*hauteurcell; //PCanvasTCO.Brush.Style:=bsSolid; - if TCO[x,y].BImage=23 then PCanvasTCO.Brush.Color:=clQuai else PCanvasTCO.Brush.Color:=tco[x,y].CouleurFond; + if (TCO[x,y].BImage=23) or (TCO[x,y].BImage=31) then PCanvasTCO.Brush.Color:=clQuai else PCanvasTCO.Brush.Color:=tco[x,y].CouleurFond; //PCanvasTCO.pen.color:=clyellow; PcanvasTCO.Font.Color:=tco[x,y].CoulFonte; ss:=tco[x,y].fonte; @@ -3268,7 +3520,7 @@ var x,y,DimX,DimY : integer; s : string; r : Trect; begin - //affiche('Affiche_tco',clLime); + if affevt then affiche('Affiche_tco',clLime); DimX:=LargeurCell*NbreCellX; DimY:=HauteurCell*NbreCellY; // DimX DimY maxi 8191 pixels pour les bitmap @@ -3281,8 +3533,20 @@ begin PBitMapTCO.Height:=DimY; PBitMapTCO.Width:=DimX; - PScrollBoxTCO.HorzScrollBar.Range:=DimX; - PScrollBoxTCO.VertScrollBar.Range:=DimY; + //PScrollBoxTCO.HorzScrollBar.Range:=DimX; + //PScrollBoxTCO. + with formTCO.ScrollBox do + begin + HorzScrollBar.Range:=DimX; + HorzScrollBar.Tracking:=true; + HorzScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si onclique sur la trackbar!! + VertScrollBar.Range:=DimY; + VertScrollBar.Tracking:=true; + VertScrollBar.Smooth:=false; + end; + + + //formTCO.ScrollBox.Width:=DimX; calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); //Affiche(formatfloat('0.000000',frxGlob),clyellow); @@ -3298,7 +3562,7 @@ begin FillRect(r); end; - //afficher les cellules sauf les feux + //afficher les cellules sauf les signaux for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin @@ -3308,7 +3572,7 @@ begin end; end; - //afficher les cellules des feux et les textes pour que les pieds recouvrent le reste et afficher les textes + //afficher les cellules des signaux et les textes pour que les pieds recouvrent le reste et afficher les textes for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin @@ -3338,7 +3602,9 @@ end; procedure TFormTCO.FormCreate(Sender: TObject); begin - //Affiche('FormTCO create',clyellow); + if affevt then Affiche('FormTCO create',clyellow); + offsetSourisY:=-10; + offsetSourisX:=-10; caption:='TCO'; AvecGrille:=true; TCO_modifie:=false; @@ -3357,10 +3623,23 @@ begin clTexte:=ClLime; clGrille:=$404040; // évite le clignotement pendant les affichages mais ne marche pas - DoubleBuffered:=true; + //DoubleBuffered:=true; comborepr.Enabled:=false; - ImageTCO.Top:=0; - ImageTCO.Left:=0; + // pour imageTCO incluse dans la scollbox: mettre autosize à true, et ne pas mettre align à alclient. + // c'est pour éviter le clignotement lors du glisser déposer des icones. + with imageTCO do + begin + AutoSize:=true; + align:=alNone; + Top:=0; + Left:=0; + end; + VBm:=TbitMap.Create; // masque + Vbm.Width:=100; + Vbm.Height:=100; + oldbmp:=Tbitmap.Create; + oldbmp.width:=100; + oldbmp.Height:=100; //controlStyle:=controlStyle+[csOpaque]; end; @@ -3387,11 +3666,11 @@ begin x:=xc; y:=yc; end - else + else begin x:=0; y:=0; - end; + end; end; procedure Erreur_TCO(x,y : integer); @@ -3413,7 +3692,7 @@ end; // =2 : couleur de l'index train procedure zone_TCO(det1,det2,mode: integer); -var i,j,x,y,xn,yn,ancienY,ancienX,Xdet1,Ydet1,Xdet2,Ydet2,Bimage,adresse, +var direction,i,j,x,y,xn,yn,ancienY,ancienX,Xdet1,Ydet1,Xdet2,Ydet2,Bimage,adresse, pos,pos2,ir,ax,ay,sx,sy: integer; memtrouve,sortir,horz,diag : boolean; mdl : Tequipement; @@ -3429,68 +3708,97 @@ begin // inverser coordonnées des détecteurs si à l'envers en X - //Affiche('trouvé '+intToSTR(det1)+' en '+IntToSTR(xDet1)+'/'+intToSTR(ydet1),clyellow); - //Affiche('trouvé '+intToSTR(det2)+' en '+IntToSTR(xDet2)+'/'+intToSTR(ydet2),clyellow); + if debugTCO then + begin + AfficheDebug('trouvé '+intToSTR(det1)+' en '+IntToSTR(xDet1)+'/'+intToSTR(ydet1),clyellow); + AfficheDebug('trouvé '+intToSTR(det2)+' en '+IntToSTR(xDet2)+'/'+intToSTR(ydet2),clyellow); + end; - // Aller de det1 à det2 vers le sens X croissant du TCO + memtrouve:=false; - if ydet20 then s:=s+'adr='+intToStr(adresse); - AfficheDebug(s,clyellow); + // vers case suivante: trouver le trajet pour rejoindre det1 à det2 + case Bimage of + // voie + 1 : begin + if debugTCO then + begin + s:='El 1';if adresse<>0 then s:=s+'adr='+intToStr(adresse); + AfficheDebug(s,clyellow); + end; + if ancienXx) and (ancienY=Y) then begin xn:=x-1;if pos=const_devie then yn:=y+1;end; + if (ancienXy) then xn:=x+1; + if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; + end; + 3 : begin + //if debugTCO then AfficheDebug('El 3',clyellow); + pos:=positionTCO(x,y); + if (ancienXx) and (ancienY=Y) then xn:=x-1; + if (ancienX>x) and (ancienYx) and (ancienY=Y) then xn:=x-1; + if (ancienX>x) and (ancienY>y) then xn:=x-1; + if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; - if ancienXx) and (ancienY=Y) then begin xn:=x-1;if pos=const_devie then yn:=y+1;end; - if (ancienXy) then xn:=x+1; - if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; - end; - 3 : begin - //if debugTCO then AfficheDebug('El 3',clyellow); - pos:=positionTCO(x,y); - if (ancienXx) and (ancienY=Y) then xn:=x-1; - if (ancienX>x) and (ancienYx) and (ancienY=Y) then xn:=x-1; - if (ancienX>x) and (ancienY>y) then xn:=x-1; - if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; - end; 5 : begin //if debugTCO then AfficheDebug('El 5',clyellow); pos:=positionTCO(x,y); @@ -3554,7 +3862,10 @@ begin //if debugTCO then AfficheDebug('El 19',clyellow); if ancienYx) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; if (ancienXy) and (ancienX=x) then + begin + yn:=y-1;if pos=const_devie then xn:=x-1 else xn:=x; + end; + // on vient d'en haut + if (ancienYdet2) and memTrouve) or (i>NbCellulesTCO); - //until ((adresse<>det2) and memTrouve) or (i>NbCellulesTCO) or sortir; - until (memTrouve) or (i>NbCellulesTCO) or (x>NbreCellX) or (y>NbreCellY) or (x=0) or (y=0) or sortir; + // tjd ou croisement + 25 : begin + mdl:=rien; + if adresse<>0 then + begin + j:=Index_Aig(adresse); + mdl:=aiguillage[j].modele; + // tjd ou tjs + if (mdl=tjd) or (mdl=tjs) then + begin + pos:=aiguillage[j].position; + if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; + if (mdl=tjd) or (mdl=tjs) and (aiguillage[j].EtatTJD=4) then + begin + j:=Index_Aig(aiguillage[j].Ddroit); + pos2:=aiguillage[j].position; // 2eme adresse de la TJD + if (pos2=const_inconnu) then begin Erreur_TCO(x,y);exit;end; + if (pos=const_droit) and (pos2=const_droit) then + begin + if ancienXx) and (ancienY>Y) then begin xn:=x-1;yn:=yn-1;end; + if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; + end; + + end + else + + begin + // fausse route, sortir + //if DebugTCO then + // AfficheDebug('Sortie de calcul route TCO par élement '+intToSTR(Bimage)+' inconnu en x='+intToSTR(x)+' y='+intToSTR(y)+' sur route '+intToSTR(det1)+' à '+intToSTR(det2),clOrange); + sortir:=true; + end; + end; + inc(i); + if adresse=det2 then memTrouve:=true; + ancienX:=X; + ancienY:=y; + x:=xn; + y:=yn; + until (memTrouve) or (i>NbCellulesTCO) or (x>NbreCellX) or (y>NbreCellY) or (x=0) or (y=0) or sortir; + inc(direction) + until (direction=5) or memtrouve ; + //Affiche(intToSTR(x),clLime); if i>NbCellulesTCO then begin @@ -3705,6 +4096,11 @@ begin if DebugTCO then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); exit; end; + if not(MemTrouve) then + begin + if DebugTCO then AfficheDebug('Pas de liaison entre '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); + exit; + end; dec(ir); // et affichage de la route @@ -3712,6 +4108,9 @@ begin begin x:=routeTCO[i].x; y:=routeTCO[i].y; + Tco[x,y].mode:=mode; + //Affiche(intToSTR(x)+' '+intToSTR(y),clorange); + bimage:=TCO[x,y].BImage; adresse:=TCO[x,y].Adresse; tco[x,y].trajet:=0; @@ -3756,12 +4155,32 @@ begin if tco[x,y].trajet=0 then affiche('Erreur 51 TCO',clred); end; - Affiche_cellule(routeTCO[i].x,routeTCO[i].y); + // croisement + if (bimage=25) and (i>1) then + begin + j:=index_aig(adresse); + mdl:=aiguillage[j].modele; + ax:=routeTCO[i-1].x; // précédent + ay:=routeTCO[i-1].y; + sx:=routeTCO[i+1].x; // suivant + sy:=routeTCO[i+1].y; + if (ax-x=0) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[x,y].trajet:=1; // de haut à bas + if (ax-x=0) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[x,y].trajet:=1; // de bas à haut + if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[x,y].trajet:=2; // de haut gauche vers bas droit + if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[x,y].trajet:=2; // de bas droit vers haut gauche + if (ax-x=-1) and (ay-y=1) and (sx-x=0) and (sy-y=1) then tco[x,y].trajet:=3; // de haut gauche vers bas + if (ax-x=0) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[x,y].trajet:=3; // de bas vers haut gauche + if (ax-x=0) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[x,y].trajet:=4; // de haut vers bas droite + if (ax-x=-1) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[x,y].trajet:=4; // de bas droit vers haut + if tco[x,y].trajet=0 then affiche('Erreur 52 TCO',clred); + end; + Affiche_cellule(x,y); end; end; procedure TFormTCO.FormActivate(Sender: TObject); var s : string; + r :Trect; begin if affevt then Affiche('Form TCO activate',clyellow); if not(Forminit) then @@ -3772,14 +4191,13 @@ begin ButtonCalibrage.Visible:=not(diffusion); ButtonSimu.Visible:=not(Diffusion); ImageTemp.Visible:=not(Diffusion); + ImageTemp2.Visible:=not(Diffusion); SourisX.Visible:=not(Diffusion); SourisY.Visible:=not(Diffusion); ButtonAfficheBandeau.visible:=false; TrackBarZoom.Max:=ZoomMax; TrackBarZoom.Min:=ZoomMin; - PScrollBoxTCO:=FormTCO.ScrollBox; - HauteurCell:=ImagePalette1.Height; LargeurCell:=ImagePalette1.Width; calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); @@ -3808,10 +4226,11 @@ begin dessin_20(ImagePalette20.canvas,1,1,0); dessin_21(ImagePalette21.canvas,1,1,0); dessin_22(ImagePalette22.canvas,1,1,0); - dessin_23(ImagePalette23.canvas,1,1,0); + dessin_31(ImagePalette31.canvas,1,1,0); + dessin_24(ImagePalette24.canvas,1,1,0); + dessin_25(ImagePalette25.canvas,1,1,0); s:='Voie'; - ImagePalette1.Hint:=s;ImagePalette1.ShowHint:=true; ImagePalette6.Hint:=s;ImagePalette6.ShowHint:=true; ImagePalette7.Hint:=s;ImagePalette7.ShowHint:=true; ImagePalette8.Hint:=s;ImagePalette8.ShowHint:=true; @@ -3822,7 +4241,11 @@ begin ImagePalette17.Hint:=s;ImagePalette17.ShowHint:=true; ImagePalette18.Hint:=s;ImagePalette18.ShowHint:=true; ImagePalette19.Hint:=s;ImagePalette19.ShowHint:=true; + + s:='Voie pouvant porter un détecteur'; + ImagePalette1.Hint:=s;ImagePalette1.ShowHint:=true; ImagePalette20.Hint:=s;ImagePalette20.ShowHint:=true; + s:='Aiguillage'; ImagePalette2.Hint:=s;ImagePalette2.ShowHint:=true; ImagePalette3.Hint:=s;ImagePalette3.ShowHint:=true; @@ -3832,6 +4255,12 @@ begin ImagePalette13.Hint:=s;ImagePalette13.ShowHint:=true; ImagePalette14.Hint:=s;ImagePalette14.ShowHint:=true; ImagePalette15.Hint:=s;ImagePalette15.ShowHint:=true; + ImagePalette24.Hint:=s;ImagePalette24.ShowHint:=true; + + s:='Croisement ou TJD ou TJS'; + ImagePalette21.Hint:=s;ImagePalette21.ShowHint:=true; + ImagePalette22.Hint:=s;ImagePalette22.ShowHint:=true; + ImagePalette25.Hint:=s;ImagePalette25.ShowHint:=true; NbCellulesTCO:=NbreCellX*NbreCellY; ImageTCO.Width:=LargeurCell*NbreCellX; @@ -3854,11 +4283,14 @@ begin Picture.Bitmap.TransparentColor:=clblue; Transparent:=true; Picture.Bitmap:=Formprinc.Image9feux.Picture.Bitmap; + end; - //Affiche_tco; - TrackBarZoom.Position:=(ZoomMax+Zoommin) div 2; + //Affiche_tco par r + trackBarZoom.Position:=(ZoomMax+Zoommin) div 2; + ScrollBox.Width:=clientWidth-80; + //ScrollBox.Width:=clientWidth-200; if MasqueBandeauTCO then begin ButtonAfficheBandeau.visible:=true; @@ -3879,7 +4311,6 @@ end; // evt qui se produit quand on clic droit dans l'image procedure TFormTCO.ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var Position: TPoint; - begin GetCursorPos(Position); @@ -3897,10 +4328,161 @@ begin //Affiche('XClicCell='+intToSTR(XclicCell)+' '+'YClicCell='+intToSTR(YclicCell),clyellow); end; +// vérifie que les icones adjacentes sont cohérentes +function verif_cellule(x,y,Bim : integer) : boolean; +var res,verif : boolean; + Bimz,i : integer; + bl,bz : integer; +begin + result:=true; + verif:=false; + if (bim=23) or (bim>=30) or (AvecVerifIconesTCO=0) then exit; + //exit; + res:=true; + bl:=liaisons[Bim]; + for i:=0 to 7 do + begin + //Affiche(IntToHex(bl,2),clyellow); + // NO + if testbit(bl,i) then + begin + if (i=0) then + begin + if (x>1) and (y>1) then + begin + Bimz:=tco[x-1,y-1].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],4) ) then res:=false; + end; + if x>1 then + begin + Bimz:=tco[x-1,y].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],2) then res:=false; + end; + if y>1 then + begin + Bimz:=tco[x,y-1].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],6) then res:=false; + end; + if verif and not(res) then affiche('NO 0',clred); + end; + + // N + if (i=1) then + begin + if (y>1) then + begin + Bimz:=tco[x,y-1].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],5) ) then res:=false; + end; + if verif and not(res) then affiche('N 1',clred); + end; + + // NE + if (i=2) then + begin + if (x1) then + begin + Bimz:=tco[x+1,y-1].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],6) ) then res:=false; + end; + if (x=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],0) then res:=false; + end; + if (y>1) then + begin + Bimz:=tco[x,y-1].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],4) then res:=false; + end; + if verif and not(res) then affiche('NE 2',clred); + end; + + // E + if (i=3) then + begin + if (x=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],7) ) then res:=false; + end; + if verif and not(res) then affiche('E 3',clred); + end; + + // SE + if (i=4) then + begin + if (x=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],0) ) then res:=false; + end; + if (x=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],6) then res:=false; + end; + if (y=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],2) then res:=false; + end; + if verif and not(res) then affiche('SE 4',clred); + end; + + // S + if (i=5) then + begin + if (y=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],1) ) then res:=false; + end; + if verif and not(res) then affiche('S 5',clred); + end; + + // SO + if (i=6) then + begin + if (x>1) and (y=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],2) ) then res:=false; + end; + if x>1 then + begin + Bimz:=tco[x-1,y].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],4) then res:=false; + end; + if (y=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],0) then res:=false; + end; + if verif and not(res) then affiche('SO 6',clred); + end; + + // O + if (i=7) then + begin + if (x>1) then + begin + Bimz:=tco[x-1,y].BImage; + if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],3) ) then res:=false; + end; + if verif and not(res) then affiche('O 7',clred); + end; + end; + end; + + //if res=true then Affiche('oui',ClLime) else Affiche('non',clred); + result:=res; +end; procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); begin exit; + if affevt then Affiche('TCO.FormKeyDown',clOrange); Entoure_cell(XclicCell,YclicCell); case Key of VK_right : if XClicCell'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,5)) then exit; + + TCO_modifie:=true; + dessin_5(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=5; // image 5 tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); - end; procedure TFormTCO.ImagePalette2EndDrag(Sender,Target: TObject; X,Y: Integer); -begin +begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,2)) then exit; + + TCO_modifie:=true; + tco[XClicCell,YClicCell].BImage:=2; // image 2 tco[xClicCell,YClicCell].CoulFonte:=clYellow; dessin_2(ImageTCO.Canvas,XClicCell,YClicCell,0); - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); - end; procedure TFormTCO.ImagePalette2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette2.BeginDrag(true); + debut_drag(ImagePalette2); end; procedure TFormTCO.ImagePalette3EndDrag(Sender, Target: TObject; X,Y: Integer); @@ -4020,16 +4617,18 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; - tco[xClicCell,YClicCell].CoulFonte:=clYellow; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,3)) then exit; + + TCO_modifie:=true; + tco[xClicCell,YClicCell].CoulFonte:=clYellow; dessin_3(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=3; // image 3 - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4037,7 +4636,7 @@ end; procedure TFormTCO.ImagePalette3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette3.BeginDrag(true); + debut_drag(ImagePalette3); end; procedure TFormTCO.ImagePalette4EndDrag(Sender, Target: TObject; X,Y: Integer); @@ -4045,16 +4644,18 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,4)) then exit; + + TCO_modifie:=true; dessin_4(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=4; // image 4 tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4062,58 +4663,64 @@ end; procedure TFormTCO.ImagePalette4MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette4.BeginDrag(true); + debut_drag(ImagePalette4); end; +procedure TFormTCO.ImagePalette5MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + debut_drag(ImagePalette5); +end; + + procedure TFormTCO.ImagePalette1EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(target=ImageTCO) then exit; if (x=0) and (y=0) then exit; + drag:=false; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,1)) then exit; + + TCO_modifie:=true; dessin_voie(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=1; // image 1 tco[xClicCell,YClicCell].CoulFonte:=clYellow; - tco[XClicCell,YClicCell].Adresse:=0; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; + tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); - end; -procedure TFormTCO.ImagePalette1MouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - ImagePalette1.BeginDrag(true); -end; procedure TFormTCO.ImagePalette6EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,6)) then exit; + + TCO_modifie:=true; dessin_6(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=6; // image 6 - tco[XClicCell,YClicCell].Adresse:=0; + tco[XClicCell,YClicCell].Adresse:=0; tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette6MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette6.BeginDrag(true); + debut_drag(ImagePalette6); end; procedure TFormTCO.ImagePalette7EndDrag(Sender, Target: TObject; X, @@ -4122,17 +4729,19 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,7)) then exit; + + TCO_modifie:=true; dessin_7(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=7; // image 7 tco[XClicCell,YClicCell].Adresse:=0; tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4140,26 +4749,27 @@ end; procedure TFormTCO.ImagePalette7MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette7.BeginDrag(true); + debut_drag(ImagePalette7); end; -procedure TFormTCO.ImagePalette8EndDrag(Sender, Target: TObject; X, - Y: Integer); +procedure TFormTCO.ImagePalette8EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,8)) then exit; + + TCO_modifie:=true;; dessin_8(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=8; // image 8 tco[XClicCell,YClicCell].Adresse:=0; tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4167,101 +4777,97 @@ end; procedure TFormTCO.ImagePalette8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette7.BeginDrag(true); + debut_drag(ImagePalette8); end; procedure TFormTCO.ImagePalette9MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette9.BeginDrag(true); + debut_drag(ImagePalette9); end; procedure TFormTCO.ImagePalette12MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette12.BeginDrag(true); + debut_drag(ImagePalette12); end; procedure TFormTCO.ImagePalette13MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette13.BeginDrag(true); + debut_drag(ImagePalette13); end; procedure TFormTCO.ImagePalette14MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette14.BeginDrag(true); + debut_drag(ImagePalette14); end; procedure TFormTCO.ImagePalette15MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette15.BeginDrag(true); + debut_drag(ImagePalette15); end; procedure TFormTCO.ImagePalette16MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette16.BeginDrag(true); + debut_drag(ImagePalette16); end; procedure TFormTCO.ImagePalette17MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette17.BeginDrag(true); + debut_drag(ImagePalette17); end; - procedure TFormTCO.ImagePalette18MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette18.BeginDrag(true); + debut_drag(ImagePalette18); end; procedure TFormTCO.ImagePalette19MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette19.BeginDrag(true); -end; - -procedure TFormTCO.ImagePalette20MouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - ImagePalette20.BeginDrag(true); + debut_drag(ImagePalette19); end; procedure TFormTCO.ImagePalette21MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette21.BeginDrag(true); + debut_drag(ImagePalette21); end; procedure TFormTCO.ImagePalette22MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette22.BeginDrag(true); + debut_drag(ImagePalette22); end; -procedure TFormTCO.ImagePalette9EndDrag(Sender, Target: TObject; X, - Y: Integer); +procedure TFormTCO.ImagePalette9EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,9)) then exit; + + TCO_modifie:=true; dessin_9(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=9; // image 9 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); + entoure_cell_grille(XClicCell,YClicCell); _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); @@ -4273,43 +4879,45 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,12)) then exit; + + TCO_modifie:=true; dessin_12(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=12; // image 12 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); - end; -procedure TFormTCO.ImagePalette13EndDrag(Sender, Target: TObject; X, - Y: Integer); +procedure TFormTCO.ImagePalette13EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); + imageTCO.repaint; efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - dessin_13(ImageTCO.Canvas,XClicCell,YClicCell,0); + if not(verif_cellule(XclicCell,YclicCell,13)) then exit; + + TCO_modifie:=true; + dessin_13(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=13; // image 13 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); - end; procedure TFormTCO.ImagePalette14EndDrag(Sender, Target: TObject; X, @@ -4318,17 +4926,19 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,14)) then exit; + + TCO_modifie:=true; dessin_14(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=14; // image 14 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4339,17 +4949,20 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,15)) then exit; + + TCO_modifie:=true; + Dessin_15(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=15; // image 15 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4359,17 +4972,20 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,16)) then exit; + + TCO_modifie:=true; + Dessin_16(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=16; // image 16 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4380,17 +4996,19 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,17)) then exit; + + TCO_modifie:=true; Dessin_17(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=17; // image 17 tco[XClicCell,YClicCell].Adresse:=0; // rien - entoure_cell_grille(XClicCell,YClicCell); tco[xClicCell,YClicCell].CoulFonte:=clYellow; - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4401,17 +5019,20 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,18)) then exit; + + TCO_modifie:=true; + Dessin_18(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=18; // image 18 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4422,38 +5043,19 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,19)) then exit; + + TCO_modifie:=true; Dessin_19(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=19; // image 19 tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; - EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); - EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); -end; - -procedure TFormTCO.ImagePalette20EndDrag(Sender, Target: TObject; X, - Y: Integer); -begin - if not(Target is TImage) then exit; - if (Target as TImage).Name<>'ImageTCO' then exit; - if (x=0) and (y=0) then exit; - efface_entoure; - TCO_modifie:=true; - Xclic:=X;YClic:=Y; - XclicCell:=Xclic div largeurCell +1; - YclicCell:=Yclic div hauteurCell +1; - Dessin_20(ImageTCO.Canvas,XClicCell,YClicCell,0); - tco[XClicCell,YClicCell].BImage:=20; // image 20 - tco[XClicCell,YClicCell].Adresse:=0; // rien - entoure_cell_grille(XClicCell,YClicCell); - tco[xClicCell,YClicCell].CoulFonte:=clYellow; - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4464,17 +5066,19 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,21)) then exit; + + TCO_modifie:=true; Dessin_21(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=21; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4484,17 +5088,20 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; - TCO_modifie:=true; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,22)) then exit; + + TCO_modifie:=true; + Dessin_22(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].BImage:=22; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; @@ -4631,7 +5238,6 @@ var position : Tpoint; Bimage : integer; s : string; begin -// ImageTCO.BeginDrag(true); if button=mbLeft then begin if affEvt then Affiche('TCO Souris clicG enfoncée',clLime); @@ -4667,10 +5273,12 @@ begin if YclicCell>NbreCellY then exit; Bimage:=tco[XClicCell,YClicCell].Bimage; + if formConfCellTCOAff then + begin // si aiguillage, mettre à jour l'option de pilotage inverse if (bimage=2) or (bimage=3) or (bimage=4) or (bimage=5) or (bimage=12) or (bimage=13) - or (bimage=14) or (bimage=15) then + or (bimage=14) or (bimage=15) or (bimage=24) then begin // aiguillage inversé with FormConfCellTCO.CheckPinv do @@ -4686,9 +5294,10 @@ begin CheckPinv.enabled:=false; FormConfCellTCO.checkPinv.enabled:=false; end; + end; // si voie ou rien ou signal ou quai - if (Bimage=1) or (Bimage=0) or (Bimage=23) then + if (Bimage=1) or (Bimage=0) or (Bimage=23) or (Bimage=31) or (Bimage=30) then begin s:=Tco[XClicCell,YClicCell].Texte; EditTexte.Text:=s; @@ -4713,7 +5322,7 @@ begin ComboRepr.ItemIndex:=tco[XClicCell,yClicCell].repr; ShapeCoulFond.Brush.Color:=tco[XClicCell,yClicCell].CouleurFond; - if not(selectionaffichee) then _entoure_cell_clic; //zizi + if not(selectionaffichee) then _entoure_cell_clic; actualise; clicTCO:=false; end; @@ -4737,17 +5346,16 @@ begin end; procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer); -var Position: TPoint; - r : Trect; - cellX,cellY,x0,y0,XSel1,YSel1,XSel2,YSel2,Bimage,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer; - s : string; +var r : Trect; + cellX,cellY,x0,y0,XSel1,YSel1,XSel2,YSel2,Bimage,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer; + s : string; begin - // if affevt then Affiche('ImageTCOMouseMove',clLime); + //Affiche('ImageTCOMouseMove',clLime); if Temposouris<1 then exit; if not(sourisclic) then exit; SourisX.Caption:=IntToSTR(x); SourisY.Caption:=IntToSTR(y); - + //affiche(intToSTR(x),clorange); cellX:=x div largeurCell+1; cellY:=y div hauteurCell+1; @@ -4834,7 +5442,7 @@ procedure TFormTCO.EditAdrElementChange(Sender: TObject); var Adr,erreur,index : integer; begin //Affiche('Chgt adresse',clyellow); - if clicTCO then exit; + if clicTCO or not(formConfCellTCOAff) then exit; Val(EditAdrElement.Text,Adr,erreur); if (erreur<>0) or (Adr<0) or (Adr>2048) then Adr:=0; @@ -4878,7 +5486,7 @@ begin Key:=#0; // évite beeping Val(EditTypeImage.Text,Bimage,erreur); //Affiche('Keypressed / Bimage='+IntToSTR(bimage),clyellow); - if (erreur<>0) or not(Bimage in[0..23,30]) then + if (erreur<>0) or not(Bimage in[0..23,30,31]) then begin EditTypeImage.text:=intToSTR(tco[XClicCell,YClicCell].BImage); exit; @@ -4892,6 +5500,7 @@ begin end; end; +// mise à jour des cellules de l'adresse "adresse" procedure TFormTCO.Maj_TCO(Adresse : integer); var x,y: integer; begin @@ -4912,7 +5521,6 @@ begin Maj_tco(569); end; - procedure TFormTCO.Button2Click(Sender: TObject); begin Detecteur[569].etat:=false; @@ -4920,60 +5528,62 @@ begin end; -// dépose d'un feu sur le TCO -procedure TFormTCO.ImageDiag10EndDrag(Sender, Target: TObject; X, Y: Integer); +procedure TFormTCO.ImagePalette10EndDrag(Sender, Target: TObject; X, Y: Integer); begin - if not(Target is TImage) then exit; - if (Target as TImage).Name<>'ImageTCO' then exit; + if not(target=ImageTCO) then exit; if (x=0) and (y=0) then exit; - TCO_modifie:=true; + drag:=false; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); + efface_entoure; + imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,10)) then exit; + + TCO_modifie:=true; dessin_10(ImageTCO.Canvas,XClicCell,YClicCell,0); - tco[XClicCell,YClicCell].BImage:=10; // image 10 - tco[XClicCell,YClicCell].Adresse:=0; - tco[XClicCell,YClicCell].FeuOriente:=1; - entoure_cell_grille(XClicCell,YClicCell); - tco[xClicCell,YClicCell].CoulFonte:=clYellow; - _entoure_cell_clic; - tco[XClicCell,YClicCell].x:=0; // XClicCell; //?? - tco[XClicCell,YClicCell].y:=0; // YClicCell; //?? - - EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + tco[XClicCell,YClicCell].BImage:=10; + tco[xClicCell,YClicCell].CoulFonte:=clYellow; + tco[XClicCell,YClicCell].Adresse:=0; + EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + + +procedure TFormTCO.ImagePalette11EndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if not(target=ImageTCO) then exit; + if (x=0) and (y=0) then exit; + drag:=false; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); + efface_entoure; + imageTCO.repaint; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,11)) then exit; + + TCO_modifie:=true; + dessin_11(ImageTCO.Canvas,XClicCell,YClicCell,0); + tco[XClicCell,YClicCell].BImage:=11; + tco[xClicCell,YClicCell].CoulFonte:=clYellow; + tco[XClicCell,YClicCell].Adresse:=0; + EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette10MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette10.BeginDrag(true); -end; - -procedure TFormTCO.ImageDiag11EndDrag(Sender, Target: TObject; X, - Y: Integer); -begin - if not(Target is TImage) then exit; - if (Target as TImage).Name<>'ImageTCO' then exit; - if (x=0) and (y=0) then exit; - TCO_modifie:=true; - Xclic:=X;YClic:=Y; - XclicCell:=Xclic div largeurCell +1; - YclicCell:=Yclic div hauteurCell +1; - dessin_11(ImageTCO.Canvas,XClicCell,YClicCell,0); - tco[XClicCell,YClicCell].BImage:=11; - tco[XClicCell,YClicCell].Adresse:=0; - entoure_cell_grille(XClicCell,YClicCell); - tco[xClicCell,YClicCell].CoulFonte:=clYellow; - _entoure_cell_clic; - EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); - EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); + debut_drag(ImagePalette10); end; procedure TFormTCO.ImagePalette11MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette11.BeginDrag(true); + debut_drag(ImagePalette11); end; procedure TFormTCO.ButtonConfigTCOClick(Sender: TObject); @@ -4988,35 +5598,83 @@ begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - //PCanvasTCO.Draw((xClicCell-1)*LargeurCell,(yClicCell-1)*HauteurCell,ImageFeu.Picture.Bitmap); tco[XClicCell,YClicCell].BImage:=30; tco[XClicCell,YClicCell].Adresse:=0; tco[XClicCell,YClicCell].FeuOriente:=1; tco[XClicCell,YClicCell].PiedFeu:=1; tco[XClicCell,YClicCell].coulFonte:=clWhite; - + tco[XClicCell,YClicCell].x:=0; tco[XClicCell,YClicCell].y:=0; - // ne pas convertir l'adresse sinon evt changement du composant et on écrase l'aspect EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); - - dessin_feu(PCanvasTCO,XclicCell,YClicCell); - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; - + Dessin_feu(ImageTCO.Canvas,XClicCell,YClicCell); end; -procedure TFormTCO.ImagePalette30MouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); +procedure TFormTCO.ImagePalette30MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); +var l,h : integer; begin - ImagePalette30.BeginDrag(true); + l:=Formprinc.Image9feux.width; //57 + h:=Formprinc.Image9feux.height; //105 + ImagePalette30.BeginDrag(true); + //ImageTemp:=ImagePalette30; + BitBlt(OldBmp.Canvas.Handle,0,0,LargeurCell,HauteurCell,ImageTCO.Canvas.Handle,offsetSourisX,offsetSourisY,SRCCOPY); + // StretchBlt(formTCO.ImageTemp.canvas.Handle,0,0,largeurCell,HauteurCell, // destination avec mise à l'échelle + // formprinc.Image9feux.Canvas.Handle,0,0,l,h,srccopy); + drag:=true; + oldx:=offsetSourisX;oldy:=offsetSourisY; + // debut_drag(ImagePalette30); + + + + //imagePalette30.BeginDrag(true); + //StretchBlt(formTCO.ImageTCO.canvas.Handle,0,0,largeurCell,HauteurCell, // destination avec mise à l'échelle + // formprinc.Image9feux.Canvas.Handle,0,0,l,h,srccopy); + + //Efface_Cellule(formTCO.ImageTCO.canvas,1,1,pmCopy); + + {TransparentBlt(formTCO.ImageTemp.canvas.Handle,0,0,largeurCell,HauteurCell, // destination avec mise à l'échelle //50,50 ok 51,51 nok + formprinc.Image9feux.Canvas.Handle,0,0,50,90,clblue); + formtco.ImageTCO.repaint; + } + with formTCO.ImageTemp2.Canvas do + begin + pen.Color:=clfond; + brush.Color:=clblack; + Rectangle(0,0,91,91); + end; + TransparentBlt(formTCO.ImageTemp2.canvas.Handle,0,0,largeurCell,HauteurCell, // destination avec mise à l'échelle //50,50 ok 51,51 nok + formprinc.Image9feux.Canvas.Handle,0,0,50,90,clblue); + //StretchBlt(formTCO.ImageTemp2.canvas.Handle,0,0,largeurCell,HauteurCell, // destination avec mise à l'échelle + // formprinc.Image9feux.Canvas.Handle,0,0,50,90,srccopy); + formtco.ImageTCO.repaint; + // formTCO.ImageTemp.Canvas.Rectangle(0,0,91,91); + formTCO.ImageTemp:=formTCO.ImageTemp2; + BitBlt(formTCO.ImageTemp.canvas.Handle,0,0,20,20,formTCO.ImageTemp2.canvas.Handle,0,0,SRCCOPY); + + // + { + BitBlt(OldBmp.Canvas.Handle,0,0,LargeurCell,HauteurCell,FormTCO.ImageTCO.Canvas.Handle,offsetSourisX,offsetSourisY,SRCCOPY); + StretchBlt(Vbm.Handle,0,0,largeurCell,HauteurCell, // destination masque avec mise à l'échelle + formprinc.Image9feux.canvas.handle,0,0,l,h,srccopy); //Formprinc.Image9feux.Picture.Bitmap; + drag:=true; + oldx:=offsetSourisX;oldy:=offsetSourisY; + + //https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-bitblt + StretchBlt(formTCO.ImageTCO.canvas.Handle,0,0,largeurCell,HauteurCell, // destination masque avec mise à l'échelle + formprinc.Image9feux.canvas.handle,0,0,l,h,srccopy); //Formprinc.Image9feux.Picture.Bitmap; + } +// TransparentBlt(formTCO.ImageTCO.canvas.Handle,0,0,largeurCell,HauteurCell, +// formprinc.Image9feux.canvas.handle,0,0,l,h,clblue); + + formtco.ImageTCO.repaint; end; procedure Tourne90G; @@ -5028,7 +5686,7 @@ begin TCO_modifie:=true; - // effacement de l'ancien feu + // effacement de l'ancien signal if tco[XClicCell,YClicCell].FeuOriente=3 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); @@ -5048,7 +5706,7 @@ begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,PmCopy); end; - tco[XClicCell,YClicCell].FeuOriente:=2; // feu orienté à 90° gauche + tco[XClicCell,YClicCell].FeuOriente:=2; // signal orienté à 90° gauche Affiche_TCO; actualise; // met à jour la fenetre de config de la cellule end; @@ -5059,7 +5717,7 @@ begin end; procedure tourne90D; -var BImage ,aspect,adresse : integer; +var BImage,aspect,adresse : integer; begin if actualize then exit; BImage:=TCO[XClicCell,YClicCell].Bimage; @@ -5071,14 +5729,14 @@ begin aspect:=feux[index_feu(adresse)].Aspect; if aspect=0 then aspect:=9; - // ancien feu orienté orienté 90D + // ancien signal orienté orienté 90D if tco[XClicCell,YClicCell].FeuOriente=3 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; - // ancien feu orienté orienté 90G + // ancien signal orienté orienté 90G if tco[XClicCell,YClicCell].FeuOriente=2 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); @@ -5108,7 +5766,7 @@ var BImage ,aspect,Adresse : integer; begin if actualize then exit; BImage:=TCO[XClicCell,YClicCell].Bimage; - // si c'est autre chose qu'un feu, sortir + // si c'est autre chose qu'un signal, sortir if Bimage<>30 then exit; TCO_modifie:=true; @@ -5116,21 +5774,21 @@ begin aspect:=feux[index_feu(adresse)].Aspect; if aspect=0 then aspect:=9; - // effacement de l'ancien feu + // effacement de l'ancien signal - // ancien feu orienté orienté 90D + // ancien signal orienté orienté 90D if tco[XClicCell,YClicCell].FeuOriente=3 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); - // si le feu occupe 2 cellules + // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; - // ancien feu orienté orienté 90G + // ancien signal orienté orienté 90G if tco[XClicCell,YClicCell].FeuOriente=2 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); - // si le feu occupe 2 cellules + // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; @@ -5141,7 +5799,7 @@ begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,PmCopy); end; - tco[XClicCell,YClicCell].FeuOriente:=1; // feu orienté à 180° + tco[XClicCell,YClicCell].FeuOriente:=1; // signal orienté à 180° //dessin_feu(PCanvasTCO,XclicCell,YClicCell); affiche_tco; actualise; // met à jour la fenetre de config de la cellule @@ -5150,10 +5808,11 @@ end; procedure TFormTCO.Pos_vertClick(Sender: TObject); begin vertical; -end; +end; procedure TFormTCO.TrackBarZoomChange(Sender: TObject); begin + if affevt then Affiche('TrackVBarZoomChange',clyellow); calcul_cellules; Affiche_TCO; SelectionAffichee:=false; @@ -5186,6 +5845,8 @@ begin aiguillage[Index_Aig(3)].position:=const_droit; aiguillage[Index_Aig(4)].position:=const_devie; aiguillage[Index_Aig(5)].position:=const_devie; + aiguillage[Index_Aig(8)].position:=const_devie; + aiguillage[Index_Aig(9)].position:=const_droit; aiguillage[Index_Aig(7)].position:=const_devie; aiguillage[Index_Aig(12)].position:=const_devie; aiguillage[Index_Aig(20)].position:=const_droit; @@ -5200,9 +5861,11 @@ begin aiguillage[Index_Aig(116)].position:=const_droit; aiguillage[Index_Aig(117)].position:=const_devie; - zone_TCO(530,520,1); - zone_TCO(515,517,1); - zone_TCO(523,590,2); + //zone_TCO(530,520,1); + //zone_TCO(515,517,1); + zone_tco(522,527,1); + + //zone_tco(599,527,1); end; @@ -5242,12 +5905,19 @@ procedure TFormTCO.ImageTCODblClick(Sender: TObject); var Bimage,Adresse,i : integer; tjdC : boolean; begin - //Affiche('Double clic',clred); + if affEvt then Affiche('Double clic',clYellow); Bimage:=Tco[xClicCell,yClicCell].BImage; - Adresse:=TCO[xClicCell,yClicCell].Adresse; + Adresse:=Tco[xClicCell,yClicCell].Adresse; if adresse=0 then exit; + if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and (adresse<>0) then + begin + detecteur[adresse].etat:=not(detecteur[adresse].etat); + Affiche_tco; + end; + tjdC:=false; + // commande tjd/c if (Bimage=21) or (Bimage=22) then begin i:=Index_aig(Adresse); @@ -5256,7 +5926,7 @@ begin // commande aiguillage if (Bimage=2) or (Bimage=3) or (Bimage=4) or (Bimage=5) or (Bimage=12) or - (Bimage=13) or (Bimage=14) or (Bimage=15) or TJDc then + (Bimage=13) or (Bimage=14) or (Bimage=15) or (Bimage=24) or TJDc then begin aiguille:=Adresse; TformAig.create(nil); @@ -5276,7 +5946,7 @@ begin TFormPilote.Create(Self); with formPilote do begin - show; + show; ImagePilote.top:=40;ImagePilote.left:=220; ImagePilote.Parent:=FormPilote; ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto; @@ -5286,7 +5956,7 @@ begin ImagePilote.Picture.BitMap:=feux[i].Img.Picture.Bitmap; LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(Adresse); feux[0].EtatSignal:=feux[i].EtatSignal; - + LabelNbFeux.Visible:=False; EditNbreFeux.Visible:=false; GroupBox1.Visible:=true; @@ -5309,8 +5979,6 @@ begin GroupBox1.Visible:=true; GroupBox2.Visible:=true; end; - - sourisclic:=false; // évite de générer un cadre de sélection end; end; @@ -5345,6 +6013,12 @@ begin accept:=true; end; +procedure TFormTCO.ImagePalette4DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + accept:=true; +end; + procedure TFormTCO.ImagePalette5DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin @@ -5387,36 +6061,140 @@ begin accept:=true; end; -procedure TFormTCO.ImagePalette23DragOver(Sender, Source: TObject; X, +procedure TFormTCO.ImagePalette31DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; -procedure TFormTCO.ImagePalette23EndDrag(Sender, Target: TObject; X, +procedure TFormTCO.ImagePalette24DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + accept:=true; +end; + +procedure TFormTCO.ImagePalette25DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + accept:=true; +end; + +procedure TFormTCO.ImagePalette20DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + accept:=true; +end; + + +procedure TFormTCO.ImagePalette31EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; - Dessin_23(ImageTCO.Canvas,XClicCell,YClicCell,0); - tco[XClicCell,YClicCell].BImage:=23; + Dessin_31(ImageTCO.Canvas,XClicCell,YClicCell,0); + tco[XClicCell,YClicCell].BImage:=31; tco[XClicCell,YClicCell].Adresse:=0; - entoure_cell_grille(XClicCell,YClicCell); - _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; -procedure TFormTCO.ImagePalette23MouseDown(Sender: TObject; + +procedure TFormTCO.ImagePalette24EndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if not(Target is TImage) then exit; + if (Target as TImage).Name<>'ImageTCO' then exit; + if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); + efface_entoure; + imageTCO.repaint; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,24)) then exit; + + TCO_modifie:=true; + + Dessin_24(ImageTCO.Canvas,XClicCell,YClicCell,0); + tco[XClicCell,YClicCell].BImage:=24; + tco[XClicCell,YClicCell].Adresse:=0; + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + +procedure TFormTCO.ImagePalette25EndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if not(Target is TImage) then exit; + if (Target as TImage).Name<>'ImageTCO' then exit; + if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); + efface_entoure; + imageTCO.repaint; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,25)) then exit; + + TCO_modifie:=true; + Dessin_25(ImageTCO.Canvas,XClicCell,YClicCell,0); + tco[XClicCell,YClicCell].BImage:=25; + tco[XClicCell,YClicCell].Adresse:=0; + EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + +procedure TFormTCO.ImagePalette20EndDrag(Sender, Target: TObject; X, + Y: Integer); +begin + if not(Target is TImage) then exit; + if (Target as TImage).Name<>'ImageTCO' then exit; + if (x=0) and (y=0) then exit; + BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); + efface_entoure; + imageTCO.repaint; + Xclic:=X;YClic:=Y; + XclicCell:=Xclic div largeurCell +1; + YclicCell:=Yclic div hauteurCell +1; + if not(verif_cellule(XclicCell,YclicCell,20)) then exit; + TCO_modifie:=true; + + Dessin_20(ImageTCO.Canvas,XClicCell,YClicCell,0); + tco[XClicCell,YClicCell].BImage:=20; + tco[XClicCell,YClicCell].Adresse:=0; + EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); + EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); +end; + +procedure TFormTCO.ImagePalette31MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - ImagePalette23.BeginDrag(true); + debut_drag(ImagePalette31); +end; + +procedure TFormTCO.ImagePalette24MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + debut_drag(ImagePalette24); +end; + +procedure TFormTCO.ImagePalette25MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + debut_drag(ImagePalette25); +end; + +procedure TFormTCO.ImagePalette20MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + debut_drag(ImagePalette20); end; procedure TFormTCO.ImagePalette6DragOver(Sender, Source: TObject; X, @@ -5452,7 +6230,7 @@ end; procedure TFormTCO.ImagePalette17DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin - accept:=true; + accept:=true; end; procedure TFormTCO.ImagePalette18DragOver(Sender, Source: TObject; X, @@ -5467,12 +6245,6 @@ begin accept:=true; end; -procedure TFormTCO.ImagePalette20DragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -begin - accept:=true; -end; - procedure TFormTCO.ImagePalette10DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin @@ -5633,16 +6405,12 @@ begin PopUpMenu1.Items[6][4].checked:=false; PopUpMenu1.Items[6][5].checked:=true; end; - - - end + end else PopUpMenu1.Items[6].Enabled:=false; - end; - procedure TFormTCO.N3Click(Sender: TObject); begin actualise; @@ -5869,7 +6637,7 @@ procedure TFormTCO.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var i,maxi : integer; begin - + if affevt then Affiche('FormMouseWheel',clOrange); i:=FormTCO.TrackBarZoom.Position; if WheelDelta>0 then @@ -5951,7 +6719,7 @@ begin with formTCO do begin cs:='ColorA='+IntToHex(clfond,6); // pour rajouter aux couleurs personnalisées - colorDialog1.CustomColors.Add(cs); + colorDialog1.CustomColors.Add(cs); if colorDialog1.Execute then begin if modeSelection then @@ -5974,12 +6742,32 @@ begin end; - procedure TFormTCO.ButtonCoulFondClick(Sender: TObject); begin change_couleur_fond; end; +procedure TFormTCO.FormKeyPress(Sender: TObject; var Key: Char); begin + if affevt then Affiche('TCO.FormKeyPress',clOrange); +end; + +procedure TFormTCO.ImagePalette1MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + debut_drag(ImagePalette1); +end; + + +procedure TFormTCO.FormDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); +begin + accept:=true; +end; + + + +begin + + end. diff --git a/Unit_Pilote_aig.dcu b/Unit_Pilote_aig.dcu index ce95e69..05f1ebc 100644 Binary files a/Unit_Pilote_aig.dcu and b/Unit_Pilote_aig.dcu differ diff --git a/Unitplace.dcu b/Unitplace.dcu index 93f22e4..ab03b79 100644 Binary files a/Unitplace.dcu and b/Unitplace.dcu differ diff --git a/Unitplace.dfm b/Unitplace.dfm index fd9919a..455a337 100644 --- a/Unitplace.dfm +++ b/Unitplace.dfm @@ -19,7 +19,7 @@ object FormPlace: TFormPlace PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel - Left = 32 + Left = 40 Top = 8 Width = 229 Height = 20 @@ -123,22 +123,13 @@ object FormPlace: TFormPlace Font.Style = [fsBold] ParentFont = False end - object Buttonferme: TButton - Left = 16 - Top = 416 - Width = 75 - Height = 25 - Caption = 'Fermer' - TabOrder = 0 - OnClick = ButtonfermeClick - end object ButtonInitAig: TButton Left = 16 Top = 248 Width = 273 Height = 25 Caption = 'Positionner les aiguillages en position initiale' - TabOrder = 1 + TabOrder = 0 OnClick = ButtonInitAigClick end object ButtonSauve: TButton @@ -146,8 +137,13 @@ object FormPlace: TFormPlace Top = 376 Width = 273 Height = 25 + Hint = + 'Enregistre la configuration de placement dans le fichier de conf' + + 'iguration' Caption = 'Enregistrer la configuration de placement' - TabOrder = 2 + ParentShowHint = False + ShowHint = True + TabOrder = 1 OnClick = ButtonSauveClick end object Edit1: TEdit @@ -158,7 +154,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur recevant le train 1' ParentShowHint = False ShowHint = True - TabOrder = 3 + TabOrder = 2 OnChange = Edit1Change end object Edit2: TEdit @@ -169,7 +165,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur recevant le train 2' ParentShowHint = False ShowHint = True - TabOrder = 4 + TabOrder = 3 OnChange = Edit2Change end object Edit3: TEdit @@ -180,7 +176,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur recevant le train 3' ParentShowHint = False ShowHint = True - TabOrder = 5 + TabOrder = 4 OnChange = Edit3Change end object Edit4: TEdit @@ -191,7 +187,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur recevant le train 4' ParentShowHint = False ShowHint = True - TabOrder = 6 + TabOrder = 5 OnChange = Edit4Change end object Edit5: TEdit @@ -202,7 +198,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur recevant le train 5' ParentShowHint = False ShowHint = True - TabOrder = 7 + TabOrder = 6 OnChange = Edit5Change end object Edit6: TEdit @@ -213,7 +209,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur recevant le train 6' ParentShowHint = False ShowHint = True - TabOrder = 8 + TabOrder = 7 OnChange = Edit6Change end object ButtonPlace: TButton @@ -222,7 +218,7 @@ object FormPlace: TFormPlace Width = 273 Height = 25 Caption = 'Placer les trains sur les d'#233'tecteurs ci-dessus' - TabOrder = 9 + TabOrder = 8 OnClick = ButtonPlaceClick end object ButtonLanceRoutage: TButton @@ -237,7 +233,7 @@ object FormPlace: TFormPlace Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False - TabOrder = 10 + TabOrder = 9 OnClick = ButtonLanceRoutageClick end object Button1: TButton @@ -246,7 +242,7 @@ object FormPlace: TFormPlace Width = 81 Height = 25 Caption = 'Config trains' - TabOrder = 11 + TabOrder = 10 OnClick = Button1Click end object ButtonArretroutage: TButton @@ -255,7 +251,7 @@ object FormPlace: TFormPlace Width = 273 Height = 25 Caption = 'Arr'#234't du roulage' - TabOrder = 12 + TabOrder = 11 OnClick = ButtonArretroutageClick end object CheckInverse1: TCheckBox @@ -267,7 +263,7 @@ object FormPlace: TFormPlace Caption = 'sens inverse' ParentShowHint = False ShowHint = True - TabOrder = 13 + TabOrder = 12 OnClick = CheckInverse1Click end object CheckInverse2: TCheckBox @@ -279,7 +275,7 @@ object FormPlace: TFormPlace Caption = 'sens inverse' ParentShowHint = False ShowHint = True - TabOrder = 14 + TabOrder = 13 OnClick = CheckInverse2Click end object CheckInverse3: TCheckBox @@ -291,7 +287,7 @@ object FormPlace: TFormPlace Caption = 'sens inverse' ParentShowHint = False ShowHint = True - TabOrder = 15 + TabOrder = 14 OnClick = CheckInverse3Click end object CheckInverse4: TCheckBox @@ -303,7 +299,7 @@ object FormPlace: TFormPlace Caption = 'sens inverse' ParentShowHint = False ShowHint = True - TabOrder = 16 + TabOrder = 15 OnClick = CheckInverse4Click end object CheckInverse5: TCheckBox @@ -315,7 +311,7 @@ object FormPlace: TFormPlace Caption = 'sens inverse' ParentShowHint = False ShowHint = True - TabOrder = 17 + TabOrder = 16 OnClick = CheckInverse5Click end object CheckInverse6: TCheckBox @@ -327,7 +323,7 @@ object FormPlace: TFormPlace Caption = 'sens inverse' ParentShowHint = False ShowHint = True - TabOrder = 18 + TabOrder = 17 OnClick = CheckInverse6Click end object EditDir1: TEdit @@ -338,7 +334,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur suivant vers lequel doit se diriger le train 1' ParentShowHint = False ShowHint = True - TabOrder = 19 + TabOrder = 18 OnChange = EditDir1Change end object EditDir2: TEdit @@ -349,7 +345,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur suivant vers lequel doit se diriger le train 2' ParentShowHint = False ShowHint = True - TabOrder = 20 + TabOrder = 19 OnChange = EditDir2Change end object EditDir3: TEdit @@ -360,7 +356,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur suivant vers lequel doit se diriger le train 3' ParentShowHint = False ShowHint = True - TabOrder = 21 + TabOrder = 20 OnChange = EditDir3Change end object EditDir4: TEdit @@ -371,7 +367,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur suivant vers lequel doit se diriger le train 4' ParentShowHint = False ShowHint = True - TabOrder = 22 + TabOrder = 21 OnChange = EditDir4Change end object EditDir5: TEdit @@ -382,7 +378,7 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur suivant vers lequel doit se diriger le train 5' ParentShowHint = False ShowHint = True - TabOrder = 23 + TabOrder = 22 OnChange = EditDir5Change end object EditDir6: TEdit @@ -393,7 +389,16 @@ object FormPlace: TFormPlace Hint = 'D'#233'tecteur suivant vers lequel doit se diriger le train 6' ParentShowHint = False ShowHint = True - TabOrder = 24 + TabOrder = 23 OnChange = EditDir6Change end + object BitBtn1: TBitBtn + Left = 16 + Top = 416 + Width = 73 + Height = 25 + TabOrder = 24 + OnClick = BitBtn1Click + Kind = bkClose + end end diff --git a/Unitplace.pas b/Unitplace.pas index 8686fb5..08f348c 100644 --- a/Unitplace.pas +++ b/Unitplace.pas @@ -1,526 +1,542 @@ -unit Unitplace; -interface +unit Unitplace; +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, unitprinc, unitpilote , unitDebug, Buttons; + +type + TFormPlace = class(TForm) + Label1: TLabel; + ButtonInitAig: TButton; + ButtonSauve: TButton; + LabelTrain1: TLabel; + LabelTrain2: TLabel; + LabelTrain3: TLabel; + LabelTrain4: TLabel; + LabelTrain5: TLabel; + Edit1: TEdit; + Edit2: TEdit; + Edit3: TEdit; + Edit4: TEdit; + Edit5: TEdit; + LabelTrain6: TLabel; + Edit6: TEdit; + Label2: TLabel; + ButtonPlace: TButton; + LabelTexte: TLabel; + Label3: TLabel; + ButtonLanceRoutage: TButton; + Button1: TButton; + ButtonArretroutage: TButton; + CheckInverse1: TCheckBox; + CheckInverse2: TCheckBox; + CheckInverse3: TCheckBox; + CheckInverse4: TCheckBox; + CheckInverse5: TCheckBox; + CheckInverse6: TCheckBox; + EditDir1: TEdit; + Label4: TLabel; + EditDir2: TEdit; + EditDir3: TEdit; + EditDir4: TEdit; + EditDir5: TEdit; + EditDir6: TEdit; + Label5: TLabel; + BitBtn1: TBitBtn; + procedure ButtonInitAigClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ButtonPlaceClick(Sender: TObject); + procedure Edit1Change(Sender: TObject); + procedure Edit2Change(Sender: TObject); + procedure Edit3Change(Sender: TObject); + procedure Edit4Change(Sender: TObject); + procedure Edit5Change(Sender: TObject); + procedure Edit6Change(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure ButtonSauveClick(Sender: TObject); + procedure FormKeyPress(Sender: TObject; var Key: Char); + procedure ButtonLanceRoutageClick(Sender: TObject); + procedure ButtonArretroutageClick(Sender: TObject); + procedure CheckInverse1Click(Sender: TObject); + procedure CheckInverse2Click(Sender: TObject); + procedure CheckInverse3Click(Sender: TObject); + procedure CheckInverse4Click(Sender: TObject); + procedure CheckInverse5Click(Sender: TObject); + procedure CheckInverse6Click(Sender: TObject); + procedure EditDir1Change(Sender: TObject); + procedure EditDir2Change(Sender: TObject); + procedure EditDir3Change(Sender: TObject); + procedure EditDir4Change(Sender: TObject); + procedure EditDir5Change(Sender: TObject); + procedure EditDir6Change(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure BitBtn1Click(Sender: TObject); + private + { Déclarations privées } + public + { Déclarations publiques } + end; + +var + FormPlace: TFormPlace; + +implementation + +uses UnitConfig, UnitTCO; + +{$R *.dfm} + + + +procedure TFormPlace.ButtonInitAigClick(Sender: TObject); +begin + if cdm_connecte then + begin + Affiche('Placement des trains incompatible en mode CDM rail',clOrange); + exit; + end; + ButtonLanceRoutage.Enabled:=false; + init_aiguillages; + ButtonLanceRoutage.Enabled:=true; +end; + +procedure TFormPlace.FormActivate(Sender: TObject); +begin + LabelTrain1.Caption:=trains[1].nom_train; + Edit1.text:=intToSTR(placement[1].detecteur); + EditDir1.Text:=IntToSTR(placement[1].detdir); + CheckInverse1.Checked:=placement[1].inverse; + LabelTrain2.Caption:=trains[2].nom_train; + EditDir2.Text:=IntToSTR(placement[2].detdir); + CheckInverse2.Checked:=placement[2].inverse; + Edit2.text:=intToSTR(placement[2].detecteur); + CheckInverse3.Checked:=placement[3].inverse; + EditDir3.Text:=IntToSTR(placement[3].detdir); + LabelTrain3.Caption:=trains[3].nom_train; + Edit3.text:=intToSTR(placement[3].detecteur); + LabelTrain4.Caption:=trains[4].nom_train; + EditDir4.Text:=IntToSTR(placement[4].detdir); + Edit4.text:=intToSTR(placement[4].detecteur); + CheckInverse4.Checked:=placement[4].inverse; + LabelTrain5.Caption:=trains[5].nom_train; + EditDir5.Text:=IntToSTR(placement[5].detdir); + Edit5.text:=intToSTR(placement[5].detecteur); + CheckInverse5.Checked:=placement[5].inverse; + LabelTrain6.Caption:=trains[6].nom_train; + EditDir6.Text:=IntToSTR(placement[6].detdir); + Edit6.text:=intToSTR(placement[6].detecteur); + CheckInverse6.Checked:=placement[6].inverse; +end; + +procedure TFormPlace.ButtonPlaceClick(Sender: TObject); +var Suiv,prec,detect,erreur,i,it : integer; + s,Ssuiv,NomTrain : string; +begin + if cdm_connecte then + begin + Affiche('Placement des trains incompatible en mode CDM rail',clOrange); + exit; + end; + + raz_tout; + for detect:=1 to NbMemZone do + begin + detecteur[detect].train:=''; + detecteur[detect].AdrTrain:=0; + detecteur[detect].IndexTrain:=0; + detecteur[detect].etat:=false; + end; + + it:=0; + for i:=1 to 6 do + begin + case i of + 1 : begin s:=edit1.Text;Ssuiv:=EditDir1.Text;end; + 2 : begin s:=edit2.Text;Ssuiv:=EditDir2.Text;end; + 3 : begin s:=edit3.Text;Ssuiv:=EditDir3.Text;end; + 4 : begin s:=edit4.Text;Ssuiv:=EditDir4.Text;end; + 5 : begin s:=edit5.Text;Ssuiv:=EditDir5.Text;end; + 6 : begin s:=edit6.Text;Ssuiv:=EditDir6.Text;end; + end; + + if (s<>'') and (Ssuiv<>'') then + begin + val(s,detect,erreur); + val(Ssuiv,Suiv,erreur); + NomTrain:=trains[i].nom_train; + if (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train '+intToSTR(i); + if detect<>0 then + begin + prec:=det_suiv_cont(Suiv,detect,1); // détecteur précédent (d'ou vient la loco) arret sur suivant + if (prec<9990) then + begin + inc(it); + //detecteur[detect].adrTrain:=trains[i].adresse; + //event_detecteur(detect,true,trains[i].nom_train); + { + SauvefiltrageDet0:=filtrageDet0; + filtrageDet0:=0; + Affiche(intToSTR(prec)+' 1',clyellow); + event_detecteur(prec,true,NomTrain); + Affiche(intToSTR(prec)+' 0',clyellow); + event_detecteur(prec,false,NomTrain); + + Affiche(intToSTR(detect)+' 1',clyellow); + event_detecteur(detect,true,NomTrain); + filtrageDet0:=SauveFiltrageDet0; + } + + detecteur[detect].etat:=true; + detecteur[detect].AdrTrain:=trains[i].adresse; + detecteur[detect].train:=placement[i].train; + detecteur[detect].IndexTrain:=i; + + MemZone[prec,detect].etat:=true; + MemZone[prec,detect].train:=placement[i].train; + MemZone[prec,detect].Adrtrain:=trains[i].adresse; + MemZone[prec,detect].NumTrain:=i; + //Affiche(inttostr(prec)+' '+intToSTR(detect),clorange); + + event_det_train[it].NbEl:=1 ; + event_det_train[it].AdrTrain:=trains[i].adresse; + event_det_train[it].det[1].adresse:=prec; + event_det_train[it].det[1].etat:=false; + event_det_train[it].nom_train:=placement[i].train; -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, unitprinc, unitpilote , unitDebug; + Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+Ssuiv,clLime); -type - TFormPlace = class(TForm) - Buttonferme: TButton; - Label1: TLabel; - ButtonInitAig: TButton; - ButtonSauve: TButton; - LabelTrain1: TLabel; - LabelTrain2: TLabel; - LabelTrain3: TLabel; - LabelTrain4: TLabel; - LabelTrain5: TLabel; - Edit1: TEdit; - Edit2: TEdit; - Edit3: TEdit; - Edit4: TEdit; - Edit5: TEdit; - LabelTrain6: TLabel; - Edit6: TEdit; - Label2: TLabel; - ButtonPlace: TButton; - LabelTexte: TLabel; - Label3: TLabel; - ButtonLanceRoutage: TButton; - Button1: TButton; - ButtonArretroutage: TButton; - CheckInverse1: TCheckBox; - CheckInverse2: TCheckBox; - CheckInverse3: TCheckBox; - CheckInverse4: TCheckBox; - CheckInverse5: TCheckBox; - CheckInverse6: TCheckBox; - EditDir1: TEdit; - Label4: TLabel; - EditDir2: TEdit; - EditDir3: TEdit; - EditDir4: TEdit; - EditDir5: TEdit; - EditDir6: TEdit; - Label5: TLabel; - procedure ButtonfermeClick(Sender: TObject); - procedure ButtonInitAigClick(Sender: TObject); - procedure FormActivate(Sender: TObject); - procedure ButtonPlaceClick(Sender: TObject); - procedure Edit1Change(Sender: TObject); - procedure Edit2Change(Sender: TObject); - procedure Edit3Change(Sender: TObject); - procedure Edit4Change(Sender: TObject); - procedure Edit5Change(Sender: TObject); - procedure Edit6Change(Sender: TObject); - procedure Button1Click(Sender: TObject); - procedure ButtonSauveClick(Sender: TObject); - procedure FormKeyPress(Sender: TObject; var Key: Char); - procedure ButtonLanceRoutageClick(Sender: TObject); - procedure ButtonArretroutageClick(Sender: TObject); - procedure CheckInverse1Click(Sender: TObject); - procedure CheckInverse2Click(Sender: TObject); - procedure CheckInverse3Click(Sender: TObject); - procedure CheckInverse4Click(Sender: TObject); - procedure CheckInverse5Click(Sender: TObject); - procedure CheckInverse6Click(Sender: TObject); - procedure EditDir1Change(Sender: TObject); - procedure EditDir2Change(Sender: TObject); - procedure EditDir3Change(Sender: TObject); - procedure EditDir4Change(Sender: TObject); - procedure EditDir5Change(Sender: TObject); - procedure EditDir6Change(Sender: TObject); - procedure FormCreate(Sender: TObject); - private - { Déclarations privées } - public - { Déclarations publiques } - end; - -var - FormPlace: TFormPlace; - -implementation - -uses UnitConfig, UnitTCO; - -{$R *.dfm} - -procedure TFormPlace.ButtonfermeClick(Sender: TObject); -begin - close; -end; - -procedure TFormPlace.ButtonInitAigClick(Sender: TObject); -begin - if cdm_connecte then - begin - Affiche('Placement des trains incompatible en mode CDM rail',clOrange); - exit; - end; - ButtonLanceRoutage.Enabled:=false; - init_aiguillages; - ButtonLanceRoutage.Enabled:=true; -end; - -procedure TFormPlace.FormActivate(Sender: TObject); -begin - LabelTrain1.Caption:=trains[1].nom_train; - Edit1.text:=intToSTR(placement[1].detecteur); - EditDir1.Text:=IntToSTR(placement[1].detdir); - CheckInverse1.Checked:=placement[1].inverse; - LabelTrain2.Caption:=trains[2].nom_train; - EditDir2.Text:=IntToSTR(placement[2].detdir); - CheckInverse2.Checked:=placement[2].inverse; - Edit2.text:=intToSTR(placement[2].detecteur); - CheckInverse3.Checked:=placement[3].inverse; - EditDir3.Text:=IntToSTR(placement[3].detdir); - LabelTrain3.Caption:=trains[3].nom_train; - Edit3.text:=intToSTR(placement[3].detecteur); - LabelTrain4.Caption:=trains[4].nom_train; - EditDir4.Text:=IntToSTR(placement[4].detdir); - Edit4.text:=intToSTR(placement[4].detecteur); - CheckInverse4.Checked:=placement[4].inverse; - LabelTrain5.Caption:=trains[5].nom_train; - EditDir5.Text:=IntToSTR(placement[5].detdir); - Edit5.text:=intToSTR(placement[5].detecteur); - CheckInverse5.Checked:=placement[5].inverse; - LabelTrain6.Caption:=trains[6].nom_train; - EditDir6.Text:=IntToSTR(placement[6].detdir); - Edit6.text:=intToSTR(placement[6].detecteur); - CheckInverse6.Checked:=placement[6].inverse; -end; - -procedure TFormPlace.ButtonPlaceClick(Sender: TObject); -var Suiv,prec,detect,erreur,i,it : integer; - s,Ssuiv,NomTrain : string; -begin - if cdm_connecte then - begin - Affiche('Placement des trains incompatible en mode CDM rail',clOrange); - exit; - end; - - for detect:=1 to NbMemZone do - begin - detecteur[detect].train:=''; - detecteur[detect].AdrTrain:=0; - detecteur[detect].IndexTrain:=0; - end; - - it:=0; - for i:=1 to 6 do - begin - case i of - 1 : begin s:=edit1.Text;Ssuiv:=EditDir1.Text;end; - 2 : begin s:=edit2.Text;Ssuiv:=EditDir2.Text;end; - 3 : begin s:=edit3.Text;Ssuiv:=EditDir3.Text;end; - 4 : begin s:=edit4.Text;Ssuiv:=EditDir4.Text;end; - 5 : begin s:=edit5.Text;Ssuiv:=EditDir5.Text;end; - 6 : begin s:=edit6.Text;Ssuiv:=EditDir6.Text;end; - end; - - if (s<>'') and (Ssuiv<>'') then - begin - val(s,detect,erreur); - val(Ssuiv,Suiv,erreur); - NomTrain:=trains[i].nom_train; - if (detect>NbMemZone )then LabelTexte.caption:='Erreur détecteur train '+intToSTR(i); - prec:=det_suiv_cont(Suiv,detect); // détecteur précédent (d'ou vient la loco) - if detect<>0 then - begin - inc(it); - //detecteur[detect].adrTrain:=trains[i].adresse; - //event_detecteur(detect,true,trains[i].nom_train); - { - SauvefiltrageDet0:=filtrageDet0; - filtrageDet0:=0; - Affiche(intToSTR(prec)+' 1',clyellow); - event_detecteur(prec,true,NomTrain); - Affiche(intToSTR(prec)+' 0',clyellow); - event_detecteur(prec,false,NomTrain); - - Affiche(intToSTR(detect)+' 1',clyellow); - event_detecteur(detect,true,NomTrain); - filtrageDet0:=SauveFiltrageDet0; - } - - detecteur[detect].etat:=true; - detecteur[detect].AdrTrain:=trains[i].adresse; - detecteur[detect].train:=placement[i].train; - detecteur[detect].IndexTrain:=i; - - MemZone[prec,detect].etat:=true; - MemZone[prec,detect].train:=placement[i].train; - MemZone[prec,detect].Adrtrain:=trains[i].adresse; - MemZone[prec,detect].NumTrain:=i; - //Affiche(inttostr(prec)+' '+intToSTR(detect),clorange); - - event_det_train[it].NbEl:=1 ; - event_det_train[it].AdrTrain:=trains[i].adresse; - event_det_train[it].det[1].adresse:=prec; - event_det_train[it].det[1].etat:=false; - event_det_train[it].nom_train:=placement[i].train; - - Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+Ssuiv,clLime); - - inc(N_trains); - - end - else - begin - detecteur[detect].etat:=false; - detecteur[detect].train:=''; - detecteur[detect].adrTrain:=0; - end; - end; - end; - - if formTCO.Showing then - begin - affiche_tco; - end; - -end; - -procedure TFormPlace.Edit1Change(Sender: TObject); -var i,erreur : integer; -begin - val(edit1.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[1].train:=trains[1].nom_train; - placement[1].detecteur:=i; -end; - -procedure TFormPlace.Edit2Change(Sender: TObject); -var i,erreur : integer; -begin - val(edit2.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[2].train:=trains[2].nom_train; - placement[2].detecteur:=i; -end; - -procedure TFormPlace.Edit3Change(Sender: TObject); -var i,erreur : integer; -begin - val(edit3.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[3].train:=trains[3].nom_train; - placement[3].detecteur:=i; -end; - -procedure TFormPlace.Edit4Change(Sender: TObject); -var i,erreur : integer; -begin - val(edit4.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[4].train:=trains[4].nom_train; - placement[4].detecteur:=i; -end; - -procedure TFormPlace.Edit5Change(Sender: TObject); -var i,erreur : integer; -begin - val(edit5.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[5].train:=trains[5].nom_train; - placement[5].detecteur:=i; -end; - -procedure TFormPlace.Edit6Change(Sender: TObject); -var i,erreur : integer; -begin - val(edit6.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[6].train:=trains[6].nom_train; - placement[6].detecteur:=i; -end; - -procedure TFormPlace.Button1Click(Sender: TObject); -begin - formconfig.PageControl.ActivePage:=formconfig.TabSheetTrains; - formconfig.showmodal; - formconfig.Close; -end; - -procedure TFormPlace.ButtonSauveClick(Sender: TObject); -begin - sauve_config; -end; - -procedure TFormPlace.FormKeyPress(Sender: TObject; var Key: Char); -begin - if key=chr(27) then close; -end; - -procedure TFormPlace.ButtonLanceRoutageClick(Sender: TObject); -var a,i,j,id,adrDet,AdrTrain,AdrFeu : integer; - trouve,rouge : boolean; - var s: string; -begin - if cdm_connecte then - begin - Affiche('Placement des trains incompatible en mode CDM rail',clOrange); - exit; - end; - - trouve:=false; - // explorer les détecteurs pour lancer les trains - for i:=1 to NDetecteurs do + inc(N_trains); + end + else + begin + s:='Train '+nomtrain +' non positionné car détecteurs '+IntToSTR(detect)+' '+intToSTR(suiv)+' non consécutifs'; + Affiche(s,clred); + detecteur[detect].etat:=false; + detecteur[detect].train:=''; + detecteur[detect].adrTrain:=0; + end; + end + else + begin + detecteur[detect].etat:=false; + detecteur[detect].train:=''; + detecteur[detect].adrTrain:=0; + end; + end; + end; + + if formTCO.Showing then + begin + affiche_tco; + end; + maj_feux(true); + maj_feux(true); + maj_feux(true); +end; + +procedure TFormPlace.Edit1Change(Sender: TObject); +var i,erreur : integer; +begin + val(edit1.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[1].train:=trains[1].nom_train; + placement[1].detecteur:=i; +end; + +procedure TFormPlace.Edit2Change(Sender: TObject); +var i,erreur : integer; +begin + val(edit2.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[2].train:=trains[2].nom_train; + placement[2].detecteur:=i; +end; + +procedure TFormPlace.Edit3Change(Sender: TObject); +var i,erreur : integer; +begin + val(edit3.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[3].train:=trains[3].nom_train; + placement[3].detecteur:=i; +end; + +procedure TFormPlace.Edit4Change(Sender: TObject); +var i,erreur : integer; +begin + val(edit4.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[4].train:=trains[4].nom_train; + placement[4].detecteur:=i; +end; + +procedure TFormPlace.Edit5Change(Sender: TObject); +var i,erreur : integer; +begin + val(edit5.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[5].train:=trains[5].nom_train; + placement[5].detecteur:=i; +end; + +procedure TFormPlace.Edit6Change(Sender: TObject); +var i,erreur : integer; +begin + val(edit6.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[6].train:=trains[6].nom_train; + placement[6].detecteur:=i; +end; + +procedure TFormPlace.Button1Click(Sender: TObject); +begin + formconfig.PageControl.ActivePage:=formconfig.TabSheetTrains; + formconfig.showmodal; + formconfig.Close; +end; + +procedure TFormPlace.ButtonSauveClick(Sender: TObject); +begin + sauve_config; +end; + +procedure TFormPlace.FormKeyPress(Sender: TObject; var Key: Char); +begin + if key=chr(27) then close; +end; + +procedure TFormPlace.ButtonLanceRoutageClick(Sender: TObject); +var a,i,j,id,adrDet,AdrTrain,AdrFeu : integer; + trouve,rouge : boolean; + var s: string; +begin + if cdm_connecte then + begin + Affiche('Placement des trains incompatible en mode CDM rail',clOrange); + exit; + end; + + trouve:=false; + // explorer les détecteurs pour lancer les trains + for i:=1 to NDetecteurs do begin adrDet:=Adresse_detecteur[i]; if Detecteur[adrDet].etat and (detecteur[adrDet].train<>'') then - begin - rouge:=false; - trouve:=true; - roulage:=true; - AdrTrain:=detecteur[AdrDet].AdrTrain; - AdrFeu:=signal_detecteur(AdrDet); // trouve l'adresse du feu correspondant au détecteur - - // si il y a un signal sur le détecteur de démarrage du train est il au rouge? - if adrFeu<>0 then - begin - id:=index_feu(AdrFeu); - a:=feux[id].EtatSignal; + begin + rouge:=false; + trouve:=true; + roulage:=true; + AdrTrain:=detecteur[AdrDet].AdrTrain; + AdrFeu:=signal_detecteur(AdrDet); // trouve l'adresse du feu correspondant au détecteur + + // si il y a un signal sur le détecteur de démarrage du train est il au rouge? + if adrFeu<>0 then + begin + id:=index_feu(AdrFeu); + a:=feux[id].EtatSignal; if ((a=semaphore_F) or (a=carre_F) or (a=violet_F)) then rouge:=true; - end; - - if not(rouge) then - begin - j:=index_train_adresse(AdrTrain); - vitesse_loco('',adrTrain,trains[j].VitNominale,not(placement[j].inverse)); - - maj_feux(true); // avec détecteurs - s:='Lancement du train '+detecteur[adrDet].train+' depuis détecteur '+intToSTR(adrDet); - Affiche(s,clYellow); - if traceListe then AfficheDebug(s,clyellow); - reserve_canton(AdrDet,placement[j].detdir,adrtrain); - - end - Else Affiche('Le signal '+intToSTR(AdrFeu)+' étant rouge, le train '+detecteur[adrDet].train+' @'+intToSTR(AdrTrain)+' ne démarre pas',clyellow); - end; - end; - - // au moins un train démarre - if trouve then - begin - Maj_feux(true); - Formprinc.LabelTitre.caption:=titre+' - Mode roulage en cours'; - with Formprinc.SBMarcheArretLoco do - begin - Visible:=true; - end; - end; - if not(trouve) then Affiche('Pas de train placé',clOrange); -end; - -procedure TFormPlace.ButtonArretroutageClick(Sender: TObject); -var i : integer; -begin - roulage:=false; - Affiche('Arrêt du roulage de tous les trains',clorange); - Formprinc.LabelTitre.caption:=titre+' '; - for i:=1 to ntrains do - vitesse_loco('',trains[i].adresse,0,true); -end; - -procedure TFormPlace.CheckInverse1Click(Sender: TObject); -begin - placement[1].inverse:=CheckInverse1.Checked; -end; - -procedure TFormPlace.CheckInverse2Click(Sender: TObject); -begin - placement[2].inverse:=CheckInverse2.Checked; -end; - -procedure TFormPlace.CheckInverse3Click(Sender: TObject); -begin - placement[3].inverse:=CheckInverse3.Checked; -end; - -procedure TFormPlace.CheckInverse4Click(Sender: TObject); -begin - placement[4].inverse:=CheckInverse4.Checked; -end; - -procedure TFormPlace.CheckInverse5Click(Sender: TObject); -begin - placement[5].inverse:=CheckInverse4.Checked; -end; - -procedure TFormPlace.CheckInverse6Click(Sender: TObject); -begin - placement[6].inverse:=CheckInverse6.Checked; -end; - -procedure TFormPlace.EditDir1Change(Sender: TObject); -var i,erreur : integer; -begin - val(editDir1.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[1].detdir:=i; -end; - -procedure TFormPlace.EditDir2Change(Sender: TObject); -var i,erreur : integer; -begin - val(editDir2.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[2].detdir:=i; -end; - -procedure TFormPlace.EditDir3Change(Sender: TObject); -var i,erreur : integer; -begin - val(editDir3.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[3].detdir:=i; -end; - - - -procedure TFormPlace.EditDir4Change(Sender: TObject); -var i,erreur : integer; -begin - val(editDir4.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[4].detdir:=i; -end; - -procedure TFormPlace.EditDir5Change(Sender: TObject); -var i,erreur : integer; -begin - val(editDir5.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[5].detdir:=i; -end; - -procedure TFormPlace.EditDir6Change(Sender: TObject); -var i,erreur : integer; -begin - val(editDir6.Text,i,erreur); - if erreur<>0 then exit; - if index_adresse_detecteur(i)=0 then - begin - LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; - exit; - end; - labelTexte.caption:=''; - placement[6].detdir:=i; -end; - -procedure TFormPlace.FormCreate(Sender: TObject); -begin - PlaceAffiche:=true; -end; - -end. + end; + + if not(rouge) then + begin + j:=index_train_adresse(AdrTrain); + vitesse_loco('',adrTrain,trains[j].VitNominale,not(placement[j].inverse)); + + maj_feux(true); // avec détecteurs + s:='Lancement du train '+detecteur[adrDet].train+' depuis détecteur '+intToSTR(adrDet); + Affiche(s,clYellow); + if traceListe then AfficheDebug(s,clyellow); + reserve_canton(AdrDet,placement[j].detdir,adrtrain); + + end + Else Affiche('Le signal '+intToSTR(AdrFeu)+' étant rouge, le train '+detecteur[adrDet].train+' @'+intToSTR(AdrTrain)+' ne démarre pas',clyellow); + end; + end; + + // au moins un train démarre + if trouve then + begin + Maj_feux(true); + Formprinc.LabelTitre.caption:=titre+' - Mode roulage en cours'; + with Formprinc.SBMarcheArretLoco do + begin + Visible:=true; + end; + end; + if not(trouve) then Affiche('Pas de train placé',clOrange); +end; + +procedure TFormPlace.ButtonArretroutageClick(Sender: TObject); +var i : integer; +begin + roulage:=false; + Affiche('Arrêt du roulage de tous les trains',clorange); + Formprinc.LabelTitre.caption:=titre+' '; + for i:=1 to ntrains do + vitesse_loco('',trains[i].adresse,0,true); +end; + +procedure TFormPlace.CheckInverse1Click(Sender: TObject); +begin + placement[1].inverse:=CheckInverse1.Checked; +end; + +procedure TFormPlace.CheckInverse2Click(Sender: TObject); +begin + placement[2].inverse:=CheckInverse2.Checked; +end; + +procedure TFormPlace.CheckInverse3Click(Sender: TObject); +begin + placement[3].inverse:=CheckInverse3.Checked; +end; + +procedure TFormPlace.CheckInverse4Click(Sender: TObject); +begin + placement[4].inverse:=CheckInverse4.Checked; +end; + +procedure TFormPlace.CheckInverse5Click(Sender: TObject); +begin + placement[5].inverse:=CheckInverse4.Checked; +end; + +procedure TFormPlace.CheckInverse6Click(Sender: TObject); +begin + placement[6].inverse:=CheckInverse6.Checked; +end; + +procedure TFormPlace.EditDir1Change(Sender: TObject); +var i,erreur : integer; +begin + val(editDir1.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[1].detdir:=i; +end; + +procedure TFormPlace.EditDir2Change(Sender: TObject); +var i,erreur : integer; +begin + val(editDir2.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[2].detdir:=i; +end; + +procedure TFormPlace.EditDir3Change(Sender: TObject); +var i,erreur : integer; +begin + val(editDir3.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[3].detdir:=i; +end; + + + +procedure TFormPlace.EditDir4Change(Sender: TObject); +var i,erreur : integer; +begin + val(editDir4.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[4].detdir:=i; +end; + +procedure TFormPlace.EditDir5Change(Sender: TObject); +var i,erreur : integer; +begin + val(editDir5.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[5].detdir:=i; +end; + +procedure TFormPlace.EditDir6Change(Sender: TObject); +var i,erreur : integer; +begin + val(editDir6.Text,i,erreur); + if erreur<>0 then exit; + if index_adresse_detecteur(i)=0 then + begin + LabelTexte.caption:='Détecteur '+intToSTR(i)+' inexistant'; + exit; + end; + labelTexte.caption:=''; + placement[6].detdir:=i; +end; + +procedure TFormPlace.FormCreate(Sender: TObject); +begin + PlaceAffiche:=true; +end; + +procedure TFormPlace.BitBtn1Click(Sender: TObject); +begin + close; +end; + +end. diff --git a/verif_version.dcu b/verif_version.dcu index 918c98a..82a9e25 100644 Binary files a/verif_version.dcu and b/verif_version.dcu differ diff --git a/verif_version.pas b/verif_version.pas index 7483ad7..05a3602 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -23,8 +23,8 @@ var Lance_verif : integer; verifVersion,notificationVersion : boolean; -Const Version='5.6'; // sert à la comparaison de la version publiée - SousVersion=' '; // en cas d'absence de sous version mettre un espace +Const Version='5.7'; // sert à la comparaison de la version publiée + SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace implementation diff --git a/versions.txt b/versions.txt index 361bf07..27d00c8 100644 --- a/versions.txt +++ b/versions.txt @@ -150,5 +150,11 @@ version 5.51 : Renforcement de la v version 5.52 : Correction bug exploitation TCO version 5.6 : Ajout d'affichage d'informations supplémentaires Couleur de fond définissable pour chaque cellule du TCO ou une zone. + Correction d'un bug sur les trackbar du TCO sous Windows 10/11 +version 5.7 : Glisser-déposer du TCO avec les icônes de placement. + Vérification des incompatibilités de placement des icônes du TCO. + Gestion des passages à niveau par comptage/décomptage des trains. + +