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

V2.3B

Browse Source
This commit is contained in:
f1iwq2
2020-12-23 12:12:19 +01:00
parent 77b55f6aee
commit db036a7bd8
16 changed files with 1434 additions and 2764 deletions
Download Patch File Download Diff File Expand all files Collapse all files
UnitConfig.dcu
BIN
View File
Binary file not shown.
UnitConfig.dfm
+23 -24
View File
@@ -1776,7 +1776,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 585
Height = 441
ActivePage = TabSheetSig
ActivePage = TabSheetAct
Font.Charset = DEFAULT_CHARSET
Font.Color = clBackground
Font.Height = -11
@@ -2783,7 +2783,7 @@ object FormConfig: TFormConfig
Top = 48
Width = 129
Height = 21
ItemHeight = 13
ItemHeight = 0
TabOrder = 1
OnChange = ComboBoxDecChange
end
@@ -2895,31 +2895,13 @@ object FormConfig: TFormConfig
'Liste de mod'#233'lisation des actionneurs du fichier config.cfg - cl' +
'iquez sur une ligne pour afficher la description de l'#39'action'
end
object MemoAct: TMemo
Left = 0
Top = 24
Width = 289
Height = 369
Color = clInfoText
Font.Charset = DEFAULT_CHARSET
Font.Color = clAqua
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
WordWrap = False
OnClick = MemoActClick
end
object GroupBox13: TGroupBox
Left = 304
Top = 32
Width = 257
Height = 345
Caption = 'Description de l'#39'actionneur '
TabOrder = 1
TabOrder = 0
object GroupBox14: TGroupBox
Left = 16
Top = 24
@@ -2957,7 +2939,7 @@ object FormConfig: TFormConfig
end
object GroupBoxAct: TGroupBox
Left = 8
Top = 200
Top = 216
Width = 225
Height = 145
Caption = 'Actionneur fonction de locomotive '
@@ -3011,6 +2993,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 0
Text = 'EditAct'
OnChange = EditActChange
end
object EditTrain: TEdit
Left = 112
@@ -3019,6 +3002,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 1
Text = 'EditTrain'
OnChange = EditTrainChange
end
object EditEtatFoncSortie: TEdit
Left = 160
@@ -3027,6 +3011,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 2
Text = 'EditEtatFoncSortie'
OnChange = EditEtatFoncSortieChange
end
object EditFonctionAccess: TEdit
Left = 112
@@ -3035,6 +3020,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 3
Text = 'EditFonc'
OnChange = EditFonctionAccessChange
end
object EditTempo: TEdit
Left = 112
@@ -3043,6 +3029,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 4
Text = 'EditTempo'
OnChange = EditTempoChange
end
object EditEtatActionneur: TEdit
Left = 184
@@ -3051,6 +3038,7 @@ object FormConfig: TFormConfig
Height = 21
TabOrder = 5
Text = 'EditEtat'
OnChange = EditEtatActionneurChange
end
object CheckRAZ: TCheckBox
Left = 48
@@ -3059,11 +3047,12 @@ object FormConfig: TFormConfig
Height = 17
Caption = 'Remise '#224' 0 apr'#232's pilotage'
TabOrder = 6
OnClick = CheckRAZClick
end
end
object GroupBoxPN: TGroupBox
Left = 72
Top = 8
Left = 56
Top = 56
Width = 225
Height = 193
Caption = 'Actionneurs gestion passage '#224' niveau'
@@ -3207,6 +3196,16 @@ object FormConfig: TFormConfig
end
end
end
object RichAct: TRichEdit
Left = 0
Top = 32
Width = 289
Height = 369
Color = clBlack
ScrollBars = ssVertical
TabOrder = 1
OnMouseDown = RichActMouseDown
end
end
end
end
UnitConfig.pas
+221 -17
View File
@@ -77,7 +77,6 @@ type
Label15: TLabel;
TabSheetAct: TTabSheet;
Label16: TLabel;
MemoAct: TMemo;
CheckBoxSrvSig: TCheckBox;
Memo1: TMemo;
Memo2: TMemo;
@@ -185,12 +184,12 @@ type
GroupBox15: TGroupBox;
EditNbDetDist: TEdit;
Label31: TLabel;
RichAct: TRichEdit;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MemoSignauxClick(Sender: TObject);
procedure MemoActClick(Sender: TObject);
procedure PageControlChange(Sender: TObject);
procedure RichAigMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
@@ -213,6 +212,15 @@ type
procedure EditSuiv3Change(Sender: TObject);
procedure EditDet4Change(Sender: TObject);
procedure EditSuiv4Change(Sender: TObject);
procedure EditActChange(Sender: TObject);
procedure RichActMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EditEtatActionneurChange(Sender: TObject);
procedure EditTrainChange(Sender: TObject);
procedure EditFonctionAccessChange(Sender: TObject);
procedure EditEtatFoncSortieChange(Sender: TObject);
procedure EditTempoChange(Sender: TObject);
procedure CheckRAZClick(Sender: TObject);
private
{ Déclarations privées }
public
@@ -267,7 +275,7 @@ var temps : integer;
begin
if SocketCDM_connecte=false then begin envoi_CDM:=false;exit;end;
//Affiche('Envoi à CDM rail',clRed);Affiche(s,ClGreen);
if trace then affiche(s,clLime);
if traceTrames then afficheDebug(s,clLime);
Formprinc.ClientSocketCDM.Socket.SendText(s);
// attend l'ack
ackCDM:=false;nackCDM:=false;
@@ -333,7 +341,7 @@ begin
end;
procedure connecte_CDM;
var s , ss : string;
var s : string;
i : integer;
begin
// déconnexion de l'ancienne liaison éventuelle
@@ -389,7 +397,7 @@ end;
// teste si une adresse IP V4 est ok
function Ipok(s : string) : boolean;
var i,k,posp,n,octet,erreur : integer;
var i,k,octet,erreur : integer;
begin
for k:=1 to 3 do
begin
@@ -405,7 +413,7 @@ end;
// vérifie si la config de la com série/usb est ok
function config_com(s : string) : boolean;
var sa : string;
j,i,erreur : integer;
i,erreur : integer;
begin
sa:=s;
protocole:=-1;
@@ -414,19 +422,15 @@ begin
if i<>0 then
begin
delete(s,1,i);
j:=i;
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
@@ -564,6 +568,30 @@ begin
encode_sig:=s;
end;
// transforme l'actionneur type loco ou actionneur du tableau en texte
// paramètre d'entrée : index
function encode_act_loc(i : integer): string;
var s : string;
c : char;
adresse : integer;
begin
// adresse
adresse:=Tablo_Actionneur[i].actionneur;
if adresse=0 then begin encode_act_loc:='';exit;end;
if Formconfig.radioButtonLoc.Checked then
s:=IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].Etat)+','+Tablo_Actionneur[i].train+',F'+IntToSTR(Tablo_Actionneur[i].fonction)+','+intToSTR(Tablo_Actionneur[i].tempo);
if FormConfig.RadioButtonAccess.Checked then
begin
s:=IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].Etat)+','+Tablo_Actionneur[i].train+
',A'+IntToSTR(Tablo_Actionneur[i].accessoire)+','+intToSTR(Tablo_Actionneur[i].sortie)+',';
if Tablo_Actionneur[i].Raz then s:=s+'Z' else s:=s+'S';
end;
encode_act_loc:=s;
end;
// modifie les fichiers de config en fonction du paramétrage
procedure genere_config;
var s: string;
@@ -1040,7 +1068,10 @@ begin
// actionneurs
for i:=1 to maxTablo_act do
MemoAct.Lines.Add(mod_Act[i]);
begin
RichAct.Lines.Add(mod_Act[i]);
RE_ColorLine(RichAct,RichAct.lines.count-1,ClAqua)
end;
PageControl.ActivePage:=TabSheetCDM; // force le premier onglet sur la page
for i:=1 to NbDecodeur do
@@ -1415,9 +1446,12 @@ var i,v, ligne,etatact,erreur, adresse,sortie,fonction,tempo,access : integer;
s,s2,ss : string;
trouve : bool;
begin
with formConfig.MemoAct do
with formConfig.RichAct do
begin
ligne:=Perform(EM_LINEFROMCHAR,-1,0); // numéro de la lignée cliquée
AncLigneCliquee:=Ligne;
ligneCliquee:=ligne;
//affiche(intToSTR(ligne),clLime);
s:=Uppercase(Lines[ligne]);
if s='' then exit;
SelStart:=Perform(EM_LINEINDEX,Ligne,0); // début de la sélection
@@ -1578,11 +1612,6 @@ begin
Aff_champs_sig;
end;
procedure TFormConfig.MemoActClick(Sender: TObject);
begin
Aff_champs_act;
end;
procedure TFormConfig.PageControlChange(Sender: TObject);
begin
if PageControl.ActivePage=TabSheetAig then
@@ -2114,6 +2143,181 @@ begin
end;
end;
procedure TFormConfig.EditActChange(Sender: TObject);
var s : string;
act,erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
s:=EditAct.Text;
if radioButtonLoc.Checked or RadioButtonAccess.Checked then
begin
Val(s,act,erreur);
if erreur<>0 then
begin
LabelInfo.caption:='Erreur adresse actionneur';exit
end else LabelInfo.caption:=' ';
tablo_actionneur[lignecliquee+1].actionneur:=act;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
procedure TFormConfig.RichActMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
clicliste:=true;
LabelInfo.caption:='';
Aff_champs_Act;
clicliste:=false;
end;
procedure TFormConfig.EditEtatActionneurChange(Sender: TObject);
var s : string;
etat,erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
s:=EditEtatActionneur.Text;
if radioButtonLoc.Checked or RadioButtonAccess.Checked then
begin
Val(s,etat,erreur);
if (erreur<>0) or (etat<0) or (etat>1) then
begin
LabelInfo.caption:='Erreur état actionneur';exit
end else LabelInfo.caption:=' ';
tablo_actionneur[lignecliquee+1].etat:=etat;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
procedure TFormConfig.EditTrainChange(Sender: TObject);
var s,train : string;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
if radioButtonLoc.Checked or RadioButtonAccess.Checked then
begin
train:=editTrain.Text;
if train='' then
begin
LabelInfo.caption:='Erreur train';exit
end else LabelInfo.caption:=' ';
tablo_actionneur[lignecliquee+1].train:=train;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
procedure TFormConfig.EditFonctionAccessChange(Sender: TObject);
var s : string;
fonction,erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
s:=EditFonctionAccess.Text;
if radioButtonLoc.Checked or RadioButtonAccess.Checked then
begin
Val(s,fonction,erreur);
if erreur<>0 then
begin
LabelInfo.caption:='Erreur fonction actionneur';exit
end else LabelInfo.caption:=' ';
if radioButtonLoc.Checked then tablo_actionneur[lignecliquee+1].fonction:=fonction;
if RadioButtonAccess.Checked then Tablo_Actionneur[lignecliquee+1].accessoire:=fonction;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
procedure TFormConfig.EditEtatFoncSortieChange(Sender: TObject);
var s : string;
Etat,erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
s:=EditEtatFoncSortie.Text;
if radioButtonAccess.Checked then
begin
Val(s,etat,erreur);
if (erreur<>0) or (etat<0) or (etat>2) then
begin
LabelInfo.caption:='Erreur Etat actionneur';exit
end else LabelInfo.caption:=' ';
tablo_actionneur[lignecliquee+1].sortie:=etat;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
procedure TFormConfig.EditTempoChange(Sender: TObject);
var s : string;
tempo,erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
s:=EditTempo.Text;
if radioButtonLoc.Checked then
begin
Val(s,tempo,erreur);
if erreur<>0 then
begin
LabelInfo.caption:='Erreur Tempo actionneur';exit
end else LabelInfo.caption:=' ';
tablo_actionneur[lignecliquee+1].tempo:=tempo;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
procedure TFormConfig.CheckRAZClick(Sender: TObject);
var s : string;
Etat,erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then
with Formconfig do
begin
if radioButtonAccess.Checked then
begin
tablo_actionneur[lignecliquee+1].raz:=CheckRAZ.checked;
s:=encode_act_loc(lignecliquee+1);
RichAct.Lines[lignecliquee]:=s;
end;
end;
end;
end.
UnitDebug.dcu
BIN
View File
Binary file not shown.
UnitDebug.dfm
+51 -36
View File
@@ -1,7 +1,7 @@
object FormDebug: TFormDebug
Left = 329
Top = 122
Width = 842
Width = 855
Height = 762
Caption = 'Fen'#234'tre de d'#233'bug'
Color = clWindow
@@ -15,12 +15,12 @@ object FormDebug: TFormDebug
Position = poMainFormCenter
OnCreate = FormCreate
DesignSize = (
826
839
724)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 642
Left = 655
Top = 4
Width = 108
Height = 13
@@ -36,7 +36,7 @@ object FormDebug: TFormDebug
ParentFont = False
end
object Label2: TLabel
Left = 474
Left = 487
Top = 2
Width = 131
Height = 18
@@ -50,7 +50,7 @@ object FormDebug: TFormDebug
ParentFont = False
end
object Label3: TLabel
Left = 472
Left = 485
Top = 160
Width = 99
Height = 185
@@ -68,7 +68,7 @@ object FormDebug: TFormDebug
WordWrap = True
end
object EditNivDebug: TEdit
Left = 754
Left = 767
Top = 2
Width = 49
Height = 21
@@ -84,7 +84,7 @@ object FormDebug: TFormDebug
OnKeyPress = EditNivDebugKeyPress
end
object MemoEvtDet: TMemo
Left = 578
Left = 591
Top = 344
Width = 239
Height = 225
@@ -103,7 +103,7 @@ object FormDebug: TFormDebug
TabOrder = 1
end
object ButtonEcrLog: TButton
Left = 474
Left = 487
Top = 464
Width = 97
Height = 29
@@ -112,52 +112,40 @@ object FormDebug: TFormDebug
TabOrder = 2
OnClick = ButtonEcrLogClick
end
object MemoDebug: TMemo
Left = 0
Top = 0
Width = 465
Height = 721
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'MemoDebug')
ScrollBars = ssBoth
TabOrder = 3
WordWrap = False
end
object ButtonRazTampon: TButton
Left = 474
Left = 487
Top = 536
Width = 97
Height = 33
Anchors = [akTop, akRight]
Caption = 'Raz Tampon Ev'#232'nements ---->'
TabOrder = 4
TabOrder = 3
WordWrap = True
OnClick = ButtonRazTamponClick
end
object ButtonCherche: TButton
Left = 474
Left = 487
Top = 432
Width = 97
Height = 25
Anchors = [akTop, akRight]
Caption = 'Chercher erreurs'
TabOrder = 5
TabOrder = 4
OnClick = ButtonChercheClick
end
object ButtonAffEvtChrono: TButton
Left = 474
Left = 487
Top = 392
Width = 97
Height = 33
Anchors = [akTop, akRight]
Caption = 'Affiche Evts d'#233'tecteurs et aig'
TabOrder = 6
TabOrder = 5
WordWrap = True
OnClick = ButtonAffEvtChronoClick
end
object ButtonCop: TButton
Left = 474
Left = 487
Top = 344
Width = 97
Height = 41
@@ -169,34 +157,40 @@ object FormDebug: TFormDebug
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 7
TabOrder = 6
WordWrap = True
OnClick = ButtonCopClick
end
object RichEdit: TRichEdit
Left = 578
Left = 591
Top = 160
Width = 239
Height = 185
Anchors = [akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HideScrollBars = False
ParentFont = False
PopupMenu = PopupMenuRE
ScrollBars = ssVertical
TabOrder = 8
TabOrder = 7
end
object ButtonRazLog: TButton
Left = 474
Left = 487
Top = 496
Width = 97
Height = 33
Anchors = [akTop, akRight]
Caption = 'Raz Tampon Log <-----'
TabOrder = 9
TabOrder = 8
WordWrap = True
OnClick = ButtonRazLogClick
end
object GroupBox1: TGroupBox
Left = 472
Left = 485
Top = 576
Width = 353
Height = 145
@@ -210,7 +204,7 @@ object FormDebug: TFormDebug
Font.Style = []
ParentColor = False
ParentFont = False
TabOrder = 10
TabOrder = 9
object GroupBox3: TGroupBox
Left = 8
Top = 16
@@ -332,7 +326,7 @@ object FormDebug: TFormDebug
end
end
object GroupBox2: TGroupBox
Left = 472
Left = 485
Top = 20
Width = 345
Height = 137
@@ -346,7 +340,7 @@ object FormDebug: TFormDebug
Font.Style = []
ParentColor = False
ParentFont = False
TabOrder = 11
TabOrder = 10
object CheckAffSig: TCheckBox
Left = 8
Top = 16
@@ -455,6 +449,19 @@ object FormDebug: TFormDebug
OnClick = CheckBoxAffDebDecSigClick
end
end
object RichDebug: TRichEdit
Left = 8
Top = 8
Width = 470
Height = 705
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'RichDebug')
PopupMenu = PopupMenuRD
ScrollBars = ssBoth
TabOrder = 11
OnChange = RichDebugChange
end
object SaveDialog: TSaveDialog
Left = 768
Top = 488
@@ -467,4 +474,12 @@ object FormDebug: TFormDebug
OnClick = copier1Click
end
end
object PopupMenuRD: TPopupMenu
Left = 808
Top = 360
object Copier2: TMenuItem
Caption = 'Copier'
OnClick = Copier2Click
end
end
end
UnitDebug.pas
+36 -19
View File
@@ -15,7 +15,6 @@ type
SaveDialog: TSaveDialog;
ButtonEcrLog: TButton;
Label3: TLabel;
MemoDebug: TMemo;
ButtonRazTampon: TButton;
ButtonCherche: TButton;
ButtonAffEvtChrono: TButton;
@@ -44,6 +43,9 @@ type
EditActuel: TEdit;
Button1: TButton;
Button2: TButton;
RichDebug: TRichEdit;
PopupMenuRD: TPopupMenu;
Copier2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure ButtonEcrLogClick(Sender: TObject);
procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char);
@@ -65,6 +67,8 @@ type
procedure ButtonCanSuivSigClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Copier2Click(Sender: TObject);
procedure RichDebugChange(Sender: TObject);
private
{ Déclarations privées }
public
@@ -113,11 +117,6 @@ uses UnitPrinc;
{$R *.dfm}
procedure AfficheDebug(s : string;lacouleur : TColor);
begin
FormDebug.MemoDebug.Lines.add(s);
end;
procedure RE_ColorLine(ARichEdit : TRichEdit;ARow : Integer;AColor : TColor);
begin
with ARichEdit do
@@ -129,6 +128,13 @@ begin
end;
end;
procedure AfficheDebug(s : string;lacouleur : TColor);
begin
FormDebug.RichDebug.Lines.add(s);
RE_ColorLine(FormDebug.RichDebug,FormDebug.RichDebug.lines.count-1,lacouleur);
end;
procedure TFormDebug.FormCreate(Sender: TObject);
var s: string;
i : integer;
@@ -138,14 +144,14 @@ begin
s:=s+'comportement du programme. Positionner le niveau de 1 à 3 pour';
s:=s+' afficher des informations plus ou moins détaillées.';
Label3.caption:=s;
MemoDebug.WordWrap:=false; // interdit la coupure des chaînes en limite du composant
MemoDebug.color:=$33;
RichDebug.WordWrap:=false; // interdit la coupure des chaînes en limite du composant
RichDebug.color:=$33;
initform:=false;
MemoDebug.clear;
RichDebug.clear;
s:=DateToStr(date)+' '+TimeToStr(Time)+' ';
if IsWow64Process then s:=s+' OS 64 Bits' else s:=s+' OS 32 Bits';
RichEdit.color:=$111122;
MemoDebug.Lines.add(s);
RichDebug.Lines.add(s);
end;
procedure TFormDebug.ButtonEcrLogClick(Sender: TObject);
@@ -163,7 +169,7 @@ begin
assignFile(fte,s);
rewrite(fte);
writeln(fte,s);
with MemoDebug do
with RichDebug do
for i:=0 to Lines.Count do
begin
writeln(fte,Lines[i]);
@@ -186,7 +192,7 @@ begin
end
else EditNivDebug.text:='0';
end;
MemoDebug.Lines.add('Niveau='+intToSTR(NivDebug));
RichDebug.Lines.add('Niveau='+intToSTR(NivDebug));
end;
@@ -208,7 +214,7 @@ var i : integer;
trouve : boolean;
begin
with MemoDebug do
with RichDebug do
begin
i:=0;
repeat
@@ -229,7 +235,7 @@ procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject);
var i,j,etat : integer;
s : string;
begin
MemoDebug.Clear;
RichDebug.Clear;
if N_event_tick=0 then
begin
AfficheDebug('Il n''y a aucun évènement détecteur ou aiguillage',clyellow);
@@ -269,17 +275,15 @@ end;
procedure TFormDebug.CheckTrameClick(Sender: TObject);
begin
trace:=CheckTrame.Checked;
traceTrames:=CheckTrame.Checked;
end;
procedure TFormDebug.ButtonCopClick(Sender: TObject);
var i : integer;
begin
MemoDebug.Lines:=Formprinc.ListBox1.Items
RichDebug.Lines:=Formprinc.FenRich.lines;
end;
procedure TFormDebug.copier1Click(Sender: TObject);
begin
RichEdit.SelectAll;
@@ -289,7 +293,7 @@ end;
procedure TFormDebug.ButtonRazLogClick(Sender: TObject);
begin
MemoDebug.Clear;
RichDebug.Clear;
end;
procedure TFormDebug.CheckBoxActClick(Sender: TObject);
@@ -376,4 +380,17 @@ begin
NivDebug:=AncDebug;
end;
procedure TFormDebug.Copier2Click(Sender: TObject);
begin
RichDebug.SelectAll;
RichDebug.CopyToClipboard;
RichDebug.SetFocus;
end;
// pour déplacer l'ascenseur de l'affichage automatiquement en bas
procedure TFormDebug.RichDebugChange(Sender: TObject);
begin
SendMessage(RichDebug.handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
end.
UnitPrinc.dcu
BIN
View File
Binary file not shown.
UnitPrinc.dfm
+37 -24
View File
@@ -1,6 +1,6 @@
object FormPrinc: TFormPrinc
Left = 12
Top = 210
Left = 1296
Top = 222
Width = 1212
Height = 664
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
@@ -1201,24 +1201,6 @@ object FormPrinc: TFormPrinc
Font.Style = []
ParentFont = False
end
object ListBox1: TListBox
Left = 8
Top = 48
Width = 609
Height = 505
Style = lbOwnerDrawFixed
Anchors = [akLeft, akTop, akRight, akBottom]
Color = clBlack
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = 16
Font.Name = 'Arial'
Font.Style = []
ItemHeight = 16
ParentFont = False
TabOrder = 0
OnDrawItem = ListBox1DrawItem
end
object ScrollBox1: TScrollBox
Left = 631
Top = 168
@@ -1231,7 +1213,7 @@ object FormPrinc: TFormPrinc
Anchors = [akTop, akRight, akBottom]
Color = clWhite
ParentColor = False
TabOrder = 1
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 631
@@ -1240,7 +1222,7 @@ object FormPrinc: TFormPrinc
Height = 129
Anchors = [akTop, akRight]
Caption = 'Commande d'#39'accessoires'
TabOrder = 2
TabOrder = 1
object Label2: TLabel
Left = 7
Top = 16
@@ -1339,7 +1321,7 @@ object FormPrinc: TFormPrinc
Width = 281
Height = 129
Anchors = [akTop, akRight]
TabOrder = 5
TabOrder = 4
object BoutonRaf: TButton
Left = 8
Top = 8
@@ -1439,7 +1421,7 @@ object FormPrinc: TFormPrinc
Height = 25
Anchors = [akTop, akRight]
Caption = 'Panel2'
TabOrder = 6
TabOrder = 5
object Label1: TLabel
Left = 16
Top = 4
@@ -1468,7 +1450,26 @@ object FormPrinc: TFormPrinc
Height = 17
Anchors = [akLeft, akRight, akBottom]
Caption = 'xx'
TabOrder = 6
end
object FenRich: TRichEdit
Left = 8
Top = 48
Width = 617
Height = 497
Anchors = [akLeft, akTop, akRight, akBottom]
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clYellow
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
PopupMenu = PopupMenuFenRich
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 7
OnChange = FenRichChange
end
object Timer1: TTimer
Interval = 100
@@ -1499,6 +1500,10 @@ object FormPrinc: TFormPrinc
Caption = 'Etat des aiguillages'
OnClick = Etatdesaiguillages1Click
end
object Etatdessignaux1: TMenuItem
Caption = 'Etat des signaux'
OnClick = Etatdessignaux1Click
end
object N3: TMenuItem
Caption = '-'
end
@@ -1611,4 +1616,12 @@ object FormPrinc: TFormPrinc
Left = 888
Top = 16
end
object PopupMenuFenRich: TPopupMenu
Left = 208
Top = 24
object Copier1: TMenuItem
Caption = 'Copier'
OnClick = Copier1Click
end
end
end
UnitPrinc.pas
+92 -79
View File
@@ -20,7 +20,6 @@ uses
type
TFormPrinc = class(TForm)
ListBox1: TListBox;
Timer1: TTimer;
LabelTitre: TLabel;
ScrollBox1: TScrollBox;
@@ -91,6 +90,10 @@ type
ButtonLanceCDM: TButton;
Affichefentredebug1: TMenuItem;
StaticText: TStaticText;
FenRich: TRichEdit;
PopupMenuFenRich: TPopupMenu;
Copier1: TMenuItem;
Etatdessignaux1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -98,8 +101,6 @@ type
procedure BoutVersionClick(Sender: TObject);
procedure ButtonCommandeClick(Sender: TObject);
procedure EditvalEnter(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure BoutonRafClick(Sender: TObject);
procedure ClientSocketLenzError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
@@ -143,7 +144,9 @@ type
procedure ButtonAffTCOClick(Sender: TObject);
procedure ButtonLanceCDMClick(Sender: TObject);
procedure Affichefentredebug1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FenRichChange(Sender: TObject);
procedure Copier1Click(Sender: TObject);
procedure Etatdessignaux1Click(Sender: TObject);
private
{ Déclarations privées }
procedure DoHint(Sender : Tobject);
@@ -236,7 +239,7 @@ var
branche : array [1..100] of string;
FormPrinc: TFormPrinc;
ack,portCommOuvert,trace,AffMem,AfficheDet,CDM_connecte,SocketCDM_connecte,
ack,portCommOuvert,traceTrames,AffMem,AfficheDet,CDM_connecte,SocketCDM_connecte,
Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,
Srvc_PosTrain,Srvc_Sig,debugtrames : boolean;
tablo : array of byte; // tableau rx usb
@@ -414,10 +417,8 @@ begin
begin
brush.Color:=couleur;
Pen.Color:=clBlack;
//Affiche('clignote '+IntToSTR(x)+' '+intToSTR(y),clyellow);
Ellipse(x-rayon,y-rayon,x+rayon,y+rayon);
end;
//Affiche(IntToSTR(y),clyellow);
end;
// dessine les feux sur une cible à 2 feux dans le canvas spécifié
@@ -1058,19 +1059,18 @@ begin
end;
// affiche un texte dans la fenêtre
procedure Affiche(s : string;lacouleur : TColor);
begin
couleur:=lacouleur;
with formprinc.ListBox1 do
with formprinc do
begin
Items.addObject(s,pointer(lacouleur));
TopIndex:= Items.Count - 1;
FenRich.lines.add(s);
RE_ColorLine(FenRich,FenRich.lines.count-1,lacouleur);
//FenRich.SetFocus;
//FenRich.SelStart := FenRich.GetTextLen;
//FenRich.Perform(EM_SCROLLCARET, 0, 0);
end;
end;
// renvoie l'index du feu dans le tableau feux[] en fonction de son adresse
//si pas de feu renvoie 0
function Index_feu(adresse : integer) : integer;
@@ -1265,7 +1265,7 @@ end;
// Affiche une chaîne en Hexa Ascii
procedure affiche_chaine_hex(s : string;couleur : Tcolor);
begin
if trace then Affiche(chaine_HEX(s),couleur);
if traceTrames then AfficheDebug(chaine_HEX(s),couleur);
end;
// temporisation en x 100 ms (0,1 s)
@@ -1285,7 +1285,7 @@ var i,timeout,valto : integer;
begin
// com:=formprinc.MSCommUSBLenz;
s:=entete+s+suffixe;
if Trace then Affiche('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClGreen);
if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Env '+chaine_Hex(s),ClGreen);
// par port com-usb
if portCommOuvert then
@@ -3570,10 +3570,9 @@ begin
trouve_fonte:=true;
delete(s,i,length(sa));
TailleFonte:=StrToINT(s);
with FormPrinc.ListBox1 do
with FormPrinc.FenRich do
begin
Font.Height:=TailleFonte;
ItemHeight:=TailleFonte+1;
Font.Size:=TailleFonte;
end;
end;
@@ -4041,8 +4040,7 @@ begin
s:=lit_ligne;
mod_Branches[Nligne]:=s;inc(Nligne);
//Affiche(s,clWhite);
//adresse:=pos('0',s);
//s:='A16B,557,0' ;
if s<>'0' then
begin
branche[i]:=s;
@@ -4077,6 +4075,7 @@ begin
begin
//Affiche(IntToSTR(detect),clyellow);
//Affiche(s,clorange); Affiche(IntToStr(detect),clorange);
//if detect=0 then affiche('buttoir'+sOrigine,clyellow);
BrancheN[i,j].adresse:=detect; // adresse
BrancheN[i,j].btype:=1;// ident détecteur
if detect=0 then begin BrancheN[i,j].btype:=4;end; // buttoir
@@ -5239,7 +5238,8 @@ end;
// renvoie l'adresse du détecteur suivant des deux éléments contigus
// TypeElprec/actuel: 1= détecteur 2= aiguillage 4=Buttoir
function detecteur_suivant(prec : integer;TypeElPrec : integer;actuel : integer;TypeElActuel : integer) : integer ;
// algo= type d'algorythme pour suivant_alg3
function detecteur_suivant(prec : integer;TypeElPrec : integer;actuel : integer;TypeElActuel,algo : integer) : integer ;
var actuelCalc,PrecCalc,etat,i,j,AdrSuiv ,
TypeprecCalc,TypeActuelCalc : integer;
begin
@@ -5253,7 +5253,7 @@ begin
// étape 1 trouver le sens
repeat
inc(j);
AdrSuiv:=suivant_alg3(precCalc,TypeprecCalc,actuelCalc,TypeActuelCalc,1);
AdrSuiv:=suivant_alg3(precCalc,TypeprecCalc,actuelCalc,TypeActuelCalc,algo);
if (typeGen=2) and false then // si le précédent est une TJD/S et le suivant aussi
begin
if ((aiguillage[AdrSuiv].modele=2) or (aiguillage[AdrSuiv].modele=3)) and
@@ -5270,6 +5270,7 @@ begin
TypeActuelCalc:=typeGen;
//Affiche('Suivant signalaig='+IntToSTR(AdrSuiv),clyellow);
until (j=10) or (typeGen=1) or (AdrSuiv=0) or (AdrSuiv>=9996); // arret si détecteur
// si trouvé le sens, trouver le suivant
if AdrSuiv=actuel then
begin
@@ -5398,7 +5399,7 @@ begin
if j=2 then i1:=IndexBranche_det1-1;
if NivDebug=3 then
begin
s:='Test 1 en ';
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);
@@ -5434,7 +5435,7 @@ begin
sortie:=((typeDet2=TypeGen) and (Adr=el2)) or (Adr=0) or (Adr>=9996) or (i=15) or (N_Det=Nb_det_dist);
until sortie ;
if (i=15) and (Nivdebug=3) then afficheDebug('Pas trouvé',clyellow);
if (N_det=Nb_det_dist) and (Nivdebug=3) then afficheDebug('Détecteurs trop distants',clyellow);
if (N_det=Nb_det_dist) and (Nivdebug=3) then afficheDebug('Détecteurs trop distants',clred);
end
else
@@ -5443,7 +5444,7 @@ begin
adr:=el2;typeGen:=TypeDet2;
end;
if (typeDet2=TypeGen) and (Adr=el2) then
if (typeDet2=TypeGen) and (Adr=el2) and (N_Det<>Nb_det_dist) then
begin
if Nivdebug=3 then AfficheDebug('614 : Trouvé '+intToSTR(el2),clYellow);
i:=0;
@@ -5458,6 +5459,7 @@ begin
case typeGen of
1 : s:=s+' detecteur';
2 : s:=s+' aiguillage';
4 : s:=s+' buttoir';
end;
AfficheDebug(s,clorange);
end;
@@ -5468,7 +5470,7 @@ begin
sortie:=(TypeGen=1) or (Adr=0) or (Adr>=9996) or (i=10);
until sortie;
if TypeGen=1 then
if (TypeGen=1) or (TypeGen=4) then
begin
if NivDebug=3 then
begin
@@ -5482,7 +5484,7 @@ begin
if (i=10) then if NivDebug=3 then AfficheDebug('201 : Itération trop longue',clred);
inc(j);
//AfficheDebug('j='+intToSTR(j),clyellow);
until j=3;
until j=3; // boucle incrément/décrément
detecteur_suivant_el:=9996;
if NivDebug=3 then affichedebug('------------------',clyellow);
@@ -5866,7 +5868,7 @@ begin
ife:=1; // index feu de 1 à 4 pour explorer les 4 détecteurs d'un feu
repeat
j:=0;
if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clred);
if NivDebug=3 then AfficheDebug('Boucle de test feu '+intToSTR(ife)+'/4',clOrange);
if (ife=1) then
begin
prec:=feux[i].Adr_det1;
@@ -5934,7 +5936,7 @@ begin
end;
if NivDebug=3 then AfficheDebug('130 - suivant='+IntToSTR(adrsuiv),clred);
if NivDebug=3 then AfficheDebug('132 - suivant='+IntToSTR(adrsuiv),clYellow);
if actuel=0 then
begin
// si c'est un buttoir
@@ -6072,13 +6074,13 @@ begin
test_route_valide:=10 ;
end;
// présence train 3 détecteurs avant le feu
function PresTrainPrec(AdrFeu : integer) : boolean;
var PresTrain : boolean;
j,i,Det_initial,Adr_El_Suiv,Btype_el_suivant,DetPrec1,DetPrec2,DetPrec3,DetPrec4 : integer;
begin
i:=index_feu(Adrfeu);
//memZone[518,520]:=true;
if i=0 then
begin
Affiche('Erreur 602 - feu '+IntToSTR(adrFeu)+' non trouvé',clred);
@@ -6104,27 +6106,27 @@ begin
if (j=2) then
begin
det_initial:=feux[i].Adr_det2;Adr_El_Suiv:=feux[i].Adr_el_suiv2;
if feux[i].Btype_suiv1=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv1=4 then Btype_el_suivant:=2;
if feux[i].Btype_suiv2=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv2=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv2=4 then Btype_el_suivant:=2;
end;
if (j=3) then
begin
det_initial:=feux[i].Adr_det3;Adr_El_Suiv:=feux[i].Adr_el_suiv3;
if feux[i].Btype_suiv1=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv1=4 then Btype_el_suivant:=2;
if feux[i].Btype_suiv3=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv3=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv3=4 then Btype_el_suivant:=2;
end;
if (j=4) then
begin
det_initial:=feux[i].Adr_det4;Adr_El_Suiv:=feux[i].Adr_el_suiv4;
if feux[i].Btype_suiv1=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv1=4 then Btype_el_suivant:=2;
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;
end;
if (det_initial<>0) then
begin
DetPrec1:=detecteur_suivant(Adr_El_Suiv,Btype_el_suivant,det_initial,1);
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
DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1);
@@ -6295,6 +6297,8 @@ begin
// si le signal suivant est rouge
begin
if AffSignal then AfficheDebug('pas d''aiguille déviée',clYellow);
// effacer la signbalisation combinée
EtatSignalCplx[adrFeu]:=EtatSignalCplx[adrFeu] and not($3c00);
if TestBit(etat,carre) or testBit(etat,semaphore) or testBit(etat,semaphore_cli )then Maj_Etat_Signal(AdrFeu,jaune)
else
begin
@@ -6505,7 +6509,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) ; // détecteur précédent le feu
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);
@@ -6726,7 +6730,7 @@ begin
begin
AdrSuiv:=Feux[i].Adr_el_suiv1;TypeSuiv:=Feux[i].Btype_suiv1;
if AffSignal then AfficheDebug('Pour Feu '+intToSTR(AdrFeu)+' detecteursuivant('+intToSTR(AdrSuiv)+','+IntToSTR(typeSuiv)+','+intToSTR(AdrDetFeu)+',1)',clyellow);
AdrPrec:=detecteur_suivant(AdrSuiv,typeSuiv,AdrDetFeu,1) ; // détecteur précédent le feu
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 AfficheDebug('Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow);
@@ -6885,22 +6889,22 @@ begin
if (valeur and $C)=$8 then
begin
Event_Aig(adraig+3,const_droit,0);
if trace then begin s:='accessoire '+intToSTR(adraig+3)+'=2';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=2';AfficheDebug(s,clYellow);end;
end;
if (valeur and $C)=$4 then
begin
Event_Aig(adraig+3,const_devie,0);
if trace then begin s:='accessoire '+intToSTR(adraig+3)+'=1';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig+3)+'=1';AfficheDebug(s,clYellow);end;
end;
if (valeur and $3)=$2 then
begin
Event_Aig(adraig+2,const_droit,0);
if trace then begin s:='accessoire '+intToSTR(adraig+2)+'=2';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=2';AfficheDebug(s,clYellow);end;
end;
if (valeur and $3)=$1 then
begin
Event_Aig(adraig+2,const_devie,0);
if trace then begin s:='accessoire '+intToSTR(adraig+2)+'=1';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig+2)+'=1';AfficheDebug(s,clYellow);end;
end;
end;
end;
@@ -6941,22 +6945,22 @@ begin
if (valeur and $C)=$8 then
begin
Event_Aig(adraig+1,const_droit,0);
if trace then begin s:='accessoire '+intToSTR(adraig+1)+'=2';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=2';AfficheDebug(s,clYellow);end;
end;
if (valeur and $C)=$4 then
begin
Event_Aig(adraig+1,const_devie,0);
if trace then begin s:='accessoire '+intToSTR(adraig+1)+'=1';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig+1)+'=1';AfficheDebug(s,clYellow);end;
end;
if (valeur and $3)=$2 then
begin
Event_Aig(adraig,const_droit,0);
if trace then begin s:='accessoire '+intToSTR(adraig)+'=2';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=2';AfficheDebug(s,clYellow);end;
end;
if (valeur and $3)=$1 then
begin
Event_Aig(adraig,const_devie,0);
if trace then begin s:='accessoire '+intToSTR(adraig)+'=1';Affiche(s,clYellow);end;
if traceTrames then begin s:='accessoire '+intToSTR(adraig)+'=1';AfficheDebug(s,clYellow);end;
end;
end;
end;
@@ -6982,8 +6986,8 @@ begin
#5 : begin nack:=true;msg:='plus de time slot';end;
#6 : begin nack:=true;msg:='débordement tampon LI100';end;
end;
if trace and (chaineINT[2]=#4) then Affiche(msg,clYellow);
if trace and (chaineINT[2]<>#4) then Affiche(msg,clRed);
if traceTrames and (chaineINT[2]=#4) then AfficheDebug(msg,clYellow);
if traceTrames and (chaineINT[2]<>#4) then AfficheDebug(msg,clRed);
delete(chaineINT,1,3);
decode_chaine_retro:=chaineINT;
exit;
@@ -7682,7 +7686,7 @@ begin
begin
chaine_recue:=chaine_recue+char(tablo[i]);
end;
if trace then Affiche('Tick='+IntToSTR(tick)+'/Rec '+chaine_Hex(chaine_recue),Clwhite);
if traceTrames then AfficheDebug('Tick='+IntToSTR(tick)+'/Rec '+chaine_Hex(chaine_recue),Clwhite);
if terminal then Affiche(chaine_recue,clLime);
interprete_reponse(chaine_recue);
chaine_recue:='';
@@ -7946,17 +7950,6 @@ begin
if (Editval.Text<>'1') and (Editval.Text<>'2') then editval.text:='1';
end;
// gestion de la couleur des textes de la list box
procedure TFormPrinc.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
//with control as Tlistbox do
with listbox1.Canvas do
begin
Font.color:=Tcolor(ListBox1.Items.Objects[index]);
TextOut(Rect.Left,Rect.Top+4,ListBox1.Items[index]);
end;
end;
procedure TFormPrinc.BoutonRafClick(Sender: TObject);
begin
@@ -8010,7 +8003,7 @@ procedure TFormPrinc.ClientSocketLenzRead(Sender: TObject;
var s : string;
begin
s:=ClientSocketLenz.Socket.ReceiveText;
if trace then affiche(chaine_hex(s),clWhite);
if traceTrames then afficheDebug(chaine_hex(s),clWhite);
interprete_reponse(s);
end;
@@ -8035,7 +8028,6 @@ begin
Affiche('en circulation sur le réseau',ClYellow);
Affiche('Il est nécessaire de renseigner les fichiers config.cfg et config-gl.cfg',ClOrange);
Affiche('En vert : Trames envoyées à l''interface',ClWhite);
Affiche('En blanc : Trames reçues de l''interface',ClWhite);
Affiche('En violet : Trames brutes reçues de l''interface',ClWhite);
Affiche('En rouge : erreurs et défauts',ClWhite);
Affiche('En orange : pilotage des signaux / erreurs mineures',ClWhite);
@@ -8078,6 +8070,7 @@ procedure TFormPrinc.MenuConnecterEthernetClick(Sender: TObject);
begin
if AdresseIP<>'0' then
begin
Affiche('Demande de connexion de l''interface Lenz en ethernet '+AdresseIP+':'+IntToSTR(Port),clyellow);
ClientSocketLenz.port:=port;
ClientSocketLenz.Address:=AdresseIP;
ClientSocketLenz.Open;
@@ -8484,20 +8477,19 @@ begin
inc(Nbre_recu_cdm);
//if Nbre_recu_cdm>1 then Affiche('Empilement de trames CDM: '+intToSTR(Nbre_recu_cdm),clred);
recuCDM:=ClientSocketCDM.Socket.ReceiveText; // commandeCDM est le morceau tronquée de la fin de la réception précédente
//if residuCDM<>'' then Affiche(recuCDM,clLime);
residuCDM:='';
if trace then
begin
if traceTrames then AfficheDebug(recuCDM,clWhite);
{begin
n:=80;
Affiche('recu de CDM Tick='+IntToSTR(tick)+' '+IntToSTR(length(recuCDM))+' car',clWhite);Affiche(copy(recuCDM,1,n),clWhite);
AfficheDebug(recuCDM,clWhite);
l:=length(recuCDM);
i:=1;
i:=0;
repeat
Affiche(copy(recuCDM,i*n,n),clWhite);
AfficheDebug(copy(recuCDM,(i*n)+1,n),clWhite);
inc(i);
until l<i*n;
end;
end;}
Interprete_trameCDM(recuCDM);
end;
@@ -8881,17 +8873,38 @@ begin
vitesse_loco(3,20,true);
end;
procedure TFormPrinc.Button1Click(Sender: TObject);
// pour déplacer l'ascenseur de l'affichage automatiquement en bas
procedure TFormPrinc.FenRichChange(Sender: TObject);
begin
Interprete_trameCDM('yfytrf');
SendMessage(FenRich.handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
procedure TFormPrinc.Copier1Click(Sender: TObject);
begin
FenRich.CopyToClipboard;
FenRich.SetFocus;
end;
procedure TFormPrinc.Etatdessignaux1Click(Sender: TObject);
var Adr,etat,i : integer;
aspect,combine : word;
s : string;
begin
for i:=1 to NbreFeux do
begin
Adr:=Feux[i].Adresse;
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;
begin
UnitPrinc.~dfm
-1609
View File
File diff suppressed because it is too large Load Diff
UnitPrinc.~pas
+678 -416
View File
File diff suppressed because it is too large Load Diff
UnitSimule.dcu
BIN
View File
Binary file not shown.
UnitTCO.dcu
BIN
View File
Binary file not shown.
verif_version.pas
+4 -3
View File
@@ -130,12 +130,13 @@ begin
begin
i:=pos('.zip',s);
trouve_zip:=i<>0;
if trouve_zip then s3:=s;
if trouve_zip then
s3:=s;
end;
// Aff(s)
end;
closefile(fichier);
if trouve_version then
if trouve_version and trouve_zip then
begin
// isoler le champ version
i:=pos('version ',s2);
@@ -190,7 +191,7 @@ begin
end
else
begin
if notificationVersion then Affiche('Pas d''accès au site CDM rail',clorange);
if notificationVersion then Affiche('Pas d''accès au site CDM rail ou échec téléchargement',clorange);
end;
end;
verif_version.~dfm
-35
View File
@@ -1,35 +0,0 @@
object FormVersion: TFormVersion
Left = 500
Top = 341
Width = 468
Height = 194
Caption = 'V'#233'rification de version'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -16
Font.Name = 'Arial Narrow'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 20
object Memo1: TMemo
Left = 16
Top = 32
Width = 425
Height = 105
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
ScrollBars = ssVertical
TabOrder = 0
end
object TimerVerif: TTimer
OnTimer = TimerVerifTimer
end
end
verif_version.~pas
-210
View File
@@ -1,210 +0,0 @@
unit verif_version;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls , ComCtrls ,WinInet, ExtCtrls;
type
TFormVersion = class(TForm)
TimerVerif: TTimer;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure TimerVerifTimer(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormVersion: TFormVersion;
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='2.11'; // sert à la comparaison de la version publiée
implementation
uses UnitPrinc;
{$R *.dfm}
Procedure Aff(s : string);
begin
FormVersion.Memo1.lines.add(s);
end;
function GetCurrentProcessEnvVar(const VariableName: string): string;
var
nSize: DWord;
begin
nSize:=0;
nSize:=GetEnvironmentVariable(PChar(VariableName), nil, nSize);
if nSize=0 then
begin
result:='';
end
else
begin
SetLength(result,nSize-1);
if GetEnvironmentVariable(PChar(VariableName), PChar(result), nSize) <> nSize - 1 then
raise Exception.Create(SysErrorMessage(GetlastError))
end;
end;
// téléchargement d'une page internet sans cache dans un fichier
function DownloadURL_NOCache(aUrl: string;s : string): Boolean;
var
hSession: HINTERNET;
hService: HINTERNET;
Fs:TFileStream;
lpBuffer: array[0..1024 + 1] of byte;
dwBytesRead: DWORD;
dwTimeout : integer;
begin
Result:=False;
DeleteFile(s);
Try Fs:=TFileStream.Create(s,fmCreate,fmShareDenyNone);
hSession:=InternetOpen('MyApp',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if Assigned(hSession) then
begin
// fonction longue
dwTimeout:=2000; //2s
InternetSetOption(hSession,INTERNET_OPTION_CONNECT_TIMEOUT,@dwTimeOut, SizeOf(dwTimeOut));
hService:=InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(hService) then
try
while True do
begin
dwBytesRead:=1024;
InternetReadFile(hService,@lpBuffer,1024,dwBytesRead);
fs.WriteBuffer(lpBuffer,dwBytesRead);
if dwBytesRead=0 then break;
end;
Result:=True;
finally
InternetCloseHandle(hService);
end;
end;
finally
InternetCloseHandle(hSession);
end;
finally
fs.Free;
end;
end;
procedure verifie_version;
var s,s2,s3,Version_p,Url,LocalFile : string;
trouve_version,trouve_zip : boolean;
fichier : text;
i,j,erreur : integer;
V_publie,V_utile : real;
begin
//Affiche('vérifie version',clLime);
if not(AvecInit) then exit ;
if not(verifVersion) then exit;
Url:='http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906#p50499';
LocalFile:='page.txt';
trouve_version:=false;
trouve_zip:=false;
if DownloadURL_NOCache(Url,localFile) then
begin
AssignFile(fichier,LocalFile);
reset(fichier);
while not(eof(fichier)) and (not(trouve_version) or not(trouve_zip)) do
begin
readln(fichier,s);
s:=LowerCase(s);
if not(trouve_version) then
begin
i:=pos('version ',s);
trouve_version:=i<>0;
if trouve_version then s2:=s;
end;
if not(trouve_zip) then
begin
i:=pos('.zip',s);
trouve_zip:=i<>0;
if trouve_zip then s3:=s;
end;
// Aff(s)
end;
closefile(fichier);
if trouve_version then
begin
// isoler le champ version
i:=pos('version ',s2);
delete(s2,1,i+7);
j:=pos(' ',s2);
Version_p:=copy(s2,1,j-1); // version dans version_p
// isoler l'url du zip
i:=pos('href="',s3);
delete(s3,1,i+5);
j:=pos('"',s3);
s3:=copy(s3,1,j-1);
i:=pos('.',s3);
if i<>0 then delete(s3,i,1); // supprimer le .
s3:='http://cdmrail.free.fr/ForumCDR'+s3 ;
aff(s3); // lien dans s3
// changer le . en ,
s:=Version_p;
// i:=pos('.',s);if i<>0 then s[i]:=',';
s2:=version;
// i:=pos('.',s2);if i<>0 then s2[i]:=',';
val(s,V_publie,erreur); if erreur<>0 then exit;
val(s2,V_utile,erreur); if erreur<>0 then exit;
if V_utile<V_publie then
begin
FormVersion.show;
s:='Vous utilisez la version '+version+' mais il existe la version '+Version_p;
Aff(s);
if MessageDlg(s+'. Voulez-vous la télécharger?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
// récupérer depuis la variable d'environnement windows USERPROFILE le repertoire de la session ouverte
s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\Signaux_Complexes_GL.Zip';
Aff('Téléchargement de '+s3+' dans ');
Aff(s);
if DownloadURL_NOCache(s3,s) then
//if true then
begin
Aff('Téléchargement réussi');
Aff('Vous pouvez ouvrir le dossier de téléchargement, décomprimer le zip et l''installer');
end
else Aff('Echec de téléchargement');
end
else formVersion.Free;
end;
if (V_utile=V_publie) and notificationVersion then Affiche('Votre version '+Version_p+' est à jour',clLime);
end;
end
else
begin
if notificationVersion then Affiche('Pas d''accès au site CDM rail',clorange);
end;
end;
procedure TFormVersion.FormCreate(Sender: TObject);
begin
Timerverif.Interval:=1000; // timer à 1 seconde
Lance_verif:=2; // lancer la vérification de version dans 1s
end;
procedure TFormVersion.TimerVerifTimer(Sender: TObject);
begin
if lance_verif>0 then dec(lance_verif);
if lance_verif=1 then verifie_version;
end;
end.