From e1c2f6b40c097dc5749daa499320d464d2e760f1 Mon Sep 17 00:00:00 2001 From: f1iwq2 Date: Sun, 26 Oct 2025 09:50:37 +0100 Subject: [PATCH] V10.75 --- UnitClock.pas | 2 +- UnitCompteur.pas | 2 +- UnitConfig.dfm | 22 ++++----- UnitConfig.pas | 17 +++---- UnitDebug.pas | 2 +- UnitFicheHoraire.pas | 8 ++-- UnitPrinc.dfm | 43 +++++++++--------- UnitPrinc.pas | 77 +++++++++++++++++++------------- UnitRoute.pas | 4 +- UnitRouteTrains.dfm | 16 ++++++- UnitRouteTrains.pas | 104 ++++++++++++++++++++++++++++++++++++++++--- UnitTCO.pas | 2 +- verif_version.pas | 2 +- 13 files changed, 214 insertions(+), 87 deletions(-) diff --git a/UnitClock.pas b/UnitClock.pas index f197fcf..1abab9b 100644 --- a/UnitClock.pas +++ b/UnitClock.pas @@ -487,7 +487,7 @@ end; procedure TFormClock.TjsVerClick(Sender: TObject); begin SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); - // le checked ne fonctionne pas sous D7, fonctionne sous D12. + // le checked ne fonctionne pas sous D7, fonctionne sous D13. TjsDev.Checked:=true; Dverrouiller1.Checked:=false; VerrouilleClock:=true; diff --git a/UnitCompteur.pas b/UnitCompteur.pas index 1143987..201eb3d 100644 --- a/UnitCompteur.pas +++ b/UnitCompteur.pas @@ -694,7 +694,7 @@ begin 3 : compteurT[i].paramcompt.rav:=round(115*compteurT[i].paramcompt.redx); end; - //ne pas faire compteurT[i].FCBitMap.Free çà fait une exception si il est déja en nil, contrairement à D12. + //ne pas faire compteurT[i].FCBitMap.Free çà fait une exception si il est déja en nil, contrairement à D13. compteurT[i].fcBitMap:=tbitmap.Create; with compteurT[i].FCBitMap do begin diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 9a20af5..03395b2 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1542,12 +1542,12 @@ object FormConfig: TFormConfig Visible = False WordWrap = True end - object LabelD12: TLabel + object LabelD13: TLabel Left = 752 Top = 64 Width = 40 Height = 31 - Caption = 'D12' + Caption = 'D13' Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -27 @@ -2097,7 +2097,7 @@ object FormConfig: TFormConfig 'S'#233'lection du style d'#39#39'affichage - Le style sera chang'#233' '#224' la ferm' + 'eture de la fen'#234'tre'#39 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 0 @@ -3779,7 +3779,7 @@ object FormConfig: TFormConfig Top = 56 Width = 193 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxDecodeurPersoChange end @@ -3798,7 +3798,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxNationChange end @@ -3844,7 +3844,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 6 OnChange = ComboBoxDecCdeChange end @@ -4057,7 +4057,7 @@ object FormConfig: TFormConfig Top = 96 Width = 137 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxOperateurChange OnDrawItem = ComboBoxOperateurDrawItem @@ -4077,7 +4077,7 @@ object FormConfig: TFormConfig Top = 96 Width = 161 Height = 21 - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 4 @@ -4189,7 +4189,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 7 OnChange = ComboBoxFLChange end @@ -4739,7 +4739,7 @@ object FormConfig: TFormConfig Height = 21 Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 10 @@ -6466,7 +6466,7 @@ object FormConfig: TFormConfig Width = 153 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxUSBTrChange end diff --git a/UnitConfig.pas b/UnitConfig.pas index df5e8df..e472f69 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -290,7 +290,7 @@ type CheckBoxSombre: TCheckBox; ButtonCouleur: TButton; ColorDialogFond: TColorDialog; - LabelD12: TLabel; + LabelD13: TLabel; ButtonPropage: TButton; ButtonPFCDM: TButton; TabAvance: TTabSheet; @@ -1679,13 +1679,14 @@ begin until s[1]=')'; delete(s,1,1); inc(k); - until length(s)<1; + until k>l+1; //(length(s)<1) or ; dec(k); if k<>l+1 then begin Affiche('Erreur 675 ligne '+chaine_signal,clred); Affiche('Nombre incorrect de description des aiguillages: '+intToSTR(k)+' pour '+intToSTR(l)+' feux directionnels',clred); end; + if length(s)>0 then delete(s,1,1); end else // feu de signalisation--------------------------------- @@ -7827,7 +7828,7 @@ begin cree_image_onglet_train(i); end; - affecte_trains_config; // affecte les trains aux cantons + //affecte_trains_config; // affecte les trains aux cantons labeledEditVit1.Hint:='Vitesse en crans du coefficient V1'+#13+'(vitesse lente)'; labeledEditVit2.Hint:='Vitesse en crans du coefficient V2'+#13+'(vitesse moyenne)'; @@ -7853,12 +7854,12 @@ begin end; {$IF CompilerVersion >= 28.0} - labelD12.Visible:=true; + labelD13.Visible:=true; GroupBoxStyles.Visible:=true; {$IFEND} {$IFDEF WIN64} // si compilé en 64 bits - labelD12.Caption:='D12 x64'; - LabelD12.Left:=LabelD12.Left-30; + labelD13.Caption:='D13 x64'; + LabelD13.Left:=LabelD13.Left-30; {$ENDIF} // création des champs dynamiques de l'onglet décodeurs personnalisés @@ -8727,9 +8728,9 @@ begin ShowHint:=true; end; - // compilation avec D12---------------------------------------- + // compilation avec D13---------------------------------------- {$IF CompilerVersion >= 28.0} - labelD12.Visible:=true; + labelD13.Visible:=true; // Styles (Embarcadero Dephi11) // remplir la combobox avec les styles disponibles diff --git a/UnitDebug.pas b/UnitDebug.pas index 1a326ea..2c5572c 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -214,7 +214,7 @@ begin visible:=false; RichDebug.clear; s:=DateToStr(date)+' '+TimeToStr(Time)+' '; - // l'ascenseur de la fenetre dans D12 ------------ + // l'ascenseur de la fenetre dans D13 ------------ // ne fonctionne que si le style est windows !!! (bug du VCL) // obligé d'utiliser une scrollBox diff --git a/UnitFicheHoraire.pas b/UnitFicheHoraire.pas index a18692a..b474dc5 100644 --- a/UnitFicheHoraire.pas +++ b/UnitFicheHoraire.pas @@ -290,7 +290,7 @@ var DRect: TRect; couleur : tColor; Grid: TStringGrid; - d12 : boolean; + d13 : boolean; begin Grid:=Sender as TStringGrid; @@ -338,15 +338,15 @@ begin end; } - d12:=false; + d13:=false; {$IF CompilerVersion >= 28.0} - d12:=true; + d13:=true; {$IFEND} //Affiche(intToSTR(arow)+' '+intToSTR(aCol),clYellow); // couleur de fond if Arow=0 then begin - if d12 then couleur:=grid.canvas.Pixels[35,6] else couleur:=$E0E0E0; + if d13 then couleur:=grid.canvas.Pixels[35,6] else couleur:=$E0E0E0; with grid.canvas do begin Brush.Color := couleur; diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 36032a0..efa0236 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -5,7 +5,7 @@ object FormPrinc: TFormPrinc BorderStyle = bsNone Caption = 'Signaux complexes' ClientHeight = 513 - ClientWidth = 915 + ClientWidth = 1094 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -23,7 +23,7 @@ object FormPrinc: TFormPrinc OnKeyDown = FormKeyDown OnResize = FormResize DesignSize = ( - 915 + 1094 513) PixelsPerInch = 96 TextHeight = 13 @@ -1432,7 +1432,7 @@ object FormPrinc: TFormPrinc Visible = False end object LabelClock: TLabel - Left = 823 + Left = 1002 Top = 0 Width = 85 Height = 22 @@ -5422,17 +5422,19 @@ object FormPrinc: TFormPrinc Visible = False end object Label1: TLabel - Left = 856 + Left = 792 Top = 4 Width = 89 Height = 13 + Anchors = [akTop, akRight] Caption = 'Nombre de trains : ' end object LabelNbTrains: TLabel - Left = 960 + Left = 888 Top = 2 Width = 9 Height = 19 + Anchors = [akTop, akRight] Caption = '0' Font.Charset = ANSI_CHARSET Font.Color = clBlack @@ -5444,7 +5446,7 @@ object FormPrinc: TFormPrinc object StatusBar1: TStatusBar Left = 0 Top = 491 - Width = 915 + Width = 1094 Height = 22 Panels = < item @@ -5778,7 +5780,7 @@ object FormPrinc: TFormPrinc OnClick = SBMarcheArretLocoClick end object BoutonRaf: TButton - Left = 8 + Left = 4 Top = 8 Width = 89 Height = 33 @@ -5792,7 +5794,7 @@ object FormPrinc: TFormPrinc OnClick = BoutonRafClick end object ButtonArretSimu: TButton - Left = 192 + Left = 190 Top = 88 Width = 89 Height = 33 @@ -5803,7 +5805,7 @@ object FormPrinc: TFormPrinc OnClick = ButtonArretSimuClick end object ButtonAffTCO: TButton - Left = 104 + Left = 100 Top = 48 Width = 81 Height = 33 @@ -5812,7 +5814,7 @@ object FormPrinc: TFormPrinc OnClick = ButtonAffTCOClick end object ButtonLanceCDM: TButton - Left = 192 + Left = 190 Top = 8 Width = 89 Height = 33 @@ -5824,7 +5826,7 @@ object FormPrinc: TFormPrinc OnClick = ButtonLanceCDMClick end object ButtonLocCV: TButton - Left = 104 + Left = 100 Top = 88 Width = 81 Height = 33 @@ -5836,7 +5838,7 @@ object FormPrinc: TFormPrinc OnClick = ButtonLocCVClick end object BoutonRazTrains: TButton - Left = 192 + Left = 190 Top = 48 Width = 89 Height = 33 @@ -5851,7 +5853,7 @@ object FormPrinc: TFormPrinc OnClick = BoutonRazTrainsClick end object ButtonAffAnalyseCDM: TButton - Left = 8 + Left = 4 Top = 48 Width = 89 Height = 33 @@ -5864,7 +5866,7 @@ object FormPrinc: TFormPrinc OnClick = ButtonAffAnalyseCDMClick end object ButtonCDM: TButton - Left = 104 + Left = 100 Top = 8 Width = 81 Height = 33 @@ -5883,7 +5885,7 @@ object FormPrinc: TFormPrinc Text = '<1>' end object ButtonEnv: TButton - Left = 9 + Left = 4 Top = 88 Width = 88 Height = 33 @@ -5895,8 +5897,8 @@ object FormPrinc: TFormPrinc end end object GroupBoxCV: TGroupBox - Left = 657 - Top = 72 + Left = 617 + Top = 128 Width = 265 Height = 81 Anchors = [akTop, akRight] @@ -6497,7 +6499,8 @@ object FormPrinc: TFormPrinc end object PopupMenuSignal: TPopupMenu OnPopup = PopupMenuSignalPopup - Left = 784 + Left = 504 + Top = 32 object Proprits1: TMenuItem Caption = 'Propri'#233't'#233's du signal' OnClick = Proprits1Click @@ -6536,7 +6539,7 @@ object FormPrinc: TFormPrinc end object PopupMenuTrains: TPopupMenu OnPopup = PopupMenuTrainsPopup - Left = 816 + Left = 480 object Propritsdutrain1: TMenuItem Caption = 'Propri'#233't'#233's du train' OnClick = Propritsdutrain1Click @@ -6551,7 +6554,7 @@ object FormPrinc: TFormPrinc end object PopupMenuCompteurs: TPopupMenu OnPopup = PopupMenuCompteursPopup - Left = 848 + Left = 512 object Propritsdescompteurs1: TMenuItem Caption = 'Propri'#233't'#233's des compteurs' OnClick = Propritsdescompteurs1Click diff --git a/UnitPrinc.pas b/UnitPrinc.pas index f96df66..9172798 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -9,7 +9,7 @@ unit Unitprinc; on utilise activeX Tmscomm pour les liaisons série/USB -------------------------------------------------------------- - Delphi 12 : + Delphi 13 : Dans Outils / Options / Interface utilisateurs / Concerpteur de fiches / Haute résolution Sélectionner Automatique (PPI de l'écran) et cocher "taille de la grille..." @@ -37,7 +37,7 @@ unit Unitprinc; Dans projet/option/fiches : fiches disponibles : formtco uniquement En cas d'erreur interne L1333, supprimer les fichiers DCU du projet ou simplement faire construire - Pour le mode sombre sous D12, il faut sélectionner: + Pour le mode sombre sous D13, il faut sélectionner: Projet / Options // Application / manifeste / fichier manifeste : personnaliser à la sauvegarde, ce champ apparaitra sous "générer automatiquement" et : décocher "activer les thèmes d'exécution" @@ -86,7 +86,8 @@ unit Unitprinc; // à la centrale par le menu "interface / demander état détecteurs" // // Si SC envoie une position d'aiguillage à CDM, il ne change pas sa représentation dans CDM. - + //https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions + //{$Q-} // pas de vérification du débordement des opérations de calcul //{$R-} // pas de vérification des limites d'index du tableau et des variables //{$D-} // pas d'information de debuggage : pas de débug possible @@ -947,8 +948,12 @@ tTrain = record route : TuneRoute; // tableau de la route en cours du train NomRoute : array[1..30] of string; // nom de la route sauvegardée NomRouteCour : string; // nom de la route courante - routePref : array[0..30] of TUneroute; // tableaux dess route sauvegardées du train. routePref[0,0].adresse est le nombre de routes - // routePref[0,0].talon = consigne inverse au train + routePref : array[0..30] of TUneroute; // tableaux des route sauvegardées du train. + // routePref[0,0].adresse est le nombre de routes + // si x>=1: + // routePref[x,0].adresse est le nombre d'éléments de la route + // routePref[x,0].pos = Id de route + // routePref[x,0].talon = consigne inverse au train PointRout : integer; // cantons (via leurs détecteurs) sur lesquels le train doit d'arrêter DetecteurArret : array[1..NbDetArret] of record @@ -1414,7 +1419,7 @@ begin end; } -// lire les fichiers styles vsf - Uniquement D12 +// lire les fichiers styles vsf - Uniquement D13 procedure lire_styles; var path,ext : string; DirList : TStrings; @@ -2015,7 +2020,7 @@ begin s:=DateToStr(date)+' '+TimeToStr(Time)+' V'+versionSC; {$IF CompilerVersion >= 28.0} - s:=s+' D12'; + s:=s+' D13'; {$IFEND} {$IFDEF WIN64} // si compilé en 64 bits s:=s+' x64'; @@ -2110,7 +2115,7 @@ begin s:='Début du préliminaire'; procetape(s); - // en D12, obligé de positionner la fenêtre principale après avoir fixé le style + // en D13, obligé de positionner la fenêtre principale après avoir fixé le style positionne_principal; calcul_pos_horloge_compt; @@ -6752,7 +6757,8 @@ begin end; end; Signaux[i].EtatSignal:=code; - Dessine_signal_mx(Signaux[Index_Signal(adr)].Img.Canvas,0,0,1,1,adr,1); + //if signaux[i].img<>nil then + Dessine_signal_mx(signaux[i].Img.Canvas,0,0,1,1,adr,1); end; end; @@ -8849,7 +8855,7 @@ begin Signaux[i].AncienEtat:=Signaux[i].EtatSignal; // allume les feux du signal dans la fenêtre de droite - Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adr,1); + if (Signaux[i].Img<>nil) then Dessine_signal_mx(Signaux[i].Img.Canvas,0,0,1,1,adr,1); // allume les feux du signal dans le TCO for indexTCO:=1 to NbreTCO do @@ -14388,6 +14394,7 @@ end; procedure maj_Signal_P(adrSignal : integer;detect : boolean); var adrPrec,etat : integer; begin + //Affiche('Maj_signal_P '+intToSTR(adrSignal),clyellow); Maj_signal(Adrsignal,detect); // si le signal est rouge ou rappel, mettre à jour son précédent etat:=Signaux[index_signal(AdrSignal)].EtatSignal; @@ -14413,6 +14420,7 @@ begin Maj_signaux_cours:=TRUE; i:=1; repeat + //Affiche('Mal '+intToSTR(Signaux[i].Adresse),clred); Maj_Signal_P(Signaux[i].Adresse,detect); inc(i); until (i>NbreSignaux) or Stop_Maj_Sig; @@ -17859,7 +17867,7 @@ end; // note: si on pilote un aiguillage par signaux complexes vers CDM et que celui ci est inversé, // on recoit un evt de CDM de l'aiguillage dans le mauvais sens. -// par contre si on pilote cet aiguillage dans CDM, on le recoit dans le bon sens. +// Attention : si on pilote cet aiguillage dans CDM, on le recoit dans le bon sens. // évènement d'aiguillage (accessoire) // pos = const_droit=2 ou const_devie=1 procedure Event_Aig(adresse,pos : integer); @@ -17889,7 +17897,8 @@ begin // ne pas faire l'évaluation si l'ancien état de l'aiguillage est indéterminée (9) // car le RUN vient de démarrer - faire_event:=aiguillage[index].position<>9; + //faire_event:=aiguillage[index].position<>9; + faire_event:=true; aiguillage[index].position:=pos; // stockage de la nouvelle position de l'aiguillage // ------------- stockage évènement aiguillage dans tampon event_det_tick ------------------------- @@ -17922,7 +17931,8 @@ begin // l'évaluation des routes est à faire selon conditions if faire_event and not(confignulle) then begin - evalue;evalue;evalue; + //Affiche('Evalue',clred); + evalue;evalue;evalue; // maj des signaux end; end @@ -18061,8 +18071,9 @@ end; // pilote accessoire sous condition, version taches par le timer +// si l'accessoire est un signal, adresse est l'index; function pilote_acc_sc_taches(adresse : integer;octet : byte;Acc : TAccessoire;adrTrain : integer) : boolean; -var groupe,temp,index,AdrTrainLoc : integer ; +var groupe,temp,indexAig,AdrTrainLoc : integer ; fonction,pilotage,pilotageCDM : byte; s : string; begin @@ -18073,8 +18084,9 @@ begin exit; end; pilotage:=octet; - if Acc=aigP then index:=index_aig(adresse); - if acc=Signal then Index:=Index_Signal(adresse); + //if Acc=aigP then index:=index_aig(adresse); + //if acc=Signal then Index:=adresse; + indexAig:=index_aig(adresse); // test si pilotage aiguillage inversé if (acc=aigP) then begin @@ -18105,8 +18117,10 @@ begin s:=chaine_CDM_Acc(adresse,pilotageCDM); // pilotage actif de l'accessoire---------------- - if acc<>signal then tache(ttacheAcc,0,ttDestCDM,s) // TypeTache,tempo,destinataire,chaine - else tache(ttacheAcc,signaux[index].Tempo,ttDestCDM,s); + //if acc<>signal then + tache(ttacheAcc,0,ttDestCDM,s); + // TypeTache,tempo,destinataire,chaine + // else tache(ttacheAcc,signaux[index].Tempo,ttDestCDM,s); // si l'accessoire est un signal et sans raz des signaux, sortir if (acc=signal) and not(Raz_Acc_signaux) then exit; if Acc=AigP then @@ -18147,8 +18161,8 @@ begin //if avecAck then envoi(s) else envoi_ss_ack(s); // envoi de la trame avec/sans attente Ack - if acc<>signal then tache(ttacheAcc,0,ttDestXpressNet,s) - else tache(ttacheAcc,signaux[index].Tempo,ttDestCDM,s); + //if acc<>signal then tache(ttacheAcc,0,ttDestXpressNet,s) else tache(ttacheAcc,signaux[index].Tempo,ttDestCDM,s); + tache(ttacheAcc,0,ttDestXpressNet,s); // si l'accessoire est un signal et sans raz des signaux, sortir if (acc=signal) and not(Raz_Acc_signaux) then exit; @@ -20803,7 +20817,7 @@ begin af:='Client TCP-IP ou USB CDM Rail - Système XpressNet DCC++ Version '+VersionSC+sousVersion; vc:=''; {$IF CompilerVersion >= 28.0} - vc:=' D12'; + vc:=' D13'; {$IFEND} {$IFDEF WIN64} // si compilé en 64 bits vc:=vc+' x64'; @@ -21070,7 +21084,7 @@ begin // création des composants Comm (USB COM) ----------------- {$IF CompilerVersion >= 28.0} - // D12 composant AsyncPro + // D13 composant AsyncPro try MSCommUSBInterface:=tApdComPort.Create(formprinc); except s:='Erreur 6000 : Composant Interface non créé'; @@ -21290,7 +21304,6 @@ begin clientInfo.Open; // &&& se connecte au serveur SC et envoie les infos {$IF CompilerVersion >= 28.0} - //https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions change_style; {$IFEND} init_horloge; @@ -21329,13 +21342,6 @@ begin end; if serveur_ouvert then ServerSocket.Active:=true; - Menu_tco(NbreTCO); - procetape('Lecture du TCO'); - for i:=1 to NbreTCO do - begin - EcranTCO[i]:=1; - lire_fichier_tco(i); - end; verif_coherence; procetape('La configuration a été lue'); @@ -21362,6 +21368,15 @@ begin cree_image_signal(i); // et initialisation tableaux signaux end; + Menu_tco(NbreTCO); + procetape('Lecture du TCO'); + for i:=1 to NbreTCO do + begin + EcranTCO[i]:=1; + lire_fichier_tco(i); + end; + + Tempo_init:=5; // démarre les initialisations des signaux et des aiguillages dans 0,5 s OrgMilieu:=formprinc.width div 2; @@ -24277,7 +24292,7 @@ begin Affiche(' ',clyellow); s:='Signaux complexes GL version '+versionSC+sousVersion; {$IF CompilerVersion >= 28.0} - s:=s+' D12'; // si compilé avec Delphi12 + s:=s+' D13'; // si compilé avec Delphi12 {$IFEND} {$IFDEF WIN64} // si compilé en 64 bits s:=s+' x64'; diff --git a/UnitRoute.pas b/UnitRoute.pas index 8c32388..627da7e 100644 --- a/UnitRoute.pas +++ b/UnitRoute.pas @@ -419,7 +419,7 @@ begin coulText:=clOrange; StyleText:=1; // gras FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(integer(StyleText))); // - //FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); //ne pas utiliser à cause des styles D12 - permet d'afficher un texte en couleurs avec l'evt onDrawItem + //FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); //ne pas utiliser à cause des styles D13 - permet d'afficher un texte en couleurs avec l'evt onDrawItem end end else @@ -428,7 +428,7 @@ begin coulText:=clYellow; StyleText:=0; // normal FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(integer(StyleText))); - //FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // ne pas utiliser à cause des styles D12 - permet d'afficher un texte en couleurs avec l'evt onDrawItem + //FormRoute.ListBoxRoutes.Items.AddObject(s,pointer(CoulText)); // ne pas utiliser à cause des styles D13 - permet d'afficher un texte en couleurs avec l'evt onDrawItem end; end; end; diff --git a/UnitRouteTrains.dfm b/UnitRouteTrains.dfm index 7b54408..0e2998b 100644 --- a/UnitRouteTrains.dfm +++ b/UnitRouteTrains.dfm @@ -53,7 +53,7 @@ object FormRouteTrain: TFormRouteTrain Top = 8 Width = 585 Height = 177 - ActivePage = TabSheetRA + ActivePage = TabSheetRM TabOrder = 1 object TabSheetRA: TTabSheet Caption = 'Route affect'#233'e' @@ -210,6 +210,7 @@ object FormRouteTrain: TFormRouteTrain Font.Style = [] ItemHeight = 13 ParentFont = False + PopupMenu = PopupMenuRoutes TabOrder = 1 OnKeyDown = ListBoxRMKeyDown OnMouseDown = ListBoxRMMouseDown @@ -277,4 +278,17 @@ object FormRouteTrain: TFormRouteTrain TabOrder = 2 OnClick = ButtonQuitteClick end + object PopupMenuRoutes: TPopupMenu + OnPopup = PopupMenuRoutesPopup + Left = 764 + Top = 144 + object Copierroute1: TMenuItem + Caption = 'Copier route' + OnClick = Copierroute1Click + end + object Collerroute1: TMenuItem + Caption = 'Coller route' + OnClick = Collerroute1Click + end + end end diff --git a/UnitRouteTrains.pas b/UnitRouteTrains.pas index 89b1fc7..3a9577a 100644 --- a/UnitRouteTrains.pas +++ b/UnitRouteTrains.pas @@ -9,7 +9,8 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, - unitprinc,UnitConfig,unitTCO,UnitHorloge,unitFicheHoraire,UnitDebug,UnitRoute,selection_train; + unitprinc,UnitConfig,unitTCO,UnitHorloge,unitFicheHoraire,UnitDebug,UnitRoute,selection_train, + Menus; type @@ -39,6 +40,9 @@ type CheckBoxSens: TCheckBox; CheckBoxSIRA: TCheckBox; LabelID: TLabel; + PopupMenuRoutes: TPopupMenu; + Copierroute1: TMenuItem; + Collerroute1: TMenuItem; procedure FormActivate(Sender: TObject); procedure ButtonQuitteClick(Sender: TObject); procedure ComboBoxTrainsChange(Sender: TObject); @@ -63,6 +67,9 @@ type Shift: TShiftState); procedure CheckBoxSensClick(Sender: TObject); procedure CheckBoxSIRAClick(Sender: TObject); + procedure Copierroute1Click(Sender: TObject); + procedure Collerroute1Click(Sender: TObject); + procedure PopupMenuRoutesPopup(Sender: TObject); private { Déclarations privées } public @@ -73,6 +80,10 @@ type var FormRouteTrain: TFormRouteTrain; IrPref : integer; + routeCopie : record + IdTrain : integer; + IdRoute : integer; + end; function aig_canton(idTrain,detect : integer) : integer; function demarre_index_train(indexTrain : integer) : boolean; @@ -281,6 +292,7 @@ begin if idtrain<1 then exit; formRouteTrain.comboBoxTrains.Clear; formRouteTrain.ListBoxRM.Clear; + for i:=1 to NTrains do begin s:=trains[i].nom_train; @@ -298,9 +310,11 @@ begin formRouteTrain.comboBoxTrains.ItemIndex:=indexTrainFR-1; Maj_icone_train(FormRouteTrain.ImageTrainR,idTrain,clWhite); + with formRouteTrain do begin - TabSheetRM.Enabled:=false; + // ahhhh TabSheetRM.Enabled:=false; + EditNomRoute.Text:=''; ListBoxRA.Clear; if trains[idtrain].route[0].adresse<>0 then // route affectée au train @@ -341,10 +355,13 @@ begin if Canvas.TextWidth(s)+30>PixelLength then PixelLength:=Canvas.TextWidth(s)+30; ListBoxRM.Items.Add(s); end; - EditNomRoute.Text:=trains[idTrain].NomRouteCour; + EditNomRoute.Text:=trains[idTrain].NomRoute[j]; SendMessage(ListBoxRM.Handle,LB_SETHORIZONTALEXTENT,PixelLength,0); // crée la HorzScroll baz end - else LabelRM.Caption:='Pas de route mémorisée au train '+trains[idtrain].nom_train; + else + begin + LabelRM.Caption:='Pas de route mémorisée au train '+trains[idtrain].nom_train; + end; if (trains[idTrain].route[0].adresse=0) and (trains[idTrain].routePref[1][0].adresse=0) then begin @@ -785,6 +802,8 @@ begin ComboBoxTrains.ItemIndex:=0; IndexTrainFR:=1; maj_infos(indexTrainFR); + routecopie.IdTrain:=0; + routecopie.IdRoute:=0; end; // choisir cette route mémorisée @@ -931,6 +950,7 @@ end; procedure TFormRouteTrain.ListBoxRMMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin + //Affiche('ListBoxRMMouseDown',clred); NumRoute:=1; IrPref:=ListBoxRM.ItemIndex+1; if irPref<1 then exit; @@ -949,6 +969,7 @@ end; procedure TFormRouteTrain.ListBoxRAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin + //Affiche('ListBoxRAMouseDown',clred); // si le train de la route est en roulage, ne pas afficher la route car // sinon les index des trains passent à 0 dans les cantons par la fonction zone_tco if trains[indexTrainFR].roulage=0 then affiche_route_tco; @@ -994,7 +1015,7 @@ begin begin dec(IrPref); end - else + else if (ord(Key)=VK_DOWN) and (IrPrefId; // Id de la route i du train de destination + inc(i); + end; + if ok then CollerRoute1.Enabled:=true + else + begin + LabelRoute.caption:='La route '+intToSTR(i-1)+' est identique à la route copiée'; + exit; + end; + + inc(nDest); + // copier la route + Trains[IdTrainDest].routePref[0,0].adresse:=ndest; + Trains[IdTrainDest].routePref[nDest]:=Trains[RouteCopie.IdTrain].RoutePref[RouteCopie.IdRoute]; + // et le nom de la route + s:=Trains[RouteCopie.IdTrain].NomRoute[RouteCopie.IdRoute]; + Trains[IdTrainDest].NomRoute[nDest]:=s; + EditNomRoute.Text:=s; + maj_infos(IdTrainDest); +end; + +procedure TFormRouteTrain.PopupMenuRoutesPopup(Sender: TObject); +begin + + if RouteCopie.IdTrain=0 then + begin + CopierRoute1.Enabled:=false; + CollerRoute1.Enabled:=false; + end; + + // valider menu copier + if (ListBoxRM.ItemIndex>=0) then + begin + + CopierRoute1.Enabled:=true; + end; + + // valider menu coller + if (RouteCopie.IdTrain<>0) then + begin + CollerRoute1.Enabled:=true; + end; + + +end; + end. diff --git a/UnitTCO.pas b/UnitTCO.pas index 824ffa2..0f3da47 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -2488,7 +2488,7 @@ begin closefile(fichier); renseigne_tous_cantons; trier_cantons; - + affecte_trains_config; sauve_styles_tco(indexTCO); // sauver le jeu sombre if jeucouleurs=2 then jeu_clair(indexTCO); diff --git a/verif_version.pas b/verif_version.pas index f768a26..bdcd602 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -26,7 +26,7 @@ var f : textFile; Const -VersionSC = '10.75'; // sert à la comparaison de la version publiée +VersionSC = '10.76'; // sert à la comparaison de la version publiée SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace // pour unzip SHCONTCH_NOPROGRESSBOX=4;