easylinux/SignauxComplexes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

V2.31

Browse Source
This commit is contained in:
f1iwq2
2020-12-28 11:07:33 +01:00
parent db036a7bd8
commit 344b86a9c5
17 changed files with 579 additions and 9212 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Signaux_complexes_GL.cfg
View File

@@ -6,7 +6,7 @@
-$F-
-$G+
-$H+
-$I+
-$I-
-$J-
-$K-
-$L+

2
Signaux_complexes_GL.dof
View File

@@ -9,7 +9,7 @@ E=0
F=0
G=1
H=1
I=1
I=0
J=0
K=0
L=1

BIN
UnitConfig.dcu
View File

Binary file not shown.

29
UnitConfig.dfm
View File

@@ -1,12 +1,12 @@
object FormConfig: TFormConfig
Left = 266
Top = 160
Left = 194
Top = 249
Hint =
'Modifie les fichiers de configuration selon les s'#233'lections chois' +
'ies'
BorderStyle = bsDialog
Caption = 'Configuration g'#233'n'#233'rale'
ClientHeight = 495
ClientHeight = 501
ClientWidth = 858
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -1776,7 +1776,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 585
Height = 441
ActivePage = TabSheetAct
ActivePage = TabSheetBranches
Font.Charset = DEFAULT_CHARSET
Font.Color = clBackground
Font.Height = -11
@@ -2120,7 +2120,7 @@ object FormConfig: TFormConfig
ImageIndex = 1
object Label9: TLabel
Left = 8
Top = 352
Top = 384
Width = 297
Height = 13
Caption = 'Ces param'#232'tres sont utilis'#233's en fonctionnement sans CDM Rail'
@@ -2335,7 +2335,7 @@ object FormConfig: TFormConfig
Left = 8
Top = 296
Width = 297
Height = 41
Height = 81
Caption = 'Divers'
TabOrder = 7
object CheckBoxRazSignaux: TCheckBox
@@ -2349,6 +2349,19 @@ object FormConfig: TFormConfig
ShowHint = True
TabOrder = 0
end
object CheckBoxInitAig: TCheckBox
Left = 8
Top = 32
Width = 281
Height = 33
Caption =
'Initialisation des aiguillages suivant liste dans fichier client' +
'-gl.cfg [section init]'
ParentShowHint = False
ShowHint = False
TabOrder = 1
WordWrap = True
end
end
end
object TabSheetAig: TTabSheet
@@ -2582,6 +2595,7 @@ object FormConfig: TFormConfig
Height = 17
Caption = 'Inversion de l'#39#233'tat CDM'
TabOrder = 7
OnClick = CheckInverseClick
end
end
object Edit_HG: TEdit
@@ -2591,6 +2605,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 1
Text = 'EditPointe'
OnChange = Edit_HGChange
end
object RichAig: TRichEdit
Left = 0
@@ -2877,6 +2892,7 @@ object FormConfig: TFormConfig
Color = clBlack
Lines.Strings = (
'RichSig')
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 1
WordWrap = False
@@ -3202,6 +3218,7 @@ object FormConfig: TFormConfig
Width = 289
Height = 369
Color = clBlack
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 1
OnMouseDown = RichActMouseDown

50
UnitConfig.pas
View File

@@ -185,6 +185,7 @@ type
EditNbDetDist: TEdit;
Label31: TLabel;
RichAct: TRichEdit;
CheckBoxInitAig: TCheckBox;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
@@ -221,6 +222,8 @@ type
procedure EditEtatFoncSortieChange(Sender: TObject);
procedure EditTempoChange(Sender: TObject);
procedure CheckRAZClick(Sender: TObject);
procedure Edit_HGChange(Sender: TObject);
procedure CheckInverseClick(Sender: TObject);
private
{ Déclarations privées }
public
@@ -254,7 +257,7 @@ var
AdresseIPCDM,AdresseIP,PortCom,recuCDM,residuCDM : string;
portCDM,TempoOctet,TimoutMaxInterface,Valeur_entete,Port,protocole,NumPort,
LigneCliquee,AncLigneCliquee : integer;
ack_cdm,clicliste : boolean;
ack_cdm,clicliste,entreeTCO : boolean;
function config_com(s : string) : boolean;
function envoi_CDM(s : string) : boolean;
@@ -265,7 +268,7 @@ procedure sauve_config;
implementation
uses UnitDebug,UnitPrinc;
uses UnitDebug,UnitPrinc, UnitTCO;
{$R *.dfm}
@@ -656,7 +659,8 @@ begin
copie_commentaire;
// avec ou sans initialisation des aiguillages
writeln(fichierN,Init_Aig_ch+'=',IntToSTR(AvecInitAiguillages));
if AvecInitAiguillages then s:='1' else s:='0';
writeln(fichierN,Init_Aig_ch+'='+s);
copie_commentaire;
// plein écran
@@ -927,6 +931,8 @@ begin
Srvc_PosTrain:=CheckServPosTrains.checked;
Srvc_Sig:=CheckBoxSrvSig.checked;
Raz_Acc_signaux:=CheckBoxRazSignaux.checked;
AvecInitAiguillages:=CheckBoxInitAig.Checked;
end;
if change_srv then services_CDM;
@@ -940,6 +946,13 @@ procedure TFormConfig.ButtonAppliquerEtFermerClick(Sender: TObject);
begin
Sauve_config;
formConfig.close;
// TCO
if avectco and not(entreeTCO) then
begin
//créée la fenêtre TCO non modale
FormTCO:=TformTCO.Create(nil);
FormTCO.show;
end;
end;
procedure TFormConfig.Button2Click(Sender: TObject);
@@ -997,6 +1010,7 @@ begin
CheckInfoVersion.Checked:=notificationVersion;
CheckLanceCDM.Checked:=LanceCDM;
CheckAvecTCO.checked:=avecTCO;
entreeTCO:=avecTCO;
EditNomLay.Text:=Lay;
RadioButton4.Checked:=ServeurInterfaceCDM=0;
RadioButton5.Checked:=ServeurInterfaceCDM=1;
@@ -1020,6 +1034,7 @@ begin
CheckBoxServAct.checked:=Srvc_Act;
CheckServPosTrains.checked:=Srvc_PosTrain;
CheckBoxRazSignaux.checked:=Raz_Acc_signaux;
CheckBoxInitAig.checked:=AvecInitAiguillages;
EditDroit_BD.Text:='';
EditPointe_BG.Text:='';
@@ -1628,6 +1643,12 @@ begin
clicliste:=false;
end;
// on change la valeur de la description du champ HG pour les TJD
procedure change_HG ;
begin
if clicliste then exit;
end;
// on change la valeur de la description de la pointe de l'aiguillage
procedure change_Pointe;
var AdrAig,adr,erreur : integer;
@@ -1823,6 +1844,11 @@ begin
change_pointe;
end;
procedure TFormConfig.Edit_HGChange(Sender: TObject);
begin
change_HG;
end;
procedure TFormConfig.EditDevie_HDChange(Sender: TObject);
begin
Change_devie;
@@ -1838,6 +1864,21 @@ begin
Change_s2;
end;
procedure TFormConfig.CheckInverseClick(Sender: TObject);
var s : string;
adrAig,erreur : integer;
begin
// récupérer l'adresse de l'aiguillage cliqué
s:=formconfig.RichAig.Lines[lignecliquee];
Val(s,adrAig,erreur);
if checkInverse.Checked then aiguillage[adraig].InversionCDM:=1 else aiguillage[adraig].InversionCDM:=0;
// réencoder la ligne
s:=encode_aig(AdrAig);
formconfig.RichAig.Lines[lignecliquee]:=s;
labelLigne.Caption:=s;
end;
procedure TFormConfig.RadioButtonsansClick(Sender: TObject);
var AdrAig,erreur : integer;
s : string;
@@ -2318,6 +2359,9 @@ begin
end;
end;
end.

BIN
UnitDebug.dcu
View File

Binary file not shown.

106
UnitDebug.dfm
View File

@@ -1,8 +1,8 @@
object FormDebug: TFormDebug
Left = 329
Top = 122
Left = 192
Top = 290
Width = 855
Height = 762
Height = 817
Caption = 'Fen'#234'tre de d'#233'bug'
Color = clWindow
TransparentColorValue = clTeal
@@ -16,7 +16,7 @@ object FormDebug: TFormDebug
OnCreate = FormCreate
DesignSize = (
839
724)
779)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
@@ -49,24 +49,6 @@ object FormDebug: TFormDebug
Font.Style = [fsBold, fsItalic]
ParentFont = False
end
object Label3: TLabel
Left = 485
Top = 160
Width = 99
Height = 185
Anchors = [akTop, akRight]
AutoSize = False
Caption = 'Label3'
Color = clGray
Font.Charset = ANSI_CHARSET
Font.Color = clWindow
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentColor = False
ParentFont = False
WordWrap = True
end
object EditNivDebug: TEdit
Left = 767
Top = 2
@@ -85,7 +67,7 @@ object FormDebug: TFormDebug
end
object MemoEvtDet: TMemo
Left = 591
Top = 344
Top = 320
Width = 239
Height = 225
Anchors = [akTop, akRight]
@@ -99,12 +81,14 @@ object FormDebug: TFormDebug
'Tableau des '#233'v'#232'nements '
'fronts descendants d'#233'tecteurs')
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 1
OnChange = MemoEvtDetChange
end
object ButtonEcrLog: TButton
Left = 487
Top = 464
Top = 312
Width = 97
Height = 29
Anchors = [akTop, akRight]
@@ -114,7 +98,7 @@ object FormDebug: TFormDebug
end
object ButtonRazTampon: TButton
Left = 487
Top = 536
Top = 344
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -125,7 +109,7 @@ object FormDebug: TFormDebug
end
object ButtonCherche: TButton
Left = 487
Top = 432
Top = 280
Width = 97
Height = 25
Anchors = [akTop, akRight]
@@ -135,7 +119,7 @@ object FormDebug: TFormDebug
end
object ButtonAffEvtChrono: TButton
Left = 487
Top = 392
Top = 240
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -146,7 +130,7 @@ object FormDebug: TFormDebug
end
object ButtonCop: TButton
Left = 487
Top = 344
Top = 192
Width = 97
Height = 41
Anchors = [akTop, akRight]
@@ -165,7 +149,7 @@ object FormDebug: TFormDebug
Left = 591
Top = 160
Width = 239
Height = 185
Height = 153
Anchors = [akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
@@ -175,12 +159,14 @@ object FormDebug: TFormDebug
HideScrollBars = False
ParentFont = False
PopupMenu = PopupMenuRE
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 7
OnChange = RichEditChange
end
object ButtonRazLog: TButton
Left = 487
Top = 496
Top = 384
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -191,7 +177,7 @@ object FormDebug: TFormDebug
end
object GroupBox1: TGroupBox
Left = 485
Top = 576
Top = 608
Width = 353
Height = 145
Anchors = [akTop, akRight]
@@ -453,15 +439,71 @@ object FormDebug: TFormDebug
Left = 8
Top = 8
Width = 470
Height = 705
Height = 743
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'RichDebug')
PopupMenu = PopupMenuRD
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 11
OnChange = RichDebugChange
end
object GroupBox5: TGroupBox
Left = 487
Top = 552
Width = 345
Height = 49
Anchors = [akTop, akRight]
Caption = 'Simulation d'#233'tecteur'
Color = cl3DLight
Font.Charset = DEFAULT_CHARSET
Font.Color = clNavy
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = False
ParentFont = False
TabOrder = 12
object EditSimuDet: TEdit
Left = 8
Top = 16
Width = 73
Height = 21
Hint = 'Adresse d'#39'un d'#233'tecteur'
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object ButtonSimuDet0: TButton
Left = 120
Top = 16
Width = 75
Height = 25
Caption = 'D'#233'tecteur '#224' 0'
TabOrder = 1
OnClick = ButtonSimuDet0Click
end
object ButtonSimuDet1: TButton
Left = 232
Top = 16
Width = 75
Height = 25
Caption = 'D'#233'tecteur '#224' 1'
TabOrder = 2
OnClick = ButtonSimuDet1Click
end
end
object ButtonRazTout: TButton
Left = 488
Top = 160
Width = 97
Height = 25
Anchors = [akTop, akRight]
Caption = 'RAZ tous trains'
TabOrder = 13
OnClick = ButtonRazToutClick
end
object SaveDialog: TSaveDialog
Left = 768
Top = 488

65
UnitDebug.pas
View File

@@ -14,7 +14,6 @@ type
Label2: TLabel;
SaveDialog: TSaveDialog;
ButtonEcrLog: TButton;
Label3: TLabel;
ButtonRazTampon: TButton;
ButtonCherche: TButton;
ButtonAffEvtChrono: TButton;
@@ -46,6 +45,11 @@ type
RichDebug: TRichEdit;
PopupMenuRD: TPopupMenu;
Copier2: TMenuItem;
GroupBox5: TGroupBox;
ButtonSimuDet0: TButton;
ButtonSimuDet1: TButton;
EditSimuDet: TEdit;
ButtonRazTout: TButton;
procedure FormCreate(Sender: TObject);
procedure ButtonEcrLogClick(Sender: TObject);
procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
@@ -69,6 +73,11 @@ type
procedure Button2Click(Sender: TObject);
procedure Copier2Click(Sender: TObject);
procedure RichDebugChange(Sender: TObject);
procedure ButtonSimuDet0Click(Sender: TObject);
procedure ButtonSimuDet1Click(Sender: TObject);
procedure ButtonRazToutClick(Sender: TObject);
procedure RichEditChange(Sender: TObject);
procedure MemoEvtDetChange(Sender: TObject);
private
{ Déclarations privées }
public
@@ -109,6 +118,7 @@ var
procedure AfficheDebug(s : string;lacouleur : TColor);
Procedure Raz_tout;
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
implementation
@@ -134,16 +144,27 @@ begin
RE_ColorLine(FormDebug.RichDebug,FormDebug.RichDebug.lines.count-1,lacouleur);
end;
Procedure Raz_tout;
var i : integer;
begin
N_Event_tick:=0;
N_event_det:=0;
N_trains:=0;
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
for i:=1 to Max_Trains do Event_det_Train[i].NbEl:=0;
i_simule:=0;
FormDebug.MemoEvtDet.Clear;
FormDebug.Richedit.Clear;
end;
procedure TFormDebug.FormCreate(Sender: TObject);
var s: string;
i : integer;
begin
EditNivDebug.Text:='0';
s:='Cette fenêtre permet d''afficher des informations sur le ';
s:=s+'comportement du programme. Positionner le niveau de 1 à 3 pour';
s:=s+'comportement du programme. Positionner le niveau du débug de 1 à 3 pour';
s:=s+' afficher des informations plus ou moins détaillées.';
Label3.caption:=s;
RichEdit.Lines.add(s);
RichDebug.WordWrap:=false; // interdit la coupure des chaînes en limite du composant
RichDebug.color:=$33;
initform:=false;
@@ -393,4 +414,40 @@ begin
SendMessage(RichDebug.handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
procedure TFormDebug.ButtonSimuDet0Click(Sender: TObject);
var det,erreur : integer;
begin
val(EditSimuDet.Text,det,erreur);
if erreur=0 then
begin
Event_Detecteur(det,false,'');
end;
end;
procedure TFormDebug.ButtonSimuDet1Click(Sender: TObject);
var det,erreur : integer;
begin
val(EditSimuDet.Text,det,erreur);
if erreur=0 then
begin
Event_Detecteur(det,true,'');
end;
end;
procedure TFormDebug.ButtonRazToutClick(Sender: TObject);
begin
Raz_tout;
end;
procedure TFormDebug.RichEditChange(Sender: TObject);
begin
SendMessage(RichEdit.handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
procedure TFormDebug.MemoEvtDetChange(Sender: TObject);
begin
SendMessage(MemoEvtDet.handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
end.

BIN
UnitPrinc.dcu
View File

Binary file not shown.

206
UnitPrinc.dfm
View File

@@ -1,6 +1,6 @@
object FormPrinc: TFormPrinc
Left = 1296
Top = 222
Left = 44
Top = 270
Width = 1212
Height = 664
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
@@ -24,7 +24,7 @@ object FormPrinc: TFormPrinc
TextHeight = 13
object LabelTitre: TLabel
Left = 8
Top = 16
Top = 8
Width = 173
Height = 18
Caption = 'Signaux complexes GL'
@@ -1203,9 +1203,9 @@ object FormPrinc: TFormPrinc
end
object ScrollBox1: TScrollBox
Left = 631
Top = 168
Width = 537
Height = 377
Top = 176
Width = 546
Height = 385
HorzScrollBar.Smooth = True
HorzScrollBar.Tracking = True
VertScrollBar.Smooth = True
@@ -1218,96 +1218,61 @@ object FormPrinc: TFormPrinc
object GroupBox1: TGroupBox
Left = 631
Top = 5
Width = 249
Height = 129
Width = 266
Height = 52
Anchors = [akTop, akRight]
Caption = 'Commande d'#39'accessoires'
TabOrder = 1
object Label2: TLabel
Left = 7
Top = 16
Top = 24
Width = 58
Height = 13
Caption = 'adresse acc'
end
object Label3: TLabel
Left = 75
Top = 16
Width = 30
Height = 13
Caption = '1 ou 2'
end
object Label4: TLabel
Left = 133
Top = 10
Width = 85
Height = 13
Caption = '1=d'#233'vi'#233' 2=droit'
end
object EditAdresse: TEdit
Left = 8
Top = 32
Width = 57
Left = 72
Top = 24
Width = 49
Height = 21
Hint = 'Adresse accessoire ou de CV'
TabOrder = 0
Text = '1'
end
object Editval: TEdit
Left = 72
Top = 32
Width = 41
Height = 21
Hint = 'Entrez 1 ou 2 pour un accessoire DCC et 1 '#224' 255 pour un CV'
TabOrder = 1
Text = '1'
OnEnter = EditvalEnter
end
object ButtonEcrCV: TButton
Left = 8
Top = 64
Width = 225
object ButtonDroit: TButton
Left = 132
Top = 16
Width = 53
Height = 25
Hint = 'Ecriture CV en mode direct sur voie de programmation'
Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet'
Hint = 'Ecriture des accessoires DCC'
Caption = 'droit'
TabOrder = 1
WordWrap = True
OnClick = ButtonDroitClick
end
object ButtonDevie: TButton
Left = 192
Top = 16
Width = 57
Height = 25
Hint = 'Ecriture des accessoires DCC'
Caption = 'devi'#233
TabOrder = 2
WordWrap = True
OnClick = ButtonEcrCVClick
end
object ButtonLitCV: TButton
Left = 8
Top = 96
Width = 225
Height = 25
Hint = 'Lecture CV en mode direct sur voie de programmation'
Caption = 'Lecture CV - 1 '#224' 255 par le bus XpressNet'
Enabled = False
TabOrder = 3
OnClick = ButtonLitCVClick
end
object ButtonCommande: TButton
Left = 124
Top = 24
Width = 109
Height = 33
Hint = 'Ecriture des accessoires DCC'
Caption = 'Envoi commande'
TabOrder = 4
WordWrap = True
OnClick = ButtonCommandeClick
OnClick = ButtonDevieClick
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 576
Top = 584
Width = 1196
Height = 30
Height = 22
Panels = <>
SimplePanel = True
end
object MSCommUSBLenz: TMSComm
Left = 720
Top = 144
Left = 1160
Top = 192
Width = 32
Height = 32
OnComm = MSCommUSBLenzComm
@@ -1316,10 +1281,10 @@ object FormPrinc: TFormPrinc
00020000802500000000080000000000000000003F00000011000000}
end
object Panel1: TPanel
Left = 887
Left = 903
Top = 5
Width = 281
Height = 129
Width = 282
Height = 132
Anchors = [akTop, akRight]
TabOrder = 4
object BoutonRaf: TButton
@@ -1385,19 +1350,20 @@ object FormPrinc: TFormPrinc
OnClick = ButtonTestClick
end
object ButtonArretSimu: TButton
Left = 104
Left = 8
Top = 88
Width = 81
Width = 89
Height = 33
Caption = 'Arret simulation'
TabOrder = 6
Visible = False
WordWrap = True
OnClick = ButtonArretSimuClick
end
object ButtonAffTCO: TButton
Left = 8
Left = 104
Top = 88
Width = 89
Width = 81
Height = 33
Caption = 'Affiche TCO'
TabOrder = 7
@@ -1415,12 +1381,11 @@ object FormPrinc: TFormPrinc
end
end
object Panel2: TPanel
Left = 631
Top = 136
Width = 153
Left = 904
Top = 144
Width = 281
Height = 25
Anchors = [akTop, akRight]
Caption = 'Panel2'
TabOrder = 5
object Label1: TLabel
Left = 16
@@ -1430,7 +1395,7 @@ object FormPrinc: TFormPrinc
Caption = 'Nombre de trains : '
end
object LabelNbTrains: TLabel
Left = 120
Left = 248
Top = 2
Width = 9
Height = 19
@@ -1445,7 +1410,7 @@ object FormPrinc: TFormPrinc
end
object StaticText: TStaticText
Left = 16
Top = 560
Top = 565
Width = 14
Height = 17
Anchors = [akLeft, akRight, akBottom]
@@ -1454,9 +1419,9 @@ object FormPrinc: TFormPrinc
end
object FenRich: TRichEdit
Left = 8
Top = 48
Top = 32
Width = 617
Height = 497
Height = 529
Anchors = [akLeft, akTop, akRight, akBottom]
Color = clBlack
Font.Charset = DEFAULT_CHARSET
@@ -1471,11 +1436,73 @@ object FormPrinc: TFormPrinc
TabOrder = 7
OnChange = FenRichChange
end
object GroupBox2: TGroupBox
Left = 632
Top = 64
Width = 265
Height = 105
Anchors = [akTop, akRight]
Caption = 'Variables CV'
TabOrder = 8
object Label3: TLabel
Left = 208
Top = 34
Width = 14
Height = 13
Caption = 'CV'
WordWrap = True
end
object LabelVCV: TLabel
Left = 208
Top = 55
Width = 47
Height = 13
Caption = 'Valeur CV'
WordWrap = True
end
object ButtonEcrCV: TButton
Left = 8
Top = 16
Width = 153
Height = 33
Hint = 'Ecriture CV en mode direct sur voie de programmation'
Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet'
TabOrder = 0
WordWrap = True
OnClick = ButtonEcrCVClick
end
object ButtonLitCV: TButton
Left = 8
Top = 64
Width = 153
Height = 33
Hint = 'Lecture CV en mode direct sur voie de programmation'
Caption = 'Lecture CV - 1 '#224' 255 par le bus XpressNet'
Enabled = False
TabOrder = 1
WordWrap = True
OnClick = ButtonLitCVClick
end
object EditCV: TEdit
Left = 168
Top = 32
Width = 33
Height = 21
TabOrder = 2
end
object EditVal: TEdit
Left = 168
Top = 52
Width = 33
Height = 21
TabOrder = 3
end
end
object Timer1: TTimer
Interval = 100
OnTimer = Timer1Timer
Left = 888
Top = 80
Left = 1168
Top = 224
end
object ClientSocketLenz: TClientSocket
Active = False
@@ -1596,6 +1623,13 @@ object FormPrinc: TFormPrinc
' sur la voie de programmation'
OnClick = LireunfichierdeCV1Click
end
object N6: TMenuItem
Caption = '-'
end
object Apropos1: TMenuItem
Caption = 'A propos'
OnClick = Apropos1Click
end
end
end
object ClientSocketCDM: TClientSocket

417
UnitPrinc.pas
View File

@@ -27,8 +27,6 @@ type
GroupBox1: TGroupBox;
EditAdresse: TEdit;
Label2: TLabel;
Editval: TEdit;
Label3: TLabel;
MainMenu1: TMainMenu;
Interface1: TMenuItem;
MenuConnecterUSB: TMenuItem;
@@ -37,7 +35,6 @@ type
MenuConnecterEthernet: TMenuItem;
MenuDeconnecterEthernet: TMenuItem;
StatusBar1: TStatusBar;
Label4: TLabel;
MSCommUSBLenz: TMSComm;
Afficher1: TMenuItem;
Etatdesdtecteurs1: TMenuItem;
@@ -62,7 +59,6 @@ type
Divers1: TMenuItem;
ClientSocketCDM: TClientSocket;
FichierSimu: TMenuItem;
ButtonEcrCV: TButton;
OpenDialog: TOpenDialog;
N1: TMenuItem;
LireunfichierdeCV1: TMenuItem;
@@ -70,7 +66,6 @@ type
N5: TMenuItem;
Quitter1: TMenuItem;
Config: TMenuItem;
ButtonLitCV: TButton;
Codificationdesactionneurs1: TMenuItem;
OuvrirunfichiertramesCDM1: TMenuItem;
Panel1: TPanel;
@@ -81,7 +76,7 @@ type
ButtonReprise: TButton;
ButtonTest: TButton;
ButtonArretSimu: TButton;
ButtonCommande: TButton;
ButtonDroit: TButton;
Panel2: TPanel;
Label1: TLabel;
LabelNbTrains: TLabel;
@@ -94,12 +89,22 @@ type
PopupMenuFenRich: TPopupMenu;
Copier1: TMenuItem;
Etatdessignaux1: TMenuItem;
N6: TMenuItem;
Apropos1: TMenuItem;
ButtonDevie: TButton;
GroupBox2: TGroupBox;
ButtonEcrCV: TButton;
ButtonLitCV: TButton;
EditCV: TEdit;
Label3: TLabel;
LabelVCV: TLabel;
EditVal: TEdit;
procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure BoutVersionClick(Sender: TObject);
procedure ButtonCommandeClick(Sender: TObject);
procedure ButtonDroitClick(Sender: TObject);
procedure EditvalEnter(Sender: TObject);
procedure BoutonRafClick(Sender: TObject);
procedure ClientSocketLenzError(Sender: TObject; Socket: TCustomWinSocket;
@@ -147,6 +152,8 @@ type
procedure FenRichChange(Sender: TObject);
procedure Copier1Click(Sender: TObject);
procedure Etatdessignaux1Click(Sender: TObject);
procedure Apropos1Click(Sender: TObject);
procedure ButtonDevieClick(Sender: TObject);
private
{ Déclarations privées }
procedure DoHint(Sender : Tobject);
@@ -166,6 +173,7 @@ const_droit=2;const_devie=1; // positions aiguillages transmises par la central
const_devieG_CDM=3; // positions aiguillages transmises par cdm
const_devieD_CDM=2; // positions aiguillages transmises par cdm
const_droit_CDM=0; // positions aiguillages transmises par cdm
const_inconnu=9; // position inconnue
ClBleuClair=$FF7070 ;
Cyan=$FF6060;
clviolet=$FF00FF;
@@ -226,14 +234,14 @@ TMA = (valide,devalide);
var
ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word;
AvecInitAiguillages,tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre,
tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre,
NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant,
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,
ServeurRetroCDM,TailleFonte,Nb_Det_Dist : integer;
Hors_tension2,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,
NackCDM,MsgSim,succes,recu_cv,AffActionneur,AffAigDet,Option_demarrage,
TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM : boolean;
TraceListe,clignotant,nack,Maj_feux_cours,configNulle,LanceCDM,AvecInitAiguillages : boolean;
CDMhd : THandle;
branche : array [1..100] of string;
@@ -360,6 +368,7 @@ function test_memoire_zones(adresse : integer) : boolean;
function PresTrainPrec(AdrFeu : integer) : boolean;
function cond_carre(adresse : integer) : boolean;
function carre_signal(adresse : integer) : boolean;
procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string);
implementation
@@ -1468,70 +1477,6 @@ begin
end;
// pilotage d'un accessoire (décodeur d'aiguillage, de signal)
// octet = 0 ou 1 ou 2
// la sortie "octet" est mise à 1 puis à 0
// acc = aig ou feu
procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire);
var groupe,temps : integer ;
fonction : byte;
s : string;
begin
//Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow);
// pilotage par CDM rail
if CDM_connecte then
begin
//AfficheDebug(intToSTR(adresse),clred);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange);
s:=chaine_CDM_Acc(adresse,octet);
envoi_CDM(s);
if (acc=feu) and not(Raz_Acc_signaux) then exit;
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
s:=chaine_CDM_Acc(adresse,0);
envoi_CDM(s);
exit;
end;
// pilotage par USB ou par éthernet de la centrale
// Affiche('Accessoire '+intToSTR(adresse),clLime);
if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then
begin
// test si pilotage aiguillage inversé
if aiguillage[adresse].inversion=1 then
begin
if octet=1 then octet:=2 else octet:=1;
end;
if (octet=0) or (octet>2) then exit;
//if (octet>2) then exit;
groupe:=(adresse-1) div 4;
fonction:=((adresse-1) mod 4)*2 + (octet-1);
// pilotage à 1
s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie
s:=checksum(s);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange);
envoi(s); // envoi de la trame et attente Ack
// si l'accessoire est un feu et sans raz des signaux, sortir
if (acc=feu) and not(Raz_Acc_signaux) then exit;
// si aiguillage, faire une temporisation
//if (index_feu(adresse)=0) or (Acc=aig) then
if Acc=Aig then
begin
temps:=aiguillage[adresse].temps;if temps=0 then temps:=4;
if portCommOuvert or parSocketLenz then tempo(temps);
end;
sleep(50);
// pilotage à 0 pour éteindre le pilotage de la bobine du relais
s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie
s:=checksum(s);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
envoi(s); // envoi de la trame et attente Ack
end;
end;
// pilote accessoire en entrée 0->2 1->1
procedure pilote_acc01(adresse : integer;octet : byte);
@@ -3486,7 +3431,7 @@ var s,sa,chaine,SOrigine: string;
begin
//initialisation aiguillages
repeat
s:=lit_ligne;
s:=lit_ligne;
j:=pos(',',s);
if j>1 then
begin
@@ -3534,7 +3479,7 @@ begin
trouve_fenetre:=false;
trouve_verif_version:=false;
trouve_Fonte:=false;
Nb_Det_Dist:=3;
// initialisation des aiguillages avec des valeurs par défaut
for i:=1 to MaxAcc do
@@ -3664,7 +3609,7 @@ begin
// avec ou sans initialisation des aiguillages
sa:=uppercase(INIT_AIG_ch)+'=';
i:=pos(sa,s);
i:=pos(sa,s);
if i<>0 then
begin
trouve_init_aig:=true;
@@ -4763,9 +4708,9 @@ begin
exit;
end;
goto recommence;
end;
end;
Affiche('44 - éléments non consécutifs: Prec='+intToSTR(prec)+' Actuel='+intTostr(Actuel),clred);
Affiche('44 - éléments non consécutifs: Prec='+intToSTR(prec)+' Actuel='+intTostr(Actuel),clred);
if NivDebug=3 then AfficheDebug('44 - éléments non consécutifs: Prec='+intToSTR(prec)+' Actuel='+intTostr(Actuel),clred);
end;
@@ -4816,14 +4761,16 @@ begin
if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis)
trouve_element(adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].Btype;
suivant_alg3:=adr;exit;
suivant_alg3:=adr;exit;
end;
end
else
begin
if NivDebug=3 then AfficheDebug('135 - aiguillage '+intToSTR(Adr)+' Pris en talon',clyellow);
if (alg=2) then // on demande d'arreter si l'aiguillage en talon est mal positionné
begin
if alg=2 then // on demande d'arreter si l'aiguillage en talon est mal positionné
begin
if aiguillage[adr].position=const_droit then
begin
// si TJD (modele=2) sur le précédent, alors substituer avec la 2eme adresse de la TJD
if aiguillage[prec].modele=2 then prec:=aiguillage[prec].DDroit;
if prec<>aiguillage[Adr].Adroit then
@@ -5155,7 +5102,7 @@ begin
if NivDebug=3 then AfficheDebug('Aiguillage triple dévié2 (à droite)',clYellow);
A:=aiguillage[Adr].Adevie2B;
Adr:=aiguillage[Adr].Adevie2;
if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis)
if A='Z' then TypeEl:=1 else TypeEL:=2; //TypeEL=(1=détécteur 2=aig 3=aig Bis)
trouve_element(Adr,TypeEl,1); // branche_trouve IndexBranche_trouve
typeGen:=BrancheN[branche_trouve,IndexBranche_trouve].BType;
suivant_alg3:=adr;exit;
@@ -5397,6 +5344,10 @@ begin
j:=1; // J=1 test en incrément J=2 test en décrément
// étape 1 : trouver le sens de progression (en incrément ou en décrément)
repeat
//préparer les variables
AdrPrec:=el1;TypePrec:=typeDet1;
if j=1 then i1:=IndexBranche_det1+1;
if j=2 then i1:=IndexBranche_det1-1;
// les suivants dansla branche sont:
@@ -5405,17 +5356,17 @@ begin
if NivDebug=3 then
begin
s:='Test en ';
if (j=1) then s:=s+'incrément ' else s:=s+'décrément ';
s:=s+'- départ depuis élément '+IntToSTR(el1)+' trouvé en index='+intToSTR(IndexBranche_det1)+' Branche='+intToSTR(branche_trouve_det1);
AfficheDebug(s,clyellow);
s:='Test en ';
if (j=1) then s:=s+'incrément ' else s:=s+'décrément ';
s:=s+'- départ depuis élément '+IntToSTR(el1)+' trouvé en index='+intToSTR(IndexBranche_det1)+' Branche='+intToSTR(branche_trouve_det1);
AfficheDebug(s,clyellow);
end;
i:=0;N_Det:=0;
i:=0;N_Det:=0;
if AdrFonc<>El2 then // si pas déja trouvé le sens de progression
begin
repeat
//AfficheDebug('Engage '+IntToSTR(AdrPrec)+','+IntToSTR(typePrec)+'/'+IntToSTR(AdrFonc)+','+IntToSTR(typeFonc),clyellow);
if nivDebug=3 then AfficheDebug('i='+IntToSTR(i)+' NDet='+IntToSTR(N_det),clyellow);
if (AdrFonc<>0) or (TypeFonc<>0) then Adr:=suivant_alg3(AdrPrec,TypePrec,AdrFonc,TypeFonc,1) else
begin
@@ -5594,7 +5545,7 @@ begin
if (AdrSuiv>500) then
begin
AdrFeu:=index_feu_det(AdrSuiv);
//Affiche(IntToSTR(AdrFeu),clOrange);
//Affiche(IntToSTR(AdrFeu),clOrange);
end;
sort:=(j=10) or (AdrFeu<>0) or (AdrSuiv=9998) or (AdrSuiv=0); // arret si aiguillage en talon ou buttoir
until (sort);
@@ -5851,7 +5802,8 @@ end;
pilote_direction(Adr,i);
end;
end;
end;
// renvoie vrai si une mémoire de zone est occupée du signal courant au signal suivant
// adresse=adresse du signal
function test_memoire_zones(adresse : integer) : boolean;
@@ -5868,6 +5820,7 @@ begin
Affiche('Erreur 650 - feu non trouvé',clred);
AfficheDebug('Erreur 650 - feu non trouvé',clred);
test_memoire_zones:=false;
end;
Pres_train:=FALSE;
ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu
@@ -5926,7 +5879,7 @@ begin
// et chaîner mémoire de zone
if (j=1) and (Typeactuel=1) then // si détecteur
begin
Pres_train:=MemZone[Prec,actuel];
Pres_train:=MemZone[Prec,actuel];
if Pres_Train and (NivDebug=3) then Affiche('Présence train de '+intToSTR(prec)+' à '+intToSTR(actuel),clyellow);
end
else
@@ -5936,7 +5889,7 @@ begin
prec:=actuel;TypePrec:=TypeActuel;
actuel:=AdrSuiv;TypeActuel:=typeGen;
if AdrSuiv>9990 then
begin
begin
test_memoire_zones:=false;exit;
end;
@@ -5948,7 +5901,7 @@ begin
// si c'est un buttoir
test_memoire_zones:=false;
if NivDebug=3 then AfficheDebug('sortie car buttoir',clyellow);
exit;
exit;
end;
// si le suivant est un détecteur ; contrôler mémoire de zone et comporte t-il un signal?
AdrFeu:=0;
@@ -5966,8 +5919,8 @@ begin
if (AdrFeu=adresse) then // si on ne reboucle sur le même signal dont on cherche le suivant
begin
AdrFeu:=0;j:=10; // on ne trouve pas de suivant
end;
if (AdrFeu<>0) then // si l'adresse est <>0
end;
if (AdrFeu<>0) then // si l'adresse est <>0
begin
if (feux[i].Adr_el_suiv1<>prec) then // le feu est-il dans le bon sens de progression?
begin
@@ -5987,11 +5940,11 @@ begin
begin
//if (traceDet) {sprintf(Affiche,"Trouvé détecteur %d mais sans signal\r\n",AdrSuiv,Etat);Display(Affiche);
AdrFeu:=0;
end;
end;
end
else
begin
if (NivDebug=3) then AfficheDebug('Trouvé aiguillage '+intToSTR(AdrSuiv),clyellow);
if (NivDebug=3) then AfficheDebug('Trouvé aiguillage '+intToSTR(AdrSuiv),clyellow);
end;
sort:=(j=10) or (AdrFeu<>0) or (N_Det>=Nb_det_dist);
until (sort); // on arrete jusqu'à trouver un signal ou si on va trop loin (10 itérations)
@@ -6127,18 +6080,22 @@ begin
begin
det_initial:=feux[i].Adr_det4;Adr_El_Suiv:=feux[i].Adr_el_suiv4;
if feux[i].Btype_suiv4=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv4=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv4=4 then Btype_el_suivant:=2;
if feux[i].Btype_suiv4=4 then Btype_el_suivant:=2;
end;
end;
if (det_initial<>0) then
begin
DetPrec1:=detecteur_suivant(Adr_El_Suiv,Btype_el_suivant,det_initial,1,2); // 2= algo2 = arret sur aiguillage en talon mal positionné
if nivdebug=3 then afficheDebug('detPrec1='+intToSTR(DetPrec1),clorange);
DetPrec1:=detecteur_suivant(Adr_El_Suiv,Btype_el_suivant,det_initial,1,2); // 2= algo2 = arret sur aiguillage en talon mal positionné
if DetPrec1<1024 then // route bloquée par aiguillage mal positionné
begin
if detPrec1<>0 then DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1) else DetPrec2:=0;
if nivdebug=3 then afficheDebug('detPrec2='+intToSTR(DetPrec2),clorange);
DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1);
if DetPrec2<1024 then
begin
if detPrec2<>0 then DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1) else DetPrec3:=0;
if nivdebug=3 then afficheDebug('detPrec3='+intToSTR(DetPrec3),clorange);
DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1);
if DetPrec3<1024 then
begin
if detPrec3<>0 then DetPrec4:=detecteur_suivant_El(DetPrec2,1,DetPrec3,1) else DetPrec4:=0;
if nivdebug=3 then afficheDebug('detPrec4='+intToSTR(DetPrec4),clorange);
@@ -6175,7 +6132,7 @@ var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,Adr_El_Suiv,
// mise à jour de l'état d'un feu en fontion de son environnement et affiche le feu
procedure Maj_Feu(Adrfeu : integer);
var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,Adr_El_Suiv,
Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ;
Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ;
PresTrain,Aff_semaphore,car : boolean;
code,combine : word;
s : string;
@@ -6227,6 +6184,7 @@ begin
Maj_Etat_Signal(AdrFeu,blanc) else Maj_Etat_Signal(AdrFeu,violet);
envoi_LEB(AdrFeu);
exit;
end;
}
// signal à 2 feux = carré violet+blanc
@@ -6236,7 +6194,9 @@ begin
// si aiguillage après signal mal positionnées
if carre_signal(AdrFeu) then
begin
Maj_Etat_Signal(AdrFeu,violet);
Maj_Etat_Signal(AdrFeu,violet);
Envoi_signauxCplx;
exit;
end
else
begin
@@ -6385,6 +6345,16 @@ begin
//affiche(inttostr(ai+1),clOrange);
//affiche('------------------------',clWhite);
recherche;
//affiche('------------------------',clGreen);
if trouve then index2_det:=i else index2_det:=0;
//affiche('index2='+IntToSTR(index2_det),clWhite);
end;
// trouve si le détecteur adr est contigu à un buttoir
function buttoir_adjacent(adr : integer) : boolean;
begin
trouve_element(adr,1,1); // branche_trouve IndexBranche_trouve
if Branche_trouve=0 then begin buttoir_adjacent:=false;exit;end;
buttoir_adjacent:=( (BrancheN[branche_trouve,IndexBranche_trouve+1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve+1].BType=4) or
(BrancheN[branche_trouve,IndexBranche_trouve-1].Adresse=0) and (BrancheN[branche_trouve,IndexBranche_trouve-1].BType=4) )
@@ -6494,13 +6464,15 @@ begin
AfficheDebug('Nouveau Tampon train '+intToStr(i)+'--------',clyellow);
AfficheDebug(intToSTR(event_det_train[i].det[1]),clyellow );
AfficheDebug(intToSTR(event_det_train[i].det[2]),clyellow );
end;
end;
exit; // sortir absolument
end;
end;
end;
// Nombre d'éléments à 0 : ici c'est un nouveau train donc créer un train, donc un tableau
if N_Trains>=Max_Trains then
begin
Affiche('Erreur nombre de train maximal atteint',clRed);
end;
Inc(N_trains);
@@ -6515,7 +6487,7 @@ begin
if (AdrDetFeu=Det3) and (feux[i].aspect<10) then
begin
AdrSuiv:=Feux[i].Adr_el_suiv1;TypeSuiv:=Feux[i].Btype_suiv1;
AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,1,1) ; // détecteur précédent le feu ; algo 1
AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,1,1) ; // détecteur précédent le feu ; algo 1
if AdrPrec=0 then
begin
if TraceListe then Affiche('FD - Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow);
@@ -6523,18 +6495,36 @@ begin
//NivDebug:=3;
//AffSignal:=true;
maj_feu(AdrFeu);
end;
end;
end;
end;
end;
end;
if TraceListe then AfficheDebug('Création Train n°'+intToSTR(i),clyellow);
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
event_det_train[N_trains].det[1]:=det3;
event_det_train[N_trains].NbEl:=1;
if TraceListe then AfficheDebug('Création Train n°'+intToSTR(i),clyellow);
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
// si on démarre d'un buttoir
if buttoir_adjacent(det3) then
begin
if TraceListe then AfficheDebug('detection démarrage depuis détecteur '+IntToSTR(det3)+' buttoir',clyellow);
event_det_train[N_trains].det[1]:=0;
event_det_train[N_trains].det[2]:=det3;
event_det_train[N_trains].NbEl:=2;
with FormDebug.MemoEvtDet do
begin
lines.add('Nouveau Tampon train '+intToStr(N_Trains)+'--------');
begin
lines.add('Nouveau Tampon train '+intToStr(N_trains)+'--------');
lines.add(intToSTR(event_det_train[N_trains].det[1]));
lines.add(intToSTR(event_det_train[N_Trains].det[1]));
lines.add(intToSTR(event_det_train[N_Trains].det[2]));
end;
end
else
begin
event_det_train[N_trains].det[1]:=det3;
event_det_train[N_trains].NbEl:=1;
with FormDebug.MemoEvtDet do
begin
lines.add('Nouveau Tampon train '+intToStr(N_trains)+'--------');
lines.add(intToSTR(event_det_train[N_trains].det[1]));
end;
if TraceListe then
begin
AfficheDebug('Nouveau Tampon train '+intToStr(N_trains)+'--------',clyellow);
@@ -6759,7 +6749,7 @@ begin
inc(N_event_det);
event_det[N_event_det]:=Adresse;
// vérification de la connaissance de la position de tous les aiguillages au premier évènement FD détecteur
if not(PremierFD) then
if not(PremierFD) then
begin
for i:=1 to MaxAiguillage do
begin
@@ -6789,18 +6779,18 @@ begin
// Mettre à jour le TCO
if AvecTCO then
begin
begin
formTCO.Maj_TCO(Adresse);
end;
end;
// évènement d'aiguillage
// évènement d'aiguillage
procedure Event_Aig(adresse,pos : integer);
var s: string;
faire_event: boolean;
begin
// ------------------- traitement du numéro d'objet -------------------------
// init objet
{ init objet
if aiguillage[adresse].objet=0 then
begin
aiguillage[adresse].objet:=objet;
@@ -6816,7 +6806,7 @@ begin
if (N_Event_tick>=Max_Event_det_tick) then
begin
N_Event_tick:=0;
Affiche('Raz Evts détecteurs',clLime);
Affiche('Raz Evts détecteurs',clLime);
end;
s:='Tick='+IntToSTR(tick)+' Evt Aig '+intToSTR(adresse)+'='+intToSTR(pos);
if pos=const_droit then s:=s+' droit' else s:=s+' dévié';
@@ -6826,7 +6816,7 @@ begin
Affiche(s,clyellow);
AfficheDebug(s,clyellow);
end;
FormDebug.MemoEvtDet.lines.add(s) ;
FormDebug.MemoEvtDet.lines.add(s) ;
if (n_Event_tick mod 10) =0 then affiche_memoire;
inc(N_Event_tick);
event_det_tick[N_event_tick].tick:=tick;
@@ -6838,6 +6828,75 @@ begin
if AvecTCO then
begin
formTCO.Maj_TCO(Adresse);
end;
// l'évaluation des routes est à faire selon conditions
if faire_event then evalue;
end;
// pilotage d'un accessoire (décodeur d'aiguillage, de signal)
// octet = 0 ou 1 ou 2
// la sortie "octet" est mise à 1 puis à 0
// acc = aig ou feu
procedure pilote_acc(adresse : integer;octet : byte;Acc : TAccessoire);
var groupe,temps : integer ;
fonction : byte;
s : string;
begin
//Affiche(IntToSTR(adresse)+' '+intToSTr(octet),clYellow);
// pilotage par CDM rail
if CDM_connecte then
begin
//AfficheDebug(intToSTR(adresse),clred);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange);
s:=chaine_CDM_Acc(adresse,octet);
envoi_CDM(s);
if (acc=feu) and not(Raz_Acc_signaux) then exit;
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
s:=chaine_CDM_Acc(adresse,0);
envoi_CDM(s);
exit;
end;
// pilotage par USB ou par éthernet de la centrale
// Affiche('Accessoire '+intToSTR(adresse),clLime);
if (hors_tension2=false) and (portCommOuvert or parSocketLenz) then
begin
// test si pilotage aiguillage inversé
if aiguillage[adresse].inversion=1 then
begin
if octet=1 then octet:=2 else octet:=1;
end;
if (octet=0) or (octet>2) then exit;
//if (octet>2) then exit;
groupe:=(adresse-1) div 4;
fonction:=((adresse-1) mod 4)*2 + (octet-1);
// pilotage à 1
s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie
s:=checksum(s);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' '+intToSTR(octet),clorange);
envoi(s); // envoi de la trame et attente Ack
// si l'accessoire est un feu et sans raz des signaux, sortir
if (acc=feu) and not(Raz_Acc_signaux) then exit;
// si aiguillage, faire une temporisation
//if (index_feu(adresse)=0) or (Acc=aig) then
if Acc=Aig then
begin
temps:=aiguillage[adresse].temps;if temps=0 then temps:=4;
if portCommOuvert or parSocketLenz then tempo(temps);
end;
sleep(50);
// pilotage à 0 pour éteindre le pilotage de la bobine du relais
s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie
s:=checksum(s);
if debug_dec_sig and (acc=feu) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
envoi(s); // envoi de la trame et attente Ack
exit;
end;
// pas de centrale et pas CDM connecté: on change la position de l'aiguillage
@@ -6888,22 +6947,22 @@ begin
end;
end;
// état de l'aiguillage
// état de l'aiguillage
if bitsITT=$00 then // module d'aiguillages, N=1
begin
adraig:=((adresse * 4)+1 ); // *4 car N=1, c'est le "poids fort"
if (valeur and $C)=$8 then
begin
begin
Event_Aig(adraig+3,const_droit);
if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=2';AfficheDebug(s,clYellow);end;
end;
if (valeur and $C)=$4 then
begin
begin
Event_Aig(adraig+3,const_devie);
if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=1';AfficheDebug(s,clYellow);end;
end;
if (valeur and $3)=$2 then
begin
begin
Event_Aig(adraig+2,const_droit);
if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=2';AfficheDebug(s,clYellow);end;
end;
@@ -6944,22 +7003,22 @@ begin
Event_detecteur(i,(valeur and $1) = $1,'');
end;
end;
end;
if bitsITT=$00 then // module d'aiguillages
begin
adraig:=(adresse * 4)+1;
if (valeur and $C)=$8 then
begin
begin
Event_Aig(adraig+1,const_droit);
if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=2';AfficheDebug(s,clYellow);end;
end;
if (valeur and $C)=$4 then
begin
begin
Event_Aig(adraig+1,const_devie);
if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=1';AfficheDebug(s,clYellow);end;
end;
if (valeur and $3)=$2 then
begin
begin
Event_Aig(adraig,const_droit);
if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=2';AfficheDebug(s,clYellow);end;
end;
@@ -7621,7 +7680,7 @@ begin
ButtonLitCV.Enabled:=false;
LireunfichierdeCV1.enabled:=false;
end ;
// Initialisation des images des signaux
NbreImagePLigne:=Formprinc.ScrollBox1.Width div (largImg+5);
@@ -7653,15 +7712,21 @@ begin
// TCO
if avectco then
begin
begin
//créée la fenêtre TCO non modale
FormTCO:=TformTCO.Create(nil);
FormTCO.show;
end;
//essai &&&&&&&&&&
Affiche('Fin des initialisations',clyellow);
LabelEtat.Caption:=' ';
Affiche('Fin des initialisations',clyellow);
LabelEtat.Caption:=' ';
Affiche_memoire;
//---------------------------------
{
aiguillage[6].position:=const_devie;
aiguillage[4].position:=const_droit;
aiguillage[3].position:=const_droit;
aiguillage[1].position:=const_devie;
aiguillage[26].position:=const_droit;
aiguillage[28].position:=const_devie;
@@ -7740,13 +7805,13 @@ begin
var index,aspect,i,a,x,y,x0,y0,Bimage,adresse,TailleX,TailleY,orientation : integer;
imageFeu : Timage;
frx,fry : real;
s : string;
s : string;
begin
inc(tick);
if Tempo_init>0 then dec(Tempo_init);
if (Tempo_init=1) and AvecInit then
begin
if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages=1) then
if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then
begin
Affiche('Positionnement des feux',clYellow);
envoi_signauxCplx; // initialisation des feux
@@ -7827,9 +7892,9 @@ begin
begin
a:=EtatsignalCplx[0];
if TestBit(a,jaune_cli) or TestBit(a,ral_60) or
TestBit(a,rappel_60) or testBit(a,semaphore_cli) or
TestBit(a,rappel_60) or testBit(a,semaphore_cli) or
testBit(a,vert_cli) or testbit(a,blanc_cli) then
Dessine_feu_pilote; // dessiner le feu en fonction du bit "clignotant"
Dessine_feu_pilote; // dessiner le feu en fonction du bit "clignotant"
end;
end;
@@ -7850,13 +7915,7 @@ begin
end;
end;
//simulation
if (index_simule<>0) then
begin
if not(MsgSim) then
begin
Affiche('Simulation en cours ',Cyan);MsgSim:=true;
N_Event_tick:=0;
//simulation
if (index_simule<>0) then
begin
if not(MsgSim) then
@@ -7876,7 +7935,7 @@ begin
s:='Simulation '+intToSTR(I_simule)+' Tick='+IntToSTR(tick)+' det='+intToSTR(Tablo_simule[i_simule].detecteur)+'='+IntToSTR(Tablo_simule[i_simule].etat);
Event_Detecteur(Tablo_simule[i_simule].detecteur, Tablo_simule[i_simule].etat=1,''); // créer évt détecteur
StaticText.caption:=s;
end;
end;
// evt aiguillage ?
if Tablo_simule[i_simule].aiguillage<>0 then
@@ -7892,7 +7951,7 @@ begin
begin
Index_Simule:=0; // fin de simulation
I_Simule:=0;
MsgSim:=false;
MsgSim:=false;
Affiche('Fin de simulation',Cyan);
StaticText.caption:='';
end;
@@ -7925,8 +7984,9 @@ begin
procedure TFormPrinc.BoutVersionClick(Sender: TObject);
var s : string;
begin
s:=#$f0;
s:=checksum(s);
s:=#$f0;
s:=checksum(s);
envoi(s);
end;
// bouton de commande d'un accessoire
@@ -7935,14 +7995,26 @@ begin
s : string;
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
if (erreur<>0) or (valeur<0) or (valeur>255) then
pilote_acc(adr,const_droit,aig);
s:='accessoire '+IntToSTR(adr)+' droit';
Affiche(s,clyellow);
end;
procedure TFormPrinc.ButtonDevieClick(Sender: TObject);
var adr,erreur : integer;
s : string;
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
exit;
end;
@@ -8120,7 +8192,7 @@ begin
begin
for i:=1 to MaxAcc do
begin
model:=aiguillage[i].modele ;
model:=aiguillage[i].modele ;
if model<>0 then
begin
s:='Aiguillage '+IntToSTR(i)+' : '+intToSTR(aiguillage[i].position);
@@ -8303,7 +8375,7 @@ begin
//Affiche('Aig '+inttostr(adr)+' pos='+IntToSTR(etat),clyellow);
//Affiche(commandeCDM,clyellow);
// aiguillage normal
if aiguillage[adr].modele=1 then
begin
@@ -8323,8 +8395,8 @@ begin
0 : begin etatAig:=2;EtatAig2:=2;end;
end;
if (aiguillage[adr].inversionCDM=1) or (aiguillage[adr2].inversionCDM=1) then
begin
//Affiche('inverse',clyellow);
begin
//Affiche('inverse',clyellow);
prv:=adr;
adr:=adr2;
adr2:=prv;
@@ -8336,8 +8408,8 @@ begin
begin
//Affiche('Triple',clyellow);
// état de l'aiguillage 1
if (etat=0) or (etat=2) then etatAig:=2;
if etat=3 then etatAig:=1;
if (etat=0) or (etat=2) then etatAig:=2;
if etat=3 then etatAig:=1;
// état de l'aiguillage 2
adr2:=aiguillage[adr].AdrTriple;
if (etat=0) or (etat=3) then etatAig2:=2;
@@ -8598,17 +8670,17 @@ var adr,valeur,erreur : integer;
begin
FormSimulation.showModal;
end;
procedure TFormPrinc.ButtonEcrCVClick(Sender: TObject);
var adr,valeur,erreur : integer;
s : string;
s : string;
begin
// doc XpressNet page 55
val(EditCV.text,adr,erreur);
if (erreur<>0) or (Adr>255) or (Adr<0) then
begin
EditCV.Text:='1';
exit;
exit;
end;
val(EditVal.Text,valeur,erreur);
@@ -8695,10 +8767,10 @@ begin
fte : textfile;
i,cv,valeur,erreur : integer;
begin
s:=GetCurrentDir;
s:=GetCurrentDir;
//s:='C:\Program Files (x86)\Borland\Delphi7\Projects\Signaux_complexes_GL';
N_Cv:=0; // nombre de CV recus à 0
sa:='';
sa:='';
Affiche('Lecture CV',clyellow);
val(EditCV.Text,cv,erreur);
@@ -8904,8 +8976,19 @@ begin
Etat:=Feux[i].EtatSignal;
s:='Feu '+IntToSTR(Adr)+' Etat=';
code_to_aspect(Etat,aspect,combine);
s:=s+IntToSTR(etat)+'='+EtatSign[aspect]+' '+EtatSign[combine];
Affiche(s,clYellow);
end;
end;
procedure TFormPrinc.Apropos1Click(Sender: TObject);
begin
Affiche(' ',clyellow);
Affiche('Signaux complexes GL version '+version+' (C) 2020 F1IWQ Gily TDR',clWhite);
Affiche('http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906',clWhite);
Affiche('https://github.com/f1iwq2/Signaux_complexes_GL',clWhite);
Affiche(' ',clyellow);
end;

8911
UnitPrinc.~pas
View File

File diff suppressed because it is too large Load Diff

BIN
UnitSimule.dcu
View File

Binary file not shown.

BIN
UnitTCO.dcu
View File

Binary file not shown.

BIN
verif_version.dcu
View File

Binary file not shown.

2
verif_version.pas
View File

@@ -23,7 +23,7 @@ var
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='2.3'; // sert à la comparaison de la version publiée
Const Version='2.31'; // sert à la comparaison de la version publiée
implementation

1
versions.txt
View File

@@ -44,6 +44,7 @@ version 2.21 : Param
Correction d'un bug de la 2.2
version 2.3 : Changement de la méthode de réception des trames du protocole IPC de CDM-Rail
Affichage au démarrage des variables manquantes du fichier config-gl.cfg
version 2.31 : Amélioration calcul des routes depuis buttoir