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