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

V7.0B

Browse Source
This commit is contained in:
f1iwq2
2023-08-01 21:32:15 +02:00
parent c688f36e4e
commit 1b54657c0c
14 changed files with 662 additions and 323 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ConfigGenerale.cfg
+14 -4
View File
@@ -1,4 +1,4 @@
/ Fichier de configuration de signaux_complexes_GL version 6.1
/ Fichier de configuration de signaux_complexes_GL version 7.0
AvecVerifIconesTCO=1
Algo_localisation=1
Avec_roulage=1
@@ -9,7 +9,7 @@ Fonte=10
Protocole=1
Verif_AdrXpressNet=1
IpV4_PC=127.0.0.1:9999
ServicesCDM=7
ServicesCDM=15
Ipv4_interface=192.168.1.23:5550
MaxCom=30
Protocole_serie=COMX:115200,N,8,1,0
@@ -23,9 +23,9 @@ Init_demUSBCOM=0
Init_demETH=0
Fenetre=0
nb_det_dist=3
verif_version=1
verif_version=0
notif_version=0
TCO=1
TCO=0
MasqueBandeauTCO=0
CDM=0
Lay=RESEAU_GILY_SIGNAL_AJOUTE.LAY
@@ -90,6 +90,16 @@ A6,516,0
A31,A34,0
0
/------------
[section_decodeurs]
Personnalisé 1
NombreAdresses=4
Nation=1
1,2,0,1,2
3,4,1,1,2
5,9,2,1,2
10,11,3,1,2
0
/------------
[section_sig]
176,7,0,1,(520,A20),1,FVC0,FRC0
190,7,0,1,(523,526),0,FVC0,FRC0
Importation.dfm
+102
View File
@@ -0,0 +1,102 @@
object FormImportation: TFormImportation
Left = 314
Top = 286
Width = 610
Height = 214
Caption = 'Compilation'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ButtonCompiler: TButton
Left = 160
Top = 144
Width = 75
Height = 25
Caption = 'Compiler'
TabOrder = 0
OnClick = ButtonCompilerClick
end
object GroupBox2: TGroupBox
Left = 8
Top = 10
Width = 169
Height = 119
Caption = 'Strat'#233'gies de compilation'
TabOrder = 1
object CheckDebugAnalyse: TCheckBox
Left = 8
Top = 32
Width = 113
Height = 17
Caption = 'Debug importation'
TabOrder = 0
OnClick = CheckDebugAnalyseClick
end
object CheckDebugBranches: TCheckBox
Left = 8
Top = 56
Width = 97
Height = 17
Caption = 'Debug branches'
TabOrder = 1
OnClick = CheckDebugBranchesClick
end
end
object GroupBox3: TGroupBox
Left = 198
Top = 10
Width = 377
Height = 119
Caption = 'Param'#232'tres'
TabOrder = 2
object RadioGroup1: TRadioGroup
Left = 8
Top = 24
Width = 281
Height = 65
Caption = 'Adressage des croisements'
TabOrder = 0
end
object RadioCroisSuite: TRadioButton
Left = 24
Top = 40
Width = 217
Height = 17
Caption = 'Croisements '#224' la suite des aiguillages'
TabOrder = 1
end
object RadioCroisBase: TRadioButton
Left = 24
Top = 56
Width = 217
Height = 17
Caption = 'Croisements '#224' partir de l'#39'adresse de base'
TabOrder = 2
end
object EditBaseCrois: TEdit
Left = 240
Top = 54
Width = 33
Height = 21
TabOrder = 3
Text = '100'
OnChange = EditBaseCroisChange
end
end
object ButtonAnnuler: TButton
Left = 264
Top = 144
Width = 75
Height = 25
Caption = 'Annuler'
TabOrder = 3
OnClick = ButtonAnnulerClick
end
end
Importation.pas
+79
View File
@@ -0,0 +1,79 @@
unit Importation;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TFormImportation = class(TForm)
ButtonCompiler: TButton;
GroupBox2: TGroupBox;
CheckDebugAnalyse: TCheckBox;
CheckDebugBranches: TCheckBox;
GroupBox3: TGroupBox;
RadioGroup1: TRadioGroup;
RadioCroisSuite: TRadioButton;
RadioCroisBase: TRadioButton;
EditBaseCrois: TEdit;
ButtonAnnuler: TButton;
procedure ButtonCompilerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckDebugAnalyseClick(Sender: TObject);
procedure CheckDebugBranchesClick(Sender: TObject);
procedure EditBaseCroisChange(Sender: TObject);
procedure ButtonAnnulerClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormImportation: TFormImportation;
BaseCroisement : integer;
debugAnalyse,debugBranche,coloration_diff,faireImport : boolean;
implementation
{$R *.dfm}
procedure TFormImportation.ButtonCompilerClick(Sender: TObject);
begin
faireImport:=true;
close;
end;
procedure TFormImportation.FormCreate(Sender: TObject);
begin
radioCroisBase.Checked:=true;
radioCroisSuite.checked:=false;
BaseCroisement:=100;
EditBaseCrois.Text:=IntToSTR(BaseCroisement);
end;
procedure TFormImportation.CheckDebugAnalyseClick(Sender: TObject);
begin
debugAnalyse:=checkDebugAnalyse.checked;
end;
procedure TFormImportation.CheckDebugBranchesClick(Sender: TObject);
begin
debugBranche:=checkDebugBranches.checked;
end;
procedure TFormImportation.EditBaseCroisChange(Sender: TObject);
var i,erreur : integer;
begin
val(editBaseCrois.text,i,erreur);
if erreur=0 then BaseCroisement:=i;
end;
procedure TFormImportation.ButtonAnnulerClick(Sender: TObject);
begin
faireImport:=false;
close;
end;
end.
Notice d'utilisation des signaux_complexes_GL_V7.0.pdf
BIN
View File
Binary file not shown.
Signaux_complexes_GL.cfg
+2 -2
View File
@@ -14,8 +14,8 @@
-$N+
-$O-
-$P+
-$Q+
-$R+
-$Q-
-$R-
-$S-
-$T-
-$U-
Signaux_complexes_GL.dof
+2 -2
View File
@@ -17,8 +17,8 @@ M=0
N=1
O=0
P=1
Q=1
R=1
Q=0
R=0
S=0
T=0
U=0
UnitAnalyseSegCDM.pas
+3 -4
View File
@@ -1265,7 +1265,7 @@ end;
procedure peindre(Indextrain,x,y : integer;Zoom : single);
var
XFormScale,XFormRot,XFormXLat,XForm,XFormOld : TXForm; // matrice
GMode,x0,y0,x1,y1,x2,y2,x3,y3,c1,c2,larg,haut,ax,ay,l2,h2 : Integer;
GMode,x0,y0,x1,y1,x2,y2,x3,y3,larg,haut,ax,ay,l2,h2 : Integer;
d,alpha,angle,z : double;
sinA,cosA : extended;
tv : array[0..3] of integer;
@@ -3328,7 +3328,6 @@ end;
// compile le fichier Texte de CDM et l'importe
procedure Compilation;
var s : string;
var s : string;
nombre,position : integer;
begin
@@ -3377,7 +3376,7 @@ begin
begin
//affiche(s,clred);
compile_periph;
end;
end;
inc(nligne);
until (nligne>nombre);
//Affiche('fin de la compilation',cllime);
@@ -3388,7 +3387,7 @@ begin
formAnalyseCDM.Show;
formprinc.ButtonAffAnalyseCDM.Visible:=true;
Affiche('Compilation terminée. Nombre de segments='+intToSTR(nSeg),clWhite);
remplit_Aig_cdm;
Affiche('nombre d''aiguillages: '+intToSTR(Naig_cdm),clyellow);
UnitConfig.dfm
+51 -13
View File
@@ -1571,7 +1571,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 633
Height = 497
ActivePage = TabSheetDecodeurs
ActivePage = TabSheetSig
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
@@ -3007,9 +3007,9 @@ object FormConfig: TFormConfig
end
object GroupBox12: TGroupBox
Left = 336
Top = 32
Width = 281
Height = 441
Top = 24
Width = 289
Height = 449
Caption = 'Description du signal'
TabOrder = 0
object ImageSignal: TImage
@@ -3054,12 +3054,17 @@ object FormConfig: TFormConfig
end
object Label17: TLabel
Left = 8
Top = 315
Width = 228
Height = 26
Top = 326
Width = 131
Height = 39
Hint =
'Permet d'#39'afficher un carr'#233' si les aiguillages sont dans les posi' +
'tions d'#233'crites ci dessous'
Caption =
'Conditions suppl'#233'mentaires d'#39'affichage du carr'#233' par les aiguilla' +
'ges :'
ParentShowHint = False
ShowHint = True
WordWrap = True
end
object Label24: TLabel
@@ -3142,12 +3147,31 @@ object FormConfig: TFormConfig
Font.Style = []
ParentFont = False
end
object Label69: TLabel
Left = 152
Top = 328
Width = 122
Height = 39
Hint =
'Permet d'#39'afficher un feu blanc si les aiguillages sont dans les ' +
'positions d'#233'crites ci dessous, si le signal ne doit pas afficher' +
' de rouge'
Caption = 'Conditions d'#39'affichage du feu blanc par les aiguillages:'
ParentShowHint = False
ShowHint = True
WordWrap = True
end
object MemoCarre: TMemo
Left = 8
Top = 344
Width = 265
Height = 89
Top = 368
Width = 137
Height = 73
Hint =
'Une ligne contient les conditions en ET. Les lignes sont cha'#238'n'#233'e' +
's en OU'
ParentShowHint = False
ScrollBars = ssBoth
ShowHint = True
TabOrder = 12
WordWrap = False
OnChange = MemoCarreChange
@@ -3158,7 +3182,7 @@ object FormConfig: TFormConfig
Width = 129
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 1
OnChange = ComboBoxDecChange
end
@@ -3262,7 +3286,7 @@ object FormConfig: TFormConfig
Width = 129
Height = 21
Style = csDropDownList
ItemHeight = 0
ItemHeight = 13
TabOrder = 2
OnChange = ComboBoxAspChange
end
@@ -3354,6 +3378,20 @@ object FormConfig: TFormConfig
TabOrder = 20
OnClick = CheckBoxContreVoieClick
end
object MemoBlanc: TMemo
Left = 152
Top = 368
Width = 129
Height = 73
Hint =
'Une ligne contient les conditions en ET. Les lignes sont cha'#238'n'#233'e' +
's en OU'
ParentShowHint = False
ScrollBars = ssBoth
ShowHint = True
TabOrder = 21
OnChange = MemoBlancChange
end
end
object RichSig: TRichEdit
Left = 0
@@ -3536,7 +3574,7 @@ object FormConfig: TFormConfig
Top = 56
Width = 193
Height = 21
ItemHeight = 13
ItemHeight = 0
TabOrder = 0
OnChange = ComboBoxDecodeurPersoChange
end
UnitConfig.pas
+271 -84
View File
@@ -356,6 +356,8 @@ type
ButtonSup: TButton;
Label68: TLabel;
LabelNbDecPers: TLabel;
MemoBlanc: TMemo;
Label69: TLabel;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -527,6 +529,7 @@ type
procedure ComboBoxDecodeurPersoChange(Sender: TObject);
procedure ButtonSupClick(Sender: TObject);
procedure ComboBoxNationChange(Sender: TObject);
procedure MemoBlancChange(Sender: TObject);
private
{ Déclarations privées }
public
@@ -578,6 +581,9 @@ EnvAigDccpp_ch='EnvAigDccpp';
AdrBaseDetDccpp_ch='AdrBaseDetDccpp';
AvecVerifIconesTCO_ch='AvecVerifIconesTCO';
NomModuleCDM_ch='NomModuleCDM';
Nba_ch='NombreAdresses';
nation_ch='Nation';
nom_dec_pers_ch='Nom_dec_pers';
// sections de config
section_aig_ch='[section_aig]';
@@ -589,8 +595,7 @@ section_initpp_ch='[init_dcc++]';
section_trains_ch='[section_trains]';
section_placement_ch='[section_placement]';
section_DecPers_ch='[section_decodeurs]';
Nba_ch='NombreAdresses';
nation_ch='Nation';
var
FormConfig: TFormConfig;
@@ -993,7 +998,7 @@ end;
// transforme le signal du tableau feux[] en texte
function encode_sig_feux(i : integer): string;
var s : string;
adresse,aspect,j,k,NfeuxDir,CondCarre,nc : integer;
adresse,aspect,j,k,NfeuxDir,CondCarre,CondFeuBlanc,nc : integer;
begin
// adresse
adresse:=feux[i].adresse;
@@ -1052,6 +1057,25 @@ begin
end;
end;
// conditions supplémentaires pour le feu blanc
for nc:=1 to 6 do
begin
CondFeuBlanc:=Length(feux[i].CondFeuBlanc[nc]); // nombre de conditions (nombre de parenthèses ex 3 pour (A21S,A6D)(A30S,A20D)(A1D,A2S,A3D)
dec(CondFeuBlanc);
if CondFeuBlanc>0 then
begin
s:=s+',CFB(';
for k:=1 to CondFeuBlanc do
begin
s:=s+'A'+IntToSTR(feux[i].CondFeuBlanc[nc][k].Adresse)+feux[i].CondFeuBlanc[nc][k].PosAig;
if k<CondFeuBlanc then s:=s+',';
end;
s:=s+')';
end;
end;
// décodeur SR
if feux[i].decodeur=7 then
begin
@@ -1403,6 +1427,44 @@ begin
until t<>1;
if length(s)>1 then if s[1]=',' then delete(s,1,1);
// si conditions supplémentaires de feu blanc (CFB)
l:=1; // nombre de parenthèses
repeat
t:=pos('CFB(',s);
if t=1 then
begin
//Affiche('Conditions supplémentaires pour le feu '+IntToSTR(adresse)+' parenthèse '+intToSTR(l),clyellow);
k:=pos(')',s);
sa:=copy(s,t+4,k-4); // contient l'intérieur des parenthèses sans les parenthèses
delete(s,1,k+1);//Affiche(s,clYellow);
// boucle dans la parenthèse
bd:=0;
repeat
inc(bd);
setlength(feux[i].condFeuBlanc[l],bd+1); // une condition en plus
k:=pos(',',sa);
if k<>0 then
chaine:=copy(sa,1,k-1) // premier champ ()
else // le reste
chaine:=sa;
if chaine[1]='A' then
begin
delete(chaine,1,1);
val(chaine,adresse,erreur);
feux[i].condFeuBlanc[l][bd].Adresse:=adresse;
if erreur<>0 then feux[i].condFeuBlanc[l][bd].PosAig:=chaine[erreur] else
Affiche('Erreur 683 Définition du signal '+IntToSTR(feux[i].adresse)+': Manque D ou S dans les conditions de feu blanc des aiguillages',clred);
end;
k:=pos(',',sa);if k<>0 then delete(sa,1,k);
until k=0;
inc(l);
end;
until t<>1;
if length(s)>1 then if s[1]=',' then delete(s,1,1);
// champ SR
if length(s)>2 then
if copy(s,1,2)='SR' then
@@ -1697,12 +1759,12 @@ begin
writeln(fichierN,section_DecPers_ch);
for i:=1 to NbreDecPers do
begin
writeln(fichierN,decodeur_pers[i].nom);
writeln(fichierN,nom_dec_pers_ch+'='+decodeur_pers[i].nom);
n:=decodeur_pers[i].NbreAdr;
s:='NombreAdresses='+intToSTR(n);
s:=Nba_ch+'='+intToSTR(n);
writeln(fichierN,s);
n:=decodeur_pers[i].nation;
s:='Nation='+intToSTR(n);
s:=nation_ch+'='+intToSTR(n);
writeln(fichierN,s);
for j:=1 to decodeur_pers[i].NbreAdr do
@@ -2416,65 +2478,82 @@ procedure compile_dec_pers;
var nv,i,j,k,l,adr : integer;
begin
Nligne:=1;
nv:=0;
repeat
s:=lit_ligne;
inc(Nligne);
if s<>'0' then
begin
if NbreDecPers<NbreMaxiDecPers then
repeat // boucle de décodeurs
nv:=0; // compteur nombre de variables
repeat // boucle d'un décodeur
s:=lit_ligne;
inc(Nligne);
if s<>'0' then
begin
inc(NbreDecPers);
decodeur_pers[NbreDecPers].nom:=sOrigine;
decodeur[NbDecodeurdeBase+NbreDecPers-1]:=sOrigine;
// nombre d'adresses
s:=lit_ligne;
k:=pos(uppercase(nba_ch)+'=',s);
if k=1 then
if NbreDecPers<NbreMaxiDecPers then
begin
delete(s,1,length(nba_ch)+1);
val(s,j,erreur); // ne pas écraser j
decodeur_pers[NbreDecPers].NbreAdr:=j;
end;
// nation
s:=lit_ligne;
k:=pos(uppercase(nation_ch)+'=',s);
if k=1 then
begin
delete(s,1,length(nation_ch)+1);
val(s,k,erreur);
if (k=0) or (k>2) then k:=1;
decodeur_pers[NbreDecPers].Nation:=k;
end;
adr:=1;
repeat
s:=lit_ligne;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].etat1:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].etat2:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].offsetadresse:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].sortie1:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].sortie2:=l;
// nom du décodeur
k:=pos(uppercase(nom_dec_pers_ch)+'=',s);
if k=1 then
begin
delete(sOrigine,1,length(nom_dec_pers_ch)+1);
s:='';
inc(adr);
until (adr>j);
inc(NbreDecPers);
decodeur_pers[NbreDecPers].nom:=sOrigine;
decodeur[NbDecodeurdeBase+NbreDecPers-1]:=sOrigine;
inc(nv);
end;
// nombre d'adresses
k:=pos(uppercase(nba_ch)+'=',s);
if (k=1) and (NbreDecPers>0) then
begin
delete(s,1,length(nba_ch)+1);
val(s,j,erreur); // ne pas écraser j
decodeur_pers[NbreDecPers].NbreAdr:=j;
inc(nv);
end;
// nation
k:=pos(uppercase(nation_ch)+'=',s);
if (k=1) and (NbreDecPers>0) then
begin
delete(s,1,length(nation_ch)+1);
val(s,k,erreur);
if (k=0) or (k>2) then k:=1;
decodeur_pers[NbreDecPers].Nation:=k;
inc(nv);
end;
end;
end;
end;
until eof(fichier) or (s='0') or (nv=3); // on sort de la boucle si on a lu les 3 variables
adr:=1;
if s<>'0' then
repeat
s:=lit_ligne;
if s<>'0' then
begin
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].etat1:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].etat2:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].offsetadresse:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].sortie1:=l;
k:=pos(',',s);
val(s,l,erreur);
delete(s,1,k);
decodeur_pers[NbreDecPers].desc[adr].sortie2:=l;
s:='';
inc(adr);
end
else Affiche('Section décodeurs - Nombre de descriptions du décodeur "'+decodeur_pers[NbreDecPers].nom+'" différents du nombre des adresses déclarées',clred);
until (adr>j) or (s='0');
until eof(fichier) or (s='0');
end;
@@ -2590,6 +2669,25 @@ begin
end;
// trie les signaux
procedure trier_sig;
var i,j : integer;
temp : TSignal;
begin
for i:=1 to NbreFeux do
begin
for j:=i+1 to NbreFeux do
begin
if feux[i].Adresse>feux[j].adresse then
begin
temp:=feux[i];
feux[i]:=feux[j];
feux[j]:=temp;
end;
end;
end;
end;
procedure lit_flux;
label ici1,ici2,ici3,ici4 ;
var i : integer;
@@ -3058,6 +3156,7 @@ begin
begin
trouve_section_sig:=true;
compile_signaux;
trier_sig;
end;
// section actionneurs
@@ -4452,6 +4551,7 @@ begin
with formconfig do
begin
MemoCarre.Lines.Clear;
MemoBlanc.Lines.Clear;
EditDet2.Text:=''; EditSuiv2.Text:='';
EditDet3.Text:=''; EditSuiv3.Text:='';
EditDet4.Text:=''; EditSuiv4.Text:='';
@@ -4505,11 +4605,24 @@ begin
end;
// affiche ou non les checkbox en fonction de l'aspect
if (((d=2) or (d>=5)) and (d<10)) or (d=20) then checkBoxFB.Visible:=true else checkBoxFB.Visible:=false;
if (((d=2) or (d>=5)) and (d<10)) or (d=20) then
begin
checkBoxFB.Visible:=true;
Label69.Visible:=true;
MemoBlanc.Visible:=true;
end
else
begin
checkBoxFB.Visible:=false;
Label69.Visible:=false;
MemoBlanc.Visible:=false;
end;
if d>2 then
begin
checkFVC.Visible:=true;
checkFRC.Visible:=true;
end
else
begin
@@ -4547,7 +4660,7 @@ begin
if (d<10) or (d>=20) then
begin
Label17.Caption:='Conditions supplémentaires d''affichage du carré par les aiguillages :';
Label17.Width:=228;
label17.Width:=131;
LabelDetAss.visible:=true;
LabelElSuiv.visible:=true;
label43.Visible:=true;
@@ -4604,10 +4717,32 @@ begin
// scrolle le MemoCarre sur la première ligne
MemoCarre.SelStart:=0;
MemoCarre.Perform(EM_SCROLLCARET,0,0);
// conditions supplémentaires du feu blanc par aiguillages
l:=1;
repeat
nc:=Length(feux[i].condFeuBlanc[l])-1 ;
if nc<>-1 then
begin
s:='';
for k:=1 to nc do
begin
s:=s+'A'+IntToSTR(feux[i].condFeuBlanc[l][k].Adresse)+feux[i].condFeuBlanc[l][k].PosAig;
if k<nc then s:=s+',';
end;
MemoBlanc.Lines.Add(s);
end;
inc(l);
until (nc<=0) or (l>6);
// scrolle le MemoCarre sur la première ligne
MemoBlanc.SelStart:=0;
MemoBlanc.Perform(EM_SCROLLCARET,0,0);
end
else
begin // directionnel
Label17.Caption:='Conditions d''affichage du feu directionnel :';
label17.Width:=131;
label43.Visible:=false;
LabelDetAss.visible:=false;
LabelElSuiv.visible:=false;
@@ -4638,8 +4773,6 @@ begin
end;
end;
// vérifier les incompatibilités
clicListe:=false;
end;
@@ -4910,7 +5043,6 @@ begin
EditZdet1V5O.text:=intToSTR(Tablo_PN[i].voie[5].detZ1O);
EditZdet2V5O.text:=intToSTR(Tablo_PN[i].voie[5].detZ2O);
end;
end;
end;
end;
@@ -5282,14 +5414,10 @@ begin
end;
EditPointe_BG.Hint:=TypeElAIg_to_char(adr,B);
end
else
LabelInfo.caption:='Erreur pointe aiguillage '+intToSTR(AdrAig);
end;
else LabelInfo.caption:='Erreur pointe aiguillage '+intToSTR(AdrAig);
end;
end;
procedure TFormConfig.EditDevieS2KeyPress(Sender: TObject; var Key: Char);
var AdrAig,adr,erreur,index : integer;
b : char;
@@ -5960,7 +6088,7 @@ end;
procedure TFormConfig.EditActChange(Sender: TObject);
var s,s2 : string;
act,erreur,det1,det2,suiv : integer;
act,erreur,det2,suiv : integer;
elsuiv : tEquipement;
de : boolean;
begin
@@ -5983,9 +6111,6 @@ begin
EditAct.Hint:=s2+intToSTR(act);
de:=pos('Z',s)<>0; // si détecteur
if de then delete(s,erreur,1);
Val(s,act,erreur);
@@ -7003,6 +7128,7 @@ begin
end;
end;
procedure supprime_act;
var i,debut,longueur,fin,ltot,lignedeb,lignefin,l : integer;
s: string;
@@ -7370,7 +7496,7 @@ begin
end;
function nombre_adresses_signal(adr : integer) : integer;
var x,dec,nc,i : integer;
var x,dec,nc,i,j : integer;
begin
nc:=0;
i:=index_feu(adr);
@@ -7416,6 +7542,12 @@ begin
end;
if dec=9 then nc:=2; // LS-DEC-NMBS
if dec=10 then nc:=feux[i].Na; // Bmodels
if dec>=NbDecodeurdeBase then
begin
j:=dec-NbDecodeurdeBase+1;
nc:=decodeur_pers[j].NbreAdr;
end;
nombre_adresses_signal:=nc;
end;
@@ -10953,7 +11085,6 @@ end;
procedure TFormConfig.CheckBoxContreVoieClick(Sender: TObject);
var s : string;
bm : Tbitmap;
adr : integer;
begin
if clicliste or (ligneClicSig<0) then exit;
@@ -11075,9 +11206,7 @@ end;
// nouveau décodeur personnalisé
procedure TFormConfig.BoutonNouveauClick(Sender: TObject);
var s: string;
cb : TcomboBox;
te : Tedit;
i,nombre,erreur,decCourant : integer;
i,nombre,decCourant : integer;
begin
if NbreDecPers>=NbreMaxiDecPers then exit;
@@ -11133,7 +11262,7 @@ end;
procedure TFormConfig.ComboBoxDecodeurPersoChange(Sender: TObject);
var i,nAdr,a : integer;
var i,a : integer;
s: string;
begin
if affevt then Affiche('Evt ComboBoxDecodeurPerso',clyellow);
@@ -11269,7 +11398,65 @@ begin
maj_decodeurs;
end;
begin
end.
procedure TFormConfig.MemoBlancChange(Sender: TObject);
var s,sO: string;
j,erreur,adr,ligne,aspect : integer;
c : char;
begin
if (ligneClicSig<0) or clicListe then exit;
if affevt then affiche('Evt MemoBlanc change',clyellow);
j:=MemoCarre.Selstart;
clicMemo:=MemoCarre.Perform(EM_LINEFROMCHAR,j,0); // numéro de la ligne du curseur
aspect:=feux[ligneClicSig+1].aspect;
if (clicMemo>5) then
begin
clicListe:=true;
LabelInfo.Caption:='Erreur 6 conditions maxi';
MemoCarre.Lines.Delete(clicMemo);
clicListe:=false;
exit;
end;
// signal normal
// boucle de ligne
for ligne:=1 to 6 do
begin
s:=uppercase(MemoBlanc.Lines[ligne-1]);
clicListe:=true;
MemoBlanc.Lines[ligne-1]:=s;
clicListe:=false;
sO:=s;
j:=1;
if s<>'' then
repeat
if s[1]<>'A' then begin LabelInfo.Caption:='Erreur manque A : '+sO;exit;end;
delete(s,1,1);
val(s,adr,erreur); // adresse
if adr=0 then exit;
c:=#0;
if erreur<>0 then c:=s[erreur]; // S ou D
if (c<>'D') and (c<>'S') then begin LabelInfo.Caption:='Erreur manque D ou S : '+sO;exit;end;
setlength(feux[ligneClicSig+1].condFeuBlanc[ligne],j+1);
feux[ligneClicSig+1].condFeuBlanc[ligne][j].PosAig:=c;
feux[ligneClicSig+1].condFeuBlanc[ligne][j].Adresse:=adr;
delete(s,1,erreur); // supprime jusque D
if length(s)<>0 then if s[1]=',' then delete(s,1,1);
inc(j);
until s=''
else
setlength(feux[ligneClicSig+1].condFeuBlanc[ligne],0);
end;
s:=encode_sig_feux(ligneClicSig+1);
RichSig.Lines[ligneClicSig]:=s;
LabelInfo.Caption:='';
clicListe:=false;
end;
begin
end.
UnitPrinc.pas
+89 -20
View File
@@ -1,5 +1,5 @@
Unit UnitPrinc;
// 30/7 11
// 1/8 20h
(********************************************
programme signaux complexes Graphique Lenz
Delphi 7 + activeX Tmscomm + clientSocket
@@ -40,7 +40,7 @@ Unit UnitPrinc;
//
// En mode centrale connectée à signaux complexes (autonome)
// si on bouge un aiguillage à la raquette, on récupère bien sa position par XpressNet.
// Une loco sur un détecteur au lancement ne renvoie pas son état. Seuls les changements
// Une loco sur un détecteur au lancement ne renvoie pas son état statique. Seuls les changements
// d'état sont renvoyés par la centrale.
//{$Q-} // pas de vérification du débordement des opérations de calcul
@@ -423,6 +423,13 @@ TSignal = record
Adresse : integer; // aiguillage
posAig : char;
end;
CondFeuBlanc : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le blanc
// attention les données sont stockées en adresse 1 du tableau dynamique
Adresse : integer; // aiguillage
posAig : char;
end;
SR : array[1..19] of record // configuration du décodeur Stéphane Ravaut ou digikeijs ou cdf
sortie1,sortie0 : integer;
end;
@@ -1310,7 +1317,7 @@ end; // AffTexteIncliBordeTexture
// inverse une image horz et la met dans dest
procedure inverse_image(imageDest,ImageSrc : Timage);
var r,mrect,nrect : trect;
var mrect,nrect : trect;
larg,haut : integer;
begin
larg:=ImageSrc.Width;
@@ -1858,6 +1865,7 @@ begin
adresse:=feux[rang].adresse;
Feux[rang].Img:=Timage.create(Formprinc.ScrollBox1);
if feux[rang].Img=nil then begin affiche('Erreur 900 : impossible de créer une image',clred);exit;end;
with Feux[rang].Img do
begin
if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime);
@@ -2487,7 +2495,7 @@ begin
end;
procedure Maj_Etat_Signal_Belge(adresse,aspect : integer);
var i,code,combine : integer;
var i : integer;
etats : word;
// La signalisation combinée est à partir du bit 10 (chiffre, chevron)
begin
@@ -3707,7 +3715,7 @@ end;
// l'adresse du signal doit être un multiple de 8 +1
// un signal peut occuper 1 3 4 ou 5 adresses
procedure envoi_b_models(adresse : integer);
var na,code,aspect,combine,mode : integer;
var na,code,aspect,combine : integer;
afb,recht,i : integer;
s : string;
begin
@@ -3827,7 +3835,7 @@ vert
blanc
}
procedure envoi_ldt_nmbs(adresse : integer);
var code,aspect,combine,mode : integer;
var code,aspect,combine : integer;
i : integer;
s : string;
begin
@@ -6237,6 +6245,59 @@ begin
end;
// renvoie vrai si les aiguillages déclarés pour le feu blanc sont bien positionnés
function cond_feuBlanc(adresse : integer) : boolean;
var i,l,k,NCondCarre,adrAig,index : integer;
resultatET,resultatOU: boolean;
s : string;
begin
i:=index_feu(adresse);
if i=0 then
begin
s:='Erreur 602 - Signal '+IntToSTR(adresse)+' non trouvé';
Affiche(s,clred);
if NivDebug=3 then AfficheDebug(s,clred);
cond_feuBlanc:=false;
exit;
end;
NCondCarre:=Length(feux[i].condFeuBlanc[1]);
l:=1;
resultatOU:=false;
while NcondCarre<>0 do
begin
if Ncondcarre<>0 then dec(Ncondcarre);
resultatET:=true;
for k:=1 to NcondCarre do
begin
//s2:=s2+'A'+IntToSTR(feux[i].condFeuBlanc[l][k].Adresse)+feux[i].condFeuBlanc[l][k].PosAig+' ';
AdrAig:=feux[i].condFeuBlanc[l][k].Adresse;
index:=index_aig(adrAig);
if index<>0 then
begin
if nivDebug=3 then AfficheDebug('Contrôle aiguillage '+IntToSTR(AdrAig),clyellow);
resultatET:=((aiguillage[index].position=const_devie) and (feux[i].condFeuBlanc[l][k].PosAig='S') or (aiguillage[index].position=const_droit) and (feux[i].condFeuBlanc[l][k].PosAig='D'))
and resultatET;
end;
end;
//if resultatET then Affiche('VRAI',clyellow) else affiche('FAUX',clred);
inc(l);
resultatOU:=resultatOU or resultatET;
NCondCarre:=Length(feux[i].condFeuBlanc[l]);
end;
//if resultatOU then Affiche('VRAI final',clyellow) else affiche('FAUX final',clred);
if NivDebug=3 then
begin
s:='Conditions supp. de feu blanc suivant aiguillages: ';
if ResultatOU then s:=s+'vrai : le signal doit afficher blanc' else s:=s+' : le signal ne doit pas afficher de feu blanc';
AfficheDebug(s,clyellow);
end;
cond_feuBlanc:=ResultatOU;
end;
// renvoie vrai si les aiguillages déclarés dans la définition du signal sont mal positionnés
// (conditions suppplémentares)
function cond_carre(adresse : integer) : boolean;
@@ -7451,7 +7512,7 @@ end;
// met à jour l'état du signel belge selon l'environnement des aiguillages et des trains
procedure signal_belge(Adrfeu : integer;detect : boolean);
var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,aiguille,etat,AdrSignalsuivant : integer;
var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant : integer;
Btype_el_suivant : TEquipement;
car,presTrain,reserveTrainTiers,Aff_Semaphore : boolean;
s: string;
@@ -7607,6 +7668,8 @@ begin
exit;
end;
// ici signal français
Adr_det:=Feux[index].Adr_det1; // détecteur sur le signal
Adr_El_Suiv:=Feux[index].Adr_el_suiv1; // adresse élément suivant au feu
Btype_el_suivant:=Feux[index].Btype_suiv1;
@@ -7646,7 +7709,8 @@ begin
end
else
begin
if test_memoire_zones(AdrFeu) then Maj_Etat_Signal(AdrFeu,violet) // test si présence train après signal
if not(cond_FeuBlanc(AdrFeu)) and test_memoire_zones(AdrFeu) then Maj_Etat_Signal(AdrFeu,violet) // test si présence train après signal
else Maj_Etat_Signal(AdrFeu,blanc);
envoi_signal(AdrFeu);
@@ -7678,8 +7742,7 @@ begin
//if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow);
if AffSignal and feux[index].VerrouilleCarre then AfficheDebug('le signal est verrouillé au carré',clYellow);
if (modele>=4) and Feux[index].VerrouCarre and
( (not(PresTrain) or car or feux[index].Verrouillecarre) ) then Maj_Etat_Signal(AdrFeu,carre)
if (modele>=4) and ((not(PresTrain) and feux[index].Verrouillecarre) or car ) then Maj_Etat_Signal(AdrFeu,carre)
else
begin
// si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation
@@ -7698,15 +7761,20 @@ begin
end
else
begin
Aig:=Aiguille_deviee(Adrfeu);
// si aiguille locale déviée
if (aig<>0) and (feux[index].aspect>=9) then // si le signal peut afficher un rappel et aiguille déviée
if cond_feuBlanc(AdrFeu) then
Maj_Etat_Signal(AdrFeu,blanc)
else
begin
indexAig:=Index_aig(aig);
if AffSignal then AfficheDebug('Aiguille '+intToSTR(aig)+' du signal '+intToSTR(AdrFeu)+' déviée',clYellow);
feux[index].EtatSignal:=0;
if (aiguillage[indexAig].vitesse=30) or (aiguillage[indexAig].vitesse=0) then Maj_Etat_Signal(AdrFeu,rappel_30);
if aiguillage[indexAig].vitesse=60 then Maj_Etat_Signal(AdrFeu,rappel_60);
Aig:=Aiguille_deviee(Adrfeu);
// si aiguille locale déviée
if (aig<>0) and (feux[index].aspect>=9) then // si le signal peut afficher un rappel et aiguille déviée
begin
indexAig:=Index_aig(aig);
if AffSignal then AfficheDebug('Aiguille '+intToSTR(aig)+' du signal '+intToSTR(AdrFeu)+' déviée',clYellow);
feux[index].EtatSignal:=0;
if (aiguillage[indexAig].vitesse=30) or (aiguillage[indexAig].vitesse=0) then Maj_Etat_Signal(AdrFeu,rappel_30);
if aiguillage[indexAig].vitesse=60 then Maj_Etat_Signal(AdrFeu,rappel_60);
// si signal suivant affiche rappel ou rouge
if (TestBit(etat,rappel_60)) or (testBit(etat,rappel_30)) or (testBit(etat,carre)) or (testBit(etat,semaphore))
@@ -7783,6 +7851,7 @@ begin
end;
end;
end;
end;
end;
end;
end;
@@ -12074,7 +12143,7 @@ begin
Application.ProcessMessages;
// Initialisation des images des signaux
procetape('Création des signaux');
NbreImagePLigne:=Formprinc.ScrollBox1.Width div (largImg+5);
NbreImagePLigne:=(Formprinc.ScrollBox1.Width div (largImg+5)) -1;
if NbreImagePLigne=0 then NbreImagePLigne:=1;
// ajoute les images des signaux dynamiquement
@@ -14339,7 +14408,7 @@ end;
procedure TFormPrinc.Informationsdusignal1Click(Sender: TObject);
var s: string;
nation,etat,index,i,k,aspect,n,combine,adresse,aig,trainReserve,AdrSignalsuivant,voie : integer;
nation,etat,index,i,aspect,n,combine,adresse,aig,trainReserve,AdrSignalsuivant,voie : integer;
reserveTrainTiers : boolean;
code : word;
begin
UnitTCO.dfm
+2 -2
View File
@@ -22,8 +22,8 @@ object FormTCO: TFormTCO
OnKeyPress = FormKeyPress
OnMouseWheel = FormMouseWheel
DesignSize = (
1133
647)
1125
639)
PixelsPerInch = 96
TextHeight = 13
object LabelCoord: TLabel
UnitTCO.pas
+45 -191
View File
@@ -1233,7 +1233,7 @@ end;
// essai courbe
procedure dessin_2C(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,jy1,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
var x0,y0,xc,yc,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
fond : tcolor;
@@ -2051,7 +2051,7 @@ begin
fond:=TCO[x,y].CouleurFond;
// mode rond
x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2);
x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2)+4;
x2:=xf+largeurCell+(largeurcell div 3);y2:=yc;
x3:=x0;y3:=y0;
x4:=xf;y4:=yc;
@@ -2125,7 +2125,6 @@ end;
// coin supérieur gauche (Element 6)
procedure dessin_6L(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2154,7 +2153,6 @@ end;
// coin supérieur gauche (Element 6)
procedure dessin_6C(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2194,7 +2192,6 @@ end;
// Element 7
procedure dessin_7L(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2223,7 +2220,6 @@ end;
procedure dessin_7C(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2266,7 +2262,6 @@ end;
// courbe: droit vers bas -\ Element 8
procedure dessin_8L(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2295,7 +2290,6 @@ end;
procedure dessin_8C(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2339,7 +2333,6 @@ end;
// courbe bas gauche vers droit Elément 9
procedure dessin_9l(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2370,7 +2363,6 @@ end;
// courbe bas gauche vers droit Elément 9
procedure dessin_9c(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2414,8 +2406,6 @@ end;
// élément 10
procedure dessin_10(Canvas : Tcanvas;x,y : integer;Mode : integer);
var Adr, x0,y0: integer;
r : Trect;
fond : Tcolor;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2462,7 +2452,6 @@ end;
// élément 11
procedure dessin_11(Canvas : Tcanvas;x,y : integer;Mode : integer);
var Adr, x0,y0 : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -2510,7 +2499,6 @@ end;
// Element 12
procedure dessin_12L(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer;
r : Trect;
fond : tcolor;
procedure trajet_droit;
@@ -2637,7 +2625,6 @@ end;
procedure dessin_12C(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer;
r : Trect;
fond : tcolor;
procedure trajet_droit;
begin
@@ -3288,7 +3275,6 @@ end;
// Element 15
procedure dessin_15L(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position : integer;
r : Trect;
fond : Tcolor;
procedure trajet_droit;
@@ -3412,7 +3398,6 @@ end;
procedure dessin_15C(Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer;
r : Trect;
fond : Tcolor;
procedure trajet_droit;
@@ -3542,7 +3527,6 @@ end;
// Element 16
procedure dessin_16L(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3572,7 +3556,6 @@ end;
procedure dessin_16C(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3615,7 +3598,6 @@ end;
// Element 17
procedure dessin_17l(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3642,7 +3624,6 @@ end;
// Element 17
procedure dessin_17c(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3681,7 +3662,6 @@ end;
// Elément 18
procedure dessin_18l(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3707,7 +3687,6 @@ end;
procedure dessin_18c(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3746,7 +3725,6 @@ end;
// Element 19
procedure dessin_19l(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3772,7 +3750,6 @@ end;
procedure dessin_19c(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -3858,7 +3835,7 @@ begin
Brush.Color:=couleur;
pen.color:=couleur;
jx1:=y0+(HauteurCell div 2);
//jx1:=y0+(HauteurCell div 2);
Pen.Width:=epaisseur;
MoveTo(xc,y0);LineTo(xc,y0+HauteurCell);
@@ -3868,7 +3845,6 @@ end;
// Element 21 - croisement - TJD
procedure dessin_21(Canvas : Tcanvas;x,y,mode : integer);
var x0,y0,xc,yc,trajet : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -4250,7 +4226,6 @@ end;
// Element 25 croisement
procedure dessin_25(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xf,yf,xc,yc,trajet : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -5189,10 +5164,9 @@ end;
// affiche le tco suivant le tableau TCO
procedure Affiche_TCO ;
var x,y,x1,y1,x2,y2,DimX,DimY : integer;
var x,y,x1,y1,DimX,DimY : integer;
s : string;
r : Trect;
coul : tcolor;
begin
if affevt then affiche('Affiche_tco',clLime);
if pImageTCO=nil then exit;
@@ -5877,170 +5851,52 @@ begin
end;
procedure dessine_icones;
var w,h,ancH,ancW : integer;
var w,h,ancH,ancW,i : integer;
ip : TImage;
begin
with formTCO do
begin
// dessine le fond des icones
for i:=1 to 25 do
begin
ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage;
if ip<>nil then
begin
with ip do
begin
w:=width;
h:=height;
with canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
end;
end;
end;
ip:=findComponent('ImagePalette31') as Timage;
if ip<>nil then
begin
with ip do
begin
w:=width;
h:=height;
with canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
end;
end;
epaisseur:=5;
ancw:=LargeurCell;
AncH:=hauteurCell;
HauteurCell:=ImagePalette1.Height;
LargeurCell:=ImagePalette1.Width;
// dessiner les icônes
epaisseur:=5;
// effacer le fond des icones
w:=ImagePalette1.width;
h:=ImagePalette1.height;
with ImagePalette1.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette2.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette3.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette4.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette5.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette6.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette7.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette8.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette9.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette10.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette11.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette12.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette13.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette14.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette15.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette16.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette17.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette18.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette19.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette20.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette21.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette22.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette24.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette25.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
with ImagePalette31.Canvas do
begin
Pen.Color:=clFond;
Brush.color:=clFond;
Rectangle(0,0,w,h);
end;
dessin_5(ImagePalette5.Canvas,1,1,0); //posX,posY,état,position
dessin_2(ImagePalette2.Canvas,1,1,0);
dessin_3(ImagePalette3.Canvas,1,1,0);
@@ -7286,7 +7142,7 @@ end;
// premier : si c'est le premier élément
// dernier : si c'est le dernier élément
function replace(x,y,el,quadrant : integer;premier,dernier : boolean) : integer;
var bim,BimS : integer;
var bim : integer;
begin
if debugTCO then Affiche('Quadrant '+intToSTR(quadrant),clred);
result:=0;
@@ -7579,7 +7435,6 @@ end;
procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var position : Tpoint;
i,Bimage,xt,yt,xf,yf : integer;
s : string;
begin
if button=mbLeft then
begin
@@ -7783,8 +7638,7 @@ end;
procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
var r : Trect;
cellX,cellY,XSel1,YSel1,XSel2,YSel2,Bimage,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP,
cx,cy : integer;
cellX,cellY,XSel1,YSel1,XSel2,YSel2,Bimage,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer;
ok : boolean;
begin
if affevt then Affiche('ImageTCOMouseMove',clLime);
verif_version.pas
+1 -1
View File
@@ -158,7 +158,7 @@ end;
// renvoie le numéro de version depuis le forum CDM
function verifie_version : real;
var s,s2,s3,Version_p,Url,LocalFile,nomfichier,UrlGIT : string;
var s,s2,s3,Version_p,Url,LocalFile,nomfichier : string;
trouve_version,trouve_zip,zone_comm,LocZip : boolean;
fichier : text;
i,j,erreur,Ncomm,i2,i3,l : integer;
versions.txt
+1
View File
@@ -172,6 +172,7 @@ version 6.2 : D
version 6.3 : Choix du graphisme du TCO en lignes brisées ou courbes.
version 6.4 : Gestion des signaux belges (avec chevron et réduction de vitesse).
version 7.0 : Possibilité de créer des décodeurs spécifiques de signaux.
Affichage du feu blanc sur les signaux sur position spécifique d'aiguillages.