This commit is contained in:
f1iwq2
2020-03-16 21:41:53 +01:00
parent 473bd0dcfe
commit d8af138d78
15 changed files with 202 additions and 105 deletions

Binary file not shown.

View File

@@ -166,6 +166,7 @@ begin
IpOk:=n=3; IpOk:=n=3;
end; end;
// vérifie si ma config de la com série/usb est ok
function config_com(s : string) : boolean; function config_com(s : string) : boolean;
var sa : string; var sa : string;
j,i,erreur : integer; j,i,erreur : integer;
@@ -201,7 +202,7 @@ begin
i:=pos(':',sa); i:=pos(':',sa);
val(copy(sa,4,i-1),Numport,erreur); val(copy(sa,4,i-1),Numport,erreur);
config_com:=not( (NumPort>9) or (protocole=-1) or (protocole>4) or (i=0) ); config_com:=not( (copy(sa,1,3)<>'COM') or (NumPort>9) or (protocole=-1) or (protocole>4) or (i=0) );
end; end;
procedure TFormConfig.Button1Click(Sender: TObject); procedure TFormConfig.Button1Click(Sender: TObject);

Binary file not shown.

View File

@@ -1,11 +1,11 @@
object FormDebug: TFormDebug object FormDebug: TFormDebug
Left = 260 Left = 217
Top = 148 Top = 167
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'Fen'#234'tre de d'#233'bug' Caption = 'Fen'#234'tre de d'#233'bug'
ClientHeight = 639 ClientHeight = 639
ClientWidth = 789 ClientWidth = 789
Color = clWhite Color = clWindow
TransparentColorValue = clTeal TransparentColorValue = clTeal
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite Font.Color = clWhite
@@ -19,8 +19,8 @@ object FormDebug: TFormDebug
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object Label1: TLabel object Label1: TLabel
Left = 464 Left = 616
Top = 28 Top = 15
Width = 108 Width = 108
Height = 13 Height = 13
Caption = 'Niveau du Debug (0-3)' Caption = 'Niveau du Debug (0-3)'
@@ -35,7 +35,7 @@ object FormDebug: TFormDebug
end end
object Label2: TLabel object Label2: TLabel
Left = 448 Left = 448
Top = 4 Top = 12
Width = 131 Width = 131
Height = 18 Height = 18
Caption = 'Fen'#234'tre de d'#233'bug' Caption = 'Fen'#234'tre de d'#233'bug'
@@ -64,9 +64,9 @@ object FormDebug: TFormDebug
WordWrap = True WordWrap = True
end end
object EditNivDebug: TEdit object EditNivDebug: TEdit
Left = 592 Left = 728
Top = 20 Top = 12
Width = 73 Width = 49
Height = 21 Height = 21
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue Font.Color = clBlue
@@ -223,25 +223,23 @@ object FormDebug: TFormDebug
Top = 64 Top = 64
Width = 257 Width = 257
Height = 17 Height = 17
Caption = 'Affichage des actionneurs' Caption = 'Affichage des '#233'v'#232'vements actionneurs'
Color = clWhite
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack Font.Color = clBlack
Font.Height = -11 Font.Height = -11
Font.Name = 'MS Sans Serif' Font.Name = 'MS Sans Serif'
Font.Style = [] Font.Style = []
ParentColor = False
ParentFont = False ParentFont = False
TabOrder = 13 TabOrder = 13
OnClick = CheckBoxActClick OnClick = CheckBoxActClick
end end
object SaveDialog: TSaveDialog object SaveDialog: TSaveDialog
Left = 680 Left = 760
Top = 8 Top = 56
end end
object PopupMenuRE: TPopupMenu object PopupMenuRE: TPopupMenu
Left = 752 Left = 760
Top = 16 Top = 80
object copier1: TMenuItem object copier1: TMenuItem
Caption = 'copier' Caption = 'copier'
OnClick = copier1Click OnClick = copier1Click

View File

@@ -63,10 +63,12 @@ var
event_det_tick : array[0..Max_Event_det_tick] of event_det_tick : array[0..Max_Event_det_tick] of
record record
tick : longint; tick : longint;
detecteur : array[1..1100] of integer; // état du détecteur [...] detecteur : integer ;
Aiguillage,position : integer ; Aiguillage : integer ;
actionneur : integer;
etat : integer ; // état du détecteur de l'aiguillage ou de l'actionneur
//train : integer ; //train : integer ;
suivant : integer ; // d'ou vient le train //suivant : integer ; // d'ou vient le train
traite : boolean; // traité lors de a recherche d'une route traite : boolean; // traité lors de a recherche d'une route
end; end;
@@ -208,9 +210,10 @@ begin
for i:=1 to N_Event_tick do for i:=1 to N_Event_tick do
begin begin
for j:=1 to 1100 do //for j:=1 to 1100 do
begin begin
etat:=event_det_tick[i].detecteur[j]; j:=event_det_tick[i].detecteur;
etat:=event_det_tick[i].etat;
if etat<>-1 then if etat<>-1 then
begin begin
s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Det='+IntToSTR(j)+'='+intToSTR(etat); s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Det='+IntToSTR(j)+'='+intToSTR(etat);
@@ -221,7 +224,7 @@ begin
etat:=event_det_tick[i].aiguillage; etat:=event_det_tick[i].aiguillage;
if etat<>-1 then if etat<>-1 then
begin begin
s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Aig='+IntToSTR(etat)+'='+intToSTR(event_det_tick[i].position); s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Aig='+IntToSTR(etat)+'='+intToSTR(event_det_tick[i].etat);
AfficheDebug(s,clyellow); AfficheDebug(s,clyellow);
end; end;
end; end;

Binary file not shown.

Binary file not shown.

View File

@@ -1,6 +1,6 @@
object FormPrinc: TFormPrinc object FormPrinc: TFormPrinc
Left = 84 Left = 25
Top = 109 Top = 101
AutoSize = True AutoSize = True
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ' Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'

View File

@@ -3581,6 +3581,7 @@ begin
//if fini then Affiche('fini',clyellow); //if fini then Affiche('fini',clyellow);
end; end;
end; end;
if (j>4) or (not(multiple)) then begin Affiche('Erreur: fichier de configuration ligne erronnée : '+chaine,clred); closefile(fichier);exit;end;
k:=pos(',',s); k:=pos(',',s);
delete(s,1,k); delete(s,1,k);
@@ -5036,11 +5037,9 @@ begin
// trouve une séquence chronologique 010 sur un détecteur // trouve une séquence chronologique 010 sur un détecteur
function trouve_seq_chrono_010(Adresse : integer) : boolean; function trouve_seq_chrono_010(Adresse : integer) : boolean;
var i,etat : integer; var i,etat : integer;
etat0_seq1,etat1_seq2,etat0_seq3 : boolean; etat0_seq1,etat1_seq2,etat0_seq3 : boolean;
begin begin
i:=N_Event_tick; i:=N_Event_tick;
if i<2 then exit;
Affiche('test si seq 010 sur det '+intToSTR(Adresse),clyellow);
if i<2 then exit; if i<2 then exit;
Affiche('test si seq 010 sur det '+intToSTR(Adresse),clyellow); Affiche('test si seq 010 sur det '+intToSTR(Adresse),clyellow);
etat0_seq1:=false; etat1_seq2:=false; etat0_seq3:=false; etat0_seq1:=false; etat1_seq2:=false; etat0_seq3:=false;
@@ -5070,18 +5069,19 @@ begin
// supprime un évènement détecteur dans la liste Event_det[] // supprime un évènement détecteur dans la liste Event_det[]
procedure supprime_event(i : integer); procedure supprime_event(i : integer);
var l : integer; var l : integer;
begin begin
for l:=i to N_Event_det do event_det[l]:=event_det[l+1]; for l:=i to N_Event_det do event_det[l]:=event_det[l+1];
dec(N_event_det); dec(N_event_det);
end; end;
// trouve adresse d'un détecteur à "etat" avant "index" dans le tableau chrono // trouve adresse d'un détecteur à "etat" avant "index" dans le tableau chrono
function trouve_index_det_chrono(Adr,etat,index : integer) : integer; function trouve_index_det_chrono(Adr,etat,index : integer) : integer;
var i : integer; var i : integer;
trouve : boolean; trouve : boolean;
begin begin
begin if index<=0 then begin affiche('Erreur 784 index invalide',clred);exit; end;
i:=index; i:=index;
if i>N_Event_tick then begin trouve_index_det_chrono:=0;exit; end; if i>N_Event_tick then begin trouve_index_det_chrono:=0;exit; end;
inc(i); inc(i);
repeat repeat
@@ -5332,6 +5332,7 @@ begin
i:=index_feu(Adrfeu); i:=index_feu(Adrfeu);
if AdrFeu<>0 then if AdrFeu<>0 then
begin begin
modele:=Feux[i].aspect;
Adr_det:=Feux[i].Adr_det1; // détecteur sur le signal Adr_det:=Feux[i].Adr_det1; // détecteur sur le signal
Adr_El_Suiv:=Feux[i].Adr_el_suiv1; // adresse élément suivant au feu Adr_El_Suiv:=Feux[i].Adr_el_suiv1; // adresse élément suivant au feu
@@ -5339,6 +5340,7 @@ begin
// signal directionnel ? // signal directionnel ?
if (modele>10) then if (modele>10) then
begin
//Affiche('Signal directionnel '+IntToSTR(AdrFeu),clyellow); //Affiche('Signal directionnel '+IntToSTR(AdrFeu),clyellow);
Signal_direction(AdrFeu); Signal_direction(AdrFeu);
exit; exit;
@@ -5358,15 +5360,20 @@ begin
end; end;
if (AdrFeu=217) then if (AdrFeu=217) then
begin begin
if ((aiguillage[24].position<>const_droit) and (aiguillage[26].position<>const_droit)) then if ((aiguillage[24].position<>const_droit) and (aiguillage[26].position<>const_droit)) then
Maj_Etat_Signal(AdrFeu,blanc) else Maj_Etat_Signal(AdrFeu,violet); Maj_Etat_Signal(AdrFeu,blanc) else Maj_Etat_Signal(AdrFeu,violet);
envoi_LEB(AdrFeu); envoi_LEB(AdrFeu);
exit; exit;
end; end;
// signal à 2 feux = carré violet+blanc
if (Feux[i].aspect=2) then //or (feux[i].check<>nil) then // si carré violet
begin begin
// si aiguillage après signal mal positionnées // si aiguillage après signal mal positionnées
if (Feux[i].aspect=2) then //or (feux[i].check<>nil) then // si carré violet if carre_signal(AdrFeu) then
begin begin
Maj_Etat_Signal(AdrFeu,violet);
Envoi_signauxCplx;
exit; exit;
end end
else else
@@ -5778,7 +5785,7 @@ begin
var i,trainAdj1,TrainAdj2,TrainActuel,Etat01 : integer; var i,trainAdj1,TrainAdj2,TrainActuel,Etat01 : integer;
s : string; s : string;
begin begin
if Etat then Etat01:=1 else Etat01:=0; if Etat then Etat01:=1 else Etat01:=0;
// vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état // vérifier si l'état du détecteur est déja stocké, car on peut reçevoir plusieurs évènements pour le même détecteur dans le même état
// on reçoit un doublon dans deux index consécutifs. // on reçoit un doublon dans deux index consécutifs.
if N_Event_tick>=1 then if N_Event_tick>=1 then
@@ -5805,7 +5812,8 @@ begin
end; end;
// stocke les changements d'état des détecteurs dans le tableau chronologique // stocke les changements d'état des détecteurs dans le tableau chronologique
if (N_Event_tick<Max_Event_det_tick) then if (N_Event_tick<Max_Event_det_tick) then
begin
inc(N_Event_tick); inc(N_Event_tick);
// event_det_tick[N_event_tick].train:=0; // event_det_tick[N_event_tick].train:=0;
@@ -5857,7 +5865,7 @@ begin
// évènement d'aiguillage // évènement d'aiguillage
procedure Event_Aig(adresse,pos : integer); procedure Event_Aig(adresse,pos : integer);
begin begin
if (N_Event_tick<Max_Event_det_tick) then if (N_Event_tick<Max_Event_det_tick) then
begin begin
inc(N_Event_tick); inc(N_Event_tick);
@@ -6521,8 +6529,12 @@ begin
begin begin
cree_image(i); // et initialisation tableaux signaux cree_image(i); // et initialisation tableaux signaux
end; end;
Tempo_init:=10; // démarre les initialisation des signaux et des aiguillages dans 1 s Tempo_init:=10; // démarre les initialisation des signaux et des aiguillages dans 1 s
// initialisation de la chronologie des évènements détecteurs
for i:=0 to Max_Event_det_tick do
begin
event_det_tick[i].aiguillage:=-1;
//for j:=1 to 1100 do //for j:=1 to 1100 do
//event_det_tick[i].detecteur[j]:=-1; // initialiser les détecteurs à -1 //event_det_tick[i].detecteur[j]:=-1; // initialiser les détecteurs à -1
event_det_tick[i].detecteur:=-1; event_det_tick[i].detecteur:=-1;
@@ -7266,6 +7278,8 @@ begin
Affiche('Version 1.11 : compatibilité pour la rétrosignalisation non XpressNet (intellibox)',clLime); Affiche('Version 1.11 : compatibilité pour la rétrosignalisation non XpressNet (intellibox)',clLime);
Affiche(' verrouillages routes pour trains consécutifs',clLime); Affiche(' verrouillages routes pour trains consécutifs',clLime);
Affiche('Version 1.2 : Renforcement de l''algorithme de suivi des trains',clLime); Affiche('Version 1.2 : Renforcement de l''algorithme de suivi des trains',clLime);
Affiche('Version 1.3 : Décodeur Unisemaf fonctionnel - Lecture/écriture des CV',clLime);
Affiche(' Protocoles variables de l''interface',clLime);
Affiche(' Configuration statique modifiable dans menu',clLime); Affiche(' Configuration statique modifiable dans menu',clLime);
Affiche('Version 1.31 : Correction des positions aiguillages triples et TJD',clLime); Affiche('Version 1.31 : Correction des positions aiguillages triples et TJD',clLime);
Affiche('Version 1.4 : Gestion des Fx vers les locomotives par actionneurs',clLime); Affiche('Version 1.4 : Gestion des Fx vers les locomotives par actionneurs',clLime);
@@ -7282,14 +7296,15 @@ begin
end; end;
procedure TFormPrinc.ChronoDetectClick(Sender: TObject); procedure TFormPrinc.ChronoDetectClick(Sender: TObject);
var i,j,etat : integer; var i,j,etat : integer;
s : string; s : string;
begin begin
for i:=1 to N_Event_tick do for i:=1 to N_Event_tick do
begin begin
//for j:=1 to 1100 do //for j:=1 to 1100 do
begin begin
begin etat:=event_det_tick[i].etat;
if etat<>-1 then if etat<>-1 then
begin begin
j:=event_det_tick[i].detecteur; j:=event_det_tick[i].detecteur;
@@ -7298,7 +7313,7 @@ begin
// s:=s+' Det suiv='+intTostr(event_det_tick[i].suivant); // s:=s+' Det suiv='+intTostr(event_det_tick[i].suivant);
Affiche(s,clyellow); Affiche(s,clyellow);
end; end;
end; end;
etat:=event_det_tick[i].aiguillage; etat:=event_det_tick[i].aiguillage;
if etat<>-1 then if etat<>-1 then

Binary file not shown.

Binary file not shown.

View File

@@ -1,6 +1,6 @@
object FormTCO: TFormTCO object FormTCO: TFormTCO
Left = 337 Left = 333
Top = 102 Top = 121
Width = 928 Width = 928
Height = 681 Height = 681
VertScrollBar.Visible = False VertScrollBar.Visible = False
@@ -22,7 +22,7 @@ object FormTCO: TFormTCO
TextHeight = 13 TextHeight = 13
object LabelX: TLabel object LabelX: TLabel
Left = 32 Left = 32
Top = 16 Top = 14
Width = 53 Width = 53
Height = 19 Height = 19
Caption = 'LabelX' Caption = 'LabelX'
@@ -49,7 +49,7 @@ object FormTCO: TFormTCO
end end
object LabelY: TLabel object LabelY: TLabel
Left = 120 Left = 120
Top = 16 Top = 14
Width = 51 Width = 51
Height = 19 Height = 19
Caption = 'Label1' Caption = 'Label1'
@@ -61,7 +61,7 @@ object FormTCO: TFormTCO
ParentFont = False ParentFont = False
end end
object Label1: TLabel object Label1: TLabel
Left = 496 Left = 776
Top = 8 Top = 8
Width = 32 Width = 32
Height = 13 Height = 13
@@ -348,6 +348,20 @@ object FormTCO: TFormTCO
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
end end
object Label18: TLabel
Left = 200
Top = 10
Width = 83
Height = 13
Caption = 'Taille des cellules'
end
object Label19: TLabel
Left = 336
Top = 10
Width = 5
Height = 13
Caption = '/'
end
object EditAdrElement: TEdit object EditAdrElement: TEdit
Left = 200 Left = 200
Top = 480 Top = 480
@@ -441,14 +455,32 @@ object FormTCO: TFormTCO
OnClick = Button1Click OnClick = Button1Click
end end
object Button2: TButton object Button2: TButton
Left = 320 Left = 792
Top = 520 Top = 592
Width = 75 Width = 75
Height = 25 Height = 25
Caption = 'Simu Det 0' Caption = 'Simu Det 0'
TabOrder = 7 TabOrder = 7
OnClick = Button2Click OnClick = Button2Click
end end
object EditCellX: TEdit
Left = 296
Top = 8
Width = 33
Height = 21
TabOrder = 8
Text = 'EditCellX'
OnKeyPress = EditCellXKeyPress
end
object EditCellY: TEdit
Left = 352
Top = 8
Width = 33
Height = 21
TabOrder = 9
Text = 'EditCellY'
OnKeyPress = EditCellYKeyPress
end
object PopupMenu1: TPopupMenu object PopupMenu1: TPopupMenu
Left = 352 Left = 352
Top = 472 Top = 472

View File

@@ -65,6 +65,10 @@ type
Label16: TLabel; Label16: TLabel;
ImageDiag2: TImage; ImageDiag2: TImage;
Label17: TLabel; Label17: TLabel;
Label18: TLabel;
EditCellX: TEdit;
EditCellY: TEdit;
Label19: TLabel;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ImageTCOClick(Sender: TObject); procedure ImageTCOClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
@@ -149,6 +153,8 @@ type
procedure ImageDiag2EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImageDiag2EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImageDiag2MouseDown(Sender: TObject; Button: TMouseButton; procedure ImageDiag2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure EditCellXKeyPress(Sender: TObject; var Key: Char);
procedure EditCellYKeyPress(Sender: TObject; var Key: Char);
private private
{ Déclarations privées } { Déclarations privées }
@@ -156,7 +162,7 @@ type
{ Déclarations publiques } { Déclarations publiques }
end; end;
TTCO = array of array of record TTCO = array[1..100] of array[1..50] of record
BType : integer ; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir BType : integer ; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir
Adresse : integer ; // adresse du détecteur ou de l'aiguillage Adresse : integer ; // adresse du détecteur ou de l'aiguillage
BImage : integer ; // 0=rien 1=voie 2= BImage : integer ; // 0=rien 1=voie 2=
@@ -229,8 +235,6 @@ begin
end; end;
end; end;
reset(fichier); reset(fichier);
setlength(tco,NbreCellX+1,NbreCellY+1);
setlength(Tampontco,NbreCellX+1,NbreCellY+1);
// 2eme passe : lire le fichier // 2eme passe : lire le fichier
while not eof(fichier) do while not eof(fichier) do
@@ -268,9 +272,6 @@ begin
end; end;
closefile(fichier); closefile(fichier);
Affiche('Dimensions du tco : '+intToSTR(NbreCellX)+'x'+intToSTR(NbreCellY),clyellow); Affiche('Dimensions du tco : '+intToSTR(NbreCellX)+'x'+intToSTR(NbreCellY),clyellow);
// adapter l'image au nombre de cellules
FormTCO.ImageTCO.Width:=NbreCellX*LargeurCell+2;
FormTCO.ImageTCO.Height:=NbreCellY*HauteurCell+2;
end; end;
procedure sauve_fichier_tco; procedure sauve_fichier_tco;
@@ -307,15 +308,16 @@ begin
With ImageTCO.canvas do With ImageTCO.canvas do
begin begin
pen.color:=ClGrille; pen.color:=ClGrille;
// lignes verticales
for x:=1 to NbreCellX do for x:=1 to NbreCellX do
begin begin
moveto(x*LargeurCell,1); moveto(x*LargeurCell,1);
LineTo(x*LargeurCell,HtImageTCO); LineTo(x*LargeurCell,HauteurCell*NbreCelly);
end; end;
for y:=1 to NbreCelly do for y:=1 to NbreCelly do
begin begin
moveto(1,y*HauteurCell); moveto(1,y*HauteurCell);
LineTo(LargimageTCO,y*HauteurCell); LineTo(LargeurCell*NbreCellX,y*HauteurCell);
end; end;
end; end;
end; end;
@@ -711,7 +713,7 @@ var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
begin begin
x0:=(x-1)*LargeurCell; x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell; y0:=(y-1)*HauteurCell;
r:=Rect(x0,y0,x0+LargeurCell+1,y0+HauteurCell+1); r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell);
with canvas do with canvas do
begin begin
@@ -719,7 +721,7 @@ begin
Pen.color:=clLime; Pen.color:=clLime;
Brush.Color:=Fond; Brush.Color:=Fond;
Brush.style:=bsSolid; Brush.style:=bsSolid;
// rectangle(r); rectangle(r);
fillRect(r); fillRect(r);
end; end;
end; end;
@@ -786,18 +788,27 @@ begin
9 : dessin_infG(ImageTCO.Canvas,X,Y,Clyellow,mode); 9 : dessin_infG(ImageTCO.Canvas,X,Y,Clyellow,mode);
10 : dessin_Diag1(ImageTCO.Canvas,X,Y,Clyellow,mode); 10 : dessin_Diag1(ImageTCO.Canvas,X,Y,Clyellow,mode);
11 : dessin_Diag2(ImageTCO.Canvas,X,Y,Clyellow,mode); 11 : dessin_Diag2(ImageTCO.Canvas,X,Y,Clyellow,mode);
else entoure_cell(x,y);
end; end;
if (BImage>=2) then if (BImage>=2) and (i<>0) then
begin // Adresse de l'élément begin // Adresse de l'élément
ImageTCO.Canvas.Brush.Color:=fond; with ImageTCO.Canvas do
ImageTCO.Canvas.Font.Color:=CouleurAdresse; begin
ImageTCO.Canvas.TextOut(xOrg+1,yOrg+1,s); font.Size:=5;
Brush.Color:=fond;
Font.Color:=CouleurAdresse;
TextOut(xOrg+1,yOrg+1,s);
end; end;
if (BImage=1) then end;
if (BImage=1) and (i<>0) then
begin // Adresse de l'élément begin // Adresse de l'élément
ImageTCO.Canvas.Brush.Color:=fond; with ImageTCO.Canvas do
ImageTCO.Canvas.Font.Color:=CouleurAdresse; begin
ImageTCO.Canvas.TextOut(xOrg+1,yOrg+21,s); font.Size:=5;
Brush.Color:=fond;
Font.Color:=CouleurAdresse;
TextOut(xOrg+1,yOrg+21,s);
end;
end; end;
end; end;
@@ -807,8 +818,11 @@ var x,y : integer;
s : string; s : string;
r : Trect; r : Trect;
begin begin
with formTCO.ImageTCO.Canvas do with ImageTCO.Canvas do
begin begin
Brush.Color:=clWhite;
r:=rect(1,1,ImageTCO.Width,ImageTCO.height);
FillRect(r);
Brush.Style:=bsSolid; Brush.Style:=bsSolid;
Brush.Color:=fond; Brush.Color:=fond;
pen.color:=clyellow; pen.color:=clyellow;
@@ -818,6 +832,7 @@ begin
for y:=1 to NbreCellY do for y:=1 to NbreCellY do
for x:=1 to NbreCellX do for x:=1 to NbreCellX do
begin begin
//Affiche(IntToSTR(x),clyellow);
affiche_cellule(x,y,PmCopy); affiche_cellule(x,y,PmCopy);
end; end;
grille; grille;
@@ -827,8 +842,11 @@ end;
procedure TFormTCO.FormCreate(Sender: TObject); procedure TFormTCO.FormCreate(Sender: TObject);
begin begin
caption:='TCO'; caption:='TCO';
LargeurCell:=35; LargeurCell:=25;
HauteurCell:=35; HauteurCell:=25;
EditCellX.text:=IntToSTR(LargeurCell);
EditCellY.text:=IntToSTR(HauteurCell);
XclicCell:=1; XclicCell:=1;
YclicCell:=1; YclicCell:=1;
@@ -846,7 +864,7 @@ end;
procedure TFormTCO.ImageTCOClick(Sender: TObject); procedure TFormTCO.ImageTCOClick(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position); Position:=ImageTCO.screenToCLient(Position);
@@ -861,7 +879,7 @@ begin
LabelY.caption:=IntToSTR(YclicCell); LabelY.caption:=IntToSTR(YclicCell);
XclicCellInserer:=XClicCell; XclicCellInserer:=XClicCell;
YclicCellInserer:=YClicCell; YclicCellInserer:=YClicCell;
Entoure_cell(XclicCellInserer,YclicCellInserer); //Entoure_cell(XclicCellInserer,YclicCellInserer);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
@@ -875,7 +893,6 @@ procedure TformTCO.Entoure_cell(x,y : integer);
var r : Trect; var r : Trect;
x0,y0 : integer; x0,y0 : integer;
begin begin
exit;
x0:=(x-1)*LargeurCell+1; x0:=(x-1)*LargeurCell+1;
y0:=(y-1)*HauteurCell+1; y0:=(y-1)*HauteurCell+1;
with ImageTCO.canvas do with ImageTCO.canvas do
@@ -921,7 +938,7 @@ procedure TFormTCO.ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var H
var Position: TPoint; var Position: TPoint;
begin begin
// efface le carré pointeur // efface le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position); Position:=ImageTCO.screenToCLient(Position);
@@ -933,7 +950,7 @@ begin
label1.caption:='clicContext'; label1.caption:='clicContext';
XclicCellInserer:=XClicCell; XclicCellInserer:=XClicCell;
YclicCellInserer:=YClicCell; YclicCellInserer:=YClicCell;
Entoure_cell(XclicCellInserer,YclicCellInserer); //Entoure_cell(XclicCellInserer,YclicCellInserer);
//Affiche('XClicCell='+intToSTR(XclicCell)+' '+'YClicCell='+intToSTR(YclicCell),clyellow); //Affiche('XClicCell='+intToSTR(XclicCell)+' '+'YClicCell='+intToSTR(YclicCell),clyellow);
end; end;
@@ -943,11 +960,11 @@ procedure TFormTCO.aiguillageG_PGClick(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_AigPG_AG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_AigPG_AG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
@@ -959,11 +976,11 @@ procedure TFormTCO.aiguillageD_PDClick(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_AigPD_AD(ImageTCO.Canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_AigPD_AD(ImageTCO.Canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
@@ -975,11 +992,11 @@ procedure TFormTCO.Aiguillagegauchepointedroite1Click(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_AigG_PD(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_AigG_PD(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
@@ -992,11 +1009,11 @@ begin
tco[XClicCellInserer,YClicCellInserer].Adresse:=1; tco[XClicCellInserer,YClicCellInserer].Adresse:=1;
tco[XClicCellInserer,YClicCellInserer].Btype:=1; tco[XClicCellInserer,YClicCellInserer].Btype:=1;
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_AigD_PG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_AigD_PG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
@@ -1006,7 +1023,7 @@ end;
procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin begin
exit; exit;
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
case Key of case Key of
VK_right : if XClicCell<NbreCellX then inc(XClicCell); VK_right : if XClicCell<NbreCellX then inc(XClicCell);
VK_left : if XClicCell>1 then dec(XClicCell); VK_left : if XClicCell>1 then dec(XClicCell);
@@ -1015,7 +1032,7 @@ begin
end; end;
LabelX.caption:=IntToSTR(XClicCell); LabelX.caption:=IntToSTR(XClicCell);
LabelY.caption:=IntToSTR(YClicCell); LabelY.caption:=IntToSTR(YClicCell);
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCell,YClicCell].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCell,YClicCell].BType);
@@ -1025,11 +1042,11 @@ procedure TFormTCO.Elmentdroit1Click(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_voie(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_voie(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType); EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
@@ -1040,11 +1057,11 @@ procedure TFormTCO.Courbegaucheversdroite1Click(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_infG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_infG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
end; end;
@@ -1052,11 +1069,11 @@ procedure TFormTCO.Courbedroiteversgauche1Click(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_infD(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_infD(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
end; end;
@@ -1065,11 +1082,11 @@ procedure TFormTCO.CourbeSupD1Click(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_SupD(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_SupD(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
end; end;
@@ -1077,11 +1094,11 @@ procedure TFormTCO.CourbeSupG1Click(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
// effacer le carré pointeur // effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
// dessine le dessin // dessine le dessin
dessin_SupG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy); dessin_SupG(ImageTCO.canvas,XClicCellInserer,YClicCellInserer,clyellow,pmCopy);
// remet le carré pointeur // remet le carré pointeur
Entoure_cell(XclicCell,YclicCell); //Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
end; end;
@@ -1387,6 +1404,7 @@ var Position: TPoint;
x0,y0,XSel1,YSel1,XSel2,YSel2 : integer; x0,y0,XSel1,YSel1,XSel2,YSel2 : integer;
begin begin
//Affiche('MouseMove',clyellow); //Affiche('MouseMove',clyellow);
//Affiche(IntToSTR(X),clyellow);
if not(sourisclic) then exit; if not(sourisclic) then exit;
//Affiche('MouseMove',clyellow); //Affiche('MouseMove',clyellow);
GetCursorPos(Position); GetCursorPos(Position);
@@ -1586,4 +1604,33 @@ begin
ImageDiag2.BeginDrag(true); ImageDiag2.BeginDrag(true);
end; end;
procedure TFormTCO.EditCellXKeyPress(Sender: TObject; var Key: Char);
var i, erreur : integer;
begin
val(EditCellX.text,i,erreur);
if (erreur=0) and (i>9) and (i<40) then
begin
LargeurCell:=i;
NbreCellX:=FormTCO.ImageTCO.Width div (LargeurCell);
Affiche('NbrecellX='+intToSTR(NbrecellX),clyellow);
Affiche_TCO;
end;
end;
procedure TFormTCO.EditCellYKeyPress(Sender: TObject; var Key: Char);
var i,erreur : integer;
begin
val(EditCellY.text,i,erreur);
if (erreur=0) and (i>9) and (i<40) then
begin
HauteurCell:=i;
NbreCellY:=FormTCO.ImageTCO.Height div (LargeurCell);
Affiche('NbrecellY='+intToSTR(NbrecellY),clyellow);
Affiche_TCO;
end;
end;
end. end.

View File

@@ -22,7 +22,7 @@ var
FormVersion: TFormVersion; FormVersion: TFormVersion;
Lance_verif : integer; Lance_verif : integer;
Const Version='1.41'; //Version='1.2';// sert à la comparaison de la version publiée Const Version='1.42'; //Version='1.2';// sert à la comparaison de la version publiée
implementation implementation
@@ -164,7 +164,7 @@ begin
FormVersion.show; FormVersion.show;
s:='Vous utilisez la version '+version+' mais il existe la version '+Version_p; s:='Vous utilisez la version '+version+' mais il existe la version '+Version_p;
Aff(s); Aff(s);
if MessageDlg(s+' Voulez-vous la télécharger?',mtConfirmation,[mbYes,mbNo],0)=mrYes then if MessageDlg(s+'. Voulez-vous la télécharger?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin begin
s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\Signaux_Complexes_GL.Zip'; s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\Signaux_Complexes_GL.Zip';
Aff('Téléchargement de '+s3+' dans '); Aff('Téléchargement de '+s3+' dans ');

View File

@@ -13,3 +13,4 @@ Version 1.3 : D
Version 1.31 : Correction des positions aiguillages triples et TJD Version 1.31 : Correction des positions aiguillages triples et TJD
Version 1.4 : Gestion des Fonctions Fx vers les locomotives par actionneurs Version 1.4 : Gestion des Fonctions Fx vers les locomotives par actionneurs
Version 1.41 : Gestion des passages à niveaux par actionneurs Version 1.41 : Gestion des passages à niveaux par actionneurs
Version 1.42 : Correction erreur lecture signaux