This commit is contained in:
f1iwq2
2025-10-26 09:50:37 +01:00
parent f053df40f9
commit e1c2f6b40c
13 changed files with 214 additions and 87 deletions
+1 -1
View File
@@ -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;
+1 -1
View File
@@ -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
+11 -11
View File
@@ -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
+9 -8
View File
@@ -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
+1 -1
View File
@@ -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
+4 -4
View File
@@ -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;
+23 -20
View File
@@ -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
+46 -31
View File
@@ -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';
+2 -2
View File
@@ -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;
+15 -1
View File
@@ -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
+99 -5
View File
@@ -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 (IrPref<ListBoxRM.Count) then
begin
inc(IrPref);
@@ -1029,5 +1050,78 @@ begin
trains[indexTrainFR].route[0].talon:=checkBoxSens.checked;
end;
procedure TFormRouteTrain.Copierroute1Click(Sender: TObject);
var i : integer;
begin
i:=ListBoxRM.ItemIndex;
if i<0 then exit;
RouteCopie.IdTrain:=ComboBoxTrains.ItemIndex+1;
RouteCopie.IdRoute:=i+1;
//Affiche('IdTrain='+intToSTR(ROuteCopie.IdTrain)+' IdRoute='+intToSTR(ROuteCopie.IdROute),clYellow);
end;
procedure TFormRouteTrain.Collerroute1Click(Sender: TObject);
var i,n,id,IdTrainDest,nDest : integer;
ok : boolean;
s : string;
begin
IdTrainDest:=ComboBoxTrains.ItemIndex+1;
nDest:=Trains[IdTrainDest].routePref[0,0].adresse;
if nDest>30 then exit;
// vérifier si une des routes du train de destination a la même id que la route qu'on veut coller
ok:=true;
n:=Trains[RouteCopie.IdTrain].routePref[0,0].adresse; // nombre de routes du train copié (route source)
id:=Trains[RouteCopie.IdTrain].routePref[RouteCopie.IdRoute,0].pos; // ID de la route du train copié
IdTrainDest:=ComboBoxTrains.ItemIndex+1;
i:=1;
while (i<=n) and ok do
begin
ok:=Trains[IdTrainDest].routePref[i,0].pos<>Id; // 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.
+1 -1
View File
@@ -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);
+1 -1
View File
@@ -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;