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

V10.3

Browse Source
This commit is contained in:
f1iwq2
2025-03-26 17:25:28 +01:00
parent cc07ac603c
commit bd591f6008
17 changed files with 2301 additions and 362 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice avancée pour les signaux complexes GL.pdf
BIN
View File
Binary file not shown.
Notice d'utilisation des signaux_complexes_GL_V10.2.pdf → Notice d'utilisation des signaux_complexes_GL_V10.3.pdf
BIN
View File
Binary file not shown.
UnitAnalyseSegCDM.pas
+30 -13
View File
@@ -1021,7 +1021,7 @@ begin
end;
// affiche le libellé de l'aiguillage du segment i
procedure coords_aff_aig(canvas : Tcanvas;i : integer);
procedure coords_aff_aig(canvas : Tcanvas;i : integer;imprime : boolean);
var segType,s: string;
a,x,y,x3,y3 : integer;
begin
@@ -1062,8 +1062,12 @@ begin
end;
s:='A'+intToSTR(adresse)+' ';
canvas.Font.Color:=clLime;
canvas.TextOut(x,y+YcrOffset,s);
with canvas do
begin
Font.Color:=clLime;
if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm;
TextOut(x,y+YcrOffset,s);
end;
a:=adresse2;
if a<>0 then
@@ -1637,6 +1641,7 @@ begin
begin
if formAnalyseCDM.CheckSegments.checked then
begin
if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm;
Textout(x1,y1,s);
pen.Width:=1;
PolyGon([point(x1,y1),Point(x2,y2)]);
@@ -1656,9 +1661,14 @@ begin
if formAnalyseCDM.CheckPorts.checked then
begin
if imprime then canvas.Font.Color:=ClBlack
if imprime then
begin
canvas.Brush.Color:=clwhite;
canvas.Font.Color:=ClBlack;
end
else
begin
canvas.Brush.Color:=fond_cdm;
if coul then Canvas.font.Color:=clWhite else
Canvas.font.color:=ClYellow;
end;
@@ -1666,6 +1676,7 @@ begin
y1:=(Segment[i].port[0].y+Segment[i].port[1].y) div 2;
coords(x1,y1);
s:='S'+intToSTR(NumSegment);
Canvas.Font.Size:=8;
Canvas.Textout(x1,y1,s);
end;
@@ -1681,8 +1692,9 @@ begin
with canvas do
begin
pen.Color:=clOrange;
Brush.Color:=clOrange;
pen.width:=2;
Ellipse(x1-5,y1-5,x1+5,y1+5);
Rectangle(x1-5,y1-5,x1+5,y1+5);
canvas.pen.Color:=clWhite;
end;
end;
@@ -1709,7 +1721,12 @@ begin
coords(x1,y1);
x1:=x1+offset;
s:='P'+intToSTR(Segment[i].port[j].numero);
canvas.textout(x1,y1,s);
with canvas do
begin
if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm;
font.Size:=8;
textout(x1,y1,s);
end;
end;
end;
//Affiche(s,ClYellow);
@@ -1732,7 +1749,7 @@ begin
moveto(portsSeg[1].x,portsSeg[1].y);
LineTo(portsSeg[3].x,portsSeg[3].y);
end;
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime);
end
else
if (segtype='turnout') or (segtype='turnout_sym') then
@@ -1745,7 +1762,7 @@ begin
LineTo(portsSeg[1].x,portsSeg[1].y);
moveTo((portsSeg[0].x+portsSeg[1].x) div 2,(portsSeg[0].y+portsSeg[1].y) div 2);
LineTo(portsSeg[2].x,portsSeg[2].y);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime);
end
else
if (segtype='turnout_3way') then
@@ -1759,7 +1776,7 @@ begin
LineTo(portsSeg[2].x,portsSeg[2].y);
moveTo((portsSeg[0].x+portsSeg[1].x) div 2,(portsSeg[0].y+portsSeg[1].y) div 2);
LineTo(portsSeg[3].x,portsSeg[3].y);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime);
end
else
if (segtype='turnout_curved') or (segtype='turnout_curved_2r')
@@ -1777,7 +1794,7 @@ begin
LineTo(portsSeg[2].x,portsSeg[2].y);
//dessine_aig_courbe(canvas,i);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i);
if formAnalyseCDM.CheckBoxAutres.checked then coords_aff_aig(canvas,i,imprime);
end
else
if (segType='arc') or (segType='curve') then
@@ -1825,7 +1842,7 @@ begin
font.Size:=TailleFonte;
//Affiche(intToSTR(round(zoom /10)),clyellow);
pen.color:=couleur;
if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm;
textout(x1+4,y1+ofs,s2);
pen.Width:=2;
Ellipse(x1-5,y1-5,x1+5,y1+5);
@@ -1837,7 +1854,7 @@ begin
font.Size:=TailleFonte;
//Affiche(intToSTR(round(zoom /10)),clyellow);
pen.color:=couleur;
if imprime then Brush.color:=clWhite else Brush.color:=Fond_cdm;
textout(x1+4,y1+ofs,s2);
pen.Width:=2;
Ellipse(x1-5,y1-5,x1+5,y1+5);
@@ -4999,7 +5016,7 @@ begin
Brush.Style:=bsSolid;
brush.Color:=fond_cdm;
end;
coords_aff_aig(canvas,indexClic);
coords_aff_aig(canvas,indexClic,false);
canvas.Brush.Style:=bsClear;
end;
end;
UnitCompteur.pas
+40 -54
View File
@@ -49,15 +49,15 @@ type
end;
type
typ=(fen,gb,im);
typ=(rien,fen,gb,im); // un compteur peut être de la fenetre 'formCompteur' (fen), des groupBox de la fenetre principale (gb) ou d'une image (onglet compteurs formConfig)
TTcompteur=array[1..10] of record
FcBitMap : Tbitmap;
paramcompt : TparamCompt;
end;
var
formCompteur : array[1..10] of TformCompteur;
Scompteur,CompteurPP : TTCompteur;
formCompteur : array[1..10] of TformCompteur; // il y a 10 fenetres mais on utilise qu'un compteur.
Scompteur : TTCompteur; // Scompteur : associé à fen
ParamCompteur : array[1..3] of record
coulAig,coulGrad,CoulNum,CoulFond,CoulArc : tcolor;
end;
@@ -145,7 +145,7 @@ end;
// change l'aiguille du compteur
// c : du compteur idTrain : index du train
// c : n° du compteur idTrain : index du train comp : composant dans lequel se trouve le compteur (form, groupbox ou image)
procedure aiguille_compteur(c,idTrain : integer ; comp : Tcomponent);
var ComptLoc,x1,y1,x2,y2,x3,y3,x4,y4,vitesse,vitesseFin,lim,him : integer;
angleDeb,AngleFin,sinD,cosD,sinF,cosF : extended ;
@@ -155,9 +155,15 @@ var ComptLoc,x1,y1,x2,y2,x3,y3,x4,y4,vitesse,vitesseFin,lim,him : integer;
begin
if compteur<1 then exit;
typDest:=rien;
if comp is tform then typDest:=fen;
if comp is tgroupBox then typDest:=gb;
if comp is tImage then typDest:=im;
if TypDest=rien then
begin
Affiche('Anomalie 47',clred);
exit;
end;
if idTrain<>0 then
begin
@@ -167,7 +173,7 @@ begin
end
else
begin
vitesse:=0;
Vitesse:=0;
VitesseFin:=0;
end;
@@ -200,19 +206,16 @@ begin
Him:=imgH;
end;
sincos(angleDeb*pisur180,sinD,cosD);
//Affiche('Ad,Af='+floatToSTR(AngleDeb)+' '+floatToSTR(AngleFin),clred);
sincos(AngleDeb*pisur180,sinD,cosD); // arc vitesse de début
sincos(AngleFin*pisur180,sinF,cosF); // arc vitesse de fin
with canvDest do
begin
// copie le fond du compteur
if typdest=fen then copyrect(rect(0,0,lim,him),Scompteur[c].FcBitMap.canvas,rect(0,0,lim,him));
if typdest=gb then copyrect(rect(0,0,lim,him),compteurT[c].FcBitMap.canvas,rect(0,0,lim,him));
if typdest=im then copyrect(rect(0,0,lim,him),FbmcompC.canvas,rect(0,0,lim,him));
//moveto(0,0);lineTo(200,200);
// afficher l'arc vert
with param do
begin
@@ -226,7 +229,6 @@ begin
y2:=AigCY + rav;
x3:=AigCX + Round(rav*sinD);
y3:=AigCY - Round(rav*cosD);
sincos(AngleFin*pisur180,sinF,cosF); // paramètres d'angleFin
x4:=AigCX + Round(rav*sinF);
y4:=AigCY - Round(rav*cosF);
pen.color:=ParamCompteur[comptloc].coulArc;
@@ -243,8 +245,8 @@ begin
end;
procedure compteur_2(c : integer;bm : tbitmap;param : tparamcompt);
var l,av,n,v,rayon2,rayon3,rayon4,x1,y1,x2,y2,xt,yt,lim,him,rg : integer;
angle,angleFin,incr,r,a : single;
var n,v,rayon2,rayon3,rayon4,x1,y1,x2,y2,xt,yt,lim,him,rg : integer;
angle,angleFin,incr,r : single;
s : string;
begin
angle:=10; // angle début des graduations
@@ -257,14 +259,11 @@ begin
with param do
begin
//AigCX:=him div 2; // centre aiguille
//AigCY:=round(200*param.redY);
r:=redx; // réduction
//Raig[1]:=(Lim div 2)-round(10*r); // rayon
rg:=round(AigCX/1.05); // rayon des graduations
rayon2:=Rg-round(10*r); // rayon de fin des graduations
rg:=round(AigCX/1.05); // rayon des graduations
rayon2:=Rg-round(10*r); // rayon de fin des graduations
rayon3:=Rg-round(20*r);
rayon4:=Rg-round(20*r); // chiffres
rayon4:=Rg-round(20*r); // chiffres
with bm.Canvas do
begin
@@ -276,7 +275,6 @@ begin
Brush.Color:=ParamCompteur[2].coulFond;
Cercle(bm.canvas,AigCX,AigCY,round(10*r),clBlack,clBlack);
font.Name:='Arial';;
@@ -341,7 +339,7 @@ end;
procedure compteur_tachro(c : integer;bm : tbitmap;param : tparamcompt);
var l,av,n,v,rayon2,rayon3,rayon4,x1,y1,x2,y2,xt,yt,lim,him,rg : integer;
angle,angleFin,incr,r,a : single;
angle,angleFin,incr,r,a,sinA,cosA : single;
s : string;
begin
angle:=-40; // angle début des graduations
@@ -372,7 +370,7 @@ begin
FillRect(Rect(0,0,lim,him));
end;
Cercle(bm.Canvas,AigCX,AigCY,round(130*r),clGray,ParamCompteur[3].CoulFond);
Cercle(bm.Canvas,AigCX,AigCY,round(125*r),clGray,ParamCompteur[3].CoulFond);
Cercle(bm.Canvas,AigCX,AigCY,round(10*r),clwhite,clWhite);
with bm.Canvas do
@@ -383,7 +381,7 @@ begin
font.color:=ParamCompteur[3].CoulNum;
font.size:=round(r*20);
//Affiche(intToSTR(font.size),clred);
font.style:=[fsbold];
font.style:=[];
end;
// dessine le cadran
@@ -401,7 +399,7 @@ begin
xt:=round(cos((angle+180-l)*pisur180)*rayon4)+AigCX;
yt:=round(sin((angle+180-l)*pisur180)*rayon4)+AigCY;
// affiche les chiffres
// affiche les chiffres avec un angle
{$IF CompilerVersion >= 28.0}
av:=round(90-angle)*10;
bm.canvas.font.orientation:=av;
@@ -414,21 +412,23 @@ begin
inc(v,20);
end;
x1:=round(cos((angle+180)*pisur180)*Rg)+AigCX;
y1:=round(sin((angle+180)*pisur180)*Rg)+AigCY;
cosA:=cos((angle+180)*pisur180);
sinA:=sin((angle+180)*pisur180);
x1:=round(cosA*Rg)+AigCX;
y1:=round(SinA*Rg)+AigCY;
// gros traits
if n mod 5 = 0 then
begin
bm.Canvas.pen.Width:=round(4*r);
x2:=round(cos((angle+180)*pisur180)*rayon3)+AigCX;
y2:=round(sin((angle+180)*pisur180)*rayon3)+AigCY;
x2:=round(cosA*rayon3)+AigCX;
y2:=round(sinA*rayon3)+AigCY;
end
else
begin
// traits fins
bm.Canvas.pen.Width:=round(2*r);
x2:=round(cos((angle+180)*pisur180)*rayon2)+AigCX;
y2:=round(sin((angle+180)*pisur180)*rayon2)+AigCY;
x2:=round(cosA*rayon2)+AigCX;
y2:=round(sinA*rayon2)+AigCY;
end;
with bm.Canvas do
@@ -437,17 +437,15 @@ begin
lineTo(x2,y2);
end;
inc(n);
angle:=angle+incr; // 18
angle:=angle+incr;
until angle>AngleFin+incr;
end;
//lim:=formCompteur[c].ImageTachro.width;
//him:=formCompteur[c].ImageTachro.height;
lim:=param.ImgL;
him:=param.ImgH;
// copie l'image du texte "tachro" mise à l'échelle
StretchBlt(bm.Canvas.Handle,round(145*r),round(85*r),round(lim*r),round(him*r),
StretchBlt(bm.Canvas.Handle,round(145*r),round(90*r),round(lim*r),round(him*r),
FormPrinc.ImageTachro.canvas.Handle,0,0,lim,him,srcCopy);
end;
@@ -464,7 +462,7 @@ begin
with Im.Canvas do
begin
Brush.Style:=bsSolid;
Brush.Color:=$141414; //$e0e0e0;
Brush.Color:=$141414;
font.name:='arial';
font.Style:=[fsBold];
@@ -530,9 +528,9 @@ begin
if (i<1) or (hautComptC=0) then exit;
//Affiche('Init compteur de vitesse',clYellow);
if c is tform then typDest:=fen; // si le compteur est la fenetre, sinon le groupBox de la fenetre principale
if c is tGroupBox then typDest:=gb;
if c is tImage then typDest:=im;
if c is tform then typDest:=fen; // si le compteur est la fenetre unique
if c is tGroupBox then typDest:=gb; // si le compteur est le groupBox de la fenetre principale
if c is tImage then typDest:=im; // si le compteur est l'image de l'onglet config compteurs
if (typDest=fen) or (typDest=gb) then ComptLoc:=compteur;
if typDest=im then ComptLoc:=formconfig.ComboBoxCompt.ItemIndex+1;
@@ -568,7 +566,6 @@ begin
if typDest=fen then
begin
Lim:=LargeurCompteurs-ofs;
//p:=Scompteur[i].paramcompt;
formCompteur[i].Width:=LargeurCompteurs;
Scompteur[i].paramcompt.ComptA:=(maxi-mini)/vmax; // pente de conversion vitesse en degrés compteur
Scompteur[i].paramcompt.ComptB:=mini; // coordonnées origine conversion
@@ -604,8 +601,6 @@ begin
end;
if typDest=gb then
begin
//Lim:=compteurT[i].gb.Width-10-round(CompteurT[i].tb.Height/r);
//him:=round(lim*r);
if l>h then
begin
lim:=LargComptC-10;
@@ -616,7 +611,6 @@ begin
him:=HautComptC-ofsGBH-CompteurT[i].tb.Height-ofsGBB;
lim:=round(him/r);
end;
//p:=compteurT[i].paramcompt;
with CompteurT[i] do
begin
gb.Width:=LargComptC;
@@ -637,11 +631,10 @@ begin
Scompteur[i].paramcompt.redY:=Him/h;
Scompteur[i].paramcompt.ImgL:=Lim;
Scompteur[i].paramcompt.ImgH:=Him;
case compteur of
1 : Scompteur[i].paramcompt.rav:=round(70*Scompteur[i].paramcompt.redx); // rayon de l'arc vert
2 : Scompteur[i].paramcompt.rav:=round(100*Scompteur[i].paramcompt.redx);
3 : Scompteur[i].paramcompt.rav:=round(122*Scompteur[i].paramcompt.redx);
3 : Scompteur[i].paramcompt.rav:=round(115*Scompteur[i].paramcompt.redx);
end;
end;
if typDest=gb then
@@ -658,12 +651,11 @@ begin
bouton.left:=(lim div 2)-6;
bouton.Width:=16;
end;
case compteur of
1 : compteurT[i].paramcompt.rav:=round(70*compteurT[i].paramcompt.redx); // rayon de l'arc vert
2 : compteurT[i].paramcompt.rav:=round(100*compteurT[i].paramcompt.redx);
3 : compteurT[i].paramcompt.rav:=round(122*compteurT[i].paramcompt.redx);
end;
3 : compteurT[i].paramcompt.rav:=round(115*compteurT[i].paramcompt.redx);
end;
end;
if typDest=fen then
@@ -727,7 +719,6 @@ begin
end;
if typDest=gb then
begin
//p:=compteurT[i].paramcompt;
compteurT[i].FCBitMap.Free;
compteurT[i].fcBitMap:=tbitmap.Create;
with compteurT[i].FCBitMap do
@@ -778,14 +769,12 @@ begin
if typDest=fen then
begin
dessin_fond_compteur(Scompteur[i].paramcompt,i,Scompteur[i].FcBitmap,compteur);
//canv:=formCompteur[i].ImageCompteur.Canvas;
Aiguille_compteur(i,IdTrainClic,formCompteur[i]);
Affiche_train_compteur(i);
end;
if typDest=gb then
begin
dessin_fond_compteur(compteurT[i].paramcompt,i,compteurT[i].fcBitmap,compteur);
//canv:=compteurT[i].Img.Canvas;
Aiguille_compteur(i,i,compteurT[i].gb);
end;
@@ -800,7 +789,6 @@ begin
with formCompteur[1] do
begin
Left:=formprinc.Left+formprinc.Width-width-2;
//left:=0;
end;
if (formClock<>nil) and not(fermeSC) then
begin
@@ -875,8 +863,6 @@ begin
end;
procedure TFormCompteur.FormCreate(Sender: TObject);
var form : Tform;
Acanvas : tcanvas;
begin
//LargComptC:=150;HautCompTC:=150;
// valeurs mini et maxi de la fenetre
@@ -904,7 +890,7 @@ end;
procedure TFormCompteur.TrackBarCChange(Sender: TObject);
var s : string;
c,i,vit,larg : integer;
i,vit : integer;
tt : ttrackbar;
f : tform;
begin
UnitConfig.dfm
+13 -13
View File
@@ -670,7 +670,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 633
Height = 505
ActivePage = TabSheetBouton
ActivePage = TabSheetAutonome
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
@@ -1205,7 +1205,7 @@ object FormConfig: TFormConfig
'S'#233'lection du style d'#39#39'affichage - Le style sera chang'#233' '#224' la ferm' +
'eture de la fen'#234'tre'#39
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 0
@@ -2412,7 +2412,7 @@ object FormConfig: TFormConfig
Width = 137
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 1
OnChange = ComboBoxDecChange
end
@@ -2543,7 +2543,7 @@ object FormConfig: TFormConfig
Width = 137
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxAspChange
end
@@ -2851,7 +2851,7 @@ object FormConfig: TFormConfig
Top = 56
Width = 193
Height = 21
ItemHeight = 0
ItemHeight = 13
TabOrder = 0
OnChange = ComboBoxDecodeurPersoChange
end
@@ -2870,7 +2870,7 @@ object FormConfig: TFormConfig
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxNationChange
end
@@ -2916,7 +2916,7 @@ object FormConfig: TFormConfig
Width = 193
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 6
OnChange = ComboBoxDecCdeChange
end
@@ -3131,7 +3131,7 @@ object FormConfig: TFormConfig
Top = 96
Width = 137
Height = 21
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxOperateurChange
OnDrawItem = ComboBoxOperateurDrawItem
@@ -3151,7 +3151,7 @@ object FormConfig: TFormConfig
Top = 96
Width = 161
Height = 21
ItemHeight = 0
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 4
@@ -3252,7 +3252,7 @@ object FormConfig: TFormConfig
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 7
OnChange = ComboBoxFLChange
end
@@ -3802,7 +3802,7 @@ object FormConfig: TFormConfig
Height = 21
Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"'
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 10
@@ -5299,7 +5299,7 @@ object FormConfig: TFormConfig
end
object GroupBoxBt: TGroupBox
Left = 312
Top = 176
Top = 200
Width = 260
Height = 121
Caption = 'Bouton'
@@ -5359,7 +5359,7 @@ object FormConfig: TFormConfig
object GroupBoxBloc: TGroupBox
Left = 312
Top = 48
Width = 257
Width = 260
Height = 113
Caption = 'G'#233'n'#233'ral'
TabOrder = 3
UnitConfig.pas
+6 -6
View File
@@ -14083,7 +14083,7 @@ function Maj_icone_train(IImage : Timage;index :integer;coulfond : Tcolor) : int
var h,l,HautDest,LargDest,y : integer;
rd : single;
begin
if (index<1) or (index>Ntrains) then
if (index<1) or (index>Ntrains) or (iImage=nil) then
begin
//Iimage.Picture:=nil;
result:=0;
@@ -14975,7 +14975,6 @@ begin
EditNbreAdr.Text:=intToSTR(decodeur_pers[decCourant].NbreAdr);
//Affiche('Décodeur courant = '+intToSTR(decCourant),clyellow);
maj_decodeurs;
end;
// renvoie vrai si chaine est dans le combobox 'combo' et renvoie son index
@@ -15026,7 +15025,7 @@ begin
for i:=ma to NbreDecPers-1 do
begin
Affiche('traitement décodeur '+inttoSTR(i),clyellow);
decodeur_pers[i]:=decodeur_pers[i+1];
decodeur_pers[i]:=decodeur_pers[i+1];
end;
dec(NbreDecPers);
if NbreDecPers=0 then ComboBoxDecodeurPerso.Text:='';
@@ -15452,7 +15451,7 @@ begin
if s='ListBoxAig' then ajoute_aiguillage;
if s='ListBoxTrains' then ajoute_train;
if s='ListBoxPeriph' then ajoute_periph;
end;
end;
procedure TFormConfig.outcopierentatquetexte1Click(Sender: TObject);
var tl: TListBox;
@@ -15928,7 +15927,7 @@ begin
index:=Index_Aig(Adresse);
AncienAdresse:=aiguillage[index].AncienAdresse;
if Adresse=AncienAdresse then exit;
Affiche('Propagation de l''adresse '+intToSTR(adresse)+' en remplacement de l''ancienne adresse '+intToSTR(AncienAdresse),clOrange);
// --------- aiguillages -----------
@@ -16102,7 +16101,6 @@ begin
ButtonPropage.Hint:='Change les adresses dans les points de connexions'+#13+
'des aiguillages, des branches et des signaux'+#13+
'si on a changé l''adresse d''un aiguillage';
clicListe:=false;
end;
@@ -19260,6 +19258,8 @@ begin
end;
end;
end.
UnitConfigCellTCO.dfm
+7 -7
View File
@@ -4,7 +4,7 @@ object FormConfCellTCO: TFormConfCellTCO
BorderStyle = bsDialog
Caption = 'FormConfCellTCO'
ClientHeight = 473
ClientWidth = 571
ClientWidth = 613
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -485,8 +485,8 @@ object FormConfCellTCO: TFormConfCellTCO
OnClick = CheckPinvClick
end
object GroupBoxAction: TGroupBox
Left = 352
Top = 80
Left = 312
Top = 152
Width = 273
Height = 145
Caption = 'Actions'
@@ -561,8 +561,8 @@ object FormConfCellTCO: TFormConfCellTCO
OnClick = BitBtnAnnuleClick
end
object GroupBoxCanton: TGroupBox
Left = 328
Top = 280
Left = 312
Top = 312
Width = 281
Height = 129
Caption = 'Canton'
@@ -639,8 +639,8 @@ object FormConfCellTCO: TFormConfCellTCO
end
end
object GroupBoxDet: TGroupBox
Left = 376
Top = 24
Left = 320
Top = 16
Width = 281
Height = 121
Caption = 'Visu options d'#39'arr'#234't des trains sur le d'#233'tecteur'
UnitConfigCellTCO.pas
+3 -3
View File
@@ -130,7 +130,7 @@ begin
if bim=Id_action then
begin
act:=ligneclicAction+1;
tco[IndexTCOCourant,X,Y].PiedFeu:=act;
tco[IndexTCOCourant,X,Y].PiedSignal:=act;
efface_cellule(indexTCOCourant,PCanvasTCO[indexTCOcourant],x,y,pmcopy);
affiche_cellule(IndexTCOCourant,x,Y);
actualise(indexTCOCourant);
@@ -370,7 +370,7 @@ begin
EditTypeImage.Enabled:=true;
with GroupBoxAction do
begin
act:=tco[indexTCO,XclicC,YclicC].PiedFeu;
act:=tco[indexTCO,XclicC,YclicC].PiedSignal;
if (act<0) or (act-1>ListBoxAction.Count) then
begin
Affiche('Erreur 29 ',clred);
@@ -607,7 +607,7 @@ begin
end;
end;
PiedFeu:=tco[indexTCO,XclicC,YclicC].PiedFeu;
PiedFeu:=tco[indexTCO,XclicC,YclicC].PiedSignal;
if PiedFeu=1 then
begin
RadioButtonG.checked:=true;
UnitModifAction.dfm
+1 -1
View File
@@ -60,7 +60,7 @@ object FormModifAction: TFormModifAction
Top = 64
Width = 729
Height = 337
ActivePage = TabSheetDecl
ActivePage = TabSheetOp
MultiLine = True
TabOrder = 1
object TabSheetDecl: TTabSheet
UnitModifAction.pas
+1 -2
View File
@@ -223,9 +223,8 @@ end;
procedure affecte_operation(i : integer;t : tListBox);
var s : string;
begin
if ligneclicAct<0 then exit;
s:=operations[i].nom;
if not(Tablo_Action[ligneclicact+1].tabloOp[i].valide) then s:=s+sd;
if ligneclicAct>0 then if not(Tablo_Action[ligneclicact+1].tabloOp[i].valide) then s:=s+sd;
if i<ActionBoutonTCO then t.Items.Add(Format('%d%s', [i-1, s])); // valeur d'index de l'icone dans la ImagelistIcones
if i=ActionBoutonTCO then t.Items.Add(Format('%d%s', [IconeBouton, s])); // valeur d'index de l'icone dans la ImagelistIcones
if i=ActionAffecteMemoire then t.Items.Add(Format('%d%s', [IconeActionAffecteMemoire, s])); // valeur d'index de l'icone dans la ImagelistIcones
UnitPrinc.dfm
+2 -2
View File
@@ -5951,8 +5951,8 @@ object FormPrinc: TFormPrinc
end
end
object GroupBoxCV: TGroupBox
Left = 593
Top = 32
Left = 697
Top = 8
Width = 265
Height = 129
Anchors = [akTop, akRight]
UnitPrinc.pas
+165 -107
View File
@@ -1,14 +1,14 @@
unit Unitprinc;
// 04/10/2024 10h
// 23/03/2025
(********************************************
Programme signaux complexes Graphique Lenz
Composants ClientSocket et ServeurSocket pour les connexions réseau socket
Delphi 7 :
on utilise activeX Tmscomm pour les liaisons série/USB
clientSocket et ServeurSocket pour les connexions réseau socket
Delphi 12 :
on utilise AsyncPro pour les liaisons série/USB - ce composant est compilable en 32 et en 64 bits.
clientSocket et ServerSocker pour les connexions réseau socket
https://github.com/TurboPack/AsyncPro
liste des fichiers nécessaires:
AdDispLog.inc
@@ -485,6 +485,7 @@ type
{ Déclarations publiques des composants dynamiques}
Procedure ImageOnClick(Sender : TObject);
procedure ImageTrainonclick(Sender : TObject);
procedure ImageTrainDoubleClic(Sender : Tobject);
procedure ProcOnMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure proc_checkBoxFB(Sender : Tobject);
procedure proc_checkBoxFV(Sender : Tobject);
@@ -601,8 +602,8 @@ titre='Signaux complexes GL ';
itMaxi=70; // itérations maxi pour les recherches
MaxAcc=1024; // adresse maxi d'accessoire XpressNet (testé à la LH100)
NbMaxDet=2048; // indice maximal de détecteurs d'un réseau
NbDetArret=500;
Max_Trains=100; // nombre maximal de train de CDM ou déclarés ou en circulation
NbDetArret=500; // Nombre de détecteurs arret de train
Max_Trains=200; // nombre maximal de train de CDM ou déclarés ou en circulation
MaxZones=250; // nombre de zones de détecteurs activés par les trains
MaxTrainZone=40; // nombre maximal de trains pour le tableau d'historique des zones
Mtd=128; // nombre maxi de détecteurs précédents stockés
@@ -619,8 +620,7 @@ NbreMaxiSignaux=250; // nombre maxi de signaux
NbreMaxiDecPers=10; // nombre maxi de décodeurs personnalisés
NbMaxi_Periph=10; // nombre maxi de périphériques COM/USB/Socket
LargImg=50;HtImg=91; // Dimensions image des signaux (le plus grand, le 9 feux)
MaxTaches=120;
MaxTaches=300; // Nombre maxi de taches pour pilotage des accessoires en mode asynchrone
MaxComUSBPeriph=2; // Nombre maxi d'objets périphériques périphériques USB Tmscom
MaxComSocketPeriph=2; // Nombre maxi d'objets périphériques périphériques socket TClientsocket
const_droit=2; // position droite aiguillages transmises par la centrale LENZ
@@ -634,7 +634,7 @@ const_talon=11; // aiguillage pris en talon
IdClients=10; // Index maxi de clients réseau
LargImgTrain=200; // largeur réservée icone train page pricipale, onglets trains
HautImgTrain=50; // hauteur réservée icone train page pricipale, onglets trains
WH_KEYBOARD_LL=13;
WH_KEYBOARD_LL=13; // code api windows pour hooker clavier de bas niveau
MaxParcoursTablo=200; // taille maxi du tableau des routes
MaxRoutesCte=25000; // Nombre maximal de routes
NbCouleurTrain=8;
@@ -684,10 +684,12 @@ EtatSignBelge: array[0..9] of string[30]=
consigneBLocUSB=125;
// constantes pour la procédure tache()
ttacheAcc=1; // pilote accessoire
ttacheVit=2; // vitesse train
ttacheFF=3; // fonction F
ttDestCDM=1; // destinataire CDM
ttacheAcc=1; // pilote accessoire
ttacheVit=2; // vitesse train
ttacheFF=3; // fonction F
ttacheTempo=4; // tempo
//
ttDestCDM=1; // destinataire CDM
ttDestXpressNet=2; // xpresset
ttDestDccpp=3; // dccpp
@@ -791,6 +793,7 @@ tagKBDLLHOOKSTRUCT =
KbDLLHookStruct = tagKbDLLHookStruct;
PkBDLLHookStruct= ^KbDLLHookStruct;
// type fonction
Tfonction =
record
typ : integer;
@@ -946,7 +949,7 @@ Tcondition = record
HeureMin,MinuteMin,
HeureMax,MinuteMax : integer;
train : string;
end;
end;
TparamCompt=record
AigCX,AigCY, // centre de l'aiguille
@@ -1006,14 +1009,13 @@ tTrain = record
VitesseReelleR : single; // Vitesse réelle calculée (tient compte de la décélération)
VitesseReelle : integer;
VitesseBlocUSB : integer;
BlocUSB : integer; // N0 du bloc USB sur lequel le train est affecté
BlocUSB : integer; // N0 du bloc USB sur lequel le train est affecté
sens : integer; // sens de déplacement, stockage provisoire pour restocker dans le tableau canton[]
longueur: integer; // longueur de la loco
compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s
cv3,cv4 : integer;
crans : integer; // crans du décodeur
// pilotage des trains-------------------
//TempoArret : integer; // tempo d'arret pour le timer
TempoArretCour : integer; // valeur dynamique
TempoArretTemp : integer; // temps d'arrêt temporisé sur un détecteur
TempoDemarre : integer; // tempo de démarrage, valeur dynamique
@@ -1065,7 +1067,7 @@ tTrain = record
routePref : array[0..30] of TUneroute; // tableaux dess route sauvegardées du train. routePref[0,0].adresse est le nombre de routes
// routePref[0,0].talon = consigne inverse au train
PointRout : integer;
// cantons (via leurs déteceteurs) sur lesquels le train doit d'arrêter
// cantons (via leurs détecteurs) sur lesquels le train doit d'arrêter
DetecteurArret : array[1..NbDetArret] of record
Prec, // adresse précédent, pour le sens
detecteur, // détecteur sur lequel s'arreter si le canton a 2 détecteurs
@@ -1076,13 +1078,11 @@ tTrain = record
Ttache = array[1..MaxTaches] of record
typeTache : integer ; // 0 : rien - 1 : accessoire
typeTache : integer ; // 0 : rien - 1 : accessoire ... etc
traite : boolean; // traitement en cours
//adresse : integer;
//etat : integer;
tempo : integer;
tempo : integer; // tempo avant exécution de la commande
dest : integer; // destinataire : 1=CDM - 2=XpressNet 3=Dccpp
chaine : string;
chaine : string; // chaine de commande à envoyer au périphérique
end;
TchaineBIN=array[0..Long_tampon_interface] of byte;
@@ -1121,7 +1121,7 @@ var
retEtatDet,roulage,init_aig_cours,affevt,placeAffiche,clicComboTrain,clicAdrTrain,
fichier_module_cdm,Diffusion,cdmDevant,serveurIPCDM_Touche,avecAckCDM,Stop_Maj_Sig,
Modesombre,serveur_ouvert,pasChgTBV,FpBouge,debugPN,simuInterface,option_demitour,
mesureTrains,AffCompteur,clicTBGB,clicTBfen,clicTBTrain,ModeTache : boolean;
mesureTrains,AffCompteur,clicTBGB,clicTBfen,clicTBTrain,ModeTache,NoTraite : boolean;
Style : array[0..200] of Tstyle;
@@ -1282,12 +1282,12 @@ var
ArbreFonc : array[0..100,0..100] of integer;
blocUSB : array[1..10] of record
AffTrain : string;
rotatifM,rotatifP,clic,increment : integer;
Bp1,bp2,bp3,bp4,bp5,bp6,bp7,bp8,bp9,bp10 : integer;
Fbp1,fbp2,fbp3,Fbp4,fbp5,fbp6,Fbp7,fbp8,fbp9,Fbp10 : integer; // fonctions F des BP
Fnp1,fnp2,fnp3,Fnp4,fnp5,fnp6,Fnp7,fnp8,fnp9,Fnp10 : integer; // état F des BP
end;
AffTrain : string;
rotatifM,rotatifP,clic,increment : integer;
Bp1,bp2,bp3,bp4,bp5,bp6,bp7,bp8,bp9,bp10 : integer;
Fbp1,fbp2,fbp3,Fbp4,fbp5,fbp6,Fbp7,fbp8,fbp9,Fbp10 : integer; // fonctions F des BP
Fnp1,fnp2,fnp3,Fnp4,fnp5,fnp6,Fnp7,fnp8,fnp9,Fnp10 : integer; // état F des BP
end;
Memoire : array[0..100] of integer;
@@ -1315,7 +1315,7 @@ var
// ils sont stockés dans les tableaux tablo_Index_Signal[adresse]=index et tablo_Index_Aiguillage[adresse]=index
Aiguillage : array[0..NbreMaxiAiguillages] of Taiguillage;
// signaux - L'index du tableau n'est pas son adresse
Signaux : array[0..NbreMaxiSignaux] of TSignal;
Signaux : array[0..NbreMaxiSignaux] of TSignal;
CompteurT : array[0..Max_trains] of record
gb : tgroupBox;
@@ -1347,7 +1347,6 @@ var
TabloParcours,TabloRoute,TabloItin : TelRoute;
// liste des évènements détecteurs
event_det : array[1..Max_event_det] of
record
@@ -1937,7 +1936,6 @@ begin
end;
end;
//Affiche('consigne_train='+trains[IdTrainClic].nom_train+' '+intToSTR(vit),cllime);
end;
@@ -1972,7 +1970,6 @@ begin
if fenetre=1 then Formprinc.windowState:=wsMaximized ;
with GrandPanel do
begin
left:=2;
@@ -2170,7 +2167,7 @@ end;
procedure envoie_infos(mode : integer);
var ts : tstrings;
s,cmd : string;
retour,i,erreur : integer;
retour,i,erreur,n : integer;
f : textFile;
begin
s:=GetCurrentProcessEnvVar('SystemDrive'); // s='c:'
@@ -2178,7 +2175,7 @@ begin
cmd:='/c vol '+s+' >vol.txt'; // /c ferme la fenetre en fin d'exec /k ne ferme pas
// si on fait un runas au lieu de open, çà ouvre une fenetre de demande admin sur les postes non admin
// ou dont le niveau d'utilisateur est bas dans le profil
retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.exe'),PChar(cmd),nil,SW_SHOWNORMAL);
retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.exe'),PChar(cmd),nil,SW_HIDE);
s:='';
if retour<=32 then
begin
@@ -2229,7 +2226,7 @@ begin
s:='NbreTCO='+intToSTR(nbreTCO);
s:=s+' Nbrecantons='+intToSTR(ncantons);
s:=s+' NbreTrains='+intToSTR(n_trains);
s:=s+' NbreTrains='+intToSTR(ntrains);
s:=s+' NbreHoraires='+intToSTR(Nombre_horaires);
s:=s+' NbreAig='+intToSTR(maxaiguillage);
s:=s+' NbreSignaux='+intToSTR(NbreSignaux);
@@ -2240,6 +2237,15 @@ begin
if mode=1 then Affiche(s,clyellow);
if mode=2 then ClientInfo.Socket.SendText(s);
for i:=1 to ntrains do
begin
n:=trains[i].routePref[0,0].adresse;
if n<>0 then s:='train '+intToSTR(i)+' : '+intToSTR(n)+' routes';
end;
if mode=1 then Affiche(s,clyellow);
if mode=2 then ClientInfo.Socket.SendText(s);
end;
procedure menu_selec;
@@ -2321,10 +2327,19 @@ begin
interface_ou_cdm; // démarrer l'interface , génère les evts détecteurs ; ou cdm
formprinc.SetFocus;
// créer les compteurs après avoir téléchargé la liste des trains de CDM
s:='Création des compteurs GB';
procetape(s);
for i:=1 to ntrains do
begin
cree_GB_compteur(i);
end;
s:='Fin du préliminaire';
procetape(s);
formprinc.SetFocus;
menu_selec;
end;
@@ -4560,30 +4575,30 @@ begin
begin
//rotation 90° vers la gauche des feux : échange des coordonnées X et Y et translation sur HtImage
ech:=frY;frY:=frX;FrX:=ech;
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp;
Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp;
Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
Temp:=HtImage-yRap1;YRap1:=XRap1;XRap1:=Temp;
Temp:=HtImage-yRap2;YRap2:=XRap2;XRap2:=Temp;
Temp:=HtImage-yjaune;YJaune:=XJaune-1;Xjaune:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc-1;XBlanc:=Temp;
Temp:=HtImage-yRal1;YRal1:=XRal1-1;XRal1:=Temp;
Temp:=HtImage-yRal2;YRal2:=XRal2-1;XRal2:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre-1;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem-1;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert-1;Xvert:=Temp;
Temp:=HtImage-yRap1;YRap1:=XRap1-1;XRap1:=Temp;
Temp:=HtImage-yRap2;YRap2:=XRap2-1;XRap2:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux : échange des coordonnées X et Y et translation sur LgImage
ech:=frY;frY:=frX;FrX:=ech;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp;
Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp;
Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp;
Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp;
Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp;
Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp-1;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp-1;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp-1;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp-1;
Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp-1;
Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp-1;
Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp-1;
Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp-1;
Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp-1;
end;
if (orientation=4) then
@@ -4661,7 +4676,6 @@ var xblanc,xvert,xrouge,Yblanc,xjauneBas,xJauneHaut,yJauneBas,yJauneHaut,YVert,Y
inverse,etatChevron,EtatChiffre,codeClignote : boolean;
r : Trect;
begin
code:=etatSignal and $3f;
combine:=etatSignal and $1c0;
// LDT-DEC-NMBS ou b-model
@@ -5417,6 +5431,7 @@ const HautTb=10; // hauteur trackbar
ofsGBB=8; // marge bas du groupbox
var Imh,Iml : integer;
begin
iml:=0;imh:=0;
//Affiche('Création compteur GroupBox'+intToSTR(rang),clYellow);
CompteurT[rang].gb:=TGroupBox.Create(Formprinc.ScrollBoxC);
// groupBox
@@ -5536,6 +5551,21 @@ begin
change_clic_train(i);
end;
procedure tformprinc.ImageTrainDoubleClic(Sender : tObject);
var P_component : tComponent;
i : integer;
begin
P_component:=sender as Tcomponent;
i:=extract_int(P_Component.name); // récupérer le nom du composant cliqué (image, label) qui contient l'index du train
if (i<1) or (i>nTrains) then exit;
IdTrainClic:=i;
AffCompteur:=true;
formCompteur[1].Show;
end;
// renseigne les composants image train, label et vitesse
procedure renseigne_comp_trains(i : integer);
begin
@@ -5618,9 +5648,11 @@ begin
begin
onClick:=Formprinc.ImageTrainonclick; // affectation procédure clique G sur image
OnDblClick:=formPrinc.ImageTrainDoubleClic;
//onMouseDown:=Formprinc.ProcOnMouseDown; // clique G ou D
PopUpMenu:=Formprinc.PopupMenuTrains; // affectation popupmenu sur clic droit
if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime);
Maj_icone_train(Image_Train[rang],rang,clWhite); // copie le bitmap à l'échelle depuis trains[].icone
@@ -5899,7 +5931,7 @@ begin
end;
// prépare une tache pour le timer
// ttache=1 : pilote accessoire
// ttache=1 : pilote accessoire...
// temporisation pour le timer avant action
// destinataire (1=CDM 2=XpressNet 3=Dccpp)
// commande : chaine de pilotage pour le destinataire
@@ -5912,6 +5944,8 @@ begin
Affiche('Nombre de taches dépassé',clred);
exit;
end;
NoTraite:=true; // interdire le traitement pour éviter interférence
with taches[pointeurTaches+1] do
begin
traite:=false;
@@ -5921,6 +5955,7 @@ begin
chaine:=commande;
end;
inc(pointeurTaches);
NoTraite:=false;
end;
@@ -5933,18 +5968,19 @@ begin
if CDM_connecte and (fonction<=12) then
begin
s:=chaine_CDM_Func(fonction,etat,train);
//envoi_cdm(s);
tache(ttacheFF,0,ttDestCDM,s);
if modeTache then tache(ttacheFF,0,ttDestCDM,s) else envoi_cdm(s);
end;
if (portCommOuvert or parSocketLenz) then
begin
loco:=index_train_nom(train);
loco:=trains[loco].adresse;
Fonction_Loco_operation(loco,fonction,etat);
if protocole=1 then Fonction_Loco_operation(loco,fonction,etat);
if protocole=2 then begin Affiche('Fonction F loco pas encore implantée',clred);end;
end;
end;
// teste la condition d'une action
function teste_condition(action : integer) : boolean;
var condValide : boolean;
vit,vit1,vit2,it,pa,m1,m2,hc,n,ncond,cond,etat : integer;
@@ -6041,7 +6077,7 @@ begin
end;
// appelé par le hooker clavier
// appellé par le hooker clavier
function traite_code_blocUSB(code: integer) : integer;
var vitesse,f,n,i : integer;
condValide,EtatValide,BlocSelec : boolean;
@@ -6309,7 +6345,7 @@ end;
// cette fonction intercepte tous les évènements clavier windows quelque soit la fenetre ou le prog activé.
// https://learn.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644984(v=vs.85)?redirectedfrom=MSDN
// https://learn.microsoft.com/fr-fr/windows/win32/api/winuser/ns-winuser-kbdllhookstruct
function ClavierHookLLProc(Code : integer; WordParam : wparam; LongParam: lparam) : longint;//; cdecl;
function ClavierHookLLProc(Code : integer; WordParam : wparam; LongParam: lparam) : longint;
const LLKHF_UP=$0080;
var
KeyState : TKeyboardState;
@@ -6435,6 +6471,7 @@ begin
end;
end;
// envoie une fonctionF à une loco en Xpressnet
// loco=adresse de la loco fonction de 0 à 28 état 0/1
procedure Fonction_Loco_Operation(loco,fonction,etat : integer);
var s : string ;
@@ -8283,10 +8320,8 @@ begin
end;
procedure envoi_virtuel(adresse : integer);
var
combine,aspect,code : integer;
i : integer;
s : string;
var i,combine,aspect,code : integer;
s : string;
begin
i:=Index_Signal(adresse);
if (Signaux[i].AncienEtat<>Signaux[i].EtatSignal) then //; && (stop_cmd==FALSE))
@@ -13978,7 +14013,11 @@ begin
if Pres_Train and (AdrTr=0) then
begin
if roulage then AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse
if roulage then
begin
AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse
if AdrTr=0 then AdrTr:=detecteur[actuel].AdrTrain;
end;
if (nivDebug=3) then
begin
s:='3.Présence train ';
@@ -14320,6 +14359,7 @@ begin
// détecteurs précédent le signal , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré
//if (Signaux[index].VerrouCarre) and (modele>=4) then
presTrain:=PresTrainPrec(AdrSignal,Nb_cantons_Sig,detect,AdrTrainLoc,voie); //etape A // présence train par adresse train ; renvoie l'adresse du train dans AdrTrainLoc
if AffSignal and roulage then AfficheDebug('L''@ du train avant le signal est '+intToSTR(AdrTrainLoc),clYellow);
// si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal
// verrouillable au carré, afficher un carré
@@ -16008,7 +16048,7 @@ begin
begin
if det_suiv=9996 then affiche_evt('Erreur 1-1 position inconnue aiguillage ',clred)
else Affiche_evt('Erreur 1-1 '+intToSTR(Det_Suiv)+' : pas de suivant detecteur_suivant_el '+intToSTR(det1)+' '+intToSTR(det3),clred);
exit;
//exit;
end;
s:='1-1 route ok de '+intToSTR(det1)+' à '+IntToSTR(det3)+' pour train '+intToSTR(i);
Affiche_Evt(s,clWhite);
@@ -17883,7 +17923,7 @@ var s: string;
faire_event,inv,bjd,rf : boolean;
prov,index,i,id,etatact,typ,adr : integer;
begin
//if AffAigDet then Affiche('Tick='+IntToSTR(tick)+' Event Aig '+intToSTR(adresse)+'='+intToSTR(pos),clorange);
if AffAigDet then Affiche('Tick='+IntToSTR(tick)+' Event Aig '+intToSTR(adresse)+'='+intToSTR(pos),clorange);
index:=index_aig(adresse);
if index<>0 then
begin
@@ -18082,10 +18122,10 @@ begin
exit;
end;
pilotage:=octet;
indexAig:=index_aig(adresse);
// test si pilotage aiguillage inversé
if (acc=aigP) then
begin
indexAig:=index_aig(adresse);
if indexAig<>0 then
begin
AdrTrainLoc:=aiguillage[indexAig].AdrTrain;
@@ -18112,30 +18152,27 @@ begin
if pilotage=2 then pilotageCDM:=2;
s:=chaine_CDM_Acc(adresse,pilotageCDM);
//envoi_CDM(s);
// pilotage actif de l'accessoire----------------
tache(ttacheAcc,0,ttDestCDM,s); // TypeTache,tempo,destinataire,chaine
if Acc<>Signal then event_aig(adresse,pilotage);
// si l'accessoire est un signal et sans raz des signaux, sortir
if (acc=signal) and not(Raz_Acc_signaux) then exit;
if Acc=AigP then
begin
temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4; // mini pour pilotage en signaux LEB
//if portCommOuvert or parSocketLenz then tempo2(temp);
end;
// remise à 0
// remise à 0 --------------
s:=chaine_CDM_Acc(adresse,0);
//envoi_CDM(s);
tache(ttacheAcc,temp,ttDestCDM,s); // TypeTache,tempo,destinataire,chaine
// si l'accessoire est un aiguillage, temporiser suivant variable de séquenceent
if indexaig<>0 then tache(ttacheTempo,tempo_Aig div 100,0,'');
result:=true;
//exit;
end;
if (pilotage=0) or (pilotage>2) then begin result:=true;exit;end;
// if (pilotage=0) or (pilotage>2) then begin result:=true;exit;end;
// pilotage par USB ou par éthernet de la centrale ------------
if (portCommOuvert or parSocketLenz) and not CDM_connecte then
@@ -18159,8 +18196,6 @@ begin
tache(ttacheAcc,0,ttDestXpressNet,s); // TypeTache,tempo,destinataire,chaine
if acc<>signal then event_aig(adresse,pilotage);
// si l'accessoire est un signal et sans raz des signaux, sortir
if (acc=signal) and not(Raz_Acc_signaux) then exit;
@@ -18168,7 +18203,6 @@ begin
if Acc=AigP then
begin
temp:=aiguillage[indexAig].temps;if temp=0 then temp:=4;
// if portCommOuvert or parSocketLenz then tempo2(temp);
end;
// pilotage à 0 pour éteindre le pilotage de la bobine du relais
@@ -18176,8 +18210,9 @@ begin
s:=checksum(s);
if debug_dec_sig and (acc=signal) then AfficheDebug('Tick='+IntToSTR(Tick)+' signal '+intToSTR(adresse)+' 0',clorange);
//if avecAck then envoi(s) else envoi_ss_ack(s); // envoi de la trame avec ou sans Ack
tache(ttacheAcc,temp,ttDestXpressNet,s);
tache(ttacheAcc,temp,ttDestXpressNet,s); // TypeTache,tempo,destinataire,chaine
if indexAig<>0 then tache(ttacheTempo,tempo_Aig div 100,0,'');
//affiche('5.'+intToSTR(tick),clyellow);
result:=true;
@@ -18198,15 +18233,13 @@ begin
tache(ttacheAcc,0,ttDestDccpp,s); // TypeTache,tempo,destinataire,chaine
result:=true;
//exit;
end;
end;
// pas de centrale et pas CDM connecté: on change la position de l'aiguillage
if acc=aigP then event_aig(adresse,octet)
if indexAig<>0 then event_aig(adresse,octet)
else
// Serveur envoi au clients
Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(octet));
// Serveur envoi au clients
Envoi_serveur('T'+intToSTR(adresse)+','+intToSTR(octet));
result:=true;
@@ -20153,7 +20186,7 @@ begin
if (pos=const_devie) or (pos=const_droit) then
begin
pilote_acc(aiguillage[i].Adresse,pos,aigP);
if portCommOuvert or parSocketLenz or CDM_connecte then sleep(Tempo_Aig);
if (portCommOuvert or parSocketLenz or CDM_connecte) and not modeTache then sleep(Tempo_Aig);
end;
end;
end;
@@ -21205,7 +21238,7 @@ begin
onConnect:=ClientInfoConnect;
OnDisconnect:=ClientInfoDisconnect;
OnError:=ClientInfoError;
Open; // se connecte au serveur SC et envoie les infos
Open; //zizi se connecte au serveur SC et envoie les infos
end;
//s:=GetCurrentDir;
@@ -21328,7 +21361,6 @@ begin
procetape('Lecture de la configuration');
lit_config;
{$IF CompilerVersion >= 28.0}
//https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions
change_style;
@@ -21357,6 +21389,8 @@ begin
if (Ecran_sc<1) or (Ecran_sc>Screen.MonitorCount) then ecran_SC:=1;
if nTrains>30 then TrackBarZC.Visible:=false;
serveur_ouvert:=true;
serverSocket.Port:=PortServeur;
try
@@ -21414,12 +21448,6 @@ begin
cree_image_signal(i); // et initialisation tableaux signaux
end;
// les compteurs
for i:=1 to ntrains do
begin
cree_GB_compteur(i);
end;
Tempo_init:=5; // démarre les initialisations des signaux et des aiguillages dans 0,5 s
OrgMilieu:=formprinc.width div 2;
@@ -21807,6 +21835,7 @@ begin
end;
// calcule les 2 équations de droite des coefficients
// pour les étalonnages des trains
procedure calcul_equations_coeff(indexTrain : integer);
begin
with trains[indexTrain] do
@@ -21824,34 +21853,50 @@ procedure traite_taches;
const affe=false;
var fonc,i,j,sortie,etat :integer;
begin
if noTraite then exit;
if pointeurTaches<0 then
begin
pointeurTaches:=0;
exit;
end;
if affe then Affiche('Tick='+intToSTR(tick)+' Pointeur de taches='+intToSTR(pointeurTaches),clYellow);
//if affe then Affiche('Tick='+intToSTR(tick)+' Pointeur de taches='+intToSTR(pointeurTaches),clYellow);
// pilote accessoire
i:=1;
repeat
//repeat
with taches[i] do
begin
//if affe then Affiche('Traite adr '+intToSTR(Typetache),clLime);
if traite then
begin
if affe then Affiche('Traite 1 en cours',clblue);
exit;
end;
// si tempo non nulle d'accessoire
// si tempo non nulle de fin d'accessoire
if (typeTache=ttacheAcc) and (tempo<>0) then
begin
if affe then Affiche('dec tempo ',clLime);
dec(tempo);
//tester tache suivante
exit; // ne rien faire d'autre dans ce tour timer
end
else
if (TypeTache=ttacheTempo) then
begin
// envoyer au destinataire
if affe then Affiche('Dec tempo fin aig',clLime);
if tempo<>0 then dec(tempo);
if tempo=0 then
begin
if affe then Affiche('dec tempo fin aig',clLime);
for j:=i to pointeurTaches do
begin
taches[j]:=taches[j+1];
end;
dec(pointeurtaches);
end;
exit;
end
else
begin
// ------------ envoyer au destinataire -------------
// pilotage accessoire
if typetache=ttacheACC then
begin
@@ -21877,7 +21922,7 @@ begin
end;
if dest=ttDestDccpp then envoi_ss_ack(chaine);
// lorsque l'action i est traitée, la supprimer, et décaler la liste d'un cran
// lorsque l'action i est traitée, la supprimer, et décaler la liste des taches d'un cran
for j:=i to pointeurTaches do
begin
taches[j]:=taches[j+1];
@@ -21911,11 +21956,15 @@ begin
dec(pointeurtaches);
exit;
end;
end;
//affiche('Pointeur='+intToSTR(pointeurtaches),clred);
end;
Affiche('Erreur tache typ='+intTOSTR(taches[1].typeTache)+' t='+intToSTR(taches[1].tempo),clred);
exit;
inc(i);
until (i>pointeurtaches);
Affiche('INC',clwhite);
//until (i>pointeurtaches);
end;
// timer à 100 ms
@@ -21947,7 +21996,6 @@ begin
end;
end;
tempoblocUSB:=0;
//if tempoBlocUSB=0 then consigne_train(2); // la consigne vient de bloc USB
end;
// séquencement des actions après tempo
@@ -22295,6 +22343,7 @@ begin
// gestion ralenti : on doit arreter le train sur le détecteur
if trains[i].arret_det then // le train est sur un détecteur d'arrêt
begin
//Affiche('Ralenti train '+intToSTR(i),clYellow);
adresseEl:=dernierDet; // identifie le détecteur
if adresseEl<>0 then
case phase_arret of // !! voir si phase arret est multitrains!!!
@@ -22316,12 +22365,13 @@ begin
else d:=9999; // si la vitesse du train est nulle, mettre une condition qui arrete le train en fin de parcours sur le détecteur
if not detecteur[adresseEl].Etat then d:=9999; // si on passe le détecteur arrêter le train.
if DebugRoulage then Affiche('D='+intToSTR(d)+' train '+intToSTR(i),clOrange);
// arrêt
//if debugRoulage then Affiche('Timer Dist='+intToSTR(d)+' Vit='+intToSTR(trains[i].vitesseReelle),clYellow);
longDet:=detecteur[adresseEl].longueur;
LongLoco:=trains[i].longueur;
longueur:=longDet-longLoco;
CompteurT[i].lbl.Caption:=trains[i].nom_train+' '+intToSTR(d);
// calculer quelle distance il faudra pour s'arrêter avec la décélération
TempsArret:=abs(0.896*cv4*VitesseCons/128);
// convertir la vitesse en cran en cm/s
@@ -22345,7 +22395,7 @@ begin
trains[i].arret_det:=false;
trains[i].phase_arret:=0;
if debugRoulage then Affiche('Timer '+trains[i].nom_train+' Arrêté',ClWhite);
CompteurT[i].lbl.Caption:=trains[i].nom_train;
trains[i].vitesseCons:=0;
vitesse_loco(trains[i].nom_train,i,trains[i].adresse,0,0,0); // arrêt du train
train_sarrete(i); // vérifie si fin de route, et copie tempo_demarre si détecteur arrêt optionnel+ tempo de redémarrage
@@ -22381,7 +22431,7 @@ begin
vitesse_loco(trains[i].nom_train,i,trains[i].adresse,vitcons,0,0);
end;
// démarrage sur consigne
// démarrage sur consigne ou répétition de la consigne
a:=trains[i].compteur_consigne;
if a<>0 then
begin
@@ -23075,6 +23125,7 @@ begin
Trains[ntrains].vitmax:=Trains_cdm[i].vitmax;
FormPrinc.ComboTrains.Items.Add(trains_cdm[i].nom_train);
cree_image_Train(ntrains);
cree_GB_compteur(ntrains);
end;
end;
@@ -23189,6 +23240,9 @@ begin
//s:='AD='+IntToSTR(adr)f;
Delete(commandeCDM,i,l-i+1);
end;
//Affiche('TrainCDM='+trains_cdm[ntrains_cdm].nom_train,clYellow);
end;
// évènement aiguillage. Le champ AD2 n'est pas forcément présent
@@ -28096,4 +28150,8 @@ begin
onglet:=PageControl.ActivePageIndex;
end;
end.
UnitRouteTrains.pas
+3 -2
View File
@@ -361,6 +361,8 @@ procedure TFormRouteTrain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
efface_route_tco(false);
maj_signaux(true);
maj_signaux(true);
end;
procedure TFormRouteTrain.ButtonSupprimeClick(Sender: TObject);
@@ -626,8 +628,6 @@ begin
if (indexTrainFR<1) then exit;
hide;
efface_route_tco(false);
maj_signaux(true);
maj_signaux(true);
// positionner les aiguillages de la route
// si le train est doté d'une route
@@ -637,6 +637,7 @@ begin
aig_canton(indexTrainFR,trains[indexTrainFR].route[1].adresse); // positionne aiguillage et fait les réservations
demarre:=demarre_index_train(indexTrainFR); // met la mémoire de roulage du train à 1
end;
maj_signaux(true);
close; // efface la route du TCO
end;
UnitTCO.dfm
+5 -22
View File
@@ -24,8 +24,8 @@ object FormTCO: TFormTCO
OnKeyPress = FormKeyPress
OnMouseWheel = FormMouseWheel
DesignSize = (
1005
556)
997
548)
PixelsPerInch = 96
TextHeight = 13
object LabelZoom: TLabel
@@ -1138,7 +1138,7 @@ object FormTCO: TFormTCO
Top = 104
Width = 33
Height = 33
Hint = 'Action'
Hint = 'Bouton action'
ParentShowHint = False
ShowHint = True
OnDragOver = ImagePalette52DragOver
@@ -1401,9 +1401,9 @@ object FormTCO: TFormTCO
end
end
object buttonRaz: TButton
Left = 889
Left = 888
Top = 88
Width = 97
Width = 96
Height = 33
Anchors = [akTop, akRight]
Caption = 'Raz des occupations'
@@ -1470,23 +1470,6 @@ object FormTCO: TFormTCO
TabOrder = 8
OnClick = RadioGroupSelClick
end
object Button1: TButton
Left = 800
Top = 88
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 9
Visible = False
end
object Button2: TButton
Left = 848
Top = 96
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 10
end
end
object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup
UnitTCO.pas
+118 -124
View File
@@ -1,4 +1,5 @@
unit UnitTCO;
// ne pas utiliser les éléments 30 et 31 qui sont les anciens signaux et quais
interface
uses
@@ -160,13 +161,11 @@ type
AffRoutes: TMenuItem;
ImageDrapVert: TImage;
ImageDrapRouge: TImage;
Button1: TButton;
Optiondesroutes1: TMenuItem;
Trouverunlment1: TMenuItem;
ImageBt0Bistable: TImage;
ImageBt1Bistable: TImage;
Mmoiredezone1: TMenuItem;
Button2: TButton;
//TimerTCO: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
@@ -346,47 +345,47 @@ type
procedure ButtonCalibrageClick(Sender: TObject);
procedure ButtonCoulFondClick(Sender: TObject);
procedure ColorDialog1Show(Sender: TObject);
procedure ImagePalette24DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette24MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette25DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette25EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette25MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette24DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette24MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette25DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette25EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette25MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);
procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);
procedure EditTypeImageChange(Sender: TObject);
procedure Toutslectionner1Click(Sender: TObject);
procedure ButtonDessinerClick(Sender: TObject);
procedure ImagePalette26DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette26EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette26MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette23EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette23DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette23MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette27DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette27MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette27EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette28DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette28EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette28MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette29DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette29EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette29MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette32DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette32EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette33DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette33EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette33MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette34DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette34EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette34MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette26DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette26EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette26MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette23EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette23DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette23MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette27DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette27MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette27EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette28DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette28EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette28MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette29DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette29EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette29MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette32DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette32EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette33DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette33EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette33MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette34DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette34EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImagePalette34MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure EditAdrElementClick(Sender: TObject);
procedure ImagePalette53DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette52EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette53MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette53MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ButtonAffSCClick(Sender: TObject);
procedure RadioGroupSelClick(Sender: TObject);
procedure SauvegarderleTCO1Click(Sender: TObject);
@@ -401,9 +400,9 @@ type
procedure RechargerleTCOdepuislefichier1Click(Sender: TObject);
procedure Supprimercanton1Click(Sender: TObject);
procedure Affecterlocomotiveaucanton1Click(Sender: TObject);
procedure ImagePalette52MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette52DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette53EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImagePalette52MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImagePalette52DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
procedure ImagePalette53EndDrag(Sender, Target: TObject; X,Y: Integer);
procedure ImageTCOEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure AffRoutesClick(Sender: TObject);
procedure Optiondesroutes1Click(Sender: TObject);
@@ -477,9 +476,8 @@ const
Id_cantonH=60; // codifications de l'icone dans le TCO
Id_cantonV=70; // "
// liaisons des voies pour chaque icone par N° de bit (0=NO 1=Nord 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest) 7
// un bit à 1 indique une liaison
// un bit à 1 indique une liaison de l'élément
Liaisons : array[0..53] of integer=
// 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
(0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$66,$23,$33,$26,$62,$32,$31,0,0,
@@ -503,7 +501,7 @@ type
TailleFonte : integer;
CouleurFond : Tcolor; // couleur de fond
// pour les signaux seulement ou action
PiedFeu : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie OU si action: type d'action
PiedSignal : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie OU si action: type d'action
NumCanton : integer; // numéro de canton, pas son index
x,y : integer; // coordonnées pixels relativés du coin sup gauche du signal pour le décalage par rapport au 0,0 cellule
Xundo,Yundo : integer; // coordonnées x,y de la cellule pour le undo
@@ -1860,7 +1858,7 @@ begin
Texte:='';
fonte:='Arial';
fontSTyle:='';
piedFeu:=0;
PiedSignal:=0;
NumCanton:=0;
x:=0;
y:=0;
@@ -2341,13 +2339,13 @@ begin
if PiedFeu<1 then PiedFeu:=1;
if PiedFeu>2 then PiedFeu:=2;
tco[indexTCO,x,y].PiedFeu:=PiedFeu;
tco[indexTCO,x,y].PiedSignal:=PiedFeu;
end;
end;
// si c'est une action, remplir les paramètres de l'action
if tco[indexTCO,x,y].Bimage=Id_action then
begin
tco[indexTCO,x,y].PiedFeu:=PiedFeu; // quelle action
tco[indexTCO,x,y].PiedSignal:=PiedFeu; // quelle action
tco[indexTCO,x,y].FeuOriente:=FeuOriente; // paramètre de l'action
if (PiedFeu=AcBouton_bistable) then
begin
@@ -2564,7 +2562,7 @@ begin
// piedFeu ou index canton
if (Bimage=Id_CantonH) or (Bimage=Id_cantonV) then s:=s+intToSTR(tco[i,x,y].NumCanton)
else s:=s+IntToSTR(tco[i,x,y].PiedFeu);
else s:=s+IntToSTR(tco[i,x,y].PiedSignal);
s:=s+',';
// texte ou nom du canton
@@ -2982,7 +2980,7 @@ begin
s:=format('%d',[TCO[indexTCO,x,y].Numcanton]);
end
else
if (b=id_action) and (tco[indexTCO,x,y].PiedFeu=AcBouton_bistable) then
if (b=id_action) and (tco[indexTCO,x,y].PiedSignal=AcBouton_bistable) then
begin
exit;
end;
@@ -5275,7 +5273,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer;
moveto(x0,yc);lineto(xc,yc); // partie droite
end;
end;
begin
x0:=(x-1)*LargeurCell[indexTCO]; // x origine
@@ -6772,7 +6770,7 @@ begin
//s:=tco[indexTCO,x,y].texte;
s:='';
if s='' then tco[indexTCO,x,y].repr:=5; // centré en X et Y
act:=tco[indexTCO,x,y].PiedFeu;
act:=tco[indexTCO,x,y].PiedSignal;
case act of
AcChangeTCO :
begin
@@ -6883,13 +6881,9 @@ begin
//PImageTCO[indexTCO].Picture.Bitmap.Canvas.textOut(x0+3,y0+3,s);
//exit;
end;
end;
//affiche_texte(indextco,x,y);
end;
end;
@@ -7405,7 +7399,6 @@ begin
PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,s,-900);
{$IFEND}
Canton[i].Xicone:=x0+round(8*frx);
Canton[i].Yicone:=yi;
Canton[i].Licone:=LargDest;
@@ -9073,7 +9066,7 @@ begin
pen.color:=fond;
Brush.Color:=fond;
pen.width:=epaisseur div 2;
moveTo(xc,y0);LineTo(xc,yc);LineTo(xf,yf);
moveTo(xc,y0);LineTo(xc,yc);LineTo(xf,yf);
end;
end;
@@ -10412,14 +10405,12 @@ end;
// calcul des facteurs de réductions X et Y pour l'adapter à l'image de destination
procedure calcul_reduction(Var frx,fry : single;DimDestX,DimDestY : integer);
begin
//frX:=DimDestX/DimOrgX;
//frY:=DimDestY/DimOrgY;
frx:=DimDestX/ZoomMax;
fry:=DimDestY/ZoomMax;
//Affiche(formatfloat('0.000000',frY),clyellow);
end;
procedure Feu_180(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean);
procedure Signal_180(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean);
var p : array[0..2] of TPoint;
TailleY,TailleX : integer;
begin
@@ -10461,7 +10452,7 @@ end;
// Affiche dans le TCO en x,y un signal à 90° d'après l'image transmise
// x y en coordonnées pixels
procedure Feu_90G(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean);
procedure Signal_90G(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean);
var p : array[0..2] of TPoint;
TailleY,TailleX : integer;
begin
@@ -10493,7 +10484,7 @@ begin
end;
// copie de l'image du signal à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire
procedure Feu_90D(index : integer;ImageSource : TImage;x,y : integer ; FrX,FrY : real;inverse : boolean);
procedure Signal_90D(index : integer;ImageSource : TImage;x,y : integer ; FrX,FrY : real;inverse : boolean);
var p : array[0..2] of TPoint;
TailleY,TailleX : integer;
begin
@@ -10587,7 +10578,7 @@ begin
end;
end;
procedure affiche_pied7_180(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied7_180(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10598,12 +10589,12 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
y1:=y1-6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else
if piedSignal=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else
LineTo( x+round((x1+40)*frX),y+round(y1*frY) );
end;
end;
procedure affiche_pied9_180(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied9_180(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10614,12 +10605,12 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
y1:=y1-6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else
if piedSignal=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else
LineTo( x+round((x1+40)*frX),y+round(y1*frY) );
end;
end;
procedure affiche_pied20_90G(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean);
procedure affiche_pied20_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10633,7 +10624,7 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
x1:=x1-6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round(x1*frX),y+round((y1+40)*frY) ) else // a gauche
if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1+40)*frY) ) else // a gauche
LineTo( x+round(x1*frX),y+round((y1-65)*frY) ); // a droite
end
else
@@ -10642,13 +10633,13 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
x1:=x1-6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round(x1*frX),y+round((y1+60)*frY) ) else
if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1+60)*frY) ) else
LineTo( x+round(x1*frX),y+round((y1-45)*frY) );
end;
end;
end;
procedure affiche_pied20_90D(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean);
procedure affiche_pied20_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10662,7 +10653,7 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
x1:=x1+6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round(x1*frX),y+round((y1+65)*frY) ) else // a gauche
if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1+65)*frY) ) else // a gauche
LineTo( x+round(x1*frX),y+round((y1-40)*frY) ); // a droite
end
else
@@ -10671,13 +10662,13 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
x1:=x1+6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round(x1*frX),y+round((y1-57)*frY) ) else
if piedSignal=1 then LineTo( x+round(x1*frX),y+round((y1-57)*frY) ) else
LineTo( x+round(x1*frX),y+round((y1+45)*frY) );
end;
end;
end;
procedure affiche_pied20_180(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean);
procedure affiche_pied20_180(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10691,7 +10682,7 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
y1:=y1-6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else // a gauche
if piedSignal=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else // a gauche
LineTo( x+round((x1+55)*frX),y+round(y1*frY) ); // a droite
end
else
@@ -10700,13 +10691,13 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
y1:=y1-6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else
if piedSignal=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else
LineTo( x+round((x1+40)*frX),y+round(y1*frY) );
end;
end;
end;
procedure affiche_pied20_vertical(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean);
procedure affiche_pied20_vertical(index,x,y : integer;FrX,frY : real;piedSignal : integer;contrevoie : boolean);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10720,7 +10711,7 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
y1:=y1+6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round((x1+40)*frX),y+round(y1*frY) ) else
if piedSignal=1 then LineTo( x+round((x1+40)*frX),y+round(y1*frY) ) else
LineTo( x+round((x1-65)*frX),y+round(y1*frY) );
end
else
@@ -10729,14 +10720,14 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frY) );
y1:=y1+6;
LineTo( x+round(x1*frX),y+round(y1*frY) );
if pied=1 then LineTo( x+round((x1+62)*frX),y+round(y1*frY) ) else
if piedSignal=1 then LineTo( x+round((x1+62)*frX),y+round(y1*frY) ) else
LineTo( x+round((x1-40)*frX),y+round(y1*frY) );
end;
end;
end;
procedure affiche_pied2G_90G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied2G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,frYR : real;
begin
@@ -10749,12 +10740,12 @@ begin
x1:=0;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frYR) );
LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) );
if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else
if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else
LineTo( x+round((x1-6)*frX),y+round((y1-50)*frYR) );
end;
end;
procedure affiche_pied2G_90D(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied2G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,frYR: real;
begin
@@ -10767,12 +10758,12 @@ begin
x1:=35;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frYR) );
LineTo( x+round((x1+6)*frX),y+round((y1+0)*frYR) );
if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else
if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else
LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ) ;
end;
end;
procedure affiche_pied_Vertical2G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied_Vertical2G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10782,12 +10773,12 @@ begin
x1:=12;y1:=35;
moveTo( x+round((x1+0)*frX),y+round(y1*frY) );
LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) );
if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else
if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else
LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) );
end;
end;
procedure affiche_pied3G_90D(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied3G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,fryR : real;
begin
@@ -10800,12 +10791,12 @@ begin
x1:=45;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) );
if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else
if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else
LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) );
end;
end;
procedure affiche_pied3G_90G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied3G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,frYR : real;
begin
@@ -10818,12 +10809,12 @@ begin
x1:=0;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1-4)*frX),y+round((y1+0)*frY) );
if pied=1 then LineTo( x+round((x1-4)*frX),y+round((y1+50)*frYR) ) else
if piedSignal=1 then LineTo( x+round((x1-4)*frX),y+round((y1+50)*frYR) ) else
LineTo( x+round((x1-4)*frX),y+round((y1-50)*fryR) );
end;
end;
procedure affiche_pied_Vertical3G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied_Vertical3G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10833,12 +10824,12 @@ begin
x1:=12;y1:=42;
moveTo( x+round((x1+0)*frX),y+round(y1*frY) );
LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) );
if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) )
if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) )
else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ) ;
end;
end;
procedure affiche_pied4G_90G(index,x,y : integer;FrX,frY : real;piedFeu : integer);
procedure affiche_pied4G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
fryR,ech : real;
begin
@@ -10851,12 +10842,12 @@ begin
x1:=0;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1-6)*frX),y+round((y1+0)*frY) );
if piedFeu=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else
if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else
LineTo( x+round((x1-6)*frX),y+round((y1-50)*frYR) ) ;
end;
end;
procedure affiche_pied4G_90D(index,x,y : integer;FrX,frY : real;piedfeu: integer);
procedure affiche_pied4G_90D(index,x,y : integer;FrX,frY : real;piedSignal: integer);
var x1,y1 : integer;
ech,frYR : real;
begin
@@ -10869,12 +10860,12 @@ begin
x1:=55;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) );
if piedFeu=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) )
if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) )
else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) );
end;
end;
procedure affiche_pied_Vertical4G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied_Vertical4G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10884,12 +10875,12 @@ begin
x1:=12;y1:=55;
moveTo( x+round((x1+0)*frX),y+round(y1*frY) );
LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) );
if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else
if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else
LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) );
end;
end;
procedure affiche_pied9G_90D(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied9G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
var ech,frYR : real;
begin
@@ -10902,12 +10893,12 @@ begin
x1:=90;y1:=38;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) );
if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR)) else
if piedSignal=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR)) else
LineTo( x+round((x1+7)*frX),y+round((y1+40)*fryR));
end;
end;
procedure affiche_pied5G_90D(index,x,y : integer;FrX,frY : real;piedFeu : integer);
procedure affiche_pied5G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,frYR : real;
begin
@@ -10920,12 +10911,12 @@ begin
x1:=66;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) );
if piedFeu=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else
if piedSignal=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else
LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) );
end;
end;
procedure affiche_pied5G_90G(index,x,y : integer;FrX,frY : real;piedFeu : integer);
procedure affiche_pied5G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,fryR : real;
begin
@@ -10938,12 +10929,12 @@ begin
x1:=0;y1:=12;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1-6)*frX),y+round((y1+0)*frY) );
if piedFeu=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else
if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else
LineTo( x+round((x1-6)*frX),y+round((y1-50)*fryR) );
end;
end;
procedure affiche_pied_Vertical5G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied_Vertical5G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
begin
with PcanvasTCO[index] do
@@ -10954,12 +10945,12 @@ begin
moveTo( x+round((x1+0)*frX),y+round(y1*frY) );
LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) );
if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else
if piedSignal=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else
LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) );
end;
end;
procedure affiche_pied7G_90D(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied7G_90D(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
ech,frYR : real;
begin
@@ -10972,7 +10963,7 @@ begin
x1:=75;y1:=38;
moveTo( x+round(x1*frX),y+round(y1*frY) );
LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) );
if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR) ) else
if piedSignal=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR) ) else
LineTo( x+round((x1+7)*frX),y+round((y1+38)*fryR) ) ;
end;
end;
@@ -11010,7 +11001,7 @@ begin
end;
end;
procedure affiche_pied9G_90G(index,x,y : integer;FrX,frY : real;pied : integer);
procedure affiche_pied9G_90G(index,x,y : integer;FrX,frY : real;piedSignal : integer);
var x1,y1 : integer;
frYR,ech : real;
begin
@@ -11025,7 +11016,7 @@ begin
moveTo( x+round(x1*frX),y+round(y1*frYR) );
LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) );
if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+58)*frYR) ) else
if piedSignal=1 then LineTo( x+round((x1-6)*frX),y+round((y1+58)*frYR) ) else
LineTo( x+round((x1-6)*frX),y+round((y1-40)*frYR) ) ;
end;
end;
@@ -11053,7 +11044,7 @@ begin
{
if y>1 then
begin
// si la cellule au dessus contient un feu vertical, ne pas effacer la cellule
// si la cellule au dessus contient un signal vertical, ne pas effacer la cellule
// if (tco[indextco,x,y-1].BImage=12) and (tco[indextco,x,y-1].FeuOriente=1) then exit;
end;
if x<NbreCellX then
@@ -11133,7 +11124,7 @@ begin
TailleX:=ImageFeu.picture.BitMap.Width;
TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale)
PiedFeu:=tco[indextco,x,y].PiedFeu; // gauche ou droite de la voie
PiedFeu:=tco[indextco,x,y].PiedSignal; // gauche ou droite de la voie
// réduction variable en fonction de la taille des cellules. 50 est le Zoom Maxi
calcul_reduction(frx,fry,Larg,haut);
@@ -11220,10 +11211,10 @@ begin
end;
end;
// affichage du feu et du pied - orientation 90°G
// affichage du signal et du pied - orientation 90°G
if Orientation=2 then
begin
Feu_90G(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); // ici on passe l'origine du signal
Signal_90G(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); // ici on passe l'origine du signal
// dessiner le pied
case aspect of
20 : affiche_pied20_90G(indexTCO,x0+2,y0+round(fry*5),frX,frY,piedFeu,contrevoie);
@@ -11239,7 +11230,7 @@ begin
// affichage du signal et du pied - orientation 90°D
if Orientation=3 then
begin
Feu_90D(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie);
Signal_90D(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie);
// dessiner le pied
case aspect of
20 : affiche_pied20_90D(indexTCO,x0+(LargeurCell[indexTCO] div 2)+round(frx*12),y0+(hauteurCell[indexTCO] div 2),frX,frY,piedFeu,contrevoie);
@@ -11255,7 +11246,7 @@ begin
// 180°
if orientation=4 then
begin
Feu_180(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie);
Signal_180(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie);
case aspect of
2 : affiche_pied2_180(indexTCO,x0,y0,frX,frY,PiedFeu);
3 : affiche_pied3_180(indexTCO,x0,y0,frX,frY,PiedFeu);
@@ -11651,7 +11642,7 @@ begin
index:=Index_Signal(adresse);
aspect:=Signaux[index].Aspect;
oriente:=tco[indextco,x,y].FeuOriente;
pied:=tco[indextco,x,y].PiedFeu;
pied:=tco[indextco,x,y].PiedSignal;
inverse:=Signaux[index].contrevoie; // pour signal belge
xt:=0;yt:=0;
// signal belge
@@ -11682,13 +11673,13 @@ begin
end;
if (aspect=9) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=round(60*fryGlob[indexTCO]);end;
if (aspect=9) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]);end; // orientation G
if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+round(25*frxGlob[indexTCO]);yt:=1;end;
if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+round(20*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end;
if (aspect=9) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end;
if (aspect=9) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end;
if (aspect=7) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end;
if (aspect=7) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end;
if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+2;yt:=1;end;
if (aspect=7) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(25*fryGlob[indexTCO]);end;
if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+2;yt:=round(4*frYGlob[indexTCO]);end;
if (aspect=7) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end;
if (aspect=7) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end;
@@ -11719,7 +11710,7 @@ begin
if (aspect=2) and (Oriente=4) then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(10*fryglob[indexTCO]);end; // orientation 180
// signaux directionnels
if (aspect>10) and (aspect<20) and(oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end;
if (aspect>10) and (aspect<20) and (oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end;
if (aspect>10) and (aspect<20) and (oriente=2) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end;
if (aspect>10) and (aspect<20) and (oriente=3) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end;
@@ -14467,7 +14458,7 @@ begin
tco[indextco,x,y].FontStyle:='';
tco[indextco,x,y].CoulFonte:=0;
// tco[indextco,x,y].CouleurFond:=0;
tco[indextco,x,y].PiedFeu:=0;
tco[indextco,x,y].PiedSignal:=0;
tco[indexTCO,x,y].NumCanton:=0;
tco[indextco,x,y].x:=0;
tco[indextco,x,y].y:=0;
@@ -16486,7 +16477,7 @@ begin
// action
if (Bimage=id_action) and not(ConfCellTCO) then
begin
i:=tco[indextco,xclic,yclic].piedfeu; // type d'action
i:=tco[indextco,xclic,yclic].PiedSignal; // type d'action
n:=tco[indextco,xclic,yclic].feuoriente;
//Affiche('Clic bouton action i='+intToSTR(i)+' n='+intToSTR(n),clYellow);
case i of
@@ -16540,7 +16531,7 @@ begin
begin
if tco[i,x,y].BImage=Id_Action then
begin
if tco[i,x,y].PiedFeu=acBouton_bistable then
if tco[i,x,y].PiedSignal=acBouton_bistable then
begin
j:=tco[indextco,xclic,yclic].Adresse;
if j=adresse then
@@ -17310,7 +17301,7 @@ begin
raz_cellule(indextco,xClic,yClic);
tco[indextco,XClic,YClic].BImage:=Id_signal;
tco[indextco,XClic,YClic].FeuOriente:=1;
tco[indextco,XClic,YClic].PiedFeu:=1;
tco[indextco,XClic,YClic].PiedSignal:=1;
tco[indextco,XClic,YClic].coulFonte:=clWhite;
clicTCO:=true;
editAdrElement.Text:='';
@@ -18057,7 +18048,7 @@ begin
if actualize then exit;
if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then
begin
tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu:=2;
tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedSignal:=2;
Affiche_TCO(indexTCO);
TCO_modifie:=true;
actualise(indexTCO); // met à jour la fenetre de config de la cellule
@@ -18078,7 +18069,7 @@ begin
if actualize then exit;
if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then
begin
tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu:=1;
tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedSignal:=1;
Affiche_TCO(indexTCO);
TCO_modifie:=true;
actualise(indexTCO); // met à jour la fenetre de config de la cellule
@@ -18149,7 +18140,7 @@ begin
PopUpMenu1.Items[6][3].checked:=true;
end;
// coche sur l'orientation du pied
PiedFeu:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu;
PiedFeu:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedSignal;
if PiedFeu=1 then
begin
PopUpMenu1.Items[6][5].checked:=true;
@@ -19326,6 +19317,9 @@ begin
defocusControl(EditAdrElement,true);
end;
end.
Vcl.pas
+1902
View File
File diff suppressed because it is too large Load Diff
verif_version.pas
+5 -6
View File
@@ -23,7 +23,7 @@ var
Lance_verif : integer;
DebugVV,verifVersion,notificationVersion,essai : boolean;
chemin_Dest,chemin_src,date_creation,nombre_tel : string;
f : text;
f : textFile;
Const
VersionSC = '10.2'; // sert à la comparaison de la version publiée
@@ -237,7 +237,7 @@ begin
i:=pos('.zip',s);
if i=0 then
begin
log('nom du zip invalide',clred);
Affiche('Nom du zip invalide',clred);
exit;
end;
@@ -267,7 +267,6 @@ begin
chdir(chemin_src);
//s:='"'+chemin_dest+'" "'+chemin_src+'"';
//log('exécution de copie_sc.exe '+s,clyellow);
close(f);
Affiche('Installation de la nouvelle version',clyellow);
Sleep(2000);
i:=ShellExecute(Formprinc.Handle,pchar('runas'), // mode admin
@@ -283,11 +282,11 @@ begin
end
else
begin
Affiche('Erreur '+intToSTR(i)+' au lancement de installeur.exe ',clred);
Affiche(SysErrorMessage(GetLastError),clred);
Affiche('Exécutez le manuellement',clred);
log('Erreur '+intToSTR(i)+' au lancement de installeur.exe ',clred);
log('Exécutez le manuellement',clred);
end;
close(f);
end;
// renvoie le numéro de version depuis le site github, et télécharge... etc