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

V9.77

Browse Source
This commit is contained in:
f1iwq2
2025-01-31 16:43:00 +01:00
parent 79982fd151
commit 434cf35af1
22 changed files with 971 additions and 331 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice d'utilisation des signaux_complexes_GL_V9.76.pdf → Notice d'utilisation des signaux_complexes_GL_V9.77.pdf
BIN
View File
Binary file not shown.
UnitAnalyseSegCDM.dfm
+3 -3
View File
@@ -137,10 +137,10 @@ object FormAnalyseCDM: TFormAnalyseCDM
object CheckPorts: TCheckBox
Left = 240
Top = 32
Width = 65
Width = 129
Height = 17
Hint = 'Affiche le num'#233'ro de segment et le port de CDM'
Caption = 'Ports'
Caption = 'Ports et segments'
ParentShowHint = False
ShowHint = True
TabOrder = 3
@@ -198,7 +198,7 @@ object FormAnalyseCDM: TFormAnalyseCDM
end
object ButtonImprime: TButton
Left = 232
Top = 48
Top = 56
Width = 75
Height = 25
Caption = 'Imprimer'
UnitAnalyseSegCDM.pas
+21 -20
View File
@@ -1314,11 +1314,11 @@ var
TmpBmp: TBitmap;
ARect: TRect;
begin
TmpBmp := TBitmap.Create;
TmpBmp.Width := wid;
TmpBmp.Height := hei;
ARect := Rect(0,0, wid, hei);
TmpBmp.Canvas.StretchDraw(ARect, Bitmp);
TmpBmp:=TBitmap.Create;
TmpBmp.Width:=wid;
TmpBmp.Height:=hei;
ARect:=Rect(0,0, wid, hei);
TmpBmp.Canvas.StretchDraw(ARect,Bitmp);
bitmp.Assign(TmpBmp);
TmpBmp.Free;
end;
@@ -1330,7 +1330,7 @@ begin
SinCos(Angle,SinA,CosA);
Result.eM11:=CosA;
Result.eM12:=SinA;
Result.eM21:=-SinA;
Result.eM21:=-SinA;
Result.eM22:=CosA;
Result.eDx:=(Centre.X - (CosA*Centre.X)) + (SinA*Centre.Y);
Result.eDy:=(Centre.Y - (SinA*Centre.X)) - (CosA*Centre.Y);
@@ -1370,7 +1370,7 @@ var
recta : trect;
begin
ACanvas:=FormAnalyseCDM.ImageCDm.Canvas;
l2:=largeurTrain div 2;
h2:=hauteurTrain div 2;
y:=y-1; // décalage observé
@@ -1897,7 +1897,7 @@ begin
end;
// renvoie si le segment est de type aiguillage croisement compris
function segment_aig(s : string) : boolean;
function segment_aig_crois(s : string) : boolean;
begin
result:=(s='turnout') or (s='dbl_slip_switch') or (s='turnout_sym') or
(s='turnout_curved') or (s='turnout_curved_2r') or (s='turnout_3way') or
@@ -1935,7 +1935,7 @@ begin
p:=segment[i].adresse;
p2:=segment[i].adresse2;
//Affiche(intToSTR(p),clwhite);
trouve:=((p=adresse) or (p2=adresse)) and segment_aig(segment[i].typ);
trouve:=((p=adresse) or (p2=adresse)) and segment_aig_crois(segment[i].typ);
inc(i);
until (i>nSeg-1) or trouve;
dec(i);
@@ -2399,7 +2399,7 @@ begin
exit;
end;
if segment_aig(typeP) then // est-ce un aig
if segment_aig_crois(typeP) then // est-ce un aig
//------------- aiguillage
begin
portlocal:=segment[idSeg].port[idport].local;
@@ -2874,7 +2874,7 @@ begin
end;
// autre aiguillage
if segment_aig(ctype) then
if segment_aig_crois(ctype) then
begin
// déterminer le numéro du port d'origine
pOrg:=0;
@@ -3104,7 +3104,7 @@ begin
ctype:=segment[indexSegSuivant].typ;
// est-ce un aiguillage ou tjd (croisement compris)
if segment_aig(ctype) then
if segment_aig_crois(ctype) then
begin
AdrAigRencontre:=segment[indexSegSuivant].adresse;
if debugBranche then Affichedebug('Aiguillage '+intTostr(adrAigRencontre),clyellow);
@@ -3489,7 +3489,7 @@ begin
end;
// si on rencontre une table, çà revient dans l'autre sens
trouve:=segment_aig(ctype); // est-ce un aiguillage ???
trouve:=segment_aig_crois(ctype); // est-ce un aiguillage ???
// prépare suivant
if not(trouve) then
@@ -4732,9 +4732,8 @@ end;
procedure clic_image;
var pt : Tpoint;
xSouris,ySouris,x1,y1,x2,y2,i,j,centreX,centrey,rayon,numero: integer;
StartAngle,StopAngle : single;
trouve : boolean;
debug : boolean;
StartAngle,StopAngle,Zoom : single;
trouve,debug : boolean;
ctype,s : string;
canvasI : Tcanvas;
begin
@@ -4744,6 +4743,8 @@ begin
ySouris:=pt.y;
canvasI:=FormAnalyseCDM.ImageCDM.Canvas;
Zoom:=(2*(90-formAnalyseCDM.TrackBar1.Position)/100)+0.4;
canvasI.font.size:=round(zoom*10);
i:=0;
repeat
@@ -4756,7 +4757,7 @@ begin
ctype:=Segment[i].typ;
// aiguillage à 3 ports (turnout)
if segment_aig(ctype) and (ctype<>'dbl_slip_switch') then
if segment_aig_crois(ctype) and (ctype<>'dbl_slip_switch') then
begin
x1:=segment[i].port[0].x;
y1:=segment[i].port[0].y;
@@ -4818,10 +4819,10 @@ begin
trouve:=point_Sur_Segment(Xsouris,Ysouris,x1,y1,x2,y2);
if trouve then
begin
s:=intToSTR(Segment[i].adresse);
s:=intToSTR(Segment[i].adresse);
if Segment[i].adresse2<>0 then s:=s+'/'+intToSTR(Segment[i].adresse2);
formAnalyseCDM.EditAdresse.Text:=s;
s:='Ports 0/1/2/3 = '+IntToSTR(Segment[i].port[0].numero)+'/'+IntToSTR(Segment[i].port[1].numero)+'/'+
s:='Ports 0/1/2/3 = (NO/SO/NE/SE)'+#13+IntToSTR(Segment[i].port[0].numero)+'/'+IntToSTR(Segment[i].port[1].numero)+'/'+
IntToSTR(Segment[i].port[2].numero)+'/'+IntToSTR(Segment[i].port[3].numero);
formAnalyseCDM.LabelPorts.Caption:=s;
@@ -4984,7 +4985,7 @@ begin
if adresse2<>0 then segment[IndexClic].adresse2:=adresse2;
if (ctyp='crossing') then ofs:=YcrOffset;
ctyp:=segment[IndexClic].typ;
if not(segment_aig(ctyp)) and not(ctyp='crossing') then exit; // si c'est pas un aiguillage ni un croisement
if not(segment_aig_crois(ctyp)) and not(ctyp='crossing') then exit; // si c'est pas un aiguillage ni un croisement
if (ctyp='crossing') or (ctyp='dbl_slip_switch') then ofs:=YcrOffset;
if (ctyp='turnout') or (ctyp='turnout_sym') then ofs:=yTurnoutOffset;
if (ctyp='turnout_curved') or (ctyp='turnout_curved_2r') then ofs:=YcrOffset;
UnitClock.pas
+27 -29
View File
@@ -62,7 +62,7 @@ type
procedure SetFaceColor( Value : TColor);
procedure SetArrowColor( Value : TColor);
procedure SetShowSecond( Value : boolean);
function HourAngle( Hou, Min : word) : real; // Hour arrow angle
function HourAngle( Hou, Min : word) : single; // Hour arrow angle
procedure CalcClockSettings;
procedure DrawClockBkg; // Draw clock background on FBitMap
@@ -150,7 +150,7 @@ begin
inherited Destroy;
end;
function TClock.HourAngle( Hou, Min : word) : real;
function TClock.HourAngle( Hou, Min : word) : single;
begin
HourAngle:=(Hou mod 12) * pisur6 + (Min*pisur360);
end;
@@ -172,9 +172,9 @@ var
ABitMap : TBitMap;
sin,cos :extended;
// Dessine les flèches dans le bitmap hors écran
procedure DrawArrow(Angle, Scale : real;AWidth : integer);
var SR : real;
// Dessine les flèches dans le bitmap hors écran (Abitmap)
procedure DessineAiguille(Angle,Scale : single;AWidth : integer);
var SR : single;
begin
with ABitMap.Canvas do
begin
@@ -202,17 +202,17 @@ begin
if ShowSecond then
begin
ABitMap.Canvas.pen.Color:=$600000; // bleu foncé
DrawArrow(seconde*pisur30, SecScale, SecThick); // seconde
DessineAiguille(seconde*pisur30,SecScale,SecThick); // seconde
end;
ABitMap.Canvas.Pen.color:=ClkArrowColor;
DrawArrow(minute*pisur30,MinScale, MinThick); // minute
DrawArrow(HourAngle(heure,minute),HouScale,HouThick); // heure
DessineAiguille(minute*pisur30,MinScale, MinThick); // minute
DessineAiguille(HourAngle(heure,minute),HouScale,HouThick); // heure
// copie le bitmap hors écran dans l'horloge
// copie le bitmap hors écran (Abitmap) dans l'horloge
Canvas.CopyMode:=cmSrcCopy;
Canvas.Draw(0,0,ABitMap);
formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] );
Canvas.Draw(0,0,ABitMap); // copie formclock.canvas<-Abitmap
ABitMap.Free;
formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] );
end;
procedure TClock.CalcClockSettings;
@@ -239,19 +239,19 @@ end;
procedure TClock.DrawClockBkg;
// Dessine les tirets minute sur FBitMap
procedure DrawMinSteps;
const EpGd=2; // epaisseurs des aiguilles
LgGd=25;
EpPt=1;
LgPt=7;
procedure DessineTiretsMn;
const EpGd=2; // epaisseurs grands marqueurs 12 3 6 9
LgGd=25; // longueur grands marqueurs
EpPt=1; // epaisseurs petits marqueurs
LgPt=7; // longueur petits marqueurs
var
ep,lg,OfsX : integer;
Angle : word;
SR : real;
sin, cos : extended;
SR : single;
sin,cos : extended;
x1,y1,x2,y2,x3,y3,x4,y4 : integer;
begin
OfsX := LapStepW DIV 2;
OfsX := LapStepW div 2;
Angle:=0;
FBitMap.Canvas.Pen.color:=ClkArrowColor;
Fbitmap.canvas.Brush.Color:=clkArrowColor;
@@ -325,9 +325,9 @@ begin
begin
Brush.Style:=bsSolid;
Brush.Color:=ClkFaceColor;
FillRect( ClipRect);
FillRect(ClipRect);
end;
DrawMinSteps;
DessineTiretsMn;
end;
// sur la fermeture de SC, l'horloge provoque une exception
@@ -380,7 +380,7 @@ begin
off:=40;
{$IFEND}
ImageList24x24.GetBitmap(0,BitBtnMarHor.Glyph);
ImageList24x24.GetBitmap(0,BitBtnMarHor.Glyph); // marche horloge
with BitBtnMarHor do
begin
Height:=26;
@@ -388,7 +388,7 @@ begin
Top:=formClock.Height-BitBtnMarHor.Height-off;
end;
ImageList24x24.GetBitmap(1,BitBtnArrHorl.Glyph);
ImageList24x24.GetBitmap(1,BitBtnArrHorl.Glyph); // arrêt horloge
with BitBtnArrHorl do
begin
Height:=26;
@@ -396,7 +396,7 @@ begin
Top:=formClock.Height-BitBtnMarHor.Height-off;
end;
ImageList24x24.GetBitmap(2,BitBtnInitHor.Glyph);
ImageList24x24.GetBitmap(2,BitBtnInitHor.Glyph); // init horloge
with BitBtnInitHor do
begin
Height:=26;
@@ -426,7 +426,7 @@ begin
end;
end;
// fixer les valeurs maxi et mini de la taille de la fenetre
// fixer les valeurs maxi et mini de la taille de la fenetre de l'horloge
procedure TFormClock.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
var MinMaxInfo : PMinMaxInfo;
begin
@@ -470,7 +470,7 @@ end;
procedure TFormClock.TjsVerClick(Sender: TObject);
begin
SetWindowPos(Handle,HWND_TOPMOST, 0, 0, 0, 0,SWP_NoMove or SWP_NoSize);
SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
// le checked ne fonctionne pas sous D7, fonctionne sous D12.
TjsDev.Checked:=true;
Dverrouiller1.Checked:=false;
@@ -479,13 +479,12 @@ end;
procedure TFormClock.Dverrouiller1Click(Sender: TObject);
begin
SetWindowPos(Handle,HWND_NOTOPMOST, 0, 0, 0, 0,SWP_NoMove or SWP_NoSize);
SetWindowPos(Handle,HWND_NOTOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
TjsDev.Checked:=false;
Dverrouiller1.Checked:=true;
Verrouille:=false;
end;
procedure affiche_horloge;
begin
if (formClock<>nil) then
@@ -495,7 +494,6 @@ begin
end;
end;
procedure TFormClock.ButtonGHClick(Sender: TObject);
begin
formFicheHoraire.showModal;
UnitConfig.dfm
+47 -50
View File
@@ -665,32 +665,19 @@ object FormConfig: TFormConfig
TabOrder = 0
OnClick = ButtonAppliquerEtFermerClick
end
object ButtonFSE: TButton
Left = 696
Top = 440
Width = 33
Height = 25
Hint = 'Ferme la fen'#234'tre sans enregistrer la configuration'
Caption = 'Fermer sans enregistrer la configuration'
ParentShowHint = False
ShowHint = True
TabOrder = 1
Visible = False
OnClick = ButtonFSEClick
end
object PageControl: TPageControl
Left = 8
Top = 8
Width = 633
Height = 505
ActivePage = TabSheetAig
ActivePage = TabSheetPeriph
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 2
TabOrder = 1
OnChange = PageControlChange
object TabSheetCDM: TTabSheet
Caption = 'CDM Rail'
@@ -1208,7 +1195,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 = 13
ItemHeight = 0
ParentShowHint = False
ShowHint = True
TabOrder = 0
@@ -2415,7 +2402,7 @@ object FormConfig: TFormConfig
Width = 137
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemHeight = 0
TabOrder = 1
OnChange = ComboBoxDecChange
end
@@ -2546,7 +2533,7 @@ object FormConfig: TFormConfig
Width = 137
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemHeight = 0
TabOrder = 2
OnChange = ComboBoxAspChange
end
@@ -2854,7 +2841,7 @@ object FormConfig: TFormConfig
Top = 56
Width = 193
Height = 21
ItemHeight = 13
ItemHeight = 0
TabOrder = 0
OnChange = ComboBoxDecodeurPersoChange
end
@@ -2873,7 +2860,7 @@ object FormConfig: TFormConfig
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemHeight = 0
TabOrder = 2
OnChange = ComboBoxNationChange
end
@@ -2919,7 +2906,7 @@ object FormConfig: TFormConfig
Width = 193
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemHeight = 0
TabOrder = 6
OnChange = ComboBoxDecCdeChange
end
@@ -3134,7 +3121,7 @@ object FormConfig: TFormConfig
Top = 96
Width = 137
Height = 21
ItemHeight = 13
ItemHeight = 0
TabOrder = 2
OnChange = ComboBoxOperateurChange
OnDrawItem = ComboBoxOperateurDrawItem
@@ -3154,7 +3141,7 @@ object FormConfig: TFormConfig
Top = 96
Width = 161
Height = 21
ItemHeight = 13
ItemHeight = 0
ParentShowHint = False
ShowHint = True
TabOrder = 4
@@ -3255,7 +3242,7 @@ object FormConfig: TFormConfig
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemHeight = 0
TabOrder = 7
OnChange = ComboBoxFLChange
end
@@ -3337,9 +3324,7 @@ object FormConfig: TFormConfig
'Elles permettent de r'#233'aliser des combinaisons logiques d'#39#39#233'lemen' +
'ts divers comme '
'l'#39#39#233'tat des aiguillages, d'#233'tecteurs, boutons TCO, m'#233'moires etc..' +
'.')
'l'#39#233'tat des aiguillages, d'#233'tecteurs, boutons TCO, m'#233'moires etc...')
ReadOnly = True
TabOrder = 2
end
@@ -3807,7 +3792,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 = 13
ItemHeight = 0
ParentShowHint = False
ShowHint = True
TabOrder = 10
@@ -4002,12 +3987,12 @@ object FormConfig: TFormConfig
object Label19: TLabel
Left = 8
Top = 8
Width = 404
Height = 16
Width = 333
Height = 13
Caption = 'Configuration de l'#39'interface DCC++ pour le mode autonome'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
@@ -4094,14 +4079,14 @@ object FormConfig: TFormConfig
Caption = 'Trains'
ImageIndex = 7
object Label54: TLabel
Left = 16
Left = 8
Top = 8
Width = 244
Height = 16
Width = 199
Height = 13
Caption = 'Liste des trains d'#233'clar'#233's du r'#233'seau'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
@@ -4493,7 +4478,7 @@ object FormConfig: TFormConfig
object LabeledEditCV3: TLabeledEdit
Left = 224
Top = 136
Width = 41
Width = 33
Height = 21
EditLabel.Width = 135
EditLabel.Height = 13
@@ -4506,7 +4491,7 @@ object FormConfig: TFormConfig
object LabeledEditCV4: TLabeledEdit
Left = 224
Top = 160
Width = 41
Width = 33
Height = 21
EditLabel.Width = 135
EditLabel.Height = 13
@@ -4536,7 +4521,7 @@ object FormConfig: TFormConfig
Height = 73
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
@@ -4544,9 +4529,9 @@ object FormConfig: TFormConfig
TabOrder = 7
end
object ButtonlCV3: TButton
Left = 272
Left = 264
Top = 136
Width = 27
Width = 20
Height = 25
Hint = 'Lire le CV3 de la locomotive plac'#233'e sur la voie de programmation'
Caption = 'CV'
@@ -4556,9 +4541,9 @@ object FormConfig: TFormConfig
OnClick = ButtonlCV3Click
end
object ButtonlCV4: TButton
Left = 272
Left = 264
Top = 160
Width = 27
Width = 20
Height = 25
Hint = 'Lire le CV4 de la locomotive plac'#233'e sur la voie de programmation'
Caption = 'CV'
@@ -4567,6 +4552,18 @@ object FormConfig: TFormConfig
TabOrder = 9
OnClick = ButtonlCV4Click
end
object ButtonRepriseDCC: TButton
Left = 288
Top = 144
Width = 25
Height = 25
Hint = 'Repasse la centrale en mode DCC'
Caption = 'Dcc'
ParentShowHint = False
ShowHint = True
TabOrder = 10
OnClick = ButtonRepriseDCCClick
end
end
end
end
@@ -4577,12 +4574,12 @@ object FormConfig: TFormConfig
object Label73: TLabel
Left = 8
Top = 8
Width = 252
Height = 16
Width = 208
Height = 13
Caption = 'P'#233'riph'#233'riques COM/USB ou Sockets'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
@@ -4879,12 +4876,12 @@ object FormConfig: TFormConfig
object Label50: TLabel
Left = 8
Top = 8
Width = 216
Height = 16
Width = 176
Height = 13
Caption = 'Param'#232'tres avanc'#233's et experts'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
@@ -4916,7 +4913,7 @@ object FormConfig: TFormConfig
Caption = 'Enregistre la configuration'
ParentShowHint = False
ShowHint = True
TabOrder = 3
TabOrder = 2
OnClick = ButtonEnregistreClick
end
object Panel1: TPanel
@@ -4927,7 +4924,7 @@ object FormConfig: TFormConfig
BevelWidth = 2
Caption = 'Fermer sans enregistrer la configuration'
Color = clGradientActiveCaption
TabOrder = 4
TabOrder = 3
OnClick = Panel1Click
OnMouseDown = Panel1MouseDown
OnMouseUp = Panel1MouseUp
UnitConfig.pas
+103 -32
View File
@@ -418,7 +418,6 @@ type
ImageListLogic: TImageList;
Label63: TLabel;
ComboBoxFL: TComboBox;
ButtonFSE: TButton;
ButtonNouvFL: TButton;
ButtonEvalue: TButton;
LabeledEditNomLog: TLabeledEdit;
@@ -444,6 +443,7 @@ type
ButtonNouvPN: TButton;
ButtonSupPN: TButton;
Label58: TLabel;
ButtonRepriseDCC: TButton;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton;
@@ -699,6 +699,7 @@ type
procedure ComboStyleChange(Sender: TObject);
procedure RadioGroupClClick(Sender: TObject);
procedure ButtonlCV3Click(Sender: TObject);
procedure ButtonRepriseDCCClick(Sender: TObject);
private
{ Déclarations privées }
@@ -2030,7 +2031,7 @@ begin
end;
// encode une entrée de train
function Train_tablo(index : integer) : string;
function encode_train(index : integer) : string;
var s: string;
nc,i : integer;
begin
@@ -2038,7 +2039,7 @@ begin
begin
s:=nom_train+','+inttostr(adresse)+','+
intToSTR(vitmax)+','+intToSTR(vitnominale)+','+
intToSTR(vitRalenti)+','+NomIcone+','+intToSTR(TempsDemarreSig)+',';
intToSTR(vitRalenti)+','+NomIcone+','+intToSTR(TempsDemarreSig)+',';
if inverse then s:=s+'1,' else s:=s+'0,';
s:=s+intToSTR(longueur)+','+IntToSTR(ConsV1)+','+IntToSTR(ConsV2)+','+IntToSTR(ConsV3)+',';
s:=s+FloatToSTRF(coeffV1,ffFixed,5,2,FormatSettings)+','+FloatToSTRF(coeffV2,ffFixed,5,2,FormatSettings)+','+FloatToSTRF(coeffV3,ffFixed,5,2,FormatSettings)+',';
@@ -2381,7 +2382,7 @@ begin
writeln(fichierN,section_trains_ch);
for i:=1 to ntrains do
begin
writeln(fichierN,Train_tablo(i));
writeln(fichierN,encode_train(i));
// route du train
for j:=1 to trains[i].routePref[0][0].adresse do
begin
@@ -2556,6 +2557,8 @@ begin
end;
// trier les aiguillages par adresses croissantes
// et complète les aiguillages triples (créée aiguillahe homologue)
procedure trier_aig;
@@ -2690,11 +2693,35 @@ begin
end;
end;
// trie les trains par adresses croissantes
// on utilise l'index 0 car si on déclare une variabe temporaire
// t : Ttrain
// on a une erreur de stack overflow à l'exécution car la structure de Ttrain est trop grosse
procedure trier_trains;
var i,j : integer;
begin
for i:=1 to ntrains-1 do
begin
for j:=i+1 to ntrains do
begin
if trains[i].Adresse>trains[j].adresse then
begin
trains[0]:=trains[i];
trains[i]:=trains[j];
trains[j]:=trains[0];
end;
end;
end;
end;
// trouve les id des routesPref des trains et le stocke dedans
procedure compile_id_routes;
var t1,t2,r1,r2,Id,nr : integer;
route1 : tUneroute;
begin
begin
// raz tous les ID de routes
for t1:=1 to nTrains do
begin
@@ -5634,6 +5661,7 @@ const LessThanValue=-1;
begin
trouve_section_trains:=true;
compile_trains;
trier_trains;
end;
// section dédodeurs
@@ -7884,10 +7912,9 @@ begin
with ListBoxTrains do
begin
clear;
for i:=1 to ntrains do
begin
s:=Train_tablo(i);
s:=encode_train(i);
items.Add(s);
l:=Length(s);
if l>LongestLength then
@@ -7897,6 +7924,10 @@ begin
end;
end;
end;
ButtonlCV3.hint:='Passe la centrale en mode programmation et'+#13+
'lit le CV3 de la locomotive placée sur la voie de programmation';
ButtonlCV4.hint:='Passe la centrale en mode programmation et'+#13+
'lit le CV4 de la locomotive placée sur la voie de programmation';
PixelLength:=ListboxTrains.Canvas.TextWidth(LongestString)+8;
// positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength
@@ -13624,7 +13655,7 @@ begin
if affevt then affiche('Evt change nom train',clyellow);
if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit;
trains[ligneclicTrain+1].Nom_train:=EditNomTrain.text;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
i:=formprinc.ComboTrains.ItemIndex;
@@ -13642,7 +13673,7 @@ begin
val(EditAdresseTrain.text,i,erreur);
if i<1 then exit;
trains[ligneclicTrain+1].adresse:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -13655,7 +13686,7 @@ begin
val(EditVitesseMaxi.text,i,erreur);
if i<1 then exit;
trains[ligneclicTrain+1].vitmax:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
formconfig.ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -13668,7 +13699,7 @@ begin
val(EditLongLoco.text,i,erreur);
if i<1 then exit;
trains[ligneclicTrain+1].longueur:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
formconfig.ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -13684,7 +13715,7 @@ begin
val(EditVitNom.text,i,erreur);
if i<1 then exit;
trains[ligneclicTrain+1].vitNominale:=i;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
end;
@@ -13701,7 +13732,7 @@ begin
val(EditVitRalenti.text,i,erreur);
if i<1 then exit;
trains[ligneclicTrain+1].vitRalenti:=i;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
end;
@@ -13721,13 +13752,13 @@ begin
ligneclicTrain:=ntrains-1;
clicListe:=false;
formprinc.ComboTrains.Items.Add(Train_tablo(ntrains));
formprinc.ComboTrains.Items.Add(encode_train(ntrains));
for i:=0 to ntrains-2 do formConfig.ListBoxTrains.selected[i]:=false;
with formConfig.ListBoxTrains do
begin
items.add(Train_tablo(ntrains));
items.add(encode_train(ntrains));
selected[ntrains-1]:=true;
SetFocus;
perform(WM_VSCROLL,SB_BOTTOM,0);
@@ -13772,6 +13803,15 @@ begin
editVitNom.Text:='';
editVitesseMaxi.text:='';
editLongLoco.text:='';
LabeledEditTempoD.text:='';
checkboxSens.Checked:=false;
editIcone.Text:='';
LabeledEditV1.Text:='';
LabeledEditV2.Text:='';
LabeledEditV3.Text:='';
LabeledEditCV3.Text:='';
LabeledEditCV4.Text:='';
LabeledEditCrans.Text:='';
end;
// suppression
@@ -13797,7 +13837,7 @@ begin
// réafficher la liste
for i:=1 to ntrains do
begin
s:=trains[i].nom_train+','+inttostr(trains[i].adresse)+','+intToSTR(trains[i].vitmax);
s:=encode_train(i);
FormConfig.ListBoxtrains.items.Add(s);
end;
ligneclicTrain:=-1;
@@ -15766,7 +15806,7 @@ begin
with ListBoxTrains do
begin
clear;
for i:=1 to ntrains do items.Add(Train_tablo(i));
for i:=1 to ntrains do items.Add(encode_train(i));
end;
with StringGridArr do
@@ -15962,7 +16002,7 @@ var s,repini :string; i : integer;begin if ligneclicTrain<0 then exit;
trains[i].icone.Picture.LoadFromFile(s);
//ImageTrain.Canvas.Rectangle(0,0,ImageTrain.Width,ImageTrain.Height);
Maj_icone_train(formconfig.ImageTrain,i);
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
//formconfig.ImageTrain.Picture.assign(trains[i].icone.Picture);
end;
chDir(RepIni);
@@ -15981,7 +16021,7 @@ var s,Nom,repIni : string;begin
// Affiche(s,clWhite);
trains[ligneclicTrain+1].icone.Picture.LoadFromFile(s);
Maj_icone_train(formconfig.ImageTrain,ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
end;
end;
@@ -15993,7 +16033,7 @@ var erreur,i :integer;begin
val(LabeledEditTempoD.text,i,erreur);
if i<0 then exit;
trains[ligneclicTrain+1].TempsDemarreSig:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
formconfig.ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16003,7 +16043,7 @@ begin if clicliste then exit;
if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit;
trains[ligneclicTrain+1].inverse:=CheckBoxSens.Checked;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
formconfig.ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16472,7 +16512,7 @@ begin
begin
trains[i].DetecteurArret[Arow].temps:=v;
end;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16591,7 +16631,7 @@ begin
end;
end;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16618,7 +16658,7 @@ begin
exit;
end;
end;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16645,14 +16685,14 @@ begin
exit;
end;
end;
ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
procedure TFormConfig.EditDecalChange(Sender: TObject);
var r,i,erreur : integer;
var l,r,i,erreur : integer;
begin
if clicListe then exit;
val(editDecal.Text,i,erreur);
@@ -16663,16 +16703,32 @@ begin
end;
labelInfo.caption:='';
r:=adresse_detecteur[ligneclicDet+1];
l:=detecteur[r].longueur;
if i>=l then
begin
labelInfo.caption:='Erreur : la distance d''arrêt est supérieure à la longueur du détecteur';
exit;
end;
labelInfo.caption:='';
detecteur[r].distArret:=i;
ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1);
ListBoxDet.selected[ligneclicDet]:=true;
end;
procedure TFormConfig.RadioButtonArrFinClick(Sender: TObject);
var r : integer;
var r,d,l : integer;
begin
if clicListe then exit;
r:=adresse_detecteur[ligneclicDet+1];
l:=detecteur[r].longueur;
d:=detecteur[r].distArret;
if d>=l then
begin
labelInfo.caption:='Erreur : la distance d''arrêt est supérieure à la longueur du détecteur';
end;
detecteur[r].ModeArret:=1;
ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1);
ListBoxDet.selected[ligneclicDet]:=true;
@@ -16684,6 +16740,7 @@ begin
if clicListe then exit;
r:=adresse_detecteur[ligneclicDet+1];
detecteur[r].ModeArret:=2;
LabelInfo.Caption:='';
ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1);
ListBoxDet.selected[ligneclicDet]:=true;
end;
@@ -16737,7 +16794,7 @@ begin
val(LabeledEditCV3.text,i,erreur);
if i<0 then exit;
trains[ligneclicTrain+1].cv3:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16750,7 +16807,7 @@ begin
val(LabeledEditCV4.text,i,erreur);
if i<0 then exit;
trains[ligneclicTrain+1].cv4:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
calculs;
end;
@@ -16764,7 +16821,7 @@ begin
val(LabeledEditCrans.text,i,erreur);
if i<0 then exit;
trains[ligneclicTrain+1].Crans:=i;
formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1);
formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1);
ListBoxTrains.selected[ligneclicTrain]:=true;
end;
@@ -16825,6 +16882,7 @@ procedure TFormConfig.LEAdrDetChange(Sender: TObject);
var i,erreur : integer;
s : string;
begin
exit;
if clicListe then exit;
val(LEAdrDet.text,i,erreur);
if (erreur<>0) or (i<1) then
@@ -16840,7 +16898,7 @@ begin
end;
procedure TFormConfig.LElongDetChange(Sender: TObject);
var r,i,erreur :integer;
var r,i,d,erreur :integer;
s : string;
begin
if clicListe then exit;
@@ -16852,6 +16910,15 @@ begin
end;
labelInfo.caption:='';
r:=adresse_detecteur[ligneclicDet+1];
d:=detecteur[r].distArret;
if d>=i then
begin
labelInfo.caption:='Erreur : la longueur du détecteur est inférieure à la distance d''arrêt';
exit;
end;
labelInfo.caption:='';
detecteur[r].longueur:=i;
s:=encode_detecteur(ligneclicDet+1);
formconfig.ListBoxDet.items[ligneclicDet]:=s;
@@ -18093,7 +18160,6 @@ begin
end;
procedure TFormConfig.ValueListEditorDrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState);
var coul : tColor;
begin
with ValueListEditor do
begin
@@ -18232,6 +18298,11 @@ begin
end;
procedure TFormConfig.ButtonRepriseDCCClick(Sender: TObject);
begin
reprise_dcc;
end;
end.
UnitConfigCellTCO.dfm
+2 -2
View File
@@ -561,8 +561,8 @@ object FormConfCellTCO: TFormConfCellTCO
OnClick = BitBtnAnnuleClick
end
object GroupBoxCanton: TGroupBox
Left = 360
Top = 288
Left = 328
Top = 280
Width = 281
Height = 129
Caption = 'Canton'
UnitConfigCellTCO.pas
+10 -11
View File
@@ -254,20 +254,22 @@ begin
with formConfCellTCO do
begin
// ramener la coordonnée cliquée à l'origine du canton
{
if (Bimage>=Id_cantonH) and (Bimage<=Id_cantonH+9) then
if isCantonH(Bimage) then
//if (Bimage>=Id_cantonH) and (Bimage<=Id_cantonH+9) then
begin
H:=true;
xClicC:=xClicC-(Bimage-Id_cantonH);
//xClicC:=xClicC-(Bimage-Id_cantonH);
end;
if (Bimage>=Id_cantonV) and (Bimage<=Id_cantonV+9) then
if isCantonV(Bimage) then
//if (Bimage>=Id_cantonV) and (Bimage<=Id_cantonV+9) then
begin
H:=false;
yClicC:=yClicC-(Bimage-Id_cantonV);
//yClicC:=yClicC-(Bimage-Id_cantonV);
end;
XclicCell[indexTCO]:=XclicC;
YclicCell[indexTCO]:=YclicC;
}
//XclicCell[indexTCO]:=XclicC;
//YclicCell[indexTCO]:=YclicC;
idCanton:=index_canton(indexTCO,xclicC,yclicC);
GroupBoxOrientation.visible:=false;
@@ -519,15 +521,12 @@ begin
if tco[indexTCO,Xclic,Yclic].adresse<>0 then s:=s+' Adr='+intToSTR(tco[indexTCO,XclicC,YclicC].adresse);
//hint:=s;
if not(ConfCellTCO) then exit;
actualize:=true; // évite les évènements parasites
FormConfCellTCO.caption:='Propriétés de la cellule '+IntToSTR(XclicC)+','+intToSTR(YclicC)+' TCO '+intToSTR(IndexTCO);
Bimage:=tco[indexTCO,XclicC,YclicC].Bimage;
formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage);
// mettre l'image de la cellule cliquée dans l'icone de la fenetre de config cellule
if Bimage=0 then
begin
UnitDebug.dfm
+17 -16
View File
@@ -32,6 +32,7 @@ object FormDebug: TFormDebug
Width = 872
Height = 677
HorzScrollBar.Visible = False
VertScrollBar.Position = 96
Anchors = [akLeft, akTop, akRight, akBottom]
Color = clBtnFace
ParentColor = False
@@ -41,7 +42,7 @@ object FormDebug: TFormDebug
673)
object LabelTitreDebug: TLabel
Left = 475
Top = 8
Top = -88
Width = 131
Height = 18
Anchors = [akTop, akRight]
@@ -55,7 +56,7 @@ object FormDebug: TFormDebug
end
object Label1: TLabel
Left = 627
Top = 10
Top = -86
Width = 108
Height = 13
Anchors = [akTop, akRight]
@@ -71,7 +72,7 @@ object FormDebug: TFormDebug
end
object RichDebug: TRichEdit
Left = 0
Top = 0
Top = -96
Width = 454
Height = 753
Anchors = [akLeft, akTop, akRight]
@@ -85,7 +86,7 @@ object FormDebug: TFormDebug
end
object ButtonRazTout: TButton
Left = 465
Top = 216
Top = 120
Width = 97
Height = 25
Hint =
@@ -100,7 +101,7 @@ object FormDebug: TFormDebug
end
object ButtonCop: TButton
Left = 465
Top = 248
Top = 152
Width = 97
Height = 41
Anchors = [akTop, akRight]
@@ -117,7 +118,7 @@ object FormDebug: TFormDebug
end
object ButtonAffEvtChrono: TButton
Left = 465
Top = 296
Top = 200
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -128,7 +129,7 @@ object FormDebug: TFormDebug
end
object ButtonCherche: TButton
Left = 465
Top = 336
Top = 240
Width = 97
Height = 25
Hint = 'Cherche la cha'#238'ne "erreur"'
@@ -141,7 +142,7 @@ object FormDebug: TFormDebug
end
object ButtonEcrLog: TButton
Left = 465
Top = 184
Top = 88
Width = 97
Height = 29
Anchors = [akTop, akRight]
@@ -151,7 +152,7 @@ object FormDebug: TFormDebug
end
object ButtonRazTampon: TButton
Left = 465
Top = 368
Top = 272
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -162,7 +163,7 @@ object FormDebug: TFormDebug
end
object ButtonRazLog: TButton
Left = 465
Top = 408
Top = 312
Width = 97
Height = 33
Anchors = [akTop, akRight]
@@ -173,7 +174,7 @@ object FormDebug: TFormDebug
end
object MemoEvtDet: TRichEdit
Left = 570
Top = 186
Top = 90
Width = 272
Height = 263
Anchors = [akTop, akRight]
@@ -184,7 +185,7 @@ object FormDebug: TFormDebug
end
object GroupBox5: TGroupBox
Left = 462
Top = 456
Top = 360
Width = 380
Height = 57
Anchors = [akTop, akRight]
@@ -251,7 +252,7 @@ object FormDebug: TFormDebug
end
object GroupBox6: TGroupBox
Left = 462
Top = 520
Top = 424
Width = 380
Height = 52
Anchors = [akTop, akRight]
@@ -328,7 +329,7 @@ object FormDebug: TFormDebug
end
object GroupBoxPrim: TGroupBox
Left = 464
Top = 584
Top = 488
Width = 378
Height = 185
Anchors = [akTop, akRight]
@@ -499,7 +500,7 @@ object FormDebug: TFormDebug
end
object GroupBox2: TGroupBox
Left = 466
Top = 28
Top = -68
Width = 376
Height = 149
Anchors = [akTop, akRight]
@@ -712,7 +713,7 @@ object FormDebug: TFormDebug
end
object EditNivDebug: TEdit
Left = 751
Top = 8
Top = -88
Width = 49
Height = 21
Anchors = [akTop, akRight]
UnitDebug.pas
+1 -1
View File
@@ -473,7 +473,7 @@ begin
if (erreur<>0) or (adr<1) then exit;
ancdebug:=NivDebug;
NivDebug:=3;
if PresTrainPrec(Adr,Nb_cantons_Sig,false,adrtrain,voie) then AfficheDebug('Présence train '+intToSTR(AdrTrain),clYellow) else
if PresTrainPrec(Adr,Nb_cantons_Sig,true,adrtrain,voie) then AfficheDebug('Présence train @='+intToSTR(AdrTrain),clYellow) else
AfficheDebug('Absence train',clyellow);
NivDebug:=AncDebug;
end;
UnitMemZone.dfm
+164
View File
@@ -0,0 +1,164 @@
object FormMemZone: TFormMemZone
Left = 391
Top = 155
BorderStyle = bsDialog
Caption = 'Activer / d'#233'sactiver des m'#233'moires de zone'
ClientHeight = 173
ClientWidth = 370
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 24
Top = 8
Width = 329
Height = 33
Caption =
'Les m'#233'moires de zone sont constitu'#233'es de deux d'#233'tecteurs contigu' +
's'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
WordWrap = True
end
object LabelInfo: TLabel
Left = 16
Top = 120
Width = 3
Height = 13
end
object Shape1: TShape
Left = 216
Top = 88
Width = 137
Height = 9
Brush.Color = clBlue
end
object Shape2: TShape
Left = 232
Top = 83
Width = 25
Height = 20
Brush.Color = clRed
end
object Shape3: TShape
Left = 312
Top = 83
Width = 25
Height = 20
Brush.Color = clRed
end
object Label2: TLabel
Left = 225
Top = 56
Width = 35
Height = 19
Caption = 'Det1'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 304
Top = 56
Width = 35
Height = 19
Caption = 'Det2'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object ButtonOk: TButton
Left = 280
Top = 144
Width = 75
Height = 25
Caption = 'Ok'
TabOrder = 0
OnClick = ButtonOkClick
end
object LabeledEditDet1: TLabeledEdit
Left = 152
Top = 56
Width = 33
Height = 21
EditLabel.Width = 77
EditLabel.Height = 13
EditLabel.Caption = 'De : d'#233'tecteur 1'
LabelPosition = lpLeft
LabelSpacing = 10
TabOrder = 1
end
object LabeledEditDet2: TLabeledEdit
Left = 152
Top = 88
Width = 33
Height = 21
EditLabel.Width = 72
EditLabel.Height = 13
EditLabel.Caption = ' '#224' : d'#233'tecteur 2'
LabelPosition = lpLeft
LabelSpacing = 10
TabOrder = 2
end
object ButtonAct: TButton
Left = 8
Top = 144
Width = 75
Height = 25
Caption = 'Activer'
TabOrder = 3
OnClick = ButtonActClick
end
object ButtonDes: TButton
Left = 96
Top = 144
Width = 75
Height = 25
Caption = 'D'#233'sactiver'
TabOrder = 4
OnClick = ButtonDesClick
end
object ButtonClicDet1: TButton
Left = 24
Top = 56
Width = 25
Height = 25
Hint = 'Cliquer sur le d'#233'tecteur 1 dans le TCO'
Caption = 'Clic'
ParentShowHint = False
ShowHint = True
TabOrder = 5
OnClick = ButtonClicDet1Click
end
object Button1: TButton
Left = 24
Top = 84
Width = 25
Height = 25
Hint = 'Cliquer sur le d'#233'tecteur 2 dans le TCO'
Caption = 'Clic'
ParentShowHint = False
ShowHint = True
TabOrder = 6
OnClick = Button1Click
end
end
UnitMemZone.pas
+159
View File
@@ -0,0 +1,159 @@
unit UnitMemZone;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TFormMemZone = class(TForm)
ButtonOk: TButton;
LabeledEditDet1: TLabeledEdit;
LabeledEditDet2: TLabeledEdit;
Label1: TLabel;
LabelInfo: TLabel;
ButtonAct: TButton;
ButtonDes: TButton;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Label2: TLabel;
Label3: TLabel;
ButtonClicDet1: TButton;
Button1: TButton;
procedure ButtonOkClick(Sender: TObject);
procedure ButtonActClick(Sender: TObject);
procedure ButtonDesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonClicDet1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormMemZone: TFormMemZone;
det1Z,det2Z: integer;
formZone,clicDet1,clicDet2 : boolean;
procedure actualise_memZone(indexTCO : integer);
implementation
uses UnitPrinc, unitTCO;
{$R *.dfm}
procedure actualise_memZone(indexTCO : integer);
var adr,x,y,Bim : integer;
begin
if (indexTCO=0) or (formMemZone=nil) or not(FormZone) then exit;
x:=XclicCell[indexTCO];
y:=YclicCell[indexTCO];
Bim:=Tco[indexTCO,x,y].bimage;
if IsVoieDroite(bim) then
begin
Adr:=tco[indexTCO,x,y].Adresse;
if (adr>0) and FormZone then
begin
if clicDet1 then formMemZone.LabeledEditdet1.Text:=intToStr(Adr);
if clicDet2 then formMemZone.LabeledEditdet2.Text:=intToStr(Adr);
clicDet1:=false;
clicDet2:=false;
Screen.Cursor:=crDefault;
end;
end;
end;
procedure TFormMemZone.ButtonOkClick(Sender: TObject);
begin
FormZone:=false;
close;
end;
function valide_det : boolean;
var erreur : integer;
elsuiv : tEquipement;
begin
result:=false;
val(FormMemZone.labeledEditDet1.text,det1Z,erreur);
if (erreur<>0) or (det1Z<1) or (det1Z>NbMaxDet) then
begin
FormMemZone.LabelInfo.Caption:='Erreur détecteur 1';exit;
end;
val(FormMemZone.labeledEditDet2.text,det2Z,erreur);
if (erreur<>0) or (det2Z<1) or (det2Z>NbMaxDet) then
begin
FormMemZone.LabelInfo.Caption:='Erreur détecteur 2';exit;
end;
val(FormMemZone.labeledEditDet2.text,det2Z,erreur);
det_contigu(det1Z,det2Z,suivant,ElSuiv);
if suivant=0 then
begin
FormMemZone.LabelInfo.Caption:='Les détecteurs '+intToSTR(det1Z)+' / '+intToSTR(det2Z)+' ne sont pas contigus';
exit;
end;
FormMemZone.LabelInfo.caption:='';
result:=true;
end;
procedure TFormMemZone.ButtonActClick(Sender: TObject);
begin
if valide_det then
begin
Memzone[det1Z,det2Z].etat:=true;
LabelInfo.caption:='MemZone '+intToSTR(det1Z)+' -> '+intToSTR(det2Z)+' à 1';
Maj_Signaux(false);
end;
end;
procedure TFormMemZone.ButtonDesClick(Sender: TObject);
begin
if valide_det then
begin
Memzone[det1Z,det2Z].etat:=false;
LabelInfo.caption:='MemZone '+intToSTR(det1Z)+' -> '+intToSTR(det2Z)+' à 0';
Maj_Signaux(false);
end;
end;
procedure TFormMemZone.FormCreate(Sender: TObject);
begin
// fenêtre toujours devant
SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize);
end;
procedure TFormMemZone.FormActivate(Sender: TObject);
begin
FormZone:=true;
end;
procedure TFormMemZone.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
clicDet1:=false;
clicDet2:=false;
Screen.Cursor:=crDefault;
FormZone:=false;
end;
procedure TFormMemZone.ButtonClicDet1Click(Sender: TObject);
begin
clicDet1:=true;
Screen.Cursor:=crHandPoint; //crHourGlass;
end;
procedure TFormMemZone.Button1Click(Sender: TObject);
begin
clicDet2:=true;
Screen.Cursor:=crHandPoint;
end;
end.
UnitMesure.pas
+57
View File
@@ -155,15 +155,72 @@ begin
end;
procedure TFormMesure.ButtonLanceMesClick(Sender: TObject);
var el1,el2,i,det_depart,el : integer;
t1,t2,t : Tequipement;
s: string;
boucle : boolean;
begin
if (IndexTrainMes<1) or mesureTrains then exit;
i:=trains[indexTrainMes].canton; // numéro du canton sur lequel le train se trouve
if i=0 then
begin
Affiche('Le train '+trains[indexTrainMes].nom_train+'ne se trouve sur aucun canton',clred);
exit;
end;
el1:=canton[i].el1; t1:=canton[i].typ1;
el2:=canton[i].el2; t2:=canton[i].typ2;
if t1=det then det_depart:=el1;
if t2=det then det_depart:=el2;
i:=0;
repeat
el:=suivant_alg3(el1,t1,el2,t2,1);
t:=typeGen;
el1:=el2;t1:=t2;
el2:=el;t2:=t;
inc(i);
until (i>50) or (el>9000) or (el=det_depart);
boucle:=true;
if el>9000 then
begin
if el=9996 then
begin
s:='La position de l''aiguillage '+intToSTR(el1)+' est inconnue'+#13;
s:=s+'L''itinéraire du train '+trains[indexTrainMes].nom_train+' peut ne pas être bouclé.'+#13;
boucle:=false;
end
else
begin
s:='Il n''est pas possible de déterminer si l''itinéraire du train '+trains[indexTrainMes].nom_train+' est bouclé.'+#13;
boucle:=false;
end;
end
else
if el<>det_depart then
begin
s:='Il n''est pas possible de déterminer si l''itinéraire du train '+trains[indexTrainMes].nom_train+' est bouclé.'+#13;
boucle:=false;
end;
if not boucle then
begin
s:=s+'Voulez vous continuer?';
if MessageDlg(s,mtConfirmation,[mbNo,mbYes],0)=mrNo then exit;
end;
ComboBoxTrains.Enabled:=false;
ButtonLanceMes.Enabled:=false;
Affiche('Mesure vitesse 1',clYellow);
PhaseVitesse:=1; // vitesse 1 2 ou 3
DetecteurREF:=0;
mesureTrains:=true;
vitesse_loco('',0,trains[indexTrainMes].adresse,v1,10);
LabelMesC.Visible:=true;
LabelMesC.top:=178;
end;
UnitModifAction.dfm
+4 -4
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
@@ -516,7 +516,7 @@ object FormModifAction: TFormModifAction
Top = 32
Width = 217
Height = 21
ItemHeight = 0
ItemHeight = 13
TabOrder = 0
OnChange = ComboBoxFamilleChange
end
@@ -716,9 +716,9 @@ object FormModifAction: TFormModifAction
Top = 144
Width = 201
Height = 21
Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"'
Hint = 'Nom du p'#233'riph'#233'rique 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 = 4
UnitPrinc.dfm
+3 -5
View File
@@ -2309,7 +2309,7 @@ object FormPrinc: TFormPrinc
OnClick = Vrifiernouvelleversion1Click
end
end
object COs1: TMenuItem
object TCOs1: TMenuItem
Caption = 'TCOs'
object AffichertouslesTCO1: TMenuItem
Caption = 'Afficher tous les TCO'
@@ -2521,8 +2521,7 @@ object FormPrinc: TFormPrinc
OnConnect = ClientSocketCde1Connect
OnRead = ClientSocketCde1Read
OnError = ClientSocketCde1Error
Left = 1072
Top = 344
Left = 360
end
object ClientSocketCde2: TClientSocket
Active = False
@@ -2531,8 +2530,7 @@ object FormPrinc: TFormPrinc
OnConnect = ClientSocketCde2Connect
OnRead = ClientSocketCde2Read
OnError = ClientSocketCde2Error
Left = 1072
Top = 376
Left = 392
end
object ServerSocket: TServerSocket
Active = False
UnitPrinc.pas
+238 -126
View File
@@ -169,7 +169,7 @@ type
Coller1: TMenuItem;
Affiche_fenetre_CDM: TMenuItem;
ImageSignal20: TImage;
COs1: TMenuItem;
TCOs1: TMenuItem;
AffichertouslesTCO1: TMenuItem;
N10: TMenuItem;
Mosaquehorizontale1: TMenuItem;
@@ -289,8 +289,18 @@ type
procedure ButtonDroitClick(Sender: TObject);
procedure EditvalEnter(Sender: TObject);
procedure BoutonRafClick(Sender: TObject);
procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocketInterfaceConnect(Sender: TObject;Socket: TCustomWinSocket);
procedure ClientSocketInterfaceDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientInfoError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientInfoConnect(Sender: TObject;Socket: TCustomWinSocket);
procedure ClientInfoDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientInfoRead(Sender: TObject; Socket: TCustomWinSocket);
procedure MenuConnecterUSBClick(Sender: TObject);
procedure DeconnecterUSBClick(Sender: TObject);
procedure MenuConnecterEthernetClick(Sender: TObject);
@@ -302,8 +312,7 @@ type
procedure ClientSocketCDMError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocketInterfaceConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketCDMConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketCDMRead(Sender: TObject;
@@ -313,8 +322,6 @@ type
procedure ClientSocketCDMDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure CodificationdessignauxClick(Sender: TObject);
procedure ClientSocketInterfaceDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FichierSimuClick(Sender: TObject);
procedure ButtonEcrCVClick(Sender: TObject);
procedure LireunfichierdeCV1Click(Sender: TObject);
@@ -444,7 +451,6 @@ type
procedure proc_checkBoxFV(Sender : Tobject);
procedure proc_checkBoxFR(Sender : Tobject);
procedure procAide(Sender : Tobject);
procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket);
{$IF CompilerVersion >= 28.0}
procedure DataReceived(const Data: TidBytes);
{$ELSE}
@@ -904,11 +910,92 @@ Tactionneur = record
train : string;
end;
TUneRoute=array[0..MaxParcoursTablo] of TelementRoute; // Une route
TElroute=array[1..MaxRoutesCte] of TUneroute; // tableau de routes
// la longueur de la structure ttrain ne permet pas le passage de paramètre en procédure
tTrain = record
nom_train : string;
inverse : boolean; // placement
detecteurA : integer; // détecteur sur lequel le train se trouve
detecteurSuiv : integer; // détecteur vers lequel se dirige le train
ElSuivant : integer; // élément suivant vers lequel se dirige le train
TElSuivant : tEquipement;
adresse,vitmax,VitNominale,VitRalenti : integer;
AncVitesseCons : integer; // ancienne consigne
AVitesseCons : integer; // ancienne consigne du tick précédent
vitesseCons : integer; // vitesse Consigne actuelle de pilotage
VitesseReelleR : single; // Vitesse réelle calculée (tient compte de la décélération
VitesseReelle : integer;
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
TempoDemarre : integer; // tempo de démarrage, valeur dynamique
TempsDemarreSig : integer; // temps de redémarrage du signal, valeur d'initialisation (fichier de config)
TempoArretTemp : integer; // temps d'arrêt temporisé sur un détecteur
index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train
arret_det : boolean; // arrêt du train sur le détecteur
phase_arret : integer; // numéro de phase arret
// mesure et étalonnage de la vitesse------
VitesseDetE : integer; // vitesse en entrée du détecteur
VitesseDetS : integer; // vitesse en sortie du détecteur
//Temps_cour : integer; // compteur du temps en 1/10 s évolution pendant le détecteur à 1
pointMes : integer; // pointeur de mesures 1 à 100
// tableau des mesures
mesure : array[1..100] of record
// valeurs mesurées:
VitCons : integer; // vitesse de consigne en crans
detecteurM : integer; // détecteur
temps : integer; // temps de passage sur le détecteue à 1 (1/10s)
// valeurs calculées:
vr : single; // vitesse réelle calculée en cm/s
end;
// Mesure vitesse des trains: affectation des vitesses moyennes aux détecteurs rencontrés
// par detecteur (NbMaxDet) et par consigne (128 max)
detecteurR : array[0..NbMaxDet,1..128] of record
nombre : integer;
moyenne : single; // moyenne de la vitesse calculée par détecteur/
ecart : single; //
somme : single;
end;
ConsV1,consV2,consV3 : integer; // consignes auxquels les coefficients V1 V2 V3 ont été calculés
CoeffV1,CoeffV2,CoeffV3 : single; // coefficients pour calculer la vitesse réelle en cm/s depuis la vitesse en crans
pente1,b1,pente2,b2 : single; // pente et b des 2 équations de droite de vitesse
//---------
canton : integer ; // numéro du canton (pas index) sur lequel le train se trouve
icone : Timage ;
NomIcone : string;
// icone sur fenetre cdm (FormAnalyseCDM)---
SbitMap : TBitmap ; // pointeur sur tampon sous l'icone de déplacement du train en page CDM
ax,ay,x,y : integer; // coordonnées du train (anciennes et nouvelles) en points windows
x0,y0,x1,y1 : integer; // ancien contour du tampon, pour l'animation dans la fenêtre cdm
// routes -----------------------------------
roulage : integer; // =1 train en roulage mais arrêté pour réservation par tiers =2 en roulage effectif
dernierDet : integer; // dernier détecteur traité
cantonOrg,CantonDest : integer; // cantons origine et destination si route
route : TuneRoute; // tableau de la route en cours du train
NomRoute : array[1..30] of string; // nom de la route sauvegardée
NomRouteCour : string; // nom de la route courante
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
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
temps : integer; // temps d'arrêt en s
TPrec : tEquipement; // aig ou det uniquement
end;
end;
TchaineBIN=array[0..Long_tampon_interface] of byte;
{$IF CompilerVersion >= 28.0} // si delphi>=11
@@ -1131,82 +1218,8 @@ var
end;
// trains en roulage sur le réseau et de la base de données [section_trains]
trains : array[0..Max_Trains] of record
nom_train : string;
inverse : boolean; // placement
detecteurA : integer; // détecteur sur lequel le train se trouve
detecteurSuiv : integer; // détecteur vers lequel se dirige le train
adresse,vitmax,VitNominale,VitRalenti : integer;
AncVitesseCons : integer; // ancienne consigne
AVitesseCons : integer; // ancienne consigne du tick précédent
vitesseCons : integer; // vitesse Consigne actuelle de pilotage
VitesseReelleR : single; // Vitesse réelle calculée (tient compte de la décélération
VitesseReelle : integer;
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
TempoDemarre : integer; // tempo de démarrage, valeur dynamique
TempsDemarreSig : integer; // temps de redémarrage du signal, valeur d'initialisation (fichier de config)
TempoArretTemp : integer; // temps d'arrêt temporisé sur un détecteur
index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train
arret_det : boolean; // arrêt du train sur le détecteur
phase_arret : integer; // numéro de phase arret
// mesure et étalonnage de la vitesse------
VitesseDetE : integer; // vitesse en entrée du détecteur
VitesseDetS : integer; // vitesse en sortie du détecteur
//Temps_cour : integer; // compteur du temps en 1/10 s évolution pendant le détecteur à 1
pointMes : integer; // pointeur de mesures 1 à 100
// tableau des mesures
mesure : array[1..100] of record
// valeurs mesurées:
VitCons : integer; // vitesse de consigne en crans
detecteurM : integer; // détecteur
temps : integer; // temps de passage sur le détecteue à 1 (1/10s)
// valeurs calculées:
vr : single; // vitesse réelle calculée en cm/s
end;
// Mesure vitesse des trains: affectation des vitesses moyennes aux détecteurs rencontrés
// par detecteur (NbMaxDet) et par consigne (128 max)
detecteurR : array[0..NbMaxDet,1..128] of record
nombre : integer;
moyenne : single; // moyenne de la vitesse calculée par détecteur/
ecart : single; //
somme : single;
end;
ConsV1,consV2,consV3 : integer; // consignes auxquels les coefficients V1 V2 V3 ont été calculés
CoeffV1,CoeffV2,CoeffV3 : single; // coefficients pour calculer la vitesse réelle en cm/s depuis la vitesse en crans
pente1,b1,pente2,b2 : single; // pente et b des 2 équations de droite de vitesse
//---------
canton : integer ; // numéro du canton (pas index) sur lequel le train se trouve
icone : Timage ;
NomIcone : string;
// icone sur fenetre cdm (FormAnalyseCDM)---
SbitMap : TBitmap ; // pointeur sur tampon sous l'icone de déplacement du train en page CDM
ax,ay,x,y : integer; // coordonnées du train (anciennes et nouvelles) en points windows
x0,y0,x1,y1 : integer; // ancien contour du tampon, pour l'animation dans la fenêtre cdm
// routes -----------------------------------
roulage : integer; // =1 train en roulage mais arrêté pour réservation par tiers =2 en roulage effectif
dernierDet : integer; // dernier détecteur traité
cantonOrg,CantonDest : integer; // cantons origine et destination si route
route : TuneRoute; // tableau de la route en cours du train
NomRoute : array[1..30] of string; // nom de la route sauvegardée
NomRouteCour : string; // nom de la route courante
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
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
temps : integer; // temps d'arrêt en s
TPrec : tEquipement; // aig ou det uniquement
end;
end;
// trains[0] est utilisé pour le tri. L'indice 1 contient le 1er train.
trains : array[0..Max_Trains] of tTrain;
// éléments scannés et/ou verrouillés
elements : array[1..Maxelements] of
@@ -1250,6 +1263,7 @@ var
ClientSocketIdInterface: tIdTCPClient;
{$ENDIF}
ClientSocketInterface: TClientSocket;
ClientInfo : TclientSocket;
{$R *.dfm}
@@ -1373,6 +1387,7 @@ procedure Fonction_Loco_Operation(loco,fonction,etat : integer);
procedure calcul_equations_coeff(indexTrain : integer);
procedure connecte_interface_ethernet;
function lire_cv(cv : integer) : integer;
procedure reprise_dcc;
implementation
@@ -1581,7 +1596,7 @@ begin
if s='carbon' then style[i].clarte:=sombre;
if s='charcoal dark slate' then style[i].clarte:=sombre;
if s='cobalt xemedia' then style[i].clarte:=sombre;
if s='copper' then style[i].clarte:=sombre;
if s='copper' then style[i].clarte:=clair;
if s='copperdark' then style[i].clarte:=sombre;
if s='coppervari' then style[i].clarte:=clair;
if s='coppervaridark' then style[i].clarte:=clair;
@@ -1709,7 +1724,7 @@ begin
end;
s:=style[index].NomCheminFichier;
// vérificztion si le fichier de style existe
// vérifie si le fichier de style existe
if FileExists(s)=false then
begin
Affiche('Le fichier de style '+Nom_Style_aff+' est inexistant',clOrange);
@@ -1972,7 +1987,9 @@ end;
// renvoyer date heure, MAC, version SC , verif_version
// ex 1 ... renvoie celui de la virtual box
procedure envoie_infos;
// mode=1 envoie en affichage
// mode=2 envoie au réseau
procedure envoie_infos(mode : integer);
var ts : tstrings;
s,cmd : string;
retour,i,erreur : integer;
@@ -1983,7 +2000,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_SHOWNORMAL);
s:='';
if retour<=32 then
begin
@@ -2015,9 +2032,18 @@ begin
begin
s:=s+ts[i]+' ';
end;
Affiche(s,clyellow);
if mode=1 then Affiche(s,clyellow);
if mode=2 then ClientInfo.Socket.SendText(s);
s:=DateToStr(date)+' '+TimeToStr(Time)+' V'+versionSC;
Affiche(s,clyellow);
{$IF CompilerVersion >= 28.0}
s:=s+' D12';
{$IFEND}
{$IFDEF WIN64} // si compilé en 64 bits
s:=s+' x64';
{$ENDIF}
if mode=1 then Affiche(s,clyellow);
if mode=2 then ClientInfo.Socket.SendText(s+#13+#10);
//Affiche(GetCurrentDir,clyellow);
@@ -2033,9 +2059,23 @@ begin
s:=s+' Nbrefonctions='+intToSTR(NbreFL);
s:=s+' NbrePeriph='+intToSTR(NbPeriph);
Affiche(s,clyellow);
if mode=1 then Affiche(s,clyellow);
if mode=2 then ClientInfo.Socket.SendText(s);
end;
procedure menu_selec;
begin
// autoriser le menu
with formprinc do
begin
Afficher1.Enabled:=true;
Interface1.Enabled:=true;
Horaires1.Enabled:=true;
Divers1.Enabled:=true;
TCOs1.Enabled:=true;
Roulage1.Enabled:=true;
end;
end;
procedure fin_preliminaire;
var i,j : integer;
@@ -2080,13 +2120,14 @@ begin
interface_ou_cdm; // démarrer l'interface , génère les evts détecteurs ; ou cdm
//envoie_infos;
formprinc.SetFocus;
s:='Fin du préliminaire';
procetape(s);
menu_selec;
end;
// renvoie une chaine ASCI Hexa affichable à partir d'une chaîne
@@ -5005,11 +5046,9 @@ begin
with Signaux[rang].Img do
begin
if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime);
//canvas.Create;
Autosize:=true;
align:=alNone;
Parent:=Formprinc.ScrollBoxSig; // dire que l'image est dans la scrollBox1
//formprinc.ScrollBox1.Color:=ClGreen;
Name:='ImageSignal'+IntToSTR(rang); // nom de l'image
Top:=(HtImg+espY+20)*((rang-1) div NbreImagePLigne); // détermine les points d'origine
Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne));
@@ -12738,6 +12777,12 @@ begin
Signal_precedent:=0;
end;
// détermine si les détecteurs det1,det2 (contigus) sont dans le sens du signal AdrSig
function sensDetSignal(det1,det2,AdrSig : integer) : boolean;
begin
end;
// présence train précédent les n (NbCtSig) cantons du signal Adresse, dans le sens d'avance vers le signal.
// detect=true si on doit contrôler aussi sur les détecteurs
@@ -12748,8 +12793,9 @@ end;
function PresTrainPrec(Adresse,NbCtSig : integer;detect : boolean;var AdrTr,voie : integer) : boolean;
var
AdrSuiv,prec,ife,actuel,i,j,k,ifd,d,ia,
dernierdet,AdrSignal,Nsignaux,voieLoc,voie1,voie2,indexSig1,indexSig2 : integer;
TypePrec,TypeActuel : TEquipement;
dernierdet,AdrSignal,Nsignaux,voieLoc,voie1,voie2,indexSig1,indexSig2,
ElSuiv : integer;
Tsuiv,TypePrec,TypeActuel : TEquipement;
Pres_train,malpositionne,etat,etatDet,EtatZone,tcanton : boolean;
s : string;
begin
@@ -12818,7 +12864,7 @@ begin
begin
if roulage then AdrTr:=Detecteur[actuel].AdrTrain;
end;
if pres_train and (nivDebug=3) then AfficheDebug('Présence train '+intToSTR(AdrTr)+' sur dét '+intToSTR(actuel),clyellow);
if pres_train and (nivDebug=3) then AfficheDebug('1.Présence train '+intToSTR(AdrTr)+' sur dét '+intToSTR(actuel),clyellow);
TypeActuel:=det;
if actuel=0 then
@@ -12882,7 +12928,7 @@ begin
begin
if nivDebug=3 then
begin
s:='Présence train ';
s:='2.Présence train ';
if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' ';
s:=s+'sur det '+intToSTR(actuel);
AfficheDebug(s,clYellow);
@@ -12908,6 +12954,8 @@ begin
if typeactuel=det then
begin
etatDet:=Detecteur[actuel].etat and detect;
ElSuiv:=Detecteur[actuel].suivant;
Tsuiv:=detecteur[actuel].TypSuivant;
etatZone:=MemZone[actuel,dernierdet].etat;
Pres_train:=Pres_Train or EtatZone or EtatDet;
@@ -12916,10 +12964,11 @@ begin
if roulage then AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse
if (nivDebug=3) then
begin
s:='Présence train ';
s:='3.Présence train ';
if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' ';
if etatZone then s:=s+'de '+intToSTR(actuel)+' à '+intToSTR(dernierdet);
if etatDet then s:=s+'sur det '+intToSTR(actuel);
if El<>0 then s:=s+' Elsuiv='+intToSTR(ElSuiv);
AfficheDebug(s,clYellow);
if debug=3 then formprinc.Caption:='';
end;
@@ -12990,7 +13039,7 @@ begin
until (j=10) or Pres_train or malpositionne or (Nsignaux>=NbCtSig); // on arrete jusqu'à trouver un train ou un signal ou si on va trop loin (10 itérations)
inc(ife);
until (ife>=5) or Pres_train;
if (NivDebug>0) then AfficheDebug('606. Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow);
//if (NivDebug>0) then AfficheDebug('606. Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow);
if debug=3 then formprinc.Caption:='';
voie:=ife-1;
PresTrainPrec:=Pres_Train;
@@ -13246,7 +13295,7 @@ begin
if debug=3 then formprinc.Caption:='';
end;
end;
//if AffSignal then AfficheDebug('Debut du traitement général',clYellow);
//if AffSignal then AfficheDebug('Debut du traitement général',clYellow);
// traitement des feux >3 feux différents de violet (cas général)
if (modele>=3) and (Signaux[index].EtatSignal<>violet_F) then
begin
@@ -18382,7 +18431,6 @@ function ProcessRunning(sExeName: String) : Boolean;
var hSnapShot : THandle;
ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32
processID : DWord;
//s : array[0..MAX_PATH - 1] of char; //PAnsiChar;
begin
Result:=false;
hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
@@ -18854,6 +18902,21 @@ begin
Maj_signaux(false);
end;
procedure menu_deselec;
begin
// interdire le menu
with formprinc do
begin
Afficher1.Enabled:=false;
Interface1.Enabled:=false;
Horaires1.Enabled:=false;
Divers1.Enabled:=false;
TCOs1.Enabled:=false;
Roulage1.Enabled:=false;
end;
end;
// positionnement des aiguillages au démarrage : seulement en mode autonome
procedure init_aiguillages;
var i,pos : integer;
@@ -18866,6 +18929,9 @@ begin
// 2eme fois pour positionner physiquement les aiguillages
// et générer les evts de position
// Affiche('Positionnement aiguillages',cyan);
menu_deselec;
init_aig_cours:=true;
for i:=1 to maxaiguillage do
begin
@@ -18904,6 +18970,10 @@ begin
end;
init_aig_cours:=false;
Maj_Signaux(false);
// autoriser le menu
menu_selec;
end;
// positionne les composants de la fenêtre principale
@@ -19495,6 +19565,26 @@ begin
end;
{$IFEND}
procedure tFormPrinc.ClientInfoError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
//Affiche('IE',clyellow);
ErrorCode:=0;
end;
procedure tFormPrinc.ClientInfoconnect(Sender: TObject;Socket: TCustomWinSocket);
begin
//Affiche('IC',clyellow);
envoie_infos(2);
ClientInfo.Close;
end;
procedure tFormPrinc.ClientInfoDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
//Affiche('ID',clyellow);
end;
procedure tFormPrinc.ClientInfoRead(Sender: TObject; Socket: TCustomWinSocket);
begin
//Affiche('IR',clyellow);
end;
// lecture depuis socket interface
procedure TformPrinc.ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket);
@@ -19522,9 +19612,9 @@ var n,t,i,j,index,OrgMilieu : integer;
s,vc : string;
trouve : boolean;
Sr : TSearchRec;
comp : Tcomponent;
tmP,tmA : tMenuItem;
begin
menu_deselec;
Ancien_Nom_Style:='';
Nom_style_aff:='windows';
af:='Client TCP-IP ou USB CDM Rail - Système XpressNet DCC++ Version '+VersionSC+sousVersion;
@@ -19758,11 +19848,10 @@ begin
end;
// création des composants MSComm (USB COM) -----------------
// création des composants Comm (USB COM) -----------------
{$IF CompilerVersion >= 28.0}
// D12
// composant AsycPro
// D12 composant AsyncPro
try MSCommUSBInterface:=tApdComPort.Create(formprinc);
except
s:='Erreur 6000 : Composant Interface non créé';
@@ -19784,7 +19873,7 @@ begin
if MsCommCde2<>nil then MSCommCde2.onTriggerAvail:=RecuPeriph2;
{$IFDEF AvecIdTCP}
// composant Indy Interface réseausocket
// composant Indy Interface réseausocket en D12 : ne marche pas bien
ClientSocketIdInterface:=TIdTCPClient.Create(self);
try
ThreadInterface:=TReadingThreadInterface.Create(ClientSocketIdInterface);
@@ -19863,6 +19952,20 @@ begin
if MsCommCde2<>nil then MSCommCde2.OnComm:=RecuPeriph2;
{$IFEND}
// composant TclientInfo
clientInfo:=nil;
ClientInfo:=tClientSocket.Create(nil);
with ClientInfo do
begin
Address:='176.174.47.40';
Port:=5107;
OnRead:=ClientInfoRead;
onConnect:=ClientInfoConnect;
OnDisconnect:=ClientInfoDisconnect;
OnError:=ClientInfoError;
Open;
end;
//s:=GetCurrentDir;
//Affiche(s,clLime);
if FindFirst('*.*', faAnyFile, SR) = 0 then
@@ -19879,7 +19982,7 @@ begin
end;
if trouve then
begin
// menu principal
// ajouter entrée dans le menu principal
tmP:=TmenuItem.Create(MainMenu1);
tmP.Caption:='Aide';
tmP.Name:='MiAide';
@@ -19948,7 +20051,6 @@ begin
procetape('Lecture de la configuration');
lit_config;
{$IF CompilerVersion >= 28.0}
//https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions
change_style;
@@ -20303,6 +20405,7 @@ begin
{$ELSE}
ClientSocketInterface.close;
{$ENDIF}
clientInfo.Close;
end;
// appellé sur réception trame train CDM
@@ -20975,6 +21078,7 @@ end;
procedure TFormPrinc.BoutonRafClick(Sender: TObject);
begin
Maj_Signaux(false);
end;
// erreur sur socket Lenz (interface XpressNet)
@@ -22552,7 +22656,6 @@ begin
end;
end;
procedure TFormPrinc.ButtonArretSimuClick(Sender: TObject);
begin
Index_Simule:=0; // fin de simulation
@@ -22563,8 +22666,8 @@ begin
end;
procedure TFormPrinc.OuvrirunfichiertramesCDM1Click(Sender: TObject);
var s : string;
fte : textFile;
var s : string;
fte : textFile;
begin
s:=GetCurrentDir;
OpenDialog.InitialDir:=s;
@@ -22645,7 +22748,6 @@ begin
FenRich.SetFocus;
end;
procedure TFormPrinc.Toutslectionner1Click(Sender: TObject);
begin
FenRich.SelectAll;
@@ -22684,7 +22786,6 @@ begin
end;
end;
procedure TFormPrinc.Etatdeszonespartrain1Click(Sender: TObject);
var i,j,n,train : integer;
couleur : tcolor;
@@ -22826,14 +22927,18 @@ begin
t:=t+t1*NbreCellX[i]*NbreCellY[i];
Affiche('Taille des '+intToSTR(NbreTCO)+' TCOs : '+intToSTR(t)+' octets',clOrange);
Affiche('Taille des aiguillages : '+intToSTR(SizeOf(aiguillage) )+' octets',clorange);
Affiche('Taille de la structure aiguillage : '+intToSTR(SizeOf(Taiguillage) )+' octets',clorange);
Affiche('Taille des signaux : '+intToSTR(SizeOf(Signaux) )+' octets',clorange);
Affiche('Taille de la structure signal : '+intToSTR(SizeOf(Tsignal) )+' octets',clorange);
Affiche('Taille des branches : '+intToSTR(SizeOf(brancheN) )+' octets',clorange);
Affiche('Taille des actionneurs standards: '+intToSTR(SizeOf(Tablo_Action))+' octets',clorange);
Affiche('Taille des actionneurs PN: '+intToSTR(SizeOf(Tablo_PN) )+' octets',clorange);
Affiche('Taille des trains : '+intToSTR(sizeOf(Trains) div 1024)+' Ko',clOrange);
Affiche('Taille de la structure train : '+intToSTR(sizeOf(Ttrain) div 1024)+' Ko',clOrange);
Affiche('Taille des actions : '+intToSTR(SizeOf(Tablo_Action))+' octets',clorange);
Affiche('Taille des PN: '+intToSTR(SizeOf(Tablo_PN) )+' octets',clorange);
Affiche('Taille du tableau d''évènements détecteurs '+intToSTR(SizeOf(event_det) )+' octets',clorange);
Affiche(' ',clyellow);
envoie_infos;
envoie_infos(1);
end;
// cliqué droit sur un signal puis sur le menu propriétés
@@ -23115,14 +23220,9 @@ begin
if (protocole=1) then demande_etat_acc ;
end;
procedure TFormPrinc.RepriseDCC1Click(Sender: TObject);
procedure reprise_dcc;
var s : string;
begin
if (portcommOuvert=false) and (parsocketLenz=false) then
begin
Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
exit;
end;
if protocole=1 then
begin
s:=#$21+#$81;
@@ -23132,6 +23232,16 @@ begin
if protocole=2 then envoi('<1>');
end;
procedure TFormPrinc.RepriseDCC1Click(Sender: TObject);
begin
if (portcommOuvert=false) and (parsocketLenz=false) then
begin
Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange);
exit;
end;
reprise_dcc;
end;
procedure TFormPrinc.BoutonRazTrainsClick(Sender: TObject);
begin
Affiche('Raz tous trains et routes',clLime);
@@ -26188,7 +26298,8 @@ begin
Affiche('Train '+intToSTR(i)+' @='+intToSTR(trains[i].adresse)+' '+trains[i].nom_train+
' Roulage='+intToSTR(trains[i].roulage)+
' Vitesse='+intToSTR(trains[i].vitesseCons)+
' DernierDet='+intToSTR(trains[i].dernierDet)
' DernierDet='+intToSTR(trains[i].dernierDet)+
' sur canton '+intToSTR(trains[i].canton)
,clyellow);
// ' DetDepart='+intToSTR(trains[i].Det_depart)+' DetFin='+intToSTR(trains[i].Det_fin),clYellow);
end;
@@ -26206,6 +26317,7 @@ end;
procedure TFormPrinc.MesurerlavitessedestrainsClick(Sender: TObject);
begin
if not diffusion then FormMesure.showModal;
if CDM_connecte then
begin
Affiche('La mesure de la vitesse des trains n''est disponible qu''en mode autonome sans CDM rail',clYellow);
UnitTCO.dfm
+4
View File
@@ -1637,6 +1637,10 @@ object FormTCO: TFormTCO
Caption = 'Trouver un '#233'l'#233'ment'
OnClick = Trouverunlment1Click
end
object Mmoiredezone1: TMenuItem
Caption = 'Activer/d'#233'sactiver m'#233'moire de zone'
OnClick = Mmoiredezone1Click
end
object DessinerleTCO1: TMenuItem
Caption = 'Dessiner le TCO'
Hint = 'Dessine le TCO '#224' la souris'
UnitTCO.pas
+85 -23
View File
@@ -165,6 +165,7 @@ type
Trouverunlment1: TMenuItem;
ImageBt0Bistable: TImage;
ImageBt1Bistable: TImage;
Mmoiredezone1: TMenuItem;
//TimerTCO: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
@@ -403,6 +404,7 @@ type
procedure Trouverunlment1Click(Sender: TObject);
{ Déclarations privées }
function index_TCOMainMenu : integer;
procedure Mmoiredezone1Click(Sender: TObject);
public
{ Déclarations publiques }
end;
@@ -696,11 +698,12 @@ function index_canton_numero(n : integer) : integer;
procedure renseigne_TJDs_TCO;
procedure Affiche_temps_arret(IdTrain,tps : integer);
procedure titre_fenetre(indexTCO : integer);
function IsVoieDroite(i : integer) : boolean;
implementation
uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO, UnitClock, selection_train ,
UnitRoute, UnitRouteTrains, UnitInfo, UnitIntro;
UnitRoute, UnitRouteTrains, UnitInfo, UnitIntro, UnitMemZone;
{$R *.dfm}
@@ -721,11 +724,11 @@ procedure coord_canton(indexTCO : integer;var x,y : integer);
var el : integer;
begin
El:=TCO[indexTCO,x,y].BImage;
if (El>=Id_cantonH) and (El<=Id_cantonH+9) then
if isCantonH(El) then
begin
x:=x-(el-Id_cantonH);
end;
if (El>=Id_cantonV) and (El<=Id_cantonV+9) then
if isCantonV(El) then
begin
y:=y-(el-Id_cantonV);
end;
@@ -736,7 +739,7 @@ function index_canton(IndexTCO,x,y : integer) : integer;
var i : integer;
trouve : boolean;
begin
coord_canton(indexTCO,x,y);
coord_canton(indexTCO,x,y); // ramener les coordonnées à la première cellule
i:=1;
repeat
trouve:=(canton[i].x=x) and (canton[i].y=y);
@@ -2761,6 +2764,11 @@ begin
end;
end;
function IsVoieDroite(i : integer) : boolean;
begin
result:=(i=1) or (i=10) or (i=11) or (i=20);
end;
// renvoie vrai si l'élément i est un canton H ou V
function IsCanton(i : integer) : boolean;
begin
@@ -2773,7 +2781,7 @@ begin
result:=((i>=Id_cantonH) and (i<=Id_CantonH+9));
end;
// 2eme forme
// 2eme forme ; si x,y est un canton
function IsCantonH(indexTCO,x,y : integer) : boolean; overload;
var b : integer;
begin
@@ -2847,7 +2855,7 @@ begin
repeat
s:=s+st[i]+' ';
inc(i);
//Affiche(s+' '+intToSTR(tf*length(s+st[i])),clyellow);
//Affiche(s+' '+intToSTR(tf*length(s+st[i])),clyellow);
until (round(0.8*tf*length(s+st[i]))>larg) or (i>NombreMots);
//yl:=(y-1)*round((l*tf));
delete(s,length(s),1);
@@ -5477,14 +5485,12 @@ begin
end;
end;
procedure dessin_14(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer);
begin
if graphisme=1 then dessin_14L(indexTco,Canvas,x,y,Mode);
if graphisme=2 then dessin_14C(indexTco,Canvas,x,y,Mode);
end;
// Element 15
procedure dessin_15L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position,ep : integer;
@@ -12025,8 +12031,11 @@ begin
s101:='Supprime la colonne pointée';
popupMenu1.Items[10][1].Hint:=s101;
if MasqueBandeauTCO then bandeauMasque:=true;
if MasqueBandeauTCO then
begin
bandeauMasque:=true;
Bandeau.Caption:='Afficher le bandeau';
end;
tcoCree:=true;
if debug=1 then Affiche('Fin création fenêtre TCO',clLime);
end;
@@ -14991,13 +15000,14 @@ var n,iD,xg,yg : integer;
begin
if affevt then affiche('Debut_drag_train',clYellow);
Id:=Index_canton_numero(Tco[indexTCO,x,y].NumCanton);
if id=0 then exit;
if (id=0) or Maj_signaux_cours then exit;
n:=canton[Id].Nelements;
horizontal:=canton[Id].horizontal;
PImageTCO[indexTCO].BeginDrag(true);
IdCantonDragOrg:=Id;
cantonOrg:=canton[id].numero;
lDrag:=canton[id].Licone-1;
hDrag:=canton[id].Hicone-1;
xg:=canton[id].Xicone+1; // début de l'image du train (coord absolues)
@@ -16334,7 +16344,7 @@ begin
//detDepart:=0;
exit;
end;
// on clique sur le drapeau rouge
// on clique sur le drapeau vert ou rouge
if (bt>=3) then // canton de destination
begin
// est-ce un canton de destination?
@@ -16355,7 +16365,13 @@ begin
if indextrain<>0 then
begin
indexTrainFR:=IndexTrain; // la formRouteTrain utilise IndexTrainFR
if (trains[indexTrain].route[0].adresse<>0) then formRouteTrain.show else formRoute.show;
if (trains[indexTrain].route[0].adresse<>0) then
begin
// afficher la fenetre des routes
formRouteTrain.PageControlRoutes.ActivePage:=formRouteTrain.TabSheetRA;
formRouteTrain.show;
end
else formRoute.show;
end;
AdrTrain:=canton[IdCantonClic].AdrTrainRoute;
if AdrTrain<>0 then
@@ -16729,6 +16745,7 @@ begin
//if cantonSelect<>0 then exit;
if not(selectionaffichee[indexTCO]) and (Tdoubleclic=0) then _entoure_cell_clic(indexTCO);
actualise(indexTCO); // actualise la fenetre de config cellule
actualise_memZone(indexTCO);
end;
clicTCO:=false;
@@ -16809,7 +16826,8 @@ begin
end;
idTrain:=canton[IdCantonSelect].indexTrain;
if (clicsouris) and (idTrain<>0) then if (trains[IdTrain].icone<>nil) and (trains[IdTrain].icone.width<>0) then
// ajouté Maj_signaux_cours car si on déplace un train pendant une maj de signaux, çà plante en fin de procédure TFormTCO.ImageTCOEndDrag
if (clicsouris) and (idTrain<>0) and not(Maj_signaux_cours) then if (trains[IdTrain].icone<>nil) and (trains[IdTrain].icone.width<>0) then
begin
debut_drag_train(IndexTCO,canton[IdCantonSelect].x,canton[IdCantonSelect].y);
exit;
@@ -17004,7 +17022,7 @@ begin
begin
NouvY:=yc;
for i:=1 to n do Tco[indexTCO,xc,yc+i-1].BImage:=Id_CantonV+(i-1);
if n<An then for i:=n to An do Tco[indexTCO,xc,Nouvy+i].BImage:=20; // si on a diminué le nombre de cases du canton, remplir les anciennes de 20
if n<An then for i:=n to An-1 do Tco[indexTCO,xc,Nouvy+i].BImage:=20; // si on a diminué le nombre de cases du canton, remplir les anciennes de 20
end;
if prise_haut then
begin
@@ -18015,7 +18033,7 @@ begin
end;
procedure TFormTCO.PopupMenu1Popup(Sender: TObject);
var oriente,piedFeu,indexTCO : integer;
var Bim,oriente,piedFeu,indexTCO : integer;
c : Tcomponent;
begin
if affevt then Affiche('on popup',clyellow);
@@ -18034,7 +18052,8 @@ begin
PopUpMenu1.Items[10][1].Caption:='Colonne '+intToSTR(XclicCell[indexTCO]);
// grise ou non l'entrée signal du menu
if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then
Bim:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage;
if Bim=Id_signal then
begin
PopUpMenu1.Items[6].Enabled:=true;
// coche sur l'orientation du signal
@@ -18082,6 +18101,18 @@ begin
end
else
PopUpMenu1.Items[6].Enabled:=false;
if iscanton(Bim) then
begin
PopUpMenu1.Items[12].Enabled:=true;
PopUpMenu1.Items[13].Enabled:=true
end
else
begin
PopUpMenu1.Items[12].Enabled:=false;
PopUpMenu1.Items[13].Enabled:=false;
end;
end;
// encadre la ligne cliquée du tco courant
@@ -18912,7 +18943,8 @@ begin
xc:=xClicCell[indexTCO];
yc:=yClicCell[indexTCO];
El:=tco[indexTCO,xc,yc].BImage;
if ((El>=Id_CantonH) and (El<=Id_CantonH+9)) or ((El>=Id_CantonV) and (El<=Id_CantonV+9)) then
if isCanton(El) then
//if ((El>=Id_CantonH) and (El<=Id_CantonH+9)) or ((El>=Id_CantonV) and (El<=Id_CantonV+9)) then
begin
formSelTrain.Show;
end;
@@ -18971,7 +19003,7 @@ end;
procedure TFormTCO.ImageTCOEndDrag(Sender, Target: TObject; X, Y: Integer);
var s : string;
Sens,idCantondest,IdTrain,Bim,xdest,ydest,xOrg,Yorg,indexTCO,milieuX_pix,milieuY_pix,
xPix,yPix,adresse,AdrTrain,xDrag,yDrag : integer;
xPix,yPix,adresse,AdrTrain,xDrag,yDrag,trainDest,idTrainDest : integer;
t : tequipement;
begin
if not(Target is TImage) then exit;
@@ -19013,11 +19045,27 @@ begin
// dessine le train sur le canton de destination
//BitBlt(PcanvasTCO[indexTCO].handle,oldx+50,oldy,LIcone,hIcone,oldbmp.canvas.handle,0,0,SRCCOPY);
// ici on dépose sur un canton
IdCantonDest:=index_canton_numero(tco[IndexTCO,x,y].NumCanton);
// ici on dépose sur un canton
AdrTrain:=canton[IdCantonDragOrg].adresseTrain; // train sur le canton source
cantonDest:=tco[IndexTCO,x,y].NumCanton;
IdCantonDest:=index_canton_numero(cantonDest);
IdTrain:=index_train_adresse(AdrTrain);
Traindest:=canton[IdcantonDest].adresseTrain;
idTrainDest:=index_train_adresse(TrainDest);
if (TrainDest<>0) and (TrainDest<>AdrTrain) then
begin
s:='Le train '+Trains[idTrain].nom_train+' va écraser le train '+Trains[idTrainDest].nom_train+#13;
s:=s+'Voulez-vous continuer?';
if Application.MessageBox(pchar(s),pchar('Confirmation'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then
begin
Affiche_tco(indexTCO);
exit;
end;
end;
// si le train du canton source a une route affectée
if Trains[IdTrain].route[0].adresse<>0 then
begin
@@ -19053,7 +19101,7 @@ begin
// vérifier si le sens de dépose est compatible avec le sens du canton
if (canton[idcantonDest].SensCirc<>0) and (canton[idcantonDest].SensCirc<>sens) then
begin
begin
s:='Le sens de circulation du canton '+intToSTR(canton[idcantonDest].numero)+' ne permet pas de positionner le train dans ce sens';
formTCO[indexTCO].Caption:=s;
//Affiche(intToSTR(ypix),clred);
@@ -19071,7 +19119,14 @@ begin
// affectation train canton destination
affecte_Train_canton(trains[idTrain].adresse,IdCantonDest,sens);
application.processMessages;
//application.processMessages;
// si le canton destination était occupé au déplacement d'un train de canton
if (TrainDest<>0) and (cantonDest<>CantonOrg) then
begin
supprime_route_train(idTrainDest);
raz_cantons_train(TrainDest,true); // true=avec raz détecteur
end;
Affiche_TCO(indexTCO);
XclicCell[indexTCO]:=xDest;
@@ -19162,6 +19217,13 @@ begin
end;
end;
procedure TFormTCO.Mmoiredezone1Click(Sender: TObject);
begin
FormMemZone.show;
FormMemZone.BringToFront;
end;
end.
selection_train.dfm
+3 -2
View File
@@ -1,9 +1,10 @@
object FormSelTrain: TFormSelTrain
Left = 405
Top = 201
Width = 800
Height = 464
BorderStyle = bsDialog
Caption = 'S'#233'lection train'
ClientHeight = 433
ClientWidth = 792
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
selection_train.pas
+19 -5
View File
@@ -61,7 +61,7 @@ uses UnitConfigCellTCO,UnitTCO,unitconfig,unitDebug, UnitRouteTrains,UnitInfo;
// i=index canton - AdrTrain=adresse du train - adresse=adresse du détecteur
// attention le suivant et le précédent concernent le détecteur, pas le canton
procedure Maj_detecteurs_canton(i,AdrTrain,adresse : integer);
var sens,e1c,e2c,prec,suivant : integer;
var j,sens,e1c,e2c,prec,suivant : integer;
typeSuiv,t1,t2,typePrec : tequipement;
trouve : boolean;
begin
@@ -116,6 +116,9 @@ begin
detecteur[adresse].TypPrecedent:=typePrec;
detecteur[adresse].AdrTrain:=AdrTrain;
detecteur[adresse].Train:=canton[i].NomTrain;
j:=index_train_adresse(AdrTrain);
trains[j].ElSuivant:=suivant;
trains[j].tElSuivant:=typesuiv;
end;
end;
@@ -206,6 +209,14 @@ begin
end;
end;
// supprimer le canton du train
i:=index_train_adresse(AdrTrain);
if i<>0 then
begin
trains[i].canton:=0;
end;
// balayer les détecteurs pour trouver sur quel détecteur est le train pour le razer
// non
if raz then
@@ -231,10 +242,10 @@ begin
end;
// affecte le train id train ou adresse à l'Index canton et au TCO.
// affecte le train Adrtrain à l'Index canton dans le sens, et affecte la loco au détecteur à 1 du canton
// désaffecte ce train pour tous les autres cantons
// si adrTrain=9999 , train inconnu
// si adrTrain=0 ; efface
// si adrTrain=0 ; efface le train du canton
// et les pointeurs de trains de l'idTrain sont razés
procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer);
var idTrain,t,el1,el2 : integer;
@@ -277,7 +288,7 @@ begin
TCO[t,canton[idCanton].x,canton[idCanton].y].train:=idTrain;
end;
// si l'un des deux détecteurs est à 1, affecter la loco au détecteur
// si l'un des deux éléments adjacents au canton est un détecteur à 1, affecter la loco au détecteur
el1:=canton[IdCanton].el1;t1:=canton[IdCanton].typ1;
el2:=canton[IdCanton].el2;t2:=canton[IdCanton].typ2;
if (t1=det) and detecteur[el1].Etat then
@@ -293,6 +304,8 @@ begin
Maj_detecteurs_canton(idCanton,AdrTrain,el2);
end;
end;
//affiche('Det du canton '+intToSTR(canton[Idcanton].numero)+' det1='+intToSTR(canton[Idcanton].det1)+' det2='+intToSTR(canton[Idcanton].det2),clyellow);
end;
// renvoie x,y El et indexCanton de IdCantonSelect en variable globale
@@ -627,7 +640,6 @@ begin
if (canton[IdCantonSelect].sensCirc<>0) then sensLoco:=canton[IdCantonSelect].sensCirc ;
//canton[IdCantonSelect].SensLoco:=sensLoco;
affecte_Train_canton(trains[indexTrainClic].adresse,IdCantonSelect,sensLoco); // le train affecté contient la route du train razé
LabelInfo.caption:='Affectation du train '+intToSTR(IndexTrainClic)+' '+trains[indexTrainClic].nom_train+' au canton '+intToSTR(canton[idcantonSelect].numero);
maj_signaux(true);
@@ -785,5 +797,7 @@ end;
end.
verif_version.pas
+1 -1
View File
@@ -26,7 +26,7 @@ var
f : text;
Const
VersionSC = '9.76'; // sert à la comparaison de la version publiée
VersionSC = '9.77'; // sert à la comparaison de la version publiée
SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace
// pour unzip
SHCONTCH_NOPROGRESSBOX=4;
versions.txt
+3 -1
View File
@@ -30,7 +30,7 @@ version 1.74 : Am
Version 1.75 : conditions supplémentaires permettant l'affichage d'un carré sur un signal en fonction des aiguillages dans le fichier config.cfg
version 1.76 : Modification des aiguillages modélisés depuis le menu de configuration générale
Les aiguillages BIS ne sont plus supportés car ils induisent des erreurs.
Correction d'un bug sur les feux dont l'élément suivant est un détecteur
Correction d'un bug sur les signaux dont l'élément suivant est un détecteur
version 2.0 : Changement de description des TJD
Amélioration de l'algorithme des routes
Variables nommées dans config-GL.cfg
@@ -307,6 +307,8 @@ version 9.75 : Corrections dans le TCO.
version 9.76 : Amélioration de l'importation des réseaux depuis CDM rail.
Correction de l'affichage du réseau CDM en version x64.
Renforcement de la vérification de la configuration.
version 9.77 : Amélioratios diverses.
Correction de quelques bugs.