unit UnitDebug; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls , ComCtrls, Menus, unitconfig; type TFormDebug = class(TForm) SaveDialog: TSaveDialog; PopupMenuRE: TPopupMenu; copier1: TMenuItem; PopupMenuRD: TPopupMenu; Copier2: TMenuItem; ScrollBoxDebug: TScrollBox; RichDebug: TRichEdit; ButtonRazTout: TButton; ButtonCop: TButton; ButtonAffEvtChrono: TButton; ButtonCherche: TButton; ButtonEcrLog: TButton; ButtonRazTampon: TButton; ButtonRazLog: TButton; MemoEvtDet: TRichEdit; GroupBox5: TGroupBox; EditSimuDet: TEdit; ButtonSimuDet0: TButton; ButtonSimuDet1: TButton; ButtonSimuAct0: TButton; ButtonSimuAct1: TButton; GroupBox6: TGroupBox; Label3: TLabel; Label5: TLabel; EditAdresse: TEdit; EditSortie: TEdit; Button1: TButton; Button0: TButton; GroupBoxPrim: TGroupBox; GroupBox3: TGroupBox; Label4: TLabel; ButtonSigSuiv: TButton; ButtonCanSuivSig: TButton; EditSigSuiv: TEdit; ButtonCP: TButton; Button2: TButton; GroupBox4: TGroupBox; ButtonDetSuiv: TButton; EditPrec: TEdit; EditActuel: TEdit; ButtonElSuiv: TButton; GroupBox2: TGroupBox; CheckAffSig: TCheckBox; CheckBoxEvtDetAig: TCheckBox; CheckBoxTraceLIste: TCheckBox; CheckTrame: TCheckBox; CheckBoxAffFD: TCheckBox; CheckBoxAffDebDecSig: TCheckBox; EditDebugSignal: TEdit; CheckBoxTiers: TCheckBox; CheckBox1: TCheckBox; CheckDebugTCO: TCheckBox; CheckDetSIg: TCheckBox; CheckBoxPrinc: TCheckBox; LabelTitreDebug: TLabel; Label1: TLabel; EditNivDebug: TEdit; ButtonAigDevie: TButton; procedure FormCreate(Sender: TObject); procedure ButtonEcrLogClick(Sender: TObject); procedure EditNivDebugKeyPress(Sender: TObject; var Key: Char); procedure CheckAffSigClick(Sender: TObject); procedure ButtonRazTamponClick(Sender: TObject); procedure ButtonChercheClick(Sender: TObject); procedure ButtonAffEvtChronoClick(Sender: TObject); procedure CheckBoxTraceLIsteClick(Sender: TObject); procedure CheckTrameClick(Sender: TObject); procedure ButtonCopClick(Sender: TObject); procedure ButtonRazLogClick(Sender: TObject); procedure CheckBoxEvtDetAigClick(Sender: TObject); procedure CheckBoxAffFDClick(Sender: TObject); procedure CheckBoxAffDebDecSigClick(Sender: TObject); procedure ButtonSigSuivClick(Sender: TObject); procedure ButtonDetSuivClick(Sender: TObject); procedure ButtonCanSuivSigClick(Sender: TObject); procedure ButtonCPClick(Sender: TObject); 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 MemoEvtDet1Change(Sender: TObject); procedure EditDebugSignalChange(Sender: TObject); procedure CheckBoxTiersClick(Sender: TObject); procedure ButtonSimuAct1Click(Sender: TObject); procedure ButtonSimuAct0Click(Sender: TObject); procedure ButtonElSuivClick(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure CheckDebugTCOClick(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button0Click(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormActivate(Sender: TObject); procedure MemoEvtDetChange(Sender: TObject); procedure CheckDetSIgClick(Sender: TObject); procedure CheckBoxPrincClick(Sender: TObject); procedure Button3Click(Sender: TObject); procedure ButtonAigDevieClick(Sender: TObject); procedure ButtonSigPrecClick(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; var FormDebug: TFormDebug; NivDebug,signalDebug,compt_erreur,positionErreur,LigneErreur : integer; AffSignal,AffAffect,initform,AffFD,debug_dec_sig,debugTCO,DebugAffiche,AFfDetSIg, ProcPrinc : boolean; N_event_det : integer; // index du dernier évènement (de 1 à 20) N_Event_tick : integer ; // dernier index procedure AfficheDebug(s : string;lacouleur : TColor); procedure AfficheDebug_suivi(s : string;lacouleur : TColor); procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor); procedure affiche_evt(s: string;lacouleur : TColor); procedure couleurs_debug; implementation uses UnitPrinc; {$R *.dfm} procedure RE_ColorLine(ARichEdit : TRichEdit;ARow : Integer;AColor : TColor); begin with ARichEdit do begin SelStart:=SendMessage(Handle,EM_LINEINDEX,ARow,0); SelLength:=Length(Lines[ARow]); SelAttributes.Color:=AColor; SelLength:=0; end; end; // affiche un texte coloré dans la fenêtre evt procedure affiche_evt(s: string;lacouleur : TColor); begin if DebugAffiche then with FormDebug.MemoEvtDet do begin Lines.add(s); RE_ColorLine(FormDebug.MemoEvtDet,FormDebug.MemoEvtDet.lines.count-1,lacouleur); end; end; procedure AfficheDebug(s : string;lacouleur : TColor); begin if debugAffiche then with FormDebug.RichDebug do begin Lines.add(s); RE_ColorLine(FormDebug.RichDebug,FormDebug.RichDebug.lines.count-1,lacouleur); end; end; procedure couleurs_debug; var c : tcomponent; i : integer; begin if ModeSombre then with formdebug do begin Color:=Couleurfond; for i:=0 to ComponentCount-1 do begin c:=Components[i]; if c is tScrollBox then begin (c as tScrollBox).Color:=color; end; end; end; end; procedure AfficheDebug_suivi(s : string;lacouleur : TColor); var i : integer; begin if DebugAffiche then with formDebug.RichDebug do begin i:=lines.Count-1; s:=lines.Strings[i]+s; lines.Strings[i]:=s; RE_ColorLine(FormDebug.RichDebug,i,lacouleur); end; end; procedure TFormDebug.FormCreate(Sender: TObject); var s: string; begin if affevt or (debug=1) then affiche('FormDebug create',clLime); EditNivDebug.Text:='0'; 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 D13 ------------ // ne fonctionne que si le style est windows !!! (bug du VCL) // obligé d'utiliser une scrollBox DebugAffiche:=true; RichDebug.Height:=scrollBoxdebug.Height-30; RichDebug.Anchors:=[akLeft,akTop,akRight,akBottom]; {$IF CompilerVersion >= 28.0} RichDebug.StyleName:='Windows'; MemoEvtDet.StyleName:='Windows'; {$IFEND} with scrollBoxdebug do begin Anchors:=[akLeft,akTop,akRight,akBottom]; VertScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si on clique sur la trackbar!! VertScrollBar.Tracking:=true; HorzScrollBar.Visible:=false; autoScroll:=true; autoSize:=false; end; checkTrame.hint:='Affiche les trames de la centrale XpressNet'+#13+'ou les trames CDM-Rail (COM_IP)'; checkBoxTiers.hint:='Nécessite d''activer les services'+#13+'"signaux" et "position des trains"'+#13+ 'dans la configuration générale'; compt_erreur:=0; LigneErreur:=0; if debug=1 then Affiche('Fin création fenêtre debug',clLime); // && débug===================== //CheckBoxEvtDetAig.Checked:=true; //CheckTrame.checked:=true; // fin debug==================== couleurs_debug; 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'; end; procedure TFormDebug.ButtonEcrLogClick(Sender: TObject); var s : string; i : integer; fte : textFile; begin s:=GetCurrentDir; SaveDialog.InitialDir:=s; SaveDialog.DefaultExt:='txt'; SaveDialog.Filter:='Fichiers texte (*.txt)|*.txt|Tous fichiers (*.*)|*.*'; if SaveDialog.Execute then begin s:=SaveDialog.FileName; assignFile(fte,s); rewrite(fte); with RichDebug do for i:=0 to Lines.Count do begin writeln(fte,Lines[i]); end; closefile(fte); end; end; procedure TFormDebug.EditNivDebugKeyPress(Sender: TObject; var Key: Char); var i,e : integer; begin if ord(Key)=VK_RETURN then begin Key:=#0; // évite bip val(EditNivDebug.text,i,e); if e=0 then begin if (i>=0) and (i<=3) then NivDebug:=i else EditNivDebug.text:='3'; end else EditNivDebug.text:='0'; end; RichDebug.Lines.add('Niveau='+intToSTR(NivDebug)); end; procedure TFormDebug.CheckAffSigClick(Sender: TObject); begin AffSignal:=checkAffSig.Checked; end; procedure TFormDebug.ButtonRazTamponClick(Sender: TObject); begin N_event_det:=0; Event_det[1].adresse:=0; MemoEvtDet.Clear; memoEvtDet.Refresh; end; procedure TFormDebug.ButtonChercheClick(Sender: TObject); var i,l,positionErreur : integer; s : string; trouve : boolean; begin with RichDebug do begin ligneErreur:=0; repeat s:=lowercase(Lines[ligneErreur]); positionErreur:=pos('erreur',s); trouve:=positionErreur<>0; inc(LigneErreur); until (LigneErreur>=Lines.Count) or trouve; if trouve then begin inc(compt_erreur); //Affiche('trouvé en '+Lines[ligneErreur-1],clred); l:=0; for i:=0 to ligneErreur-1 do begin l:=l+length(Lines[i])+2; end; SelStart:= l-length(s)+positionErreur-3; SelLength:=6; SetFocus; // afficher la sélection Perform(EM_SCROLLCARET,0,0); // et scroller à l'endroit de la sélection end else begin LigneErreur:=0; end; end; end; procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject); var i,j,etat : integer; s : string; typ : Tequipement; begin RichDebug.Clear; if N_event_tick=0 then begin AfficheDebug('Il n''y a aucun évènement détecteur ou aiguillage',clyellow); exit; end; s:='Evts chronologiques det aig du '+DateToStr(date)+' '+TimeToStr(Time)+' '+s; AfficheDebug(s,clLime); for i:=1 to N_Event_tick do begin begin j:=event_det_tick[i].adresse; etat:=event_det_tick[i].etat; if j<>-1 then begin s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick); typ:=event_det_tick[i].modele; if typ=det then s:=s+' Det='; if typ=aig then s:=s+' Aig='; if typ=act then s:=s+' Act='; s:=s+IntToSTR(j)+'='+intToSTR(etat); AfficheDebug(s,clyellow); end; end; end; AfficheDebug('-----------------------------',cllime); end; procedure TFormDebug.CheckBoxTraceLIsteClick(Sender: TObject); begin TraceListe:=CheckBoxTraceLIste.checked; end; procedure TFormDebug.CheckTrameClick(Sender: TObject); begin traceTrames:=CheckTrame.Checked; end; procedure TFormDebug.ButtonCopClick(Sender: TObject); begin RichDebug.Lines:=Formprinc.FenRich.lines; end; procedure TFormDebug.ButtonRazLogClick(Sender: TObject); begin RichDebug.Clear; end; procedure TFormDebug.CheckBoxEvtDetAigClick(Sender: TObject); begin AffAigDet:=CheckBoxEvtDetAig.checked; end; procedure TFormDebug.CheckBoxAffFDClick(Sender: TObject); begin AffFD:=CheckBoxAffFD.checked; end; procedure TFormDebug.CheckBoxAffDebDecSigClick(Sender: TObject); begin debug_dec_sig:=CheckBoxAffDebDecSig.checked; end; procedure TFormDebug.ButtonSigSuivClick(Sender: TObject); var adr,erreur,ancdebug,AdrSigSuivant : integer ; begin Val(EditSigSuiv.Text,adr,erreur); if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; etat_signal_suivant(Adr,1,AdrSigSuivant) ; NivDebug:=AncDebug; end; procedure TFormDebug.ButtonDetSuivClick(Sender: TObject); var Adr,Prec,Actuel,erreur,ancdebug : integer ; type1,type2 : tequipement; s1,s2 : string; begin ancdebug:=NivDebug; NivDebug:=3; s1:=EditPrec.Text; s2:=EditActuel.Text; if (s1='') or (s2='') then begin NivDebug:=AncDebug;exit;end; 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 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); if Adr<9996 then AfficheDebug('Le détecteur suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel)+' est '+IntToSTR(Adr),clyellow) else AfficheDebug('Pas trouvé de détecteur suvant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); NivDebug:=AncDebug; end; procedure TFormDebug.ButtonCanSuivSigClick(Sender: TObject); var Adr,erreur,ancdebug : integer ; begin Val(EditSigSuiv.Text,Adr,erreur); if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; if test_memoire_zones(Adr) then AfficheDebug('Présence train',clYellow) else AfficheDebug('Absence train',clyellow); NivDebug:=AncDebug; end; procedure TFormDebug.ButtonCPClick(Sender: TObject); var Adr,erreur,ancdebug,adrtrain,voie : integer ; begin Val(EditSigSuiv.Text,Adr,erreur); if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; if PresTrainPrec(Adr,Nb_cantons_Sig,FALSE,adrtrain,voie) then AfficheDebug('Présence train @='+intToSTR(AdrTrain),clYellow) else AfficheDebug('Absence train',clyellow); NivDebug:=AncDebug; end; procedure TFormDebug.Button2Click(Sender: TObject); var Adr,erreur,ancdebug,train : integer ; reservetraintiers : boolean; begin Val(EditSigSuiv.Text,Adr,erreur); if (erreur<>0) or (Adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; Cond_Carre(Adr); carre_signal(adr,0,reservetraintiers,train); 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; procedure TFormDebug.ButtonSimuDet0Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); if (erreur=0) and (det>0) then Event_Detecteur(det,false,''); end; procedure TFormDebug.ButtonSimuDet1Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); if (erreur=0) and (det>0) then Event_Detecteur(det,true,''); end; procedure TFormDebug.ButtonSimuAct1Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); if (erreur=0) and (det>0) then Event_Act(det,0,1,''); end; procedure TFormDebug.ButtonSimuAct0Click(Sender: TObject); var det,erreur : integer; begin val(EditSimuDet.Text,det,erreur); if (erreur=0) and (det>0) then Event_Act(det,0,0,''); end; procedure TFormDebug.ButtonRazToutClick(Sender: TObject); begin AfficheDebug('Raz tous trains et routes',clLime); Raz_tout; end; procedure TFormDebug.MemoEvtDet1Change(Sender: TObject); begin SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TFormDebug.EditDebugSignalChange(Sender: TObject); var erreur : integer; begin val(EditDebugSignal.text,signalDebug,erreur); end; procedure TFormDebug.CheckBoxTiersClick(Sender: TObject); begin AffTiers:=checkBoxTiers.checked; end; procedure TFormDebug.ButtonElSuivClick(Sender: TObject); var Adr,Prec,Actuel,erreur,ancdebug : integer ; type1,type2 : tequipement; s1,s2,s : string; begin ancdebug:=NivDebug; NivDebug:=3; s1:=EditPrec.Text; s2:=EditActuel.Text; if (s1='') or (s2='') then begin NivDebug:=AncDebug;exit;end; 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<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); if Adr<9995 then begin s:='L''élément suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel)+' est '+IntToSTR(Adr)+' '; s:=s+BTypeToChaine(typeGen); AfficheDebug(s,clYellow); end else AfficheDebug('Pas trouvé d''élement suivant aux éléments '+IntToSTR(prec)+'/'+IntToSTR(actuel),clyellow); NivDebug:=AncDebug; end; procedure TFormDebug.CheckBox1Click(Sender: TObject); begin dupliqueEvt:=CheckBox1.checked; end; procedure TFormDebug.CheckDebugTCOClick(Sender: TObject); begin debugTCO:=checkDebugTCO.checked; end; procedure TFormDebug.Button1Click(Sender: TObject); var adr,sortie,erreur,groupe : integer; fonction : byte; s : string; begin val(EditAdresse.text,adr,erreur); if (erreur<>0) or (adr<1) or (adr>2048) then begin EditAdresse.text:='1'; exit; end; val(EditSortie.text,sortie,erreur); if (sortie<1) or (sortie>2) then begin EditSortie.text:='1'; exit; end; s:='Accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 1'; AfficheDebug(s,clyellow); if CDM_connecte then begin //AfficheDebug(intToSTR(adresse),clred); s:=chaine_CDM_Acc(adr,sortie); envoi_CDM(s); end; // pilotage par USB ou par éthernet de la centrale ------------ if (hors_tension=false) and (portCommOuvert or parSocketLenz) then begin if protocole=1 then begin groupe:=(adr-1) div 4; fonction:=((adr-1) mod 4)*2 + (sortie-1); // pilotage à 1 s:=#$52+Char(groupe)+char(fonction or $88); // activer la sortie s:=checksum(s); envoi(s); // envoi de la trame et attente Ack end; if protocole=2 then AfficheDebug('D10: Commande DCC++ pas encore implantée',clred); end; Self.ActiveControl:=nil; end; procedure TFormDebug.Button0Click(Sender: TObject); var adr,sortie,erreur,groupe : integer; fonction : byte; s : string; begin val(EditAdresse.text,adr,erreur); if (erreur<>0) or (adr<1) or (adr>2048) then begin EditAdresse.text:='1'; exit; end; val(EditSortie.text,sortie,erreur); if (sortie<1) or (sortie>2) then begin EditSortie.text:='1'; exit; end; s:='Accessoire '+IntToSTR(adr)+' ; sortie '+intToSTR(sortie)+' à 0'; AfficheDebug(s,clyellow); if CDM_connecte then begin //AfficheDebug(intToSTR(adresse),clred); 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 if protocole=1 then begin groupe:=(adr-1) div 4; fonction:=((adr-1) mod 4)*2 + (sortie-1); // pilotage à 0 s:=#$52+Char(groupe)+char(fonction or $80); // désactiver la sortie 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) end; Self.ActiveControl:=nil; end; procedure TFormDebug.FormKeyPress(Sender: TObject; var Key: Char); begin if key=chr(27) then close; end; procedure TFormDebug.MemoEvtDetChange(Sender: TObject); begin SendMessage(MemoEvtDet.handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TFormDebug.CheckDetSIgClick(Sender: TObject); begin AFfDetSIg:=checkDetSig.checked; end; procedure TFormDebug.CheckBoxPrincClick(Sender: TObject); begin ProcPrinc:=checkBoxPrinc.checked; end; procedure TFormDebug.Button3Click(Sender: TObject); begin ScrollBoxDebug.VertScrollBar.Position:=0; end; procedure TFormDebug.ButtonAigDevieClick(Sender: TObject); 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; procedure TFormDebug.ButtonSigPrecClick(Sender: TObject); 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); NivDebug:=AncDebug; AfficheDebug('Signal précédent='+intToSTR(erreur),clyellow); end; end.