This commit is contained in:
f1iwq2
2025-09-28 09:52:09 +02:00
parent aad2526b3d
commit f053df40f9
9 changed files with 344 additions and 543 deletions
+89 -89
View File
@@ -1573,7 +1573,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 633
Height = 505
ActivePage = TabSheetActions
ActivePage = TabSheetSig
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
@@ -1638,7 +1638,6 @@ object FormConfig: TFormConfig
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = '123'
end
object ButtonPFCDM: TButton
Left = 16
@@ -2098,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 = 0
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 0
@@ -2295,10 +2294,10 @@ object FormConfig: TFormConfig
BevelInner = bvLowered
BevelKind = bkFlat
Lines.Strings = (
'3. Valeur maximale par tranche de 100 ms qui d'#233'finit le temps '
'd'#39'attente de la r'#233'ponse de l'#39'interface apr'#232's '
'une trame qui lui est transf'#233'r'#233'e. Cette valeur est '#224' tester en '
'fonction de votre interface. '
'3. Valeur maximale par tranche de 50 ms qui d'#233'finit le temps '
'd'#39'attente de la r'#233'ponse de l'#39'interface apr'#232's une trame qui lui '
'est transf'#233'r'#233'e. Cette valeur est '#224' tester en fonction de votre '
'interface. '
'En cas de d'#233'passement de la valeur, un message '#171' pas de '
'r'#233'ponse de l'#39'interface '#187' sera affich'#233'.')
ReadOnly = True
@@ -3140,21 +3139,6 @@ object FormConfig: TFormConfig
object TabSheetSig: TTabSheet
Caption = 'Signaux'
ImageIndex = 4
object Label15: TLabel
Left = 0
Top = 8
Width = 531
Height = 13
Caption =
'Liste de mod'#233'lisation des signaux - cliquez sur une ligne pour a' +
'fficher la description du signal'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label35: TLabel
Left = 72
Top = 436
@@ -3164,14 +3148,14 @@ object FormConfig: TFormConfig
end
object GroupBox12: TGroupBox
Left = 328
Top = 24
Top = 8
Width = 297
Height = 449
Height = 465
Caption = 'Description du signal'
TabOrder = 0
object ImageSignal: TImage
Left = 8
Top = 48
Top = 64
Width = 81
Height = 105
end
@@ -3190,30 +3174,30 @@ object FormConfig: TFormConfig
end
object LabelDec: TLabel
Left = 92
Top = 52
Top = 76
Width = 53
Height = 13
Caption = 'D'#233'codeur: '
end
object LabelDetAss: TLabel
Left = 96
Top = 104
Top = 120
Width = 86
Height = 13
Caption = 'D'#233'tecteur associ'#233
end
object LabelElSuiv: TLabel
Left = 192
Top = 104
Top = 120
Width = 75
Height = 13
Caption = 'Element suivant'
end
object Label17: TLabel
Left = 8
Top = 326
Width = 115
Height = 52
Top = 344
Width = 128
Height = 39
Hint =
'Permet d'#39'afficher un carr'#233' si les aiguillages sont dans les posi' +
'tions d'#233'crites ci dessous'
@@ -3225,8 +3209,8 @@ object FormConfig: TFormConfig
WordWrap = True
end
object Label24: TLabel
Left = 104
Top = 124
Left = 120
Top = 140
Width = 8
Height = 13
Caption = '1'
@@ -3238,8 +3222,8 @@ object FormConfig: TFormConfig
ParentFont = False
end
object Label25: TLabel
Left = 104
Top = 148
Left = 120
Top = 164
Width = 8
Height = 13
Caption = '2'
@@ -3251,8 +3235,8 @@ object FormConfig: TFormConfig
ParentFont = False
end
object Label26: TLabel
Left = 104
Top = 172
Left = 120
Top = 188
Width = 8
Height = 13
Caption = '3'
@@ -3264,8 +3248,8 @@ object FormConfig: TFormConfig
ParentFont = False
end
object Label27: TLabel
Left = 104
Top = 196
Left = 120
Top = 212
Width = 8
Height = 13
Caption = '4'
@@ -3278,22 +3262,22 @@ object FormConfig: TFormConfig
end
object Label33: TLabel
Left = 104
Top = 76
Top = 100
Width = 36
Height = 13
Caption = 'Aspect:'
end
object LabelUni: TLabel
Left = 8
Top = 176
Top = 200
Width = 72
Height = 13
Caption = 'Spec Unisemaf'
Visible = False
end
object Label43: TLabel
Left = 48
Top = 160
Left = 72
Top = 176
Width = 38
Height = 16
Caption = 'Voies:'
@@ -3306,8 +3290,8 @@ object FormConfig: TFormConfig
end
object Label69: TLabel
Left = 152
Top = 326
Width = 107
Top = 350
Width = 122
Height = 39
Hint =
'Permet d'#39'afficher un feu blanc si les aiguillages sont dans les ' +
@@ -3318,11 +3302,19 @@ object FormConfig: TFormConfig
ShowHint = True
WordWrap = True
end
object Label15: TLabel
Left = 56
Top = 44
Width = 171
Height = 13
Caption = 'Temporisation commandes (x100mx)'
WordWrap = True
end
object MemoCarre: TMemo
Left = 8
Top = 368
Top = 392
Width = 137
Height = 73
Height = 65
Hint =
'Une ligne contient les conditions en ET. Les lignes sont cha'#238'n'#233'e' +
's en OU'
@@ -3336,17 +3328,17 @@ object FormConfig: TFormConfig
end
object ComboBoxDec: TComboBox
Left = 144
Top = 48
Top = 72
Width = 137
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 1
OnChange = ComboBoxDecChange
end
object EditDet1: TEdit
Left = 136
Top = 120
Top = 136
Width = 41
Height = 21
Hint = 'D'#233'tecteur 1 (obligatoire) associ'#233' au signal'
@@ -3357,7 +3349,7 @@ object FormConfig: TFormConfig
end
object EditSuiv1: TEdit
Left = 200
Top = 120
Top = 136
Width = 41
Height = 21
Hint =
@@ -3370,7 +3362,7 @@ object FormConfig: TFormConfig
end
object EditDet2: TEdit
Left = 136
Top = 144
Top = 160
Width = 41
Height = 21
Hint = 'D'#233'tecteur 2 (optionnel) associ'#233' au signal'
@@ -3381,7 +3373,7 @@ object FormConfig: TFormConfig
end
object EditSuiv2: TEdit
Left = 200
Top = 144
Top = 160
Width = 41
Height = 21
Hint =
@@ -3394,7 +3386,7 @@ object FormConfig: TFormConfig
end
object EditDet3: TEdit
Left = 136
Top = 168
Top = 184
Width = 41
Height = 21
Hint = 'D'#233'tecteur 3 (optionnel) associ'#233' au signal'
@@ -3405,7 +3397,7 @@ object FormConfig: TFormConfig
end
object EditSuiv3: TEdit
Left = 200
Top = 168
Top = 184
Width = 41
Height = 21
Hint =
@@ -3418,7 +3410,7 @@ object FormConfig: TFormConfig
end
object EditDet4: TEdit
Left = 136
Top = 192
Top = 208
Width = 41
Height = 21
Hint = 'D'#233'tecteur 4 (optionnel) associ'#233' au signal'
@@ -3429,7 +3421,7 @@ object FormConfig: TFormConfig
end
object EditSuiv4: TEdit
Left = 200
Top = 192
Top = 208
Width = 41
Height = 21
Hint =
@@ -3442,7 +3434,7 @@ object FormConfig: TFormConfig
end
object CheckVerrouCarre: TCheckBox
Left = 136
Top = 216
Top = 240
Width = 137
Height = 17
Hint =
@@ -3467,17 +3459,17 @@ object FormConfig: TFormConfig
end
object ComboBoxAsp: TComboBox
Left = 144
Top = 72
Top = 96
Width = 137
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxAspChange
end
object EditSpecUni: TEdit
Left = 8
Top = 192
Top = 216
Width = 33
Height = 21
TabOrder = 14
@@ -3485,8 +3477,8 @@ object FormConfig: TFormConfig
OnChange = EditSpecUniChange
end
object Buttonrestaure: TButton
Left = 24
Top = 272
Left = 32
Top = 288
Width = 75
Height = 25
Hint = 'Restaure la configuration du feu d'#39'avant sa modification'
@@ -3498,7 +3490,7 @@ object FormConfig: TFormConfig
end
object CheckBoxFB: TCheckBox
Left = 136
Top = 264
Top = 288
Width = 153
Height = 17
Caption = 'Avec demande feu blanc'
@@ -3506,8 +3498,8 @@ object FormConfig: TFormConfig
OnClick = CheckBoxFBClick
end
object ButtonConfigSR: TButton
Left = 24
Top = 296
Left = 32
Top = 312
Width = 75
Height = 25
Caption = 'Configuration'
@@ -3517,7 +3509,7 @@ object FormConfig: TFormConfig
end
object CheckFVC: TCheckBox
Left = 136
Top = 232
Top = 256
Width = 121
Height = 17
Hint = 'Remplace le feu vert par un feu vert clignotant'
@@ -3529,7 +3521,7 @@ object FormConfig: TFormConfig
end
object CheckFRC: TCheckBox
Left = 136
Top = 248
Top = 272
Width = 129
Height = 17
Hint = 'Remplace le s'#233'maphore par un feu rouge clignotant'
@@ -3541,7 +3533,7 @@ object FormConfig: TFormConfig
end
object CheckBoxVersContrevoie: TCheckBox
Left = 136
Top = 280
Top = 304
Width = 137
Height = 17
Hint = 'Permet d'#39'afficher le chevron si l'#39'aiguillage du signal est devi'#233
@@ -3553,7 +3545,7 @@ object FormConfig: TFormConfig
end
object CheckBoxContreVoie: TCheckBox
Left = 136
Top = 296
Top = 320
Width = 129
Height = 17
Hint = 'Signal clignotant'
@@ -3565,9 +3557,9 @@ object FormConfig: TFormConfig
end
object MemoBlanc: TMemo
Left = 152
Top = 368
Top = 392
Width = 129
Height = 73
Height = 65
Hint =
'Une ligne contient les conditions en ET. Les lignes sont cha'#238'n'#233'e' +
's en OU'
@@ -3579,8 +3571,8 @@ object FormConfig: TFormConfig
OnChange = MemoBlancChange
end
object RadioGroupLEB: TRadioGroup
Left = 8
Top = 224
Left = 16
Top = 248
Width = 113
Height = 41
Caption = 'Pilotage'
@@ -3593,10 +3585,18 @@ object FormConfig: TFormConfig
Visible = False
OnClick = RadioGroupLEBClick
end
object EditTempoSig: TEdit
Left = 240
Top = 40
Width = 33
Height = 21
TabOrder = 23
OnChange = EditTempoSigChange
end
end
object ButtonNouvSig: TButton
Left = 0
Top = 32
Top = 16
Width = 65
Height = 17
Caption = 'Nouveau'
@@ -3605,7 +3605,7 @@ object FormConfig: TFormConfig
end
object ButtonSupSig: TButton
Left = 72
Top = 32
Top = 16
Width = 65
Height = 17
Caption = 'Supprime'
@@ -3614,7 +3614,7 @@ object FormConfig: TFormConfig
end
object ButtonInsSig: TButton
Left = 144
Top = 32
Top = 16
Width = 153
Height = 17
Caption = 'Ajouter le signal supprim'#233
@@ -3642,7 +3642,7 @@ object FormConfig: TFormConfig
end
object ListBoxSig: TListBox
Left = 0
Top = 56
Top = 48
Width = 321
Height = 337
Color = clBlack
@@ -3779,7 +3779,7 @@ object FormConfig: TFormConfig
Top = 56
Width = 193
Height = 21
ItemHeight = 0
ItemHeight = 13
TabOrder = 0
OnChange = ComboBoxDecodeurPersoChange
end
@@ -3798,7 +3798,7 @@ object FormConfig: TFormConfig
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxNationChange
end
@@ -3844,7 +3844,7 @@ object FormConfig: TFormConfig
Width = 193
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 6
OnChange = ComboBoxDecCdeChange
end
@@ -4057,7 +4057,7 @@ object FormConfig: TFormConfig
Top = 96
Width = 137
Height = 21
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxOperateurChange
OnDrawItem = ComboBoxOperateurDrawItem
@@ -4077,7 +4077,7 @@ object FormConfig: TFormConfig
Top = 96
Width = 161
Height = 21
ItemHeight = 0
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 4
@@ -4189,7 +4189,7 @@ object FormConfig: TFormConfig
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
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 = 0
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 10
@@ -5099,7 +5099,7 @@ object FormConfig: TFormConfig
Top = 16
Width = 337
Height = 457
ActivePage = TabSheet1
ActivePage = TtabSheetEt
TabOrder = 3
object TabSheetTrGen: TTabSheet
Caption = 'G'#233'n'#233'ral'
@@ -6313,7 +6313,7 @@ object FormConfig: TFormConfig
end
object GroupBoxBR: TGroupBox
Left = 312
Top = 176
Top = 120
Width = 260
Height = 121
Caption = 'Bouton rotatif'
@@ -6389,7 +6389,7 @@ object FormConfig: TFormConfig
end
object GroupBoxBt: TGroupBox
Left = 312
Top = 320
Top = 224
Width = 260
Height = 121
Caption = 'Bouton'
@@ -6466,7 +6466,7 @@ object FormConfig: TFormConfig
Width = 153
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 0
OnChange = ComboBoxUSBTrChange
end
+89 -47
View File
@@ -73,7 +73,6 @@ type
TabSheetBranches: TTabSheet;
Label14: TLabel;
TabSheetSig: TTabSheet;
Label15: TLabel;
TabSheetPN: TTabSheet;
CheckBoxSrvSig: TCheckBox;
Memo1: TMemo;
@@ -511,6 +510,8 @@ type
Label84: TLabel;
LabelTitreTrain: TLabel;
LabeledEditZone: TLabeledEdit;
EditTempoSig: TEdit;
Label15: TLabel;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton;
@@ -810,6 +811,7 @@ type
procedure LabeledEditVit2Change(Sender: TObject);
procedure LabeledEditVit3Change(Sender: TObject);
procedure LabeledEditZoneChange(Sender: TObject);
procedure EditTempoSigChange(Sender: TObject);
private
{ Déclarations privées }
@@ -1066,6 +1068,7 @@ procedure ComboBoxFL_mizajour;
procedure clic_BRM;
function crans_to_Vrcms(v,idTrain : integer) : single;
procedure courbe_train(indexTrain : integer);
procedure cree_icone_train(i : integer);
implementation
@@ -1580,6 +1583,9 @@ begin
end;
end;
// tempo de retard au pilotage
s:=s+',T'+intToSTR(Signaux[i].Tempo);
encode_signal:=s;
end;
@@ -1623,6 +1629,7 @@ begin
begin
inc(NbreSignaux);
Signaux[i].adresse:=adresse;
Signaux[i].Tempo:=0;
tablo_Index_Signal[adresse]:=i; // stocker l'index provisoire avant tri
j:=pos(',',s);
if j>1 then
@@ -1970,7 +1977,6 @@ begin
val(s,j,erreur);
delete(s,1,erreur);
Signaux[i].na:=j;
end;
end;
@@ -1994,11 +2000,18 @@ begin
if (j<0) or (j>5) then
begin
j:=5;affiche('Paramètre NA incorrect dans ligne '+chaine_signal,clred)
end;
Signaux[i].na:=j;
end;
end;
end;
end;
Signaux[i].na:=j;
end;
end;
if length(s)>1 then if s[1]='T' then
begin
delete(s,1,1);
val(s,j,erreur);
delete(s,1,erreur);
signaux[i].Tempo:=j;
end;
end;
end;
end;
end;
@@ -3090,6 +3103,21 @@ begin
result:=s;
end;
procedure cree_icone_train(i : integer);
begin
Trains[i].icone:=Timage.create(nil);
with Trains[i].icone do
begin
autosize:=true;
align:=alNone;
parent:=nil;
name:='IconeTrain'+intToSTR(i);
top:=0;left:=0;
width:=200;
height:=100;
end;
end;
// génère les informations calculées
procedure genere_informations_BD;
begin
@@ -4495,7 +4523,9 @@ const LessThanValue=-1;
if i<>0 then
begin
delete(s,i,1);
val(s,trains[ntrains].vitnominale,erreur);
val(s,i,erreur);
if i=0 then i:=trains[ntrains].vitMax;
trains[ntrains].vitnominale:=i;
delete(s,1,erreur-1);
end;
@@ -4503,7 +4533,9 @@ const LessThanValue=-1;
if i<>0 then
begin
delete(s,i,1);
val(s,trains[ntrains].vitralenti,erreur);
val(s,i,erreur);
if i=0 then i:=trains[ntrains].vitnominale div 2;
trains[ntrains].vitralenti:=i;
delete(s,1,erreur-1);
end;
@@ -4514,18 +4546,7 @@ const LessThanValue=-1;
i:=pos(',',s);
if i=0 then i:=length(s)+1;
trains[ntrains].NomIcone:=copy(s,1,i-1);
Trains[ntrains].icone:=Timage.create(nil);
with Trains[ntrains].icone do
begin
autosize:=true;
align:=alNone;
parent:=nil;
name:='IconeTrain'+intToSTR(nTrains);
top:=0;left:=0;
width:=200;
height:=100;
end;
cree_icone_train(ntrains);
Formprinc.ComboTrains.Items.Add(trains[ntrains].nom_train);
delete(s,1,i-1);
@@ -6633,6 +6654,8 @@ begin
Signal_Sauve:=Signaux[index]; // sauvegarde
formconfig.listBoxSig.itemIndex:=index-1;
formconfig.listBoxSig.Selected[index-1]:=true;
AncLigneClicSig:=ligneclicSig;
ligneClicSig:=index-1;
@@ -7356,6 +7379,9 @@ begin
end;
ButtonRdt.Caption:=s;
ListBoxTrains.ItemIndex:=index-1;
ListBoxTrains.selected[index-1]:=true;
editNomTrain.text:=Trains[index].nom_train;
LabelTitreTrain.Caption:=Trains[index].nom_train;
editAdresseTrain.Text:=intToSTR(trains[index].adresse);
@@ -7798,18 +7824,22 @@ begin
end
else Affiche('Le fichier icône train '+s+' n''a pas été trouvé',clred);
end;
cree_image_train(i);
cree_image_onglet_train(i);
end;
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)';
labeledEditVit3.Hint:='Vitesse en crans du coefficient V3'+#13+'(vitesse rapide)';
with StringGridArr do
begin
Hint:='-';
ShowHint:=true;
ColCount:=4; // nombre de colonnes
RowCount:=NbDetArret+1;
Options := StringGridArr.Options + [goEditing];
Options:=StringGridArr.Options + [goEditing]; // autorise la modification de la stringGrid
ColWidths[0]:=0; // colonne grise invisible
ColWidths[1]:=round(70/RedFonte); // Précédent
ColWidths[2]:=round(70/RedFonte); // détecteur
@@ -7820,7 +7850,7 @@ begin
Cells[3,0]:='Temps (s)';
for i:=0 to RowCount-1 do
RowHeights[i]:=18;
end;
end;
{$IF CompilerVersion >= 28.0}
labelD12.Visible:=true;
@@ -8472,6 +8502,10 @@ begin
begin
ComboBoxDec.items.add(decodeur[i-1]);
end;
EditTempoSig.Hint:='Temporisation de retard de l''affichage en dixièmes de secondes.'+#13+
'Ne fonctionne qu''en mode de pilotage asynchrone.'+#13+
'Voir paramètres avancés / pilotage des accessoires.';
EditTempoSig.ShowHint:=true;
// décodeurs personalisés
for i:=1 to NbreDecPers do
@@ -9257,6 +9291,7 @@ begin
if decodeur<>4 then RadioGroupLEB.Visible:=false;
// plus tard !! if decodeur>=11 then ButtonConfigSR.Visible:=true;
editTempoSig.Text:=intToSTR(signaux[index].Tempo);
case d of
2 : ComboBoxAsp.ItemIndex:=0;
@@ -10127,6 +10162,26 @@ begin
if affevt then Affiche('Evt ComboBox Decodeur',clOrange);
end;
procedure TFormConfig.EditTempoSigChange(Sender: TObject);
var s : string;
i,erreur : integer;
begin
if clicliste or (ligneClicSig<0) then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then
with Formconfig do
begin
s:=EditTempoSig.Text;
Val(s,i,erreur);
if (s='') or (erreur<>0) or (i<0) then begin LabelInfo.caption:='Erreur temporisation signal ';exit;end;
LabelInfo.caption:=' ';
Signaux[ligneClicSig+1].Tempo:=i;
s:=encode_signal(ligneClicSig+1);
ListBoxSig.Items[ligneClicSig]:=s;
Signaux[ligneClicSig+1].modifie:=true;
ListBoxSig.selected[ligneClicSig]:=true;
end;
end;
procedure TFormConfig.EditDet1Change(Sender: TObject);
var s : string;
@@ -11209,6 +11264,7 @@ begin
Signaux[i].SR[8].sortie0:=19;
Signaux[i].SR[8].sortie1:=0;
Signaux[i].Na:=4;
Signaux[i].Tempo:=0;
cree_image_signal(i);
s:=encode_signal(i);
@@ -11301,12 +11357,13 @@ begin
Parent:=Formprinc.ScrollBoxSig; // dire que l'image est dans la scrollBox1
Top:=(HtImg+espY+20)*((j-1) div NbreImagePLigne); // détermine les points d'origine
Left:=10+ (LargImg+5)*((j-1) mod (NbreImagePLigne));
Name:='ImageSignal'+IntToSTR(Signaux[j].adresse);
Name:='ImageSignal'+IntToSTR(j);
Maj_Hint_Signal(j);
end;
with Signaux[j].Lbl do
begin
Name:='LabelSignal'+intToSTR(j);
Top:=HtImg+((HtImg+EspY+20)*((j-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((j-1) mod (NbreImagePLigne));
caption:='@'+IntToSTR(Signaux[j].adresse);
@@ -11314,7 +11371,7 @@ begin
if Signaux[j].checkFB<>nil then
with Signaux[j].CheckFB do
begin
Name:='CheckBoxFB'+intToSTR(Signaux[j].adresse);
Name:='CheckBoxFB'+intToSTR(j);
Hint:='Feu blanc';
Top:=HtImg+15+((HtImg+EspY+20)*((j-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((j-1) mod (NbreImagePLigne));
@@ -14433,20 +14490,10 @@ begin
VitNominale:=60;
VitRalenti:=40;
vitmax:=120;
icone:=Timage.create(nil);
with icone do
begin
Name:='IconeTrain'+intToSTR(nTrains);
autosize:=true;
align:=alNone;
parent:=nil;
top:=0;left:=0;
width:=200;
height:=100;
end;
end;
clicListeTrains(ntrains);
cree_icone_train(nTrains);
ligneclicTrain:=ntrains-1;
clicListe:=false;
@@ -14463,7 +14510,8 @@ begin
perform(WM_VSCROLL,SB_BOTTOM,0);
end;
cree_image_Train(ntrains);
clicListeTrains(ntrains);
cree_image_onglet_Train(ntrains);
// ajoute le compteur
cree_GB_compteur(ntrains);
@@ -16550,9 +16598,6 @@ begin
if clicproprietesSig then clicListeSignal(IndexSignalClic);
clicproprietesSig:=false;
if clicproprietesTrains then clicListeTrains(ligneclicTrain+1);
clicproprietesTrains:=false;
// aiguillages
ListBoxAig.Clear;
@@ -16584,6 +16629,8 @@ begin
clear;
for i:=1 to ntrains do items.Add(encode_train(i));
end;
if clicproprietesTrains then clicListeTrains(ligneclicTrain+1);
clicproprietesTrains:=false;
tsbouton:=FormConfig.PageControl.ActivePage=TabSheetBouton;
@@ -19672,7 +19719,6 @@ begin
caption:=intToSTR(ValVitTrain[i]);
end;
end;
procedure TFormConfig.LabeledEditVit1Change(Sender: TObject);
@@ -19742,10 +19788,6 @@ begin
calcul_equations_coeff(ligneclicTrain+1);
end;
end.
+17 -16
View File
@@ -32,6 +32,7 @@ object FormDebug: TFormDebug
Width = 872
Height = 677
HorzScrollBar.Visible = False
VertScrollBar.Position = 96
Anchors = [akLeft, akTop, akRight, akBottom]
Color = clBtnFace
ParentColor = False
@@ -41,7 +42,7 @@ object FormDebug: TFormDebug
673)
object LabelTitreDebug: TLabel
Left = 475
Top = 8
Top = -88
Width = 131
Height = 18
Anchors = [akTop, akRight]
@@ -55,7 +56,7 @@ object FormDebug: TFormDebug
end
object Label1: TLabel
Left = 627
Top = 10
Top = -86
Width = 108
Height = 13
Anchors = [akTop, akRight]
@@ -71,7 +72,7 @@ object FormDebug: TFormDebug
end
object RichDebug: TRichEdit
Left = 0
Top = 0
Top = -96
Width = 454
Height = 753
Anchors = [akLeft, akTop, akRight]
@@ -85,7 +86,7 @@ object FormDebug: TFormDebug
end
object ButtonRazTout: TButton
Left = 465
Top = 216
Top = 120
Width = 97
Height = 25
Hint =
@@ -100,7 +101,7 @@ object FormDebug: TFormDebug
end
object ButtonCop: TButton
Left = 465
Top = 248
Top = 152
Width = 97
Height = 41
Anchors = [akTop, akRight]
@@ -117,7 +118,7 @@ object FormDebug: TFormDebug
end
object ButtonAffEvtChrono: TButton
Left = 465
Top = 296
Top = 200
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -128,7 +129,7 @@ object FormDebug: TFormDebug
end
object ButtonCherche: TButton
Left = 465
Top = 336
Top = 240
Width = 97
Height = 25
Hint = 'Cherche la cha'#238'ne "erreur"'
@@ -141,7 +142,7 @@ object FormDebug: TFormDebug
end
object ButtonEcrLog: TButton
Left = 465
Top = 184
Top = 88
Width = 97
Height = 29
Anchors = [akTop, akRight]
@@ -151,7 +152,7 @@ object FormDebug: TFormDebug
end
object ButtonRazTampon: TButton
Left = 465
Top = 368
Top = 272
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -162,7 +163,7 @@ object FormDebug: TFormDebug
end
object ButtonRazLog: TButton
Left = 465
Top = 408
Top = 312
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -173,7 +174,7 @@ object FormDebug: TFormDebug
end
object MemoEvtDet: TRichEdit
Left = 570
Top = 186
Top = 90
Width = 272
Height = 263
Anchors = [akTop, akRight]
@@ -184,7 +185,7 @@ object FormDebug: TFormDebug
end
object GroupBox5: TGroupBox
Left = 462
Top = 456
Top = 360
Width = 380
Height = 57
Anchors = [akTop, akRight]
@@ -251,7 +252,7 @@ object FormDebug: TFormDebug
end
object GroupBox6: TGroupBox
Left = 462
Top = 520
Top = 424
Width = 380
Height = 52
Anchors = [akTop, akRight]
@@ -328,7 +329,7 @@ object FormDebug: TFormDebug
end
object GroupBoxPrim: TGroupBox
Left = 464
Top = 584
Top = 488
Width = 378
Height = 185
Anchors = [akTop, akRight]
@@ -499,7 +500,7 @@ object FormDebug: TFormDebug
end
object GroupBox2: TGroupBox
Left = 466
Top = 28
Top = -68
Width = 376
Height = 149
Anchors = [akTop, akRight]
@@ -712,7 +713,7 @@ object FormDebug: TFormDebug
end
object EditNivDebug: TEdit
Left = 751
Top = 8
Top = -88
Width = 49
Height = 21
Anchors = [akTop, akRight]
+10 -10
View File
@@ -1,11 +1,11 @@
object FormPrinc: TFormPrinc
Left = -8
Top = -8
Left = 330
Top = 216
Anchors = [akLeft, akTop, akRight]
BorderStyle = bsNone
Caption = 'Signaux complexes'
ClientHeight = 942
ClientWidth = 1280
ClientHeight = 513
ClientWidth = 915
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -23,8 +23,8 @@ object FormPrinc: TFormPrinc
OnKeyDown = FormKeyDown
OnResize = FormResize
DesignSize = (
1280
942)
915
513)
PixelsPerInch = 96
TextHeight = 13
object LabelTitre: TLabel
@@ -1432,7 +1432,7 @@ object FormPrinc: TFormPrinc
Visible = False
end
object LabelClock: TLabel
Left = 1188
Left = 823
Top = 0
Width = 85
Height = 22
@@ -5443,8 +5443,8 @@ object FormPrinc: TFormPrinc
end
object StatusBar1: TStatusBar
Left = 0
Top = 920
Width = 1280
Top = 491
Width = 915
Height = 22
Panels = <
item
@@ -5963,7 +5963,7 @@ object FormPrinc: TFormPrinc
Top = 200
Width = 393
Height = 265
ActivePage = TabSheetComp
ActivePage = TabSheetSig
Anchors = []
TabOrder = 5
OnChange = PageControlChange
+77 -355
View File
@@ -4,12 +4,14 @@ unit Unitprinc;
Programme signaux complexes Graphique Lenz
Composants ClientSocket et ServeurSocket pour les connexions réseau socket
--------------------------------------------------------------
Delphi 7 :
on utilise activeX Tmscomm pour les liaisons série/USB
--------------------------------------------------------------
Delphi 12 :
Dans Outils / Options / Interface utilisateurs / Concerpteur de fiches / Haute résolution
Sélextionner Automatique (PPI de l'écran) et cocher "taille de la grille..."
Sélectionner Automatique (PPI de l'écran) et cocher "taille de la grille..."
on utilise AsyncPro pour les liaisons série/USB - ce composant est compilable en 32 et en 64 bits.
https://github.com/TurboPack/AsyncPro
@@ -28,8 +30,7 @@ unit Unitprinc;
LnsQueue.pas
OoMisc.pas
un essai avec IdTCPClient (Indy) a été fait avec D7/D12. En D7 nécéssite le fichier Idtcpclient.dcu.
En D12 l'event Rx nécessite un thread et ne fonctionne pas bien. C'est ok en D7.
-------------------------------------------------
Options de compilation D7: options du debugger/exception du langage : décocher "arreter sur exceptions delphi"
sinon une exception surgira au moment de l'ouverture du com
@@ -91,8 +92,6 @@ unit Unitprinc;
//{$D-} // pas d'information de debuggage : pas de débug possible
//{$L-} // pas d'information sur les symboles locaux
{$DEFINE xAvecIdTCP} // le composant IdTCPClient n'a pas d'evt receive, il faut le traiter dans un thread
// il ne marche pas bien en version D12, l'évent RX provoque une violation au démarrage puis plus rien
interface
uses
@@ -103,10 +102,6 @@ uses
, psAPI // GetModuleFileNameEx
{$IFDEF AvecIdTCP}
,IdTCPClient // client socket indy , ne marche pas bien
{$ENDIF}
{$IF CompilerVersion >= 28.0} // si delphi>=12
,Vcl.Themes // pour les thèmes d'affichage (auric etc)
,Vcl.Styles.Ext // styles étendus
@@ -476,105 +471,10 @@ type
{$IF CompilerVersion >= 28.0}
procedure DataReceived(const Data: TidBytes);
{$ELSE}
procedure DataReceived(const Data: string); // réception interface socket indy
procedure DataReceived(const Data: string);
{$IFEND}
end;
{$IFDEF AvecIdTCP}
{$IF CompilerVersion >= 28.0}
// thread interface socket Indy D12, pour créer event en réception
TDataEventInterface=procedure(const Data: TidBytes) of object;
TreadingThreadInterface=class(TThread)
private
FClient: TIdTCPClient;
Fdata : Tidbytes;
FOnData: TDataEventInterface;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient); reintroduce;
property OnData: TDataEventInterface read FOnData write FOnData;
procedure DataReceived;
end;
// thread périphérique1 D12 socket Indy
TDataEventPeriph1=procedure(const Data: TidBytes) of object;
TreadingThreadPeriph1=class(TThread)
private
FClient: TIdTCPClient;
Fdata : Tidbytes;
FOnData: TDataEventPeriph1;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient); reintroduce;
property OnData: TDataEventPeriph1 read FOnData write FOnData;
procedure DataReceived;
end;
// thread périphérique2 D12 socket Indy
TDataEventPeriph2=procedure(const Data: TidBytes) of object;
TreadingThreadPeriph2=class(TThread)
private
FClient: TIdTCPClient;
Fdata : Tidbytes;
FOnData: TDataEventPeriph2;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient); reintroduce;
property OnData: TDataEventPeriph2 read FOnData write FOnData;
procedure DataReceived;
end;
{$ELSE}
// Thread interface Indy D7
TDataEventInterface=procedure(const Data: string) of object;
TreadingThreadInterface=class(TThread)
private
FClient: TIdTCPClient;
FData: string;
FOnData: TDataEventInterface;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient); reintroduce;
property OnData: TDataEventInterface read FOnData write FOnData;
procedure DataReceived;
end;
// Thread périph1 Indy D7
TDataEventPeriph1=procedure(const Data: string) of object;
TreadingThreadPeriph1=class(TThread)
private
FClient: TIdTCPClient;
FData: string;
FOnData: TDataEventPeriph1;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient); reintroduce;
property OnData: TDataEventPeriph1 read FOnData write FOnData;
procedure DataReceived;
end;
// Thread périph2 Indy D7
TDataEventPeriph2=procedure(const Data: string) of object;
TreadingThreadPeriph2=class(TThread)
private
FClient: TIdTCPClient;
FData: string;
FOnData: TDataEventPeriph2;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient); reintroduce;
property OnData: TDataEventPeriph2 read FOnData write FOnData;
procedure DataReceived;
end;
{$IFEND}
{$ENDIF}
const
titre='Signaux complexes GL ';
@@ -881,6 +781,7 @@ TSignal = record
end;
Na : integer; // nombre d'adresses du signal occupées par le décodeur CDF/SR/digikeijs/Belge
DetAmont : TtabloDet; // tableau des détecteurs amonts, calculés à la lecture du fichier de config
Tempo : integer; // temporisation de retard au pilotage en x100 ms
end;
TPeripherique = record
@@ -1059,7 +960,7 @@ tTrain = record
end;
Ttache = array[1..MaxTaches] of record
Ttache = record
typeTache : integer ; // 0:rien - 1:accessoire 2:vitesse train 3:fonction F 4:tempo
traite : boolean; // traitement en cours
tempo : integer; // tempo avant exécution de la commande
@@ -1161,10 +1062,6 @@ var
end;
Adresse_detecteur : array[0..NbMaxDet] of integer; // adresses des détecteurs par index
{$IFDEF AvecIdTCP}
clientTCPInterface: tidtcpclient;
{$ENDIF}
Ecran : array[1..10] of record // écrans du pc
x0,y0,larg,haut : integer;
end;
@@ -1174,7 +1071,7 @@ var
PortDistant,PortLocal : integer;
end;
taches : Ttache;
taches : array[1..MaxTaches] of Ttache;
Actionneur_trouve : array[1..10] of integer;
@@ -1359,12 +1256,6 @@ var
Aig_supprime,Aig_sauve : TAiguillage;
BrancheN : array[1..MaxBranches,1..MaxElBranches] of TBranche;
chaine_recue : TchaineBIN;
{$IFDEF AvecIdTCP} //-----------composant Indy
ThreadInterface : TReadingThreadInterface;
ThreadPeriph1 : TReadingThreadPeriph1;
ThreadPeriph2 : TReadingThreadPeriph2;
ClientSocketIdInterface: tIdTCPClient;
{$ENDIF}
ClientSocketInterface: TClientSocket;
ClientInfo : TclientSocket;
@@ -1409,7 +1300,7 @@ function verif_UniSemaf(adresse,UniSem : integer) : integer;
function verif_LEB(adresse,UniSem : integer) : integer;
function Select_dessin_Signal(TypeSignal : integer) : TBitmap;
procedure cree_image_signal(rang : integer);
procedure cree_image_Train(rang : integer);
procedure cree_image_onglet_Train(rang : integer);
procedure trouve_aiguillage(adresse : integer);
procedure trouve_detecteur(detecteur : integer);
function ProcessRunning(sExeName: String) : Boolean;
@@ -1507,88 +1398,6 @@ uses UnitDebug, UnitPilote, UnitSimule, UnitTCO, UnitConfig,
UnitModifAction, selection_train, UnitRouteTrains, UnitRoute, UnitMesure,
UnitCompteur;
{$IFDEF AvecIdTCP} //------ composant indy socket réseau
// création thread interface
constructor TReadingThreadInterface.Create(AClient: TIdTCPClient);
begin
inherited Create(True);
FClient:=AClient;
end;
procedure TReadingThreadInterface.Execute;
begin
while not Terminated do
begin
{$IF CompilerVersion >= 28.0}
Fclient.IOHandler.ReadBytes(Fdata,0,false);
if (FData <> nil) and Assigned(FOnData) then
{$ELSE}
FData := FClient.CurrentReadBuffer;
if (FData <> '') and Assigned(FOnData) then
{$IFEND}
Synchronize(DataReceived);
end;
end;
procedure TReadingThreadInterface.DataReceived;
begin
if Assigned(FOnData) then FOnData(FData);
end;
constructor TReadingThreadPeriph1.Create(AClient: TIdTCPClient);
begin
inherited Create(True);
FClient := AClient;
end;
// création thread périphérique1
procedure TReadingThreadPeriph1.DataReceived;
begin
if Assigned(FOnData) then FOnData(FData);
end;
procedure TReadingThreadPeriph1.Execute;
begin
while not Terminated do
begin
{$IF CompilerVersion >= 28.0}
Fclient.IOHandler.ReadBytes(Fdata,0,false);
if (FData <> nil) and Assigned(FOnData) then
{$ELSE}
FData:=FClient.CurrentReadBuffer;
if (FData <> '') and Assigned(FOnData) then
{$IFEND}
Synchronize(DataReceived);
end;
end;
// création thread périphérique2
procedure TReadingThreadPeriph2.DataReceived;
begin
if Assigned(FOnData) then FOnData(FData);
end;
constructor TReadingThreadPeriph2.Create(AClient: TIdTCPClient);
begin
inherited Create(True);
FClient := AClient;
end;
procedure TReadingThreadPeriph2.Execute;
begin
while not Terminated do
begin
{$IF CompilerVersion >= 28.0}
Fclient.IOHandler.ReadBytes(Fdata,0,false);
if (FData <> nil) and Assigned(FOnData) then
{$ELSE}
FData := FClient.CurrentReadBuffer;
if (FData <> '') and Assigned(FOnData) then
{$IFEND}
Synchronize(DataReceived);
end;
end;
{$ENDIF}
{
procedure menu_interface(MA : TMA);
@@ -2589,11 +2398,7 @@ begin
// par socket (ethernet)
if parSocketLenz or (etat_init_interface>=11) then
begin
{$IFDEF AvecIdTCP}
ClientSocketIdInterface.IoHandler.write(RawToBytes(z,l)); // RawToBytes() convertit n'importe quoi en TidBytes
{$ELSE}
ClientSocketInterface.Socket.SendBuf(z,l);
{$ENDIF}
if not modetache then sleep(30);
end;
end;
@@ -2688,11 +2493,7 @@ begin
// par socket (ethernet)
if parSocketLenz or (etat_init_interface>=11) then
begin
{$IFDEF AvecIdTCP}
ClientSocketIdInterface.Socket.Send(TrameIF[0],l);
{$ELSE}
ClientSocketInterface.Socket.SendBuf(TrameIF[0],l);
{$ENDIF}
if not modetache then Sleep(30);
end;
end;
@@ -5389,7 +5190,7 @@ begin
Signaux[rang].Lbl:=Tlabel.create(Formprinc.ScrollBoxSig);
with Signaux[rang].Lbl do
begin
Name:='LabelSignal'+intToSTR(Signaux[rang].adresse);
Name:='LabelSignal'+intToSTR(rang);
caption:=' '+IntToSTR(Signaux[rang].adresse);
font.Style:=[fsBold];
Parent:=Formprinc.ScrollBoxSig;
@@ -5409,7 +5210,7 @@ begin
begin
onClick:=formprinc.proc_checkBoxFB; // affecter l'adresse de la procédure de traitement quand on clique dessus
Hint:='Feu blanc';
Name:='CheckBoxFB'+intToSTR(adresse); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure
Name:='CheckBoxFB'+intToSTR(rang); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure
caption:='dem FB';
font.color:=clBlack;
Parent:=Formprinc.ScrollBoxSig;
@@ -5595,7 +5396,7 @@ end;
// cliqué train
procedure tFormprinc.ImageTrainonclick(Sender : tObject);
var P_component : tComponent;
i : integer;
i : integer;
begin
//Affiche('clic image train',clred);
P_component:=sender as Tcomponent;
@@ -5671,7 +5472,7 @@ end;
// créée une image dans l'onglet trains , 2 label dynamiquement dans la partie droite pour un nouveau train déclaré dans le fichier de config
// rang commence à 1
procedure cree_image_Train(rang : integer);
procedure cree_image_onglet_Train(rang : integer);
var i,adresse : integer;
s : string;
begin
@@ -5982,7 +5783,7 @@ begin
chaine_CDM_Acc:=so+s;
end;
// met une tache en tableau taches[] pour le timer
// ajoute une tache en tableau taches[] pour le timer
// ttache=1 : pilote accessoire...
// temporisation pour le timer avant action
// destinataire (1=CDM 2=XpressNet 3=Dccpp)
@@ -10003,7 +9804,7 @@ begin
end
else
begin
s:='Impossible de déterminer le passage de l''aiguillage '+intToSTR(adr);
s:='Erreur 841 : impossible de déterminer le passage de l''aiguillage '+intToSTR(adr);
if (nivDebug=3) or ProcPrinc then AfficheDebug(s,clred);
Affiche(s,clred);
result:=9999;
@@ -10254,7 +10055,8 @@ begin
(aiguillage[index2].position=const_droit) ) then
begin
// d'où vient ton sur la tjs
if BtypePrec=Aig then
// si on vient d'un aiguillage pas en pointe
if (BtypePrec=Aig) and (aiguillage[index].AdroitB<>'P') then
begin
if ( ((aiguillage[index].AdroitB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdroitB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
@@ -10323,7 +10125,8 @@ begin
end;
// d'où vient ton sur la tjd
if BtypePrec=Aig then
// si on vient d'un aiguillage pas en pointe
if (BtypePrec=Aig) and (aiguillage[index].AdroitB<>'P') then
begin
if ( ((aiguillage[index].AdroitB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdroitB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
@@ -10403,7 +10206,8 @@ begin
exit;
end;
// d'où vient t-on sur la tjd
if BtypePrec=Aig then
// si on vient d'un aiguillage pas en pointe
if (BtypePrec=Aig) and (aiguillage[index].AdevieB<>'P') then
begin
if ( ((aiguillage[index].AdevieB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdevieB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
@@ -10478,7 +10282,7 @@ begin
and (aiguillage[index2].position=const_devie) then
begin
// d'où vient ton sur la tjd
if BtypePrec=Aig then
if (BtypePrec=Aig) and (aiguillage[index].AdevieB<>'P') then
begin
if ( ((aiguillage[index].AdevieB)='S') and (aiguillage[index_aig(prec)].position=const_devie) ) or
( ((aiguillage[index].AdevieB)='D') and (aiguillage[index_aig(prec)].position=const_droit) )
@@ -11876,6 +11680,7 @@ begin
// trouver éléments avant le signal
for i:=1 to MaxParcours do tabloDet[i]:=0;
i:=index_signal(adresse);
if isDirectionnel(i) then exit;
if i=0 then
begin
affiche('Erreur 842 : signal '+intToSTR(adresse)+' inconnu',clred);
@@ -11893,6 +11698,10 @@ begin
tq2:=det;
el1:=Signaux[i].Adr_el_suiv1;
tq1:=Signaux[i].Btype_suiv1;
if el1=0 then
begin
Affiche('Erreur le signal '+intToSTR(adresse)+' ne comporte pas d''élément suivant',clred);
end;
end;
2 : begin
el2:=Signaux[i].Adr_det2;
@@ -11914,6 +11723,7 @@ begin
end;
end;
if el2<>0 then
begin
it:=0;
@@ -12729,7 +12539,7 @@ begin
sort:=false;
repeat
inc(j);
AdrSuiv:=suivant_alg3(prec,typeElPrec,actuel,typeELActuel,2); // arret sur aiguille en talon mal positionéne
AdrSuiv:=suivant_alg3(prec,typeElPrec,actuel,typeELActuel,2); // arret sur aiguille en talon mal positionnée
if (AdrSuiv=9999) or (AdrSuiv=9996) or (AdrSuiv=9995) then // élément non trouvé ou position aiguillage inconnu ou buttoir
begin;
@@ -14020,7 +13830,7 @@ begin
if AdrSuiv=0 then
begin
EtatDet:=Detecteur[actuel].etat and detect;
Pres_Train:=Pres_Train or etatDet;
Pres_Train:=Pres_Train or etatDet; // contrôle si détecteur à 1 et si mode détecteur
if Pres_Train and (adrTr=0) then
begin
if roulage then AdrTr:=Detecteur[actuel].AdrTrain;
@@ -18057,7 +17867,14 @@ var s: string;
faire_event,inv,bjd,rf : boolean;
prov,index,i,id,etatact,typ,adr : integer;
begin
if AffAigDet then Affiche('Tick='+IntToSTR(tick)+' Event Aig '+intToSTR(adresse)+'='+intToSTR(pos),clorange);
if AffAigDet then
begin
s:='Tick='+IntToSTR(tick)+' Event Aig '+intToSTR(adresse)+'='+intToSTR(pos);
if pos=const_droit then s:=s+' [droit]';
if pos=const_devie then s:=s+' [dévié]';
Affiche(s,clorange);
end;
index:=index_aig(adresse);
if index<>0 then
begin
@@ -18245,7 +18062,7 @@ end;
// pilote accessoire sous condition, version taches par le timer
function pilote_acc_sc_taches(adresse : integer;octet : byte;Acc : TAccessoire;adrTrain : integer) : boolean;
var groupe,temp,indexAig,AdrTrainLoc : integer ;
var groupe,temp,index,AdrTrainLoc : integer ;
fonction,pilotage,pilotageCDM : byte;
s : string;
begin
@@ -18256,20 +18073,21 @@ begin
exit;
end;
pilotage:=octet;
indexAig:=index_aig(adresse);
if Acc=aigP then index:=index_aig(adresse);
if acc=Signal then Index:=Index_Signal(adresse);
// test si pilotage aiguillage inversé
if (acc=aigP) then
begin
if indexAig<>0 then
if index<>0 then
begin
AdrTrainLoc:=aiguillage[indexAig].AdrTrain;
AdrTrainLoc:=aiguillage[index].AdrTrain;
if (AdrTrainLoc<>0) and (AdrTrain<>0) and (AdrTrainLoc<>AdrTrain) then
begin
Affiche('Pilotage impossible, l''aiguillage '+intToSTR(adresse)+' est réservé par le train @'+intToSTR(AdrTrainLoc),clred);
Result:=false;
exit;
end;
if (aiguillage[indexAig].inversionCDM=1) then
if (aiguillage[index].inversionCDM=1) then
begin
if octet=1 then pilotage:=2 else pilotage:=1;
end;
@@ -18287,13 +18105,13 @@ begin
s:=chaine_CDM_Acc(adresse,pilotageCDM);
// pilotage actif de l'accessoire----------------
tache(ttacheAcc,0,ttDestCDM,s); // TypeTache,tempo,destinataire,chaine
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
begin
temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; // mini pour pilotage en signaux LEB
temp:=aiguillage[index].temps;if temp=0 then temp:=4; // mini pour pilotage en signaux LEB
end;
// remise à 0 --------------
@@ -18301,7 +18119,7 @@ begin
tache(ttacheAcc,temp,ttDestCDM,s); // TypeTache,tempo,destinataire,chaine
// si l'accessoire est un aiguillage, temporiser suivant variable de séquenceent
if indexaig<>0 then tache(ttacheTempo,tempo_Aig div 100,0,'');
if index<>0 then tache(ttacheTempo,tempo_Aig div 100,0,'');
result:=true;
end;
@@ -18328,7 +18146,9 @@ begin
if debug_dec_sig and (acc=signal) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(pilotage),clorange);
//if avecAck then envoi(s) else envoi_ss_ack(s); // envoi de la trame avec/sans attente Ack
tache(ttacheAcc,0,ttDestXpressNet,s); // TypeTache,tempo,destinataire,chaine
if acc<>signal then tache(ttacheAcc,0,ttDestXpressNet,s)
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;
@@ -18336,7 +18156,7 @@ begin
// si aiguillage, faire une temporisation
if Acc=AigP then
begin
temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4;
temp:=aiguillage[index].temps;if temp=0 then temp:=4;
end;
// pilotage à 0 pour éteindre le pilotage de la bobine du relais
@@ -18346,7 +18166,7 @@ begin
//if avecAck then envoi(s) else envoi_ss_ack(s); // envoi de la trame avec ou sans Ack
tache(ttacheAcc,temp,ttDestXpressNet,s);
if indexAig<>0 then tache(ttacheTempo,tempo_Aig div 100,0,'');
if index<>0 then tache(ttacheTempo,tempo_Aig div 100,0,'');
//affiche('5.'+intToSTR(tick),clyellow);
result:=true;
@@ -18370,7 +18190,7 @@ begin
end;
end;
if indexAig<>0 then event_aig(adresse,octet)
if index<>0 then event_aig(adresse,octet)
else
// Serveur envoi au clients
Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(octet));
@@ -19635,69 +19455,12 @@ begin
begin
etat_init_interface:=10;
Affiche('Demande ouverture interface par Ethernet '+AdresseIP+':'+intToSTR(portinterface),clyellow);
{$IFDEF AvecIdTCP}
with ClientSocketIdInterface do
{$ELSE}
with ClientSocketInterface do
{$ENDIF}
begin
{$IFDEF AvecIdTCP}
port:=portInterface; // composant Indy
//ClientSocketInterface.
host:=AdresseIP;
try
{$IF CompilerVersion >= 28.0} // si delphi>=12
ConnectTimeOut:=1000;
connect;
{$ELSE}
connect(1000);
{$IFEND}
except
on e : exception do
begin
Affiche(e.message+' socket interface '+AdresseIP,clred);
exit;
end;
end;
Affiche('Socket interface connecté ',clYellow);
AfficheDebug('Socket interface connecté ',clYellow);
with formprinc do
begin
ButtonEcrCV.Enabled:=true;
ButtonLitCV.Enabled:=true;
LireunfichierdeCV1.enabled:=true;
LabelTitre.caption:=titre+' Interface connectée par Ethernet';
Formprinc.StatusBar1.Panels[4].Text:=AdresseIP;
etat_init_interface:=11;
trouve:=test_protocole; // appelle l'état des détecteurs
end;
if not trouve then
begin
Affiche('Socket connecté mais centrale muette',clred);
disconnect;
etat_init_interface:=0;
exit;
end;
if protocole=1 then
begin
etat_init_interface:=20; // interface protocole reconnue
parSocketLenz:=true;
end;
if (protocole=2) then
begin
init_dccpp;
etat_init_interface:=20;
end;
// interface ethernet connectée, faire les init
init_aig_det;
{$ELSE}
port:=portInterface;
Address:=AdresseIP; // ne pas mettre active et open en même temps, ca génère 2 evt onConnect et initialise les aig 2 fois.
Open;
{$ENDIF}
end;
//Application.processMessages;
end;
@@ -20947,7 +20710,6 @@ begin
end;
end;
// Event socket interface par indy
{$IF CompilerVersion >= 28.0}
procedure TFormPrinc.DataReceived(const Data: TidBytes);
var i,l,j,lo : integer;
@@ -21329,25 +21091,12 @@ begin
end;
if MsCommCde2<>nil then MSCommCde2.onTriggerAvail:=RecuPeriph2;
{$IFDEF AvecIdTCP}
// composant Indy Interface réseausocket en D12 : ne marche pas bien
ClientSocketIdInterface:=TIdTCPClient.Create(self);
try
ThreadInterface:=TReadingThreadInterface.Create(ClientSocketIdInterface);
ThreadInterface.OnData:=DataReceived ;
ThreadInterface.Resume;
except
ClientSocketIdInterface.Disconnect;
raise;
end;
{$ELSE}
// composant TclientSocket
ClientSocketInterface:=tClientSocket.Create(nil);
ClientSocketInterface.OnRead:=ClientSocketInterfaceRead;
ClientSocketInterface.onConnect:=ClientSocketInterfaceConnect;
ClientSocketInterface.OnDisconnect:=ClientSocketInterfaceDisconnect;
ClientSocketInterface.OnError:=ClientSocketInterfaceError;
{$ENDIF}
{$ELSE}
// D7
@@ -21366,26 +21115,12 @@ begin
Affiche(s,clred);
end;
{$IFDEF AvecIdTCP}
// D7 composant Indy Interface réseausocket
ClientSocketIdInterface:=TIdTCPClient.Create(self);
try
ThreadInterface:=TReadingThreadInterface.Create(ClientSocketIdInterface);
ThreadInterface.OnData:=DataReceived ;
ThreadInterface.Resume;
except
ClientSocketIdInterface.Disconnect;
raise;
end;
{$ELSE}
// composant TclientSocket
ClientSocketInterface:=tClientSocket.Create(nil);
ClientSocketInterface.OnRead:=ClientSocketInterfaceRead;
ClientSocketInterface.onConnect:=ClientSocketInterfaceConnect;
ClientSocketInterface.OnDisconnect:=ClientSocketInterfaceDisconnect;
ClientSocketInterface.OnError:=ClientSocketInterfaceError;
{$ENDIF}
// interface centrale - provoque l'apparition de la fenêtre "préparation de l'installation"
try MSCommUSBInterface:=TMSComm.Create(formprinc);
@@ -21930,12 +21665,7 @@ begin
end;
ServerSocket.Close;
ClientSocketCDM.close;
{$IFDEF AvecIdTCP}
ClientSocketIdInterface.Disconnect;
ClientSocketIdInterface.Free;
{$ELSE}
ClientSocketInterface.close;
{$ENDIF}
clientInfo.Close;
end;
@@ -21988,7 +21718,7 @@ begin
vitesse:=grilleHoraire[i].vitesse;
if not(grilleHoraire[i].sens) then vitesse:=-vitesse;
Affiche('Démarrage train '+train+' à l''horaire '+format('%.2dh%.2d',[heure,minute]),clyellow);
// &&& voir pour la couleur
// voir pour la couleur
FormFicheHoraire.StringGridFO.Cells[1,i]:=GrilleHoraire[i].NomTrain;
Demarre_index_train(indextrain);
@@ -22082,7 +21812,7 @@ begin
// si tempo non nulle de fin d'accessoire
if (typeTache=ttacheAcc) and (tempo<>0) then
begin
if affe then Affiche('dec tempo ',clLime);
if affe then Affiche('dec tempo='+intToSTR(tempo),clLime);
dec(tempo);
exit; // ne rien faire d'autre dans ce tour timer
end
@@ -22295,17 +22025,7 @@ begin
if TpsTimeoutSL<=0 then
begin
TpsTimeoutSL:=450; // envoyer caractère toutes les 45 secondes
// indy
{$IFDEF AvecIdTCP}
s:=' ';
{$IF CompilerVersion >= 28.0}
ClientSocketIdInterface.IoHandler.write(RawToBytes(s,1),1);
{$ELSE}
ClientSocketIdInterface.Socket.Send(s,1)
{$IFEND}
{$ELSE}
ClientSocketInterface.Socket.SendText(' ');
{$ENDIF}
end;
end;
@@ -22945,11 +22665,7 @@ begin
portCommOuvert:=false;
with formprinc do
begin
{$IFDEF AvecIdTCP}
ClientSocketIdInterface.Disconnect;
{$ELSE}
ClientSocketInterface.close;
{$ENDIF}
MenuConnecterUSB.enabled:=true;
DeConnecterUSB.enabled:=false;
ConnecterCDMRail.enabled:=true;
@@ -23008,11 +22724,7 @@ end;
procedure deconnecte_interfaceEth;
begin
{$IFDEF AvecIdTCP}
ClientSocketIdInterface.disconnect;
{$ELSE}
ClientSocketInterface.Close;
{$ENDIF}
end;
procedure TFormPrinc.MenuConnecterEthernetClick(Sender: TObject);
@@ -23221,9 +22933,7 @@ begin
// interface ethernet connectée, faire les init
init_aig_det;
end;
{$IFNDEF AvecIdTCP}
if not(trouve) then ClientSocketInterface.Close;
{$ENDIF}
end;
// CDM rail se connecte
@@ -23303,9 +23013,7 @@ begin
if pos('ACK',trame_cdm)<>0 then Ack_cdm:=true;
if (pos('DSCTRN-__END',trame_cdm)<>0) and (ntrains_CDM<>0) then
begin
//fin de la description des trains
FormPrinc.ComboTrains.Items.Clear;
// fin de la description des trains
// on remplace les trains du combo et de la base (non stockée)
// dans la même adresse que l'existante
// ne pas écraser j
@@ -23316,7 +23024,7 @@ begin
trouve:=trains[l].adresse=trains_cdm[i].adresse;
if trouve then // si l'adresse du train CDM est déja existante on copie le train CDM dans le train SC
begin
//affiche('train '+intToSTR(trains_cdm[i].adresse)+' trouvé dans l''existant',clLime);
//affiche('train '+intToSTR(trains_cdm[i].adresse)+' trouvé dans l''existant index '+intToSTR(i),clLime);
Formprinc.ComboTrains.Items.Add(trains_cdm[i].nom_train);
Trains[l].nom_train:=trains_cdm[i].nom_train;
Trains[l].adresse:=Trains_cdm[i].adresse;
@@ -23325,17 +23033,20 @@ begin
inc(l);
until (l>ntrains) or trouve;
if not(trouve) then // si pas trouvé le train dans SC, on créée le train
if not(trouve) then // si pas trouvé l'adresse du train dans SC, on créée le train
begin
inc(ntrains);
//affiche('train '+intToSTR(trains_cdm[i].adresse)+' créé',clLime);
affiche('Train @'+intToSTR(trains_cdm[i].adresse)+' '+trains_cdm[i].nom_train+' importé de CDM à l''index '+intToSTR(nTrains),clLime);
Trains[ntrains].nom_train:=trains_cdm[i].nom_train;
Trains[ntrains].adresse:=Trains_cdm[i].adresse;
Trains[ntrains].vitmax:=Trains_cdm[i].vitmax;
FormPrinc.ComboTrains.Items.Add(trains_cdm[i].nom_train);
//cree_GB_compteur(ntrains);
cree_icone_train(ntrains);
cree_image_onglet_Train(ntrains);
end;
end;
// remplir la combobox
FormPrinc.ComboTrains.Items.Clear;
for i:=1 to ntrains do FormPrinc.ComboTrains.Items.Add(trains[i].nom_train);
// vérifier si pas doublon adresse train
verif_trains;
@@ -28110,9 +27821,10 @@ end;
procedure TFormPrinc.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var i,d : integer;
begin
if (PageControl.ActivePage<>TabSheettrains) or (TempoCombo>0) or (ComboTrains.Focused) or clicComboTrain then exit;
//Affiche('FormKeyDown',clyellow);
//Affiche('FormKeyDown '+intToSTR(key),clyellow);
if (key=vk_down) and (IdTrainClic<NTrains) then
begin
Maj_icone_train(Image_Train[IdTrainClic],IdTrainClic,clWhite);
@@ -28123,6 +27835,11 @@ begin
//affiche_train_compteur;
affiche_train_compteur(1);
aiguille_compteur(1,idTrainClic,formCompteur[1]);
i:=scrollBoxTrains.VertScrollBar.Position;
d:=(IdTrainClic)*Image_Train[IdTrainClic].height;
if d>i+ScrollBoxTrains.Height then scrollBoxTrains.VertScrollBar.Position:=(idTrainClic-(ScrollBoxTrains.Height div Image_Train[IdTrainClic].height))*Image_Train[IdTrainClic].height;
key:=0;
end;
if (key=vk_up) and (IdTrainClic>1) then
@@ -28135,6 +27852,11 @@ begin
//affiche_train_compteur;
affiche_train_compteur(1);
aiguille_compteur(1,idTrainClic,formCompteur[1]);
i:=scrollBoxTrains.VertScrollBar.Position;
d:=(IdTrainClic)*Image_Train[IdTrainClic].height;
if d<=i then scrollBoxTrains.VertScrollBar.Position:=(idTrainClic-(ScrollBoxTrains.Height div Image_Train[IdTrainClic].height))*Image_Train[IdTrainClic].height;
key:=0;
end;
end;
+45 -14
View File
@@ -833,9 +833,13 @@ begin
repeat
eLc1:=canton[i].el1; teLc1:=canton[i].typ1;
eLc2:=canton[i].el2; teLc2:=canton[i].typ2;
trouve:=((elc1=el1) and (teLc1=tel1) and (elc2=el2) and (teLc2=tel2)) or
((elc2=el1) and (teLc2=tel1) and (elc1=el2) and (teLc1=tel2)) ;
// ******** modif du 20/09/2025
// il faut que les deux éléments soient présents
{trouve:=((elc1=el1) and (teLc1=tel1) and (elc2=el2) and (teLc2=tel2)) or
((elc2=el1) and (teLc2=tel1) and (elc1=el2) and (teLc1=tel2)) ; }
// il faut l'un des deux éléments présents
trouve:=( ((elc1=el1) and (teLc1=tel1)) or ((elc2=el2) and (teLc2=tel2)) ) or
( ((elc2=el1) and (teLc2=tel1)) or ((elc1=el2) and (teLc1=tel2)) ) ;
inc(i);
until (trouve) or (i>nCantons);
if trouve then result:=i-1;
@@ -6375,8 +6379,13 @@ begin
position1:=aiguillage[index1].position;
sHG:=TCO[indexTCO,x,y].suivHG;tHG:=TCO[indexTCO,x,y].typHG;
sBD:=TCO[indexTCO,x,y].suivBD;tBD:=TCO[indexTCO,x,y].typBD;
canvas.pen.color:=clfond[indexTCO];
canvas.pen.Width:=epaisseur div 2;
with canvas do
begin
pen.color:=fond;
Brush.Color:=fond;
pen.Width:=epaisseur div 2;
end;
if etatTJD=4 then
begin
adr2:=aiguillage[index1].DDevie; // homologue
@@ -6481,6 +6490,8 @@ var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,position1,positi
end;
end;
// si dessin=1 dessine en épaisseur de voie
// si dessin=2 dessine en épaisseur de trajet
procedure TJDbas(dessin :integer); // morceau courbe bas
begin
x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc;
@@ -6547,6 +6558,7 @@ begin
Brush.Color:=clvoies[indexTCO];
pen.color:=clvoies[indexTCO];
pen.width:=epaisseur;
diagonale;
@@ -6651,14 +6663,19 @@ begin
position1:=aiguillage[index1].position;
sHG:=TCO[indexTCO,x,y].suivHG;tHG:=TCO[indexTCO,x,y].typHG;
sBD:=TCO[indexTCO,x,y].suivBD;tBD:=TCO[indexTCO,x,y].typBD;
canvas.pen.color:=clfond[indexTCO];
canvas.pen.Width:=epaisseur div 2;
//canvas.pen.color:=clfond[indexTCO];
with canvas do
begin
pen.color:=fond;
Brush.Color:=fond;
pen.Width:=epaisseur div 2;
end;
if etatTJD=4 then
begin
adr2:=aiguillage[index1].DDevie; // homologue
Index2:=Index_aig(adr2);
position2:=aiguillage[index2].position;
// canvas.pen.color:=clBlack;
if (position1=const_devie) and (position2=const_devie) then
begin
with canvas do begin
@@ -6939,8 +6956,15 @@ begin
position1:=aiguillage[index1].position;
sHG:=TCO[indexTCO,x,y].suivHG;tHG:=TCO[indexTCO,x,y].typHG;
sBD:=TCO[indexTCO,x,y].suivBD;tBD:=TCO[indexTCO,x,y].typBD;
canvas.pen.color:=clfond[indexTCO];;
canvas.pen.Width:=epaisseur div 2;
//canvas.pen.color:=clfond[indexTCO];;
//canvas.
with canvas do
begin
pen.color:=fond;
Brush.Color:=fond;
pen.Width:=epaisseur div 2;
end;
if etatTJD=4 then
begin
adr2:=aiguillage[index1].DDevie; // homologue
@@ -7512,8 +7536,14 @@ begin
position1:=aiguillage[index1].position;
sHG:=TCO[indexTCO,x,y].suivHG;tHG:=TCO[indexTCO,x,y].typHG;
sBD:=TCO[indexTCO,x,y].suivBD;tBD:=TCO[indexTCO,x,y].typBD;
canvas.pen.color:=clfond[indexTCO];
canvas.pen.Width:=epaisseur div 2;
//canvas.pen.color:=clfond[indexTCO];
//canvas.pen.Width:=epaisseur div 2;
with canvas do
begin
pen.color:=fond;
Brush.Color:=fond;
pen.Width:=epaisseur div 2;
end;
if etatTJD=4 then
begin
adr2:=aiguillage[index1].DDevie; // homologue
@@ -13814,6 +13844,7 @@ begin
Direction:=det2;
end;
i:=0; // itérations
repeat // boucle de test de direction
sortir:=false;
if mode<=10 then
@@ -13844,7 +13875,7 @@ begin
xn:=x;yn:=y;
ir:=1; // index de la route du tco
i:=0; // itérations
if debugTCO then afficheDebug('Direction '+intToSTR(direction),clOrange);
// initialiser les points d'où l'on vient
@@ -13956,7 +13987,7 @@ begin
if (i>NbCellulesTCO[indexTCO]) then AfficheDebug('Erreur 1000 TCO'+intToSTR(indexTCO)+' : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred);
inc(direction)
until ((direction=5) and (mode<=10)) or ((direction=9) and (mode>=11)) or memtrouve ;
until ((direction=5) and (mode<=10)) or ((direction=9) and (mode>=11)) or memtrouve or (i>NbCellulesTCO[indexTCO]) ;
if memTrouve then
begin
+3 -3
View File
@@ -26,7 +26,7 @@ var
f : textFile;
Const
VersionSC = '10.73'; // sert à la comparaison de la version publiée
VersionSC = '10.75'; // 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;
@@ -82,7 +82,7 @@ var
begin
Result:=False;
t:=0;
// l'utilisation de TfileStream.Create inplique que le répertoire de destination soit libre de droits
// l'utilisation de TfileStream.Create implique que le répertoire de destination soit libre de droits
Try Fs:=TFileStream.Create(s,fmCreate);
//hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if DebugVV then Affiche('TFileStream.Create ok',clLime);
@@ -353,7 +353,7 @@ begin
// URL de l'API github des dernières releases
Url:='https://api.github.com/repos/f1iwq2/signaux_complexes_gl/releases/latest';
// l'utilisation de TfileStream.Create inplique que le répertoire de destination soit libre de droits,
// l'utilisation de TfileStream.Create implique que le répertoire de destination soit libre de droits,
// ce qui ne marche pas pour c:\program files (x64)\signaux_complexes.
// Le fichier page.txt est donc mis dans C:\Users\moi\AppData\Roaming\signaux_complexes qui lui a tous les droits
// fabrication du nom de fichier destinataire et son chemin
+8 -3
View File
@@ -343,9 +343,14 @@ version 10.7 : Affichage du compteur de train depuis le menu contextuel des cant
Correction désaffectation trains sur cantons.
version 10.71 : Ajout dans les variables des fonctions les mémoires de zone.
Correction bug activation mémoires de zone dans le menu du TCO.
Correction bug affichage des opérations dans les actions.
version 10.72 : correction bug dans les fonctions.
version 10.73 : correction bug téléchargement trains depuis CDM.
Correction bug affichage des opérations dans les actions.
version 10.72 : Correction bug dans les fonctions.
version 10.73 : Correction bug téléchargement trains depuis CDM.
version 10.74 : Traitement du cas TJD abordée par aiguillage en pointe.
Ajout paramètre de temporisation de commande des signaux.
version 10.75 : Amélioration de l'importation des trains depuis CDM rail.
Correction suppression des signaux.