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

V2.5

Browse Source
This commit is contained in:
f1iwq2
2021-06-24 09:35:45 +02:00
parent 8cea5ebd73
commit 985f7c10ae
18 changed files with 610 additions and 369 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice d'utilisation des signaux_complexes_GL_V2.4.pdf → Notice d'utilisation des signaux_complexes_GL_V2.5.pdf
BIN
View File
Binary file not shown.
UnitConfig.dcu
BIN
View File
Binary file not shown.
UnitConfig.dfm
+283 -203
View File
@@ -2402,15 +2402,15 @@ object FormConfig: TFormConfig
Left = 280
Top = 32
Width = 289
Height = 265
Height = 353
Caption = 'Description de l'#39'aiguillage'
TabOrder = 0
object LabelAdresse: TLabel
Left = 37
Left = 13
Top = 20
Width = 188
Width = 196
Height = 19
Caption = 'Adresse de l'#39'aiguillage = '
Caption = 'Description de l'#39'aiguillage'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -16
@@ -2431,94 +2431,9 @@ object FormConfig: TFormConfig
Font.Style = []
ParentFont = False
end
object LabelBG: TLabel
Left = 18
Top = 174
Width = 9
Height = 16
Caption = 'P'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object LabelHD: TLabel
Left = 225
Top = 150
Width = 9
Height = 16
Caption = 'S'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object LabelBD: TLabel
Left = 225
Top = 174
Width = 9
Height = 16
Caption = 'D'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object ImageAffiche: TImage
Left = 80
Top = 144
Width = 137
Height = 57
end
object LabelHG: TLabel
Left = 18
Top = 142
Width = 9
Height = 16
Caption = 'D'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object Label18: TLabel
Left = 220
Top = 198
Width = 16
Height = 16
Caption = 'S2'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object LabelTJD1: TLabel
Left = 112
Top = 208
Width = 52
Height = 13
Caption = 'LabelTJD1'
end
object LabelTJD2: TLabel
Left = 168
Top = 208
Width = 52
Height = 13
Caption = 'LabelTJD1'
end
object GroupBox10: TGroupBox
Left = 8
Top = 64
Top = 104
Width = 273
Height = 73
Caption = 'Vitesse de franchissement d'#233'vi'#233' :'
@@ -2551,76 +2466,209 @@ object FormConfig: TFormConfig
OnClick = RadioButton60kmhClick
end
end
object EditDroit_BD: TEdit
Left = 240
Top = 174
Width = 41
Height = 21
TabOrder = 1
Text = 'EditDroit_BD'
OnChange = EditDroit_BDChange
end
object EditDevie_HD: TEdit
Left = 240
Top = 148
Width = 41
Height = 21
TabOrder = 2
Text = 'EditDevie_HD'
OnChange = EditDevie_HDChange
end
object EditPointe_BG: TEdit
Left = 32
Top = 172
Width = 41
Height = 21
TabOrder = 3
Text = 'EditPointe_BG'
OnChange = EditPointe_BGChange
end
object EditP1: TEdit
Left = 112
Top = 148
Width = 33
Height = 21
TabOrder = 4
Text = 'EditDDroit'
end
object EditP2: TEdit
Left = 112
Top = 172
Width = 33
Height = 21
TabOrder = 5
Text = 'EditDdevie'
end
object EditDevieS2: TEdit
Left = 240
Top = 196
Width = 41
Height = 21
TabOrder = 6
Text = 'EditDevie_HD'
OnChange = EditDevieS2Change
end
object CheckInverse: TCheckBox
Left = 40
Top = 232
Top = 312
Width = 185
Height = 17
Caption = 'Inversion de l'#39#233'tat CDM'
TabOrder = 7
TabOrder = 1
OnClick = CheckInverseClick
end
end
object Edit_HG: TEdit
Left = 312
Top = 172
Width = 41
Height = 21
TabOrder = 1
Text = 'EditPointe'
OnChange = Edit_HGChange
object EditAdrAig: TEdit
Left = 216
Top = 20
Width = 49
Height = 21
Enabled = False
TabOrder = 2
OnChange = EditAdrAigChange
end
object ComboBoxAig: TComboBox
Left = 72
Top = 64
Width = 145
Height = 21
Enabled = False
ItemHeight = 13
TabOrder = 3
Text = 'Type'
Items.Strings = (
'Aiguillage simple'
'TJD'
'TJS'
'Aiguillage triple')
end
object GroupBox16: TGroupBox
Left = 8
Top = 192
Width = 273
Height = 105
Caption = 'Repr'#233'sentation'
TabOrder = 4
object LabelHG: TLabel
Left = 10
Top = 17
Width = 9
Height = 16
Caption = 'D'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object LabelBG: TLabel
Left = 10
Top = 45
Width = 9
Height = 16
Caption = 'P'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object ImageAffiche: TImage
Left = 72
Top = 16
Width = 137
Height = 57
end
object LabelHD: TLabel
Left = 217
Top = 25
Width = 9
Height = 16
Caption = 'S'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object LabelBD: TLabel
Left = 217
Top = 49
Width = 9
Height = 16
Caption = 'D'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object Label18: TLabel
Left = 212
Top = 73
Width = 16
Height = 16
Caption = 'S2'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object LabelTJD1: TLabel
Left = 72
Top = 84
Width = 52
Height = 13
Caption = 'LabelTJD1'
end
object LabelTJD2: TLabel
Left = 152
Top = 84
Width = 52
Height = 13
Caption = 'LabelTJD1'
end
object Edit_HG: TEdit
Left = 24
Top = 20
Width = 41
Height = 21
TabOrder = 0
Text = 'EditPointe'
OnChange = Edit_HGChange
end
object EditPointe_BG: TEdit
Left = 24
Top = 44
Width = 41
Height = 21
TabOrder = 1
Text = 'EditPointe_BG'
OnChange = EditPointe_BGChange
end
object EditP1: TEdit
Left = 88
Top = 28
Width = 33
Height = 21
TabOrder = 2
Text = 'EditDDroit'
end
object EditP2: TEdit
Left = 88
Top = 48
Width = 33
Height = 21
TabOrder = 3
Text = 'EditDdevie'
end
object EditP3: TEdit
Left = 160
Top = 22
Width = 33
Height = 21
TabOrder = 4
Text = 'EditDDroit'
end
object EditP4: TEdit
Left = 160
Top = 44
Width = 33
Height = 21
TabOrder = 5
Text = 'EditDDroit'
end
object EditDevie_HD: TEdit
Left = 232
Top = 20
Width = 33
Height = 21
TabOrder = 6
Text = 'EditDevie_HD'
OnChange = EditDevie_HDChange
end
object EditDroit_BD: TEdit
Left = 232
Top = 44
Width = 33
Height = 21
TabOrder = 7
Text = 'EditDroit_BD'
OnChange = EditDroit_BDChange
end
object EditDevieS2: TEdit
Left = 232
Top = 68
Width = 33
Height = 21
TabOrder = 8
Text = 'EditDevie_HD'
OnChange = EditDevieS2Change
end
end
end
object RichAig: TRichEdit
Left = 0
@@ -2632,25 +2680,9 @@ object FormConfig: TFormConfig
'RichAig')
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 2
TabOrder = 1
OnMouseDown = RichAigMouseDown
end
object EditP3: TEdit
Left = 432
Top = 180
Width = 33
Height = 21
TabOrder = 3
Text = 'EditDDroit'
end
object EditP4: TEdit
Left = 432
Top = 204
Width = 33
Height = 21
TabOrder = 4
Text = 'EditDDroit'
end
end
object TabSheetBranches: TTabSheet
Caption = 'Branches'
@@ -2696,21 +2728,21 @@ object FormConfig: TFormConfig
Left = 288
Top = 40
Width = 281
Height = 313
Height = 353
Caption = 'Description du signal'
TabOrder = 0
object ImageSignal: TImage
Left = 8
Top = 72
Width = 65
Top = 80
Width = 81
Height = 105
end
object LabelAdrSig: TLabel
Left = 13
Top = 20
Width = 52
Width = 166
Height = 19
Caption = 'Signal '
Caption = 'Description du signal '
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -16
@@ -2719,37 +2751,39 @@ object FormConfig: TFormConfig
ParentFont = False
end
object LabelDec: TLabel
Left = 80
Left = 88
Top = 52
Width = 53
Width = 56
Height = 13
Caption = 'D'#233'codeur: '
Caption = 'D'#233'codeur : '
end
object LabelDetAss: TLabel
Left = 80
Top = 72
Left = 88
Top = 104
Width = 86
Height = 13
Caption = 'D'#233'tecteur associ'#233
end
object LabelElSuiv: TLabel
Left = 176
Top = 72
Left = 184
Top = 104
Width = 75
Height = 13
Caption = 'Element suivant'
end
object Label17: TLabel
Left = 8
Top = 216
Width = 131
Top = 248
Width = 228
Height = 26
Caption = 'Conditions suppl'#233'mentaires d'#39'affichage du carr'#233' :'
Caption =
'Conditions suppl'#233'mentaires d'#39'affichage du carr'#233' par les aiguilla' +
'ges :'
WordWrap = True
end
object Label24: TLabel
Left = 104
Top = 88
Top = 120
Width = 8
Height = 13
Caption = '1'
@@ -2762,7 +2796,7 @@ object FormConfig: TFormConfig
end
object Label25: TLabel
Left = 104
Top = 112
Top = 144
Width = 8
Height = 13
Caption = '2'
@@ -2775,7 +2809,7 @@ object FormConfig: TFormConfig
end
object Label26: TLabel
Left = 104
Top = 136
Top = 168
Width = 8
Height = 13
Caption = '3'
@@ -2788,7 +2822,7 @@ object FormConfig: TFormConfig
end
object Label27: TLabel
Left = 104
Top = 160
Top = 192
Width = 8
Height = 13
Caption = '4'
@@ -2799,17 +2833,32 @@ object FormConfig: TFormConfig
Font.Style = [fsBold]
ParentFont = False
end
object Label33: TLabel
Left = 96
Top = 76
Width = 39
Height = 13
Caption = 'Aspect :'
end
object LabelUni: TLabel
Left = 8
Top = 200
Width = 75
Height = 13
Caption = 'Spec Unisemaf:'
Visible = False
end
object MemoCarre: TMemo
Left = 8
Top = 248
Top = 280
Width = 241
Height = 49
Height = 57
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
object ComboBoxDec: TComboBox
Left = 136
Left = 144
Top = 48
Width = 129
Height = 21
@@ -2819,7 +2868,7 @@ object FormConfig: TFormConfig
end
object EditDet1: TEdit
Left = 120
Top = 88
Top = 120
Width = 41
Height = 21
TabOrder = 2
@@ -2828,7 +2877,7 @@ object FormConfig: TFormConfig
end
object EditSuiv1: TEdit
Left = 184
Top = 88
Top = 120
Width = 41
Height = 21
TabOrder = 3
@@ -2837,7 +2886,7 @@ object FormConfig: TFormConfig
end
object EditDet2: TEdit
Left = 120
Top = 112
Top = 144
Width = 41
Height = 21
TabOrder = 4
@@ -2846,7 +2895,7 @@ object FormConfig: TFormConfig
end
object EditSuiv2: TEdit
Left = 184
Top = 112
Top = 144
Width = 41
Height = 21
TabOrder = 5
@@ -2855,7 +2904,7 @@ object FormConfig: TFormConfig
end
object EditDet3: TEdit
Left = 120
Top = 136
Top = 168
Width = 41
Height = 21
TabOrder = 6
@@ -2864,7 +2913,7 @@ object FormConfig: TFormConfig
end
object EditSuiv3: TEdit
Left = 184
Top = 136
Top = 168
Width = 41
Height = 21
TabOrder = 7
@@ -2873,7 +2922,7 @@ object FormConfig: TFormConfig
end
object EditDet4: TEdit
Left = 120
Top = 160
Top = 192
Width = 41
Height = 21
TabOrder = 8
@@ -2882,7 +2931,7 @@ object FormConfig: TFormConfig
end
object EditSuiv4: TEdit
Left = 184
Top = 160
Top = 192
Width = 41
Height = 21
TabOrder = 9
@@ -2891,7 +2940,7 @@ object FormConfig: TFormConfig
end
object CheckVerrouCarre: TCheckBox
Left = 112
Top = 192
Top = 224
Width = 145
Height = 17
Caption = 'Verrouillable au carr'#233
@@ -2899,14 +2948,45 @@ object FormConfig: TFormConfig
OnClick = CheckVerrouCarreClick
end
object EditAdrSig: TEdit
Left = 72
Left = 184
Top = 18
Width = 41
Width = 33
Height = 21
Enabled = False
TabOrder = 11
Text = ' '
OnChange = EditAdrSigChange
end
object ComboBoxAsp: TComboBox
Left = 144
Top = 72
Width = 129
Height = 21
ItemHeight = 13
TabOrder = 12
OnChange = ComboBoxAspChange
Items.Strings = (
'2 feux'
'3 feux'
'4 feux'
'5 feux'
'7 feux'
'9 feux'
'Directionnel 2 feux'
'Directionnel 3 feux'
'Directionnel 4 feux'
'Directionnel 5 feux'
'Directionnel 6 feux')
end
object EditSpecUni: TEdit
Left = 8
Top = 216
Width = 33
Height = 21
TabOrder = 13
Visible = False
OnChange = EditSpecUniChange
end
end
object RichSig: TRichEdit
Left = 0
UnitConfig.pas
+192 -47
View File
@@ -90,23 +90,10 @@ type
RadioButtonsans: TRadioButton;
RadioButton30kmh: TRadioButton;
RadioButton60kmh: TRadioButton;
EditDroit_BD: TEdit;
EditDevie_HD: TEdit;
EditPointe_BG: TEdit;
LabelLigne: TLabel;
LabelBG: TLabel;
LabelHD: TLabel;
LabelBD: TLabel;
ImageAig: TImage;
ImageAffiche: TImage;
ImageTJD: TImage;
Edit_HG: TEdit;
LabelHG: TLabel;
EditP1: TEdit;
EditP2: TEdit;
ImageTri: TImage;
Label18: TLabel;
EditDevieS2: TEdit;
GroupBox12: TGroupBox;
ImageSignal: TImage;
LabelAdrSig: TLabel;
@@ -169,11 +156,7 @@ type
EditSuiv4: TEdit;
CheckVerrouCarre: TCheckBox;
Image2: TImage;
LabelTJD1: TLabel;
EditP3: TEdit;
EditP4: TEdit;
Label28: TLabel;
LabelTJD2: TLabel;
CheckInverse: TCheckBox;
RadioButtonAccess: TRadioButton;
Label29: TLabel;
@@ -189,6 +172,30 @@ type
EditAdrSig: TEdit;
Label32: TLabel;
EditTempoAig: TEdit;
EditAdrAig: TEdit;
ComboBoxAig: TComboBox;
GroupBox16: TGroupBox;
LabelHG: TLabel;
Edit_HG: TEdit;
LabelBG: TLabel;
EditPointe_BG: TEdit;
ImageAffiche: TImage;
EditP1: TEdit;
EditP2: TEdit;
EditP3: TEdit;
EditP4: TEdit;
LabelHD: TLabel;
EditDevie_HD: TEdit;
LabelBD: TLabel;
EditDroit_BD: TEdit;
Label18: TLabel;
EditDevieS2: TEdit;
LabelTJD1: TLabel;
LabelTJD2: TLabel;
Label33: TLabel;
ComboBoxAsp: TComboBox;
EditSpecUni: TEdit;
LabelUni: TLabel;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
@@ -228,6 +235,9 @@ type
procedure Edit_HGChange(Sender: TObject);
procedure CheckInverseClick(Sender: TObject);
procedure EditAdrSigChange(Sender: TObject);
procedure EditAdrAigChange(Sender: TObject);
procedure ComboBoxAspChange(Sender: TObject);
procedure EditSpecUniChange(Sender: TObject);
private
{ Déclarations privées }
public
@@ -519,11 +529,11 @@ begin
end;
// transforme le signal du tableau en texte
// transforme le signal du tableau graphique en texte
function encode_sig(i : integer): string;
var s : string;
c : char;
adresse,aspect,j,k,NfeuxDir : integer;
adresse,aspect,j,k,NfeuxDir,CondCarre,l,nc : integer;
begin
// adresse
adresse:=feux[i].adresse;
@@ -553,7 +563,7 @@ begin
s:=s+'),';
end
else
// feux directionels
// feux directionnels
begin
NfeuxDir:=aspect-10;
for j:=1 to NfeuxDir+1 do
@@ -575,6 +585,32 @@ begin
// si unsemaf, paramètre supplémentaire
if feux[i].decodeur=6 then s:=s+','+intToSTR(feux[i].unisemaf);
end;
// conditions supplémentaires pour le carré
if aspect<10 then
begin
CondCarre:=Length(feux[i].condcarre[1]); // nombre de conditions (nombre de parenthèses ex 3 pour (A21S,A6D)(A30S,A20D)(A1D,A2S,A3D)
if condCarre<>0 then
begin
dec(condCarre);
l:=1;
while condCarre<>0 do
begin
//if condcarre<>0 then dec(condcarre);
s:=s+',(';
nc:=Length(feux[i].condcarre[l])-1 ; // nombre d'aiguillages dans la parenthèse A21,S,A6,D = 4
for k:=1 to nc do
begin
s:=s+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig;
if k<nc then s:=s+',';
end;
s:=s+')';
inc(l);
//CondCarre:=Length(feux[i].condcarre[l]);
dec(condcarre);
end;
end;
end;
encode_sig:=s;
end;
@@ -1138,7 +1174,7 @@ end;
// procédure appellée quand on clique une ligne aiguillage de RichAig
procedure Aff_champs_aig;
var Adresse,Adr2,traite,erreur,i,j,Nboucle,selpos,AncAdresse,lc : integer;
bis,tjd,tri : boolean;
bis,tjd,tri,tjs : boolean;
s,ss : string;
B : char;
begin
@@ -1147,7 +1183,7 @@ begin
begin
lc:=Perform(EM_LINEFROMCHAR,-1,0); // numéro de la lignée cliquée
s:=Uppercase(Lines[lc]); // ligne cliquée
s:=Uppercase(Lines[lc]);
if s='' then exit;
AncLigneCliquee:=LigneCliquee;
@@ -1171,16 +1207,17 @@ begin
end;
Val(s,Adresse,erreur); // Adresse de l'aiguillage
Val(s,Adresse,erreur); // Récupérer l'adresse de l'aiguillage
if adresse=0 then exit;
RE_ColorLine(Formconfig.RichAig,ligneCliquee,Clyellow);
ss:='Description de l''aiguillage '+InttoSTr(Adresse);
formconfig.LabelAdresse.Caption:= ss;
ss:=InttoSTr(Adresse);
formconfig.EditAdrAig.text:= ss;
tjd:=pos('TJD',s)<>0 ;
tri:=pos('TRI',s)<>0 ;
tjs:=pos('TJS',s)<>0 ;
with formconfig do
begin
LabelLigne.caption:=s;
@@ -1188,8 +1225,10 @@ begin
ImageAffiche.Picture.Bitmap.TransparentColor:=clblue;
ImageAffiche.Transparent:=true;
// tjd
if tjd then
if tjd or tjs then
begin
if tjd then ComboBoxAig.ItemIndex:=1; // 0=n'existe pas 1=aiguillage 2=TJD 3=TJS 4=aiguillage triple
if tjs then ComboBoxAig.ItemIndex:=2;
ImageAffiche.Picture.BitMap:=Imagetjd.Picture.Bitmap;
labelBG.Caption:='S';
Edit_HG.Visible:=true;
@@ -1249,6 +1288,7 @@ begin
// aiguillage tri
if tri then
begin
ComboBoxAig.ItemIndex:=3; // 0=n'existe pas 1=aiguillage 2=TJD 3=TJS 4=aiguillage triple
tri:=true;
labelTJD1.Visible:=false;
LabelTJD2.Visible:=false;
@@ -1264,6 +1304,7 @@ begin
else
// aiguillage normal
begin
ComboBoxAig.ItemIndex:=0; // 0=n'existe pas 1=aiguillage 2=TJD 3=TJS 4=aiguillage triple
ImageAffiche.Picture.BitMap:=Imageaig.Picture.Bitmap;
labelBG.Caption:='P';
EditPointe_BG.ReadOnly:=false;
@@ -1360,14 +1401,14 @@ end;
// appellée quand on clique sur la liste signaux
Procedure aff_champs_sig;
var i,j,l,d,k, ligne,lc, adresse,erreur,condCarre,AncAdresse : integer;
var i,j,l,d,k,nc, ligne,lc, adresse,erreur,condCarre,AncAdresse : integer;
s,ss,s2 : string;
begin
// déterminer la ligne cliquée et mettre en surbrillance
with Formconfig.RichSig do
begin
lc:=Perform(EM_LINEFROMCHAR,-1,0); // numéro de la lignée cliquée
//Affiche('numéro de la ligne cliquée '+intToStr(lc),clyellow);
s:=Uppercase(Lines[lc]); // ligne cliquée
if s='' then exit;
@@ -1375,7 +1416,7 @@ begin
ligneCliquee:=lc;
//Affiche('Ancienne='+IntToSTR(AncLigneCliquee)+' Nouvelle='+IntToSTR(LigneCliquee),clyellow);
// Mettre en rouge le signal modifié quand on clique sur un autre aiguillage
// Mettre en rouge le signal modifié quand on clique sur un autre signal
if AncLigneCliquee<>-1 then
begin
val(FormConfig.RichSig.Lines[AncLigneCliquee],AncAdresse,erreur);
@@ -1392,6 +1433,7 @@ begin
FormConfig.EditAdrSig.text:=InttoSTr(Adresse);
i:=Index_feu(adresse);
with formconfig.ImageSignal do
begin
Picture.Bitmap.TransparentMode:=tmAuto;
@@ -1406,7 +1448,24 @@ begin
EditDet3.Text:=''; EditSuiv3.Text:='';
EditDet4.Text:=''; EditSuiv4.Text:='';
ComboBoxDec.ItemIndex:=feux[i].decodeur;
if feux[i].decodeur=6 then
begin
EditSpecUni.Visible:=true;LabelUni.Visible:=true;
EditSpecUni.Text:=IntToSTR(feux[i].Unisemaf);
end
else begin EditSpecUni.Visible:=false;LabelUni.Visible:=false;end;
d:=feux[i].aspect;
case d of
2 : ComboBoxAsp.ItemIndex:=0;
3 : ComboBoxAsp.ItemIndex:=1;
4 : ComboBoxAsp.ItemIndex:=2;
5 : ComboBoxAsp.ItemIndex:=3;
7 : ComboBoxAsp.ItemIndex:=4;
9 : ComboBoxAsp.ItemIndex:=5;
else
ComboBoxAsp.ItemIndex:=d-10+4;
end;
// signal normal
if d<10 then
begin
@@ -1438,26 +1497,30 @@ begin
checkVerrouCarre.Checked:=feux[i].VerrouCarre;
// conditions supplémentaires
CondCarre:=Length(feux[i].condcarre[1]);
// conditions supplémentaires du carré par aiguillages
CondCarre:=Length(feux[i].condcarre[1]); // nombre de conditions (nombre de parenthèses ex 3 pour (A21S,A6D)(A30S,A20D)(A1D,A2S,A3D)
l:=1;
while condCarre<>0 do
if condCarre<>0 then
begin
if condcarre<>0 then dec(condcarre);
s2:='';
for k:=1 to condCarre do
dec(condCarre);
while condCarre<>0 do
begin
s2:=s2+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig;
if k<condCarre then s2:=s2+',';
//if condcarre<>0 then dec(condcarre);
s2:='';
nc:=Length(feux[i].condcarre[l])-1 ; // nombre d'aiguillages dans la parenthèse A21,S,A6,D = 4
for k:=1 to nc do
begin
s2:=s2+'A'+IntToSTR(feux[i].condcarre[l][k].Adresse)+feux[i].condcarre[l][k].PosAig;
if k<nc then s2:=s2+',';
end;
MemoCarre.Lines.Add(s2);
inc(l);
dec(condcarre);
end;
//s2:=s2+'/';
MemoCarre.Lines.Add(s2);
inc(l);
CondCarre:=Length(feux[i].condcarre[l]);
end;
// scrolle le MemoCarre sur la première ligne
MemoCarre.SelStart:=0;
MemoCarre.Perform(EM_SCROLLCARET,0,0);
end;
end
else
begin // directionnel
@@ -1964,7 +2027,7 @@ procedure TFormConfig.EditDet1Change(Sender: TObject);
var s : string;
i,erreur : integer;
begin
if clicliste then exit;
if clicliste or (feux[lignecliquee+1].Aspect>10) then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then
with Formconfig do
@@ -1985,7 +2048,7 @@ var s : string;
i,erreur : integer;
B : char;
begin
if clicliste then exit;
if clicliste or (feux[lignecliquee+1].Aspect>10) then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then
with Formconfig do
@@ -2399,6 +2462,88 @@ begin
end;
procedure TFormConfig.EditAdrAigChange(Sender: TObject);
var s : string;
i, erreur : integer;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAig then
with Formconfig do
begin
s:=EditAdrAig.Text;
Val(s,i,erreur);
if erreur<>0 then begin LabelInfo.caption:='Erreur adresse aiguillage ';exit;end;
// vérifier si l'adresse de l'aiguillage existe déja
if (aiguillage[i].modele<>0) then
begin
LabelInfo.caption:='aiguillage '+IntToSTR(i)+' existe déja - ne sera pas écrasé' ;
exit;
end
else LabelInfo.caption:='';
LabelInfo.caption:=' ';
s:=encode_aig(i);
affiche(s,clyellow);
end;
end;
procedure TFormConfig.ComboBoxAspChange(Sender: TObject);
var i,index,feu,asp : integer;
s : string;
begin
i:=ComboBoxAsp.ItemIndex;
//Affiche(IntToSTR(i),clyellow);
case i of
0 : asp:=2;
1 : asp:=3;
2 : asp:=4;
3 : asp:=5;
4 : asp:=7;
5 : asp:=9;
else asp:=i+6;
end;
index:=lignecliquee+1; // index du feu
feux[index].aspect:=asp;
s:=encode_sig(index);
formconfig.RichSig.Lines[lignecliquee]:=s;
// change l'image du feu
feux[index].Img.picture.Bitmap:=Select_dessin_feu(asp);
// mettre rouge par défaut
if asp=2 then EtatSignalCplx[feux[index].adresse]:=32;
if asp=3 then EtatSignalCplx[feux[index].adresse]:=2;
if (asp>3) and (asp<10) then EtatSignalCplx[feux[index].adresse]:=1;
if asp>10 then EtatSignalCplx[feux[index].adresse]:=0;
aff_champs_sig; // redessine le graphisme du cadre
dessine_feu_mx(Feux[index].Img.Canvas,0,0,1,1,feux[index].adresse,1);
end;
procedure TFormConfig.EditSpecUniChange(Sender: TObject);
var erreur,i,Adr : integer ;
s : string ;
begin
if clicliste then exit;
if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then
with Formconfig do
begin
s:=EditSpecUni.Text;
Val(s,i,erreur); // code unisemaf
s:=EditAdrSig.Text;
Val(s,Adr,erreur); // Adresse signal
// vérification code unisemaf
erreur:=verif_unisemaf(Adr,i);
if erreur=1 then begin LabelInfo.caption:='Erreur code Unisemaf';exit;end;
if erreur=2 then begin LabelInfo.caption:='Erreur cohérence aspect signal';exit;end;
LabelInfo.caption:=' ';
feux[lignecliquee+1].Unisemaf:=i;
s:=encode_sig(lignecliquee+1);
formconfig.RichSig.Lines[lignecliquee]:=s;
end;
end;
end.
UnitConfigTCO.dcu
BIN
View File
Binary file not shown.
UnitDebug.dcu
BIN
View File
Binary file not shown.
UnitPilote.dcu
BIN
View File
Binary file not shown.
UnitPilote.dfm
+11 -3
View File
@@ -12,6 +12,7 @@ object FormPilote: TFormPilote
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
@@ -37,14 +38,14 @@ object FormPilote: TFormPilote
end
object LabelNbFeux: TLabel
Left = 208
Top = 224
Top = 240
Width = 120
Height = 13
Caption = 'Nombre de feux '#224' allumer'
end
object LabelDec: TLabel
Left = 216
Top = 192
Top = 208
Width = 72
Height = 19
Caption = 'LabelDec'
@@ -55,6 +56,13 @@ object FormPilote: TFormPilote
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 232
Top = 192
Width = 50
Height = 13
Caption = 'D'#233'codeur:'
end
object GroupBox1: TGroupBox
Left = 8
Top = 40
@@ -208,7 +216,7 @@ object FormPilote: TFormPilote
end
object EditNbreFeux: TEdit
Left = 240
Top = 248
Top = 256
Width = 57
Height = 21
TabOrder = 3
UnitPilote.pas
+12 -10
View File
@@ -32,6 +32,7 @@ type
EditNbreFeux: TEdit;
LabelNbFeux: TLabel;
LabelDec: TLabel;
Label1: TLabel;
procedure RadioVertClick(Sender: TObject);
procedure RadioVertCliClick(Sender: TObject);
procedure RadioJauneClick(Sender: TObject);
@@ -50,6 +51,7 @@ type
procedure FormCreate(Sender: TObject);
procedure ButtonPiloteClick(Sender: TObject);
procedure EditNbreFeuxKeyPress(Sender: TObject; var Key: Char);
procedure FormActivate(Sender: TObject);
private
{ Déclarations privées }
public
@@ -212,15 +214,9 @@ begin
end;
procedure TFormPilote.FormCreate(Sender: TObject);
var i,d : integer;
begin
radioVert.Checked:=false;
radioVertCli.Checked:=false;
i:=index_feu(AdrPilote);
d:=feux[i].decodeur;
//labelDec.Caption:=decodeur[d];
//Affiche(decodeur[d],clred);
radioVert.Checked:=false;
radioVertCli.Checked:=false;
end;
procedure TFormPilote.ButtonPiloteClick(Sender: TObject);
@@ -255,13 +251,19 @@ if ord(Key) = VK_RETURN then
EtatSignalCplx[0]:=i;
dessine_feu_pilote;
end;
if (i<0) and (i>6) then EditNbreFeux.text:='1';
end
else EditNbreFeux.text:='1';
end;
end;
procedure TFormPilote.FormActivate(Sender: TObject);
var i,d : integer;
begin
// mise à jour du champ décodeur
i:=index_feu(AdrPilote);
d:=feux[i].decodeur;
LabelDec.Caption:=decodeur[d];
end;
end.
UnitPrinc.dcu
BIN
View File
Binary file not shown.
UnitPrinc.dfm
+4 -4
View File
@@ -1557,12 +1557,12 @@ object FormPrinc: TFormPrinc
object Interface1: TMenuItem
Caption = 'Interface'
object MenuConnecterUSB: TMenuItem
Caption = 'Connecter l'#39'interface en USB'
Caption = 'Connecter l'#39'interface XpressNet en USB'
Hint = 'Connecter l'#39'interface en USB'
OnClick = MenuConnecterUSBClick
end
object DeconnecterUSB: TMenuItem
Caption = 'D'#233'connecter interface de l'#39'USB'
Caption = 'D'#233'connecter l'#39'interface XpressNet de l'#39'USB'
Hint = 'D'#233'connecter l'#39'interface USB'
OnClick = DeconnecterUSBClick
end
@@ -1570,12 +1570,12 @@ object FormPrinc: TFormPrinc
Caption = '-'
end
object MenuConnecterEthernet: TMenuItem
Caption = 'Connecter l'#39'interface en Ethernet'
Caption = 'Connecter l'#39'interface XpressNet en Ethernet'
Hint = 'Connecter l'#39'interface par Ethernet'
OnClick = MenuConnecterEthernetClick
end
object MenuDeconnecterEthernet: TMenuItem
Caption = 'D'#233'connecter l'#39'interface de Ethernet'
Caption = 'D'#233'connecter l'#39'interface XpressNet de Ethernet'
Hint = 'D'#233'connecter l'#39'interface par Ethernet'
OnClick = MenuDeconnecterEthernetClick
end
UnitPrinc.pas
+82 -35
View File
@@ -198,8 +198,8 @@ type TBranche = record
position, // position actuelle : 1=dévié 2=droit (centrale LENZ)
Adrtriple, // 2eme adresse pour un aiguillage triple
temps, // temps de pilotage (durée de l'impulsion en x 100 ms)
inversion : integer; // pilotage inversé pour la commande (en mode sans CDM) 0=normal 1=inversé (positionné dans fichier config_gl section_init
InversionCDM : integer ; // inversion pour les aiguillages en lecture (paramètre I1)
inversion : integer; // positionné dans fichier config_gl section_init
InversionCDM : integer ; // pour les aiguillages déclarés inversés dans CDM, utilisé en mode autonome (paramètre I1)
vitesse : integer; // vitesse de franchissement de l'aiguillage en position déviée (60 ou 90)
ADroit : integer ; // (TJD:identifiant extérieur) connecté sur la position droite en talon
@@ -329,6 +329,7 @@ var
posAig : char;
end;
CondCarre : array[1..6] of array of record // conditions supplémentaires d'aiguillages en position pour le carré
// attention les données sont stockée en adresse 1 du tableau dynamique
Adresse : integer; // aiguillage
posAig : char;
end;
@@ -369,6 +370,8 @@ function PresTrainPrec(AdrFeu : integer) : boolean;
function cond_carre(adresse : integer) : boolean;
function carre_signal(adresse : integer) : boolean;
procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string);
function verif_UniSemaf(adresse,UniSem : integer) : integer;
function Select_dessin_feu(TypeFeu : integer) : TBitmap;
implementation
@@ -1163,6 +1166,26 @@ begin
end;
end;
function Select_dessin_feu(TypeFeu : integer) : TBitmap;
var Bm : TBitMap;
begin
case TypeFeu of // charger le bit map depuis le fichier
2 : Bm:=Formprinc.Image2feux.picture.Bitmap;
3 : Bm:=Formprinc.Image3feux.picture.Bitmap;
4 : Bm:=Formprinc.Image4feux.picture.Bitmap;
5 : Bm:=Formprinc.Image5feux.picture.Bitmap;
7 : Bm:=Formprinc.Image7feux.picture.Bitmap;
9 : Bm:=Formprinc.Image9feux.picture.Bitmap;
12 : Bm:=Formprinc.Image2Dir.picture.Bitmap;
13 : Bm:=Formprinc.Image3Dir.picture.Bitmap;
14 : Bm:=Formprinc.Image4Dir.picture.Bitmap;
15 : Bm:=Formprinc.Image5Dir.picture.Bitmap;
16 : Bm:=Formprinc.Image6Dir.picture.Bitmap;
end;
Select_dessin_feu:=bm;
end;
// créée une image dynamiquement pour un nouveau feu déclaré dans le fichier de config
procedure cree_image(rang : integer);
var TypeFeu : integer;
@@ -1187,22 +1210,10 @@ begin
Picture.Bitmap.TransparentMode:=tmAuto;
Picture.Bitmap.TransparentColor:=clblue;
Transparent:=true;
// affecter le type d'image de feu dans l'image créée
picture.Bitmap:=Select_dessin_feu(TypeFeu);
case TypeFeu of // charger le bit map depuis le fichier
2 : picture.bitmap:=Formprinc.Image2feux.picture.Bitmap;
3 : picture.bitmap:=Formprinc.Image3feux.picture.Bitmap;
4 : picture.bitmap:=Formprinc.Image4feux.picture.Bitmap;
5 : picture.bitmap:=Formprinc.Image5feux.picture.Bitmap;
7 : picture.bitmap:=Formprinc.Image7feux.picture.Bitmap;
9 : picture.bitmap:=Formprinc.Image9feux.picture.Bitmap;
12 : picture.bitmap:=Formprinc.Image2Dir.picture.Bitmap;
13 : picture.bitmap:=Formprinc.Image3Dir.picture.Bitmap;
14 : picture.bitmap:=Formprinc.Image4Dir.picture.Bitmap;
15 : picture.bitmap:=Formprinc.Image5Dir.picture.Bitmap;
16 : picture.bitmap:=Formprinc.Image6Dir.picture.Bitmap;
end;
// mettre rouge par défaut
if TypeFeu=2 then EtatSignalCplx[feux[rang].adresse]:=violet_F;
if TypeFeu=3 then EtatSignalCplx[feux[rang].adresse]:=semaphore_F;
@@ -3369,6 +3380,27 @@ begin
IndexBranche_trouve:=i;
end;
// si 0 = OK
// si 1 = erreur code Unisemaf
// si 2 = erreur cohérence entre code et aspect
function verif_UniSemaf(adresse,UniSem : integer) : integer;
var aspect : integer;
begin
if UniSem=0 then begin verif_unisemaf:=0;exit;end;
if (UniSem<>2) and (UniSem<>3) and (UniSem<>4) and (UniSem<>51) and (UniSem<>52) and (UniSem<>71) and (UniSem<>72) and (UniSem<>73) and
((UniSem<90) or (UniSem>99)) then begin verif_UniSemaf:=1;exit;end;
aspect:=feux[adresse].aspect;
if ((aspect=2) and (UniSem=2)) or
((aspect=3) and (UniSem=3)) or
((aspect=4) and (UniSem=4)) or
((aspect=5) and ((UniSem=51) or (UniSem=52))) or
((aspect=7) and ((UniSem=71) or (UniSem=72) or (UniSem=73))) or
((aspect=9) and ((UniSem>=90) or (UniSem<=99)))
then Verif_unisemaf:=0
else Verif_Unisemaf:=2;
end;
procedure lit_config;
var s,sa,chaine,SOrigine: string;
c,paig : char;
@@ -3378,7 +3410,7 @@ var s,sa,chaine,SOrigine: string;
trouve_NOTIF_VERSION,trouve_verif_version,trouve_fonte,trouve_tempo_aig : boolean;
bd,virgule,i_detect,i,erreur,aig,aig2,detect,offset,index, adresse,j,position,temporisation,invers,indexPointe,indexDevie,indexDroit,
ComptEl,Compt_IT,Num_Element,k,modele,adr,adr2,erreur2,l,t,Nligne,postriple,itl,
postjd,postjs,nv,it,Num_Champ : integer;
postjd,postjs,nv,it,Num_Champ,asp : integer;
function lit_ligne : string ;
begin
repeat
@@ -3499,7 +3531,12 @@ begin
trouve_ipv4_PC:=true;
delete(s,i,length(sa));
i:=pos(':',s);
if i<>0 then begin adresseIPCDM:=copy(s,1,i-1);Delete(s,1,i);portCDM:=StrToINT(s);end;
if i<>0 then
begin
adresseIPCDM:=copy(s,1,i-1);Delete(s,1,i);portCDM:=StrToINT(s);
if portCDM=0 then affiche('Erreur port nul : '+s,clred);
end
else affiche('Erreur adresse ip cdm rail '+s,clred);
end;
// adresse ip et port de la centrale
@@ -3512,7 +3549,11 @@ begin
trouve_IPV4_INTERFACE:=true;
delete(s,i,length(sa));
i:=pos(':',s);
if i<>0 then begin adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);end
if i<>0 then
begin
adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);
if port=0 then affiche('Erreur port nul : '+s,clred);
end
else begin adresseIP:='0';parSocketLenz:=false;end;
end;
@@ -3967,7 +4008,7 @@ begin
end;
inc(itl);
until (enregistrement='') or (itl>2);
if itl>2 then begin Affiche('Erreur 400 ligne '+sOrigine,clred);closefile(fichier);exit;end;
if itl>4 then begin Affiche('Erreur 400 ligne '+sOrigine,clred);closefile(fichier);exit;end;
end;
until (s='0');
//Affiche(IntToSTR(maxaiguillage)+' Aiguillages',clYellow);
@@ -4123,10 +4164,10 @@ begin
else
// feu de signalisation---------------------------------
begin
k:=StrToInt(sa); //aspect
feux[i].aspect:=k;Delete(s,1,j);
if (k=0) or (k=6) or (k>9) then
Affiche('Fichier config.cfg: configuration aspect ('+intToSTR(k)+') feu incorrecte à la ligne '+chaine,clRed);
asp:=StrToInt(sa); //aspect
feux[i].aspect:=asp;Delete(s,1,j);
if (asp=0) or (asp=6) or (asp>9) then
Affiche('Fichier config.cfg: configuration aspect ('+intToSTR(asp)+') feu incorrecte à la ligne '+chaine,clRed);
j:=pos(',',s);
if j>1 then begin Feux[i].FeuBlanc:=(copy(s,1,j-1))='1';delete(s,1,j);end;
j:=pos(',',s);
@@ -4220,6 +4261,13 @@ begin
Delete(S,1,k);
Val(s,k,erreur);
Feux[i].UniSemaf:=k;
erreur:=verif_UniSemaf(i,k);
if erreur=1 then begin Affiche('Ligne '+chaine,clred);Affiche('Erreur code Unisemaf',clred);end;
if erreur=2 then
begin
Affiche('Ligne '+chaine,clred);Affiche('Erreur cohérence aspect signal ('+intToSTR(asp)+') et code Unisemaf ('+intToSTR(k)+')',clred);
end;
end;
end;
end;
@@ -4451,16 +4499,15 @@ begin
j:=1;
repeat
detect:=BrancheN[i][j].Adresse;
modele:=BrancheN[i][j].BType; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir
modele:=BrancheN[i][j].BType; // 1= détecteur 2= aiguillage 4=Buttoir
if (modele=2) then
begin
//affiche('trouvé aig '+intToSTR(detect),clyellow);
modele:=aiguillage[detect].modele;
if (modele=0) then Affiche('Erreur 1: Aiguillage '+intToStr(detect)+' non décrit mais présent en branche '+intToStr(i)+' pos. '+intToSTR(j),clred);
end;
j:=j+1;
until ( (modele=1) or (modele=2) or (modele=3) or ((modele=0) and (detect=0)));
// trouvé un aiguillage et récupéré son adresse dans detect
//if (type!=1) Display("Erreur aucun détecteur dans la déclaration du réseau\r\n");
if (modele=1) or (modele=2) or (modele=3) then
begin
modele:=aiguillage[detect].modele;
if (modele=0) then Affiche('Erreur 1: Aiguillage='+intToStr(detect)+' non décrit mais présent dans la description des branches '+intToStr(i)+'/'+intToSTR(j),clred);
end;
until((modele=0) and (detect=0));
end;
// vérification de la cohérence2
@@ -6797,7 +6844,7 @@ begin
// si l'aiguillage est inversé dans CDM et qu'on est en mode autonome, inverser sa position
inv:=false;
if (aiguillage[adresse].inversionCDM=1) then // and (portCommOuvert or parSocketLenz) then
if (aiguillage[adresse].inversionCDM=1) and (portCommOuvert or parSocketLenz) then
begin
prov:=pos;
inv:=true;
UnitSimule.dcu
BIN
View File
Binary file not shown.
UnitTCO.dcu
BIN
View File
Binary file not shown.
UnitTCO.pas
+19 -66
View File
@@ -465,7 +465,7 @@ end;
procedure sauve_fichier_tco;
var fichier : textfile;
s : string;
x,y,i,erreur : integer;
x,y : integer;
begin
AssignFile(fichier,'tco.cfg');
rewrite(fichier);
@@ -509,7 +509,6 @@ end;
procedure TformTCO.grille;
var x,y : integer;
r : Trect;
begin
if not(AvecGrille) then exit;
With PCanvasTCO do
@@ -533,10 +532,9 @@ end;
// élément de voie horizontale Element 1
procedure TFormTCO.dessin_voie(Canvas : Tcanvas;x,y,mode : integer);
var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
var Adr, x0,y0,jy1,jy2 : integer;
r : Trect;
couleur : Tcolor;
s : string;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -579,7 +577,6 @@ procedure TformTCO.dessin_AigG_PD(canvas : Tcanvas;x,y : integer; Mode,position
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
inverse : boolean;
r : Trect;
s : string;
procedure horz;
begin
@@ -663,7 +660,6 @@ procedure TFormTCO.dessin_AigPG_AG(Canvas : Tcanvas;x,y : integer;Mode ,position
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
inverse : boolean;
r : Trect;
s : string;
procedure horz;
begin
@@ -748,7 +744,6 @@ procedure TformTCO.dessin_AigD_PG(Canvas : Tcanvas;x,y,Mode,position : integer);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
inverse : boolean;
r : Trect;
s : string;
procedure bande_horz;
begin
@@ -836,7 +831,6 @@ procedure TFormTCO.dessin_AigPD_AD(Canvas : Tcanvas;x,y : integer;Mode,position
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
inverse : boolean;
r : Trect;
s : string;
procedure horz;
begin
@@ -983,7 +977,7 @@ end;
// courbe: droit vers bas -\ Element 8
procedure TFormTCO.dessin_infD(Canvas : Tcanvas;x,y : integer;Mode : integer);
var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
var jy1,jy2,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
@@ -1017,7 +1011,7 @@ end;
// courbe bas gauche vers droit Elément 9
procedure TFormTCO.dessin_infG(Canvas : Tcanvas;x,y : integer;Mode : integer);
var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
var jy1,jy2,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
@@ -1050,9 +1044,8 @@ end;
// élément 10
procedure TformTCO.dessin_Diag1(Canvas : Tcanvas;x,y : integer;Mode : integer);
var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
s : string;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -1097,9 +1090,8 @@ end;
// élément 11
procedure TformTCO.dessin_Diag2(Canvas : Tcanvas;x,y : integer;Mode : integer);
var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
s : string;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
@@ -1636,7 +1628,7 @@ end;
// Element 20
procedure TFormTCO.dessin_20(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,xbv1,xbv2,adr : integer;
var x0,y0,xbv1,xbv2,adr : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
@@ -1784,7 +1776,7 @@ end;
// copie de l'image du feu à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire
procedure Feu_90D(ImageSource : TImage;x,y : integer ; FrX,FrY : real);
var p : array[0..2] of TPoint;
x0,y0,TailleY,TailleX : integer;
TailleY,TailleX : integer;
begin
TailleY:=ImageSource.Picture.Height;
TailleX:=ImageSource.Picture.Width;
@@ -1806,30 +1798,6 @@ begin
end;
// renvoie un pointeur vers l'image du feu suivant l'aspect du feu de adresse
// ne marche pas
function PointeurImage(adresse : integer) : TImage;
var i,aspect : integer;
Pim : TImage;
begin
// trouver l'aspect du feu
i:=Index_feu(adresse);
aspect:=feux[i].aspect;
pim:=nil;
case aspect of
2 : Pim:=Formprinc.Image2feux;
3 : Pim:=Formprinc.Image3feux;
4 : Pim:=Formprinc.Image4feux;
5 : Pim:=Formprinc.Image5feux;
7 : Pim:=Formprinc.Image7feux;
9 : Pim:=Formprinc.Image9feux;
else Pim:=Formprinc.Image3feux;
end;
PointeurImage:=Pim;
end;
procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor);
begin
with PCanvasTCO do
@@ -2171,7 +2139,7 @@ end;
// Dessine un feu dans le canvas en x,y , dont l'adresse se trouve à la cellule x,y
procedure dessin_feu(CanvasDest : Tcanvas;x,y : integer );
var OffsetX,x0,y0,xp,yp,orientation,adresse,i,aspect,TailleX,TailleY,NbCellDest : integer;
var x0,y0,xp,yp,orientation,adresse,aspect,TailleX,TailleY : integer;
ImageFeu : Timage;
frX,frY : real;
begin
@@ -2185,7 +2153,6 @@ begin
aspect:=TCO[x,y].aspect;
// Affiche(IntToSTR(i)+' '+intToSTR(aspect),clred);
offsetX:=0;
case aspect of
2 : ImageFeu:=Formprinc.Image2feux;
3 : ImageFeu:=Formprinc.Image3feux;
@@ -2289,7 +2256,7 @@ begin
end;
procedure TFormTCO.Efface_Cellule(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
var x0,y0 : integer;
r : TRect;
begin
if y>1 then
@@ -2375,9 +2342,9 @@ begin
end;
// affiche la cellule. x et y en cases
// affiche la cellule x et y en cases
procedure TformTCO.affiche_cellule(x,y : integer);
var i,Xorg,Yorg,mode,adresse,btype,Bimage,aspect,oriente,pos : integer;
var Xorg,Yorg,mode,adresse,btype,Bimage,aspect,oriente,pos : integer;
s : string;
begin
PcanvasTCO.pen.Mode:=PmCopy;
@@ -2665,9 +2632,8 @@ end;
// clic gauche sur image
procedure TFormTCO.ImageTCOClick(Sender: TObject);
var Position: TPoint;
i,j ,adresse,Bimage : integer;
Bimage : integer;
s : string;
menuItem: TmenuItem;
begin
//Affiche('1 Clic',clyellow);
GetCursorPos(Position);
@@ -2748,7 +2714,6 @@ end;
procedure zone_TCO(det1,det2,mode : integer);
var i,x,y,ancienY,ancien2Y,ancienX,ancien2X,Xdet1,Ydet1,Xdet2,Ydet2,Bimage,adresse,
pos,pos2 : integer;
trouve : boolean;
s : string;
begin
// trouver le détecteur det1
@@ -2959,7 +2924,6 @@ begin
end;
procedure TFormTCO.FormActivate(Sender: TObject);
var r : Trect;
begin
if not(Forminit) then
begin
@@ -3075,7 +3039,6 @@ begin
end;
procedure TFormTCO.Elmentdroit1Click(Sender: TObject);
var Position: TPoint;
begin
// effacer le carré pointeur
//Entoure_cell(XclicCell,YclicCell);
@@ -3696,9 +3659,8 @@ end;
// supprimer la sélection
procedure TFormTCO.MenuCouperClick(Sender: TObject);
var Position: TPoint;
r : Trect;
Adresse,x0,y0,x,y,XCell1,YCell1,xCell2,yCell2,i,j : integer;
var
x,y,XCell1,YCell1,xCell2,yCell2 : integer;
begin
// couper sans sélection : on coupe une seule cellule
if not(SelectionAffichee) then
@@ -3780,7 +3742,7 @@ begin
end;
procedure TFormTCO.AnnulercouperClick(Sender: TObject);
var x,y,Xplace,yplace,i,j,adresse : integer;
var x,y,Xplace,yplace,adresse : integer;
begin
if TamponAffecte then
begin
@@ -3798,7 +3760,6 @@ begin
if tco[xPlace,yPlace].Bimage=30 then
begin
adresse:=tco[xPlace,yPlace].Adresse;
j:=Index_feu(adresse);
end;
end;
end;
@@ -3951,7 +3912,7 @@ end;
// changement de l'adresse d'un élément
procedure TFormTCO.EditAdrElementChange(Sender: TObject);
var Adr,erreur,i,index,aspect : integer;
var Adr,erreur,index,aspect : integer;
begin
Val(EditAdrElement.Text,Adr,erreur);
if (erreur<>0) or (Adr<0) or (Adr>2048) then
@@ -4042,7 +4003,6 @@ end;
// dépose d'un feu sur le TCO
procedure TFormTCO.ImageDiag1EndDrag(Sender, Target: TObject; X, Y: Integer);
var i : integer;
begin
if (x=0) and (y=0) then exit;
TCO_modifie:=true;
@@ -4101,8 +4061,6 @@ begin
end;
procedure TFormTCO.ImageFeuEndDrag(Sender, Target: TObject; X, Y: Integer);
var r : Trect;
i : integer;
begin
if (x=0) and (y=0) then exit;
efface_entoure;
@@ -4137,9 +4095,7 @@ end;
procedure TFormTCO.Tourner90GClick(Sender: TObject);
var BImage,aspect,adresse : integer;
ImageFeu : TImage;
frX,frY : real;
var BImage,adresse : integer;
begin
BImage:=TCO[XClicCell,YClicCell].Bimage;
if Bimage<>30 then exit;
@@ -4174,8 +4130,6 @@ end;
procedure TFormTCO.Tourner90DClick(Sender: TObject);
var BImage ,aspect,adresse : integer;
ImageFeu : TImage;
frX,frY : real;
begin
BImage:=TCO[XClicCell,YClicCell].Bimage;
if Bimage<>30 then exit;
@@ -4213,7 +4167,6 @@ end;
procedure TFormTCO.Pos_vertClick(Sender: TObject);
var BImage ,aspect,Adresse : integer;
ImageFeu : TImage;
begin
BImage:=TCO[XClicCell,YClicCell].Bimage;
// si c'est autre chose qu'un feu, sortir
@@ -4343,7 +4296,7 @@ begin
end;
procedure TFormTCO.ImageTCODblClick(Sender: TObject);
var Bimage,Adresse,aspect,i : integer;
var Bimage,Adresse,i : integer;
Msgdlg: Tform;
Result : TModalResult;
begin
verif_version.dcu
BIN
View File
Binary file not shown.
verif_version.pas
+1 -1
View File
@@ -23,7 +23,7 @@ var
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='2.4'; // sert à la comparaison de la version publiée
Const Version='2.5'; // sert à la comparaison de la version publiée
implementation
versions.txt
+6
View File
@@ -49,6 +49,12 @@ version 2.31 : Am
version 2.4 : Optimisation de la gestion des évènements aiguillages
Gestion des aiguillages inversés dans CDM pour le mode autonome
Debug pilotage feux LEB
version 2.5 : Panneau de configuration:
- Correction gestion des conditions supplémentaires d'affichage du carré
- Affichage de champs modifiables supplémentaires