This commit is contained in:
f1iwq2
2024-08-24 09:12:51 +02:00
parent ede3d91c4d
commit 7d2c4bd591
43 changed files with 32873 additions and 14550 deletions

View File

@@ -206,11 +206,15 @@ begin
RichDebug.WordWrap:=false; // interdit la coupure des chaînes en limite du composant
RichDebug.color:=$33;
//constraints.MaxHeight:=800; // taille Y maxi
ButtonDetSuiv.Hint:='Renvoie le détecteur suivant aux deux éléments (détecteurs ou aiguillages) '+#13+
'suivant la position des aiguillages.'+#13+
'Les éléments peuvent ne pas être contigus.'+#13+
'detecteur_suivant_El';
initform:=false;
visible:=false;
RichDebug.clear;
s:=DateToStr(date)+' '+TimeToStr(Time)+' ';
// l'ascenseur de la fenetre dans D11 ------------
// l'ascenseur de la fenetre dans D12 ------------
// ne fonctionne que si le style est windows !!! (bug du VCL)
// obligé d'utiliser une scrollBox
@@ -244,9 +248,9 @@ begin
end;
procedure TFormDebug.FormActivate(Sender: TObject);
begin
if affevt then affiche('FormDebug activate',clLime);
formDebug.buttonCP.Caption:='Etat '+intToSTR(Nb_cantons_Sig)+' cantons précédents signal';
begin
if affevt then affiche('FormDebug activate',clLime);
formDebug.buttonCP.Caption:='Etat '+intToSTR(Nb_cantons_Sig)+' cantons précédents signal';
end;
@@ -435,7 +439,8 @@ begin
if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det;
if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det;
Val(s1,prec,erreur);
if (erreur<>0) or (prec<1) then begin NivDebug:=AncDebug;exit;end;
if prec=0 then type1:=buttoir;
if (erreur<>0) or (prec<0) then begin NivDebug:=AncDebug;exit;end;
Val(s2,Actuel,erreur);
if (erreur<>0) or (actuel<1) then begin NivDebug:=AncDebug;exit;end;
Adr:=detecteur_suivant_El(prec,type1,actuel,type2,1);
@@ -558,7 +563,8 @@ begin
if s1[1]='A' then begin type1:=aig;delete(s1,1,1);end else type1:=det;
if s2[1]='A' then begin type2:=aig;delete(s2,1,1);end else type2:=det;
Val(s1,prec,erreur);
if (erreur<>0) or (prec<1) then begin NivDebug:=AncDebug;exit;end;;
if (erreur<>0) or (prec<0) then begin NivDebug:=AncDebug;exit;end;
if prec=0 then type1:=buttoir;
Val(s2,Actuel,erreur);
if (erreur<>0) or (actuel<1) then begin NivDebug:=AncDebug;exit;end;;
Adr:=suivant_Alg3(prec,type1,actuel,type2,1);
@@ -586,8 +592,8 @@ procedure TFormDebug.Button1Click(Sender: TObject);
var adr,sortie,erreur,groupe : integer;
fonction : byte;
s : string;
begin
val(EditAdresse.text,adr,erreur);
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
@@ -625,15 +631,15 @@ begin
if protocole=2 then AfficheDebug('D10: Commande DCC++ pas encore implantée',clred);
end;
Self.ActiveControl:=nil;
end;
Self.ActiveControl:=nil;
end;
procedure TFormDebug.Button0Click(Sender: TObject);
var adr,sortie,erreur,groupe : integer;
var adr,sortie,erreur,groupe : integer;
fonction : byte;
s : string;
begin
val(EditAdresse.text,adr,erreur);
begin
val(EditAdresse.text,adr,erreur);
if (erreur<>0) or (adr<1) or (adr>2048) then
begin
EditAdresse.text:='1';
@@ -655,7 +661,7 @@ begin
s:=chaine_CDM_Acc(adr,0);
envoi_CDM(s);
end;
// pilotage par USB ou par éthernet de la centrale ------------
if (hors_tension=false) and (portCommOuvert or parSocketLenz) then
begin
@@ -668,64 +674,64 @@ begin
s:=checksum(s);
envoi(s); // envoi de la trame et attente Ack
end;
if protocole=2 then AfficheDebug('D11: Commande DCC++ pas encore implantée',clred)
if protocole=2 then AfficheDebug('D11 Commande DCC++ pas encore implantée',clred)
end;
Self.ActiveControl:=nil;
end;
Self.ActiveControl:=nil;
end;
procedure TFormDebug.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=chr(27) then close;
end;
begin
if key=chr(27) then close;
end;
procedure TFormDebug.MemoEvtDetChange(Sender: TObject);
begin
SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0);
end;
begin
SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0);
end;
procedure TFormDebug.CheckDetSIgClick(Sender: TObject);
begin
AFfDetSIg:=checkDetSig.checked;
end;
begin
AFfDetSIg:=checkDetSig.checked;
end;
procedure TFormDebug.CheckBoxPrincClick(Sender: TObject);
begin
ProcPrinc:=checkBoxPrinc.checked;
end;
begin
ProcPrinc:=checkBoxPrinc.checked;
end;
procedure TFormDebug.Button3Click(Sender: TObject);
begin
ScrollBoxDebug.VertScrollBar.Position:=0;
end;
begin
ScrollBoxDebug.VertScrollBar.Position:=0;
end;
procedure TFormDebug.ButtonAigDevieClick(Sender: TObject);
var Adr,erreur,ancDebug : integer;
begin
Val(EditSigSuiv.Text,Adr,erreur);
var Adr,erreur,ancDebug : integer;
begin
Val(EditSigSuiv.Text,Adr,erreur);
if (erreur<>0) or (Adr<1) then exit;
ancdebug:=NivDebug;
NivDebug:=3;
Aiguille_deviee(Adr);
NivDebug:=AncDebug;
end;
end;
procedure TFormDebug.ButtonSigPrecClick(Sender: TObject);
procedure TFormDebug.ButtonSigPrecClick(Sender: TObject);
var Adr,erreur,ancDebug : integer;
begin
var Adr,erreur,ancDebug : integer;
begin
Val(EditSigSuiv.Text,Adr,erreur);
if (erreur<>0) or (Adr<1) then exit;
ancdebug:=NivDebug;
NivDebug:=3;
erreur:=Signal_Precedent(Adr);
erreur:=Signal_Precedent(Adr);
NivDebug:=AncDebug;
AfficheDebug('signal précédent='+intToSTR(erreur),clyellow);
end;
NivDebug:=AncDebug;
AfficheDebug('signal précédent='+intToSTR(erreur),clyellow);
end;
end.