This commit is contained in:
f1iwq2
2022-04-24 11:59:31 +02:00
parent 34b3b07d99
commit 398df6e641
20 changed files with 967 additions and 684 deletions
BIN
View File
Binary file not shown.
+9 -9
View File
@@ -2207,11 +2207,11 @@ object FormConfig: TFormConfig
object Label12: TLabel
Left = 0
Top = 8
Width = 564
Width = 468
Height = 13
Caption =
'Liste de mod'#233'lisation des aiguillages du fichier config.cfg - cl' +
'iquez sur une ligne pour afficher la description de l'#39'aiguillage'
'Liste de mod'#233'lisation des aiguillages - cliquez sur une ligne po' +
'ur afficher la description de l'#39'aiguillage'
end
object Label28: TLabel
Left = 88
@@ -2753,11 +2753,11 @@ object FormConfig: TFormConfig
object Label15: TLabel
Left = 0
Top = 8
Width = 530
Width = 434
Height = 13
Caption =
'Liste de mod'#233'lisation des signaux du fichier config.cfg - clique' +
'z sur une ligne pour afficher la description du signal'
'Liste de mod'#233'lisation des signaux - cliquez sur une ligne pour a' +
'fficher la description du signal'
end
object Label35: TLabel
Left = 40
@@ -3151,11 +3151,11 @@ object FormConfig: TFormConfig
object Label16: TLabel
Left = 0
Top = 8
Width = 555
Width = 459
Height = 13
Caption =
'Liste de mod'#233'lisation des actionneurs du fichier config.cfg - cl' +
'iquez sur une ligne pour afficher la description de l'#39'action'
'Liste de mod'#233'lisation des actionneurs - cliquez sur une ligne po' +
'ur afficher la description de l'#39'action'
end
object GroupBox13: TGroupBox
Left = 360
+2
View File
@@ -7178,6 +7178,8 @@ end;
begin
end.
BIN
View File
Binary file not shown.
+68 -37
View File
@@ -3,7 +3,7 @@ object FormConfigTCO: TFormConfigTCO
Top = 218
BorderStyle = bsDialog
Caption = 'Configuration du TCO'
ClientHeight = 264
ClientHeight = 277
ClientWidth = 665
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -16,16 +16,16 @@ object FormConfigTCO: TFormConfigTCO
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 32
Top = 16
Left = 8
Top = 8
Width = 83
Height = 13
Caption = 'Taille des cellules'
end
object Label2: TLabel
Left = 176
Top = 16
Width = 5
Left = 120
Top = 8
Width = 13
Height = 13
Caption = 'x'
end
@@ -63,38 +63,50 @@ object FormConfigTCO: TFormConfigTCO
Height = 13
Caption = 'LabelMaxY'
end
object LabelTailleX: TLabel
Left = 96
Top = 8
Width = 17
Height = 13
Caption = 'LabelTailleX'
end
object LabelTailleY: TLabel
Left = 136
Top = 8
Width = 25
Height = 13
Caption = 'LabelTailleY'
end
object Ratio: TLabel
Left = 8
Top = 32
Width = 25
Height = 13
Caption = 'Ratio'
end
object Label14: TLabel
Left = 72
Top = 32
Width = 17
Height = 13
Caption = '/10'
end
object ButtonOK: TButton
Left = 216
Top = 224
Top = 248
Width = 75
Height = 25
Caption = 'OK'
TabOrder = 0
OnClick = ButtonOKClick
end
object EditTailleCellX: TEdit
Left = 128
Top = 16
Width = 41
Height = 21
TabOrder = 1
Text = 'EditTailleCellX'
end
object EditTailleCellY: TEdit
Left = 192
Top = 16
Width = 41
Height = 21
TabOrder = 2
Text = 'EditTailleCellY'
end
object ButtonDessine: TButton
Left = 16
Top = 224
Top = 248
Width = 75
Height = 25
Caption = 'Redessine'
TabOrder = 3
TabOrder = 1
OnClick = ButtonDessineClick
end
object CheckDessineGrille: TCheckBox
@@ -103,14 +115,14 @@ object FormConfigTCO: TFormConfigTCO
Width = 105
Height = 17
Caption = 'dessine grille'
TabOrder = 4
TabOrder = 2
end
object EditNbCellX: TEdit
Left = 184
Top = 56
Width = 49
Height = 21
TabOrder = 5
TabOrder = 3
Text = 'EditNbCellX'
end
object EditNbCellY: TEdit
@@ -118,16 +130,16 @@ object FormConfigTCO: TFormConfigTCO
Top = 80
Width = 49
Height = 21
TabOrder = 6
TabOrder = 4
Text = 'EditNbCellY'
end
object GroupBox1: TGroupBox
Left = 304
Top = 8
Width = 353
Height = 233
Height = 265
Caption = 'Couleurs '
TabOrder = 7
TabOrder = 5
object Label5: TLabel
Left = 21
Top = 32
@@ -200,7 +212,7 @@ object FormConfigTCO: TFormConfigTCO
end
object Label10: TLabel
Left = 48
Top = 208
Top = 240
Width = 258
Height = 13
Caption = 'Cliquez sur l'#39'ic'#244'ne pour changer la couleur de l'#39#233'l'#233'ment'
@@ -240,11 +252,19 @@ object FormConfigTCO: TFormConfigTCO
Height = 13
Caption = 'Couleur de quai'
end
object CheckCouleur: TCheckBox
Left = 56
Top = 208
Width = 281
Height = 17
Caption = 'Couleur des cantons activ'#233's par la couleur des trains'
TabOrder = 0
end
end
object Memo1: TMemo
Left = 8
Top = 128
Width = 281
Left = 16
Top = 144
Width = 273
Height = 81
BevelInner = bvLowered
BevelKind = bkFlat
@@ -256,11 +276,22 @@ object FormConfigTCO: TFormConfigTCO
'tronqu'#233's seront perdus '#224' la prochaine '
'sauvegarde.')
ReadOnly = True
TabOrder = 8
TabOrder = 6
end
object EditRatio: TEdit
Left = 40
Top = 29
Width = 25
Height = 21
Hint = 'Rapport X/Y d'#39'affichage des cellules'
ParentShowHint = False
ShowHint = True
TabOrder = 7
Text = 'EditRatio'
end
object ColorDialog1: TColorDialog
OnShow = ColorDialog1Show
Left = 48
Top = 24
Left = 216
Top = 8
end
end
+24 -11
View File
@@ -10,8 +10,6 @@ type
TFormConfigTCO = class(TForm)
ButtonOK: TButton;
Label1: TLabel;
EditTailleCellX: TEdit;
EditTailleCellY: TEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
@@ -41,6 +39,12 @@ type
LabelMaxY: TLabel;
ImageQuai: TImage;
Label13: TLabel;
LabelTailleX: TLabel;
LabelTailleY: TLabel;
EditRatio: TEdit;
Ratio: TLabel;
Label14: TLabel;
CheckCouleur: TCheckBox;
procedure ButtonOKClick(Sender: TObject);
procedure ButtonDessineClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
@@ -144,8 +148,8 @@ begin
canvas.Brush.Color:=fond;
canvas.Rectangle(0,0,Width,Height);
canvas.pen.color:=clAllume;
canvas.brush.color:=clAllume;
canvas.pen.color:=clCanton;
canvas.brush.color:=clCanton;
// bande horizontale
r:=Rect(0,(height div 2)-3,width,(height div 2)+3);
canvas.FillRect(r);
@@ -198,19 +202,24 @@ begin
nokNbY:=nokNbY or (NbreCellY<10) or (NbreCellY>MaxCellY);
if nokNbY then LabelErreur.caption:='Erreur: nombre de cellules Y: mini=10 maxi='+IntToSTR(MaxCellY);
Val(EditTailleCellX.Text,LargeurCell,erreur);
{
Val(LabelTailleX.caption,LargeurCell,erreur);
nokLg:=erreur<>0;
if nokLg then LabelErreur.caption:='Erreur largeur de cellules';
nokLg:=nokLg or (LargeurCell<20) or (LargeurCell>50) ;
if nokLg then LabelErreur.caption:='Erreur: Tailles des cellules - largeur cellules mini=20 maxi=50';
Val(EditTailleCellY.Text,HauteurCell,erreur);
Val(LabelTailleY.caption,HauteurCell,erreur);
nokHt:=erreur<>0;
if nokHt then LabelErreur.caption:='Erreur hauteur de cellules';
nokHt:=nokHt or (HauteurCell<20) or (HauteurCell>50) ;
if nokHt then LabelErreur.caption:='Erreur: Tailles des cellules - hauteur cellules mini=20 maxi=50';
}
val(EditRatio.text,RatioC,erreur);
AvecGrille:=checkDessineGrille.Checked;
if checkCouleur.checked then ModeCouleurCanton:=1 else ModeCouleurCanton:=0;
end;
verif_config_TCO:=not(nokNbX or nokNbY or nokHt or nokLg);
NbCellulesTCO:=NbreCellX*NbreCellY;
@@ -228,6 +237,7 @@ begin
ImageTCO.Height:=HauteurCell*NbreCellY;
end;
AvecGrille:=checkDessineGrille.Checked;
calcul_cellules;
affiche_TCO;
LabelErreur.caption:='';
close;
@@ -246,6 +256,7 @@ begin
ImageTCO.Width:=LargeurCell*NbreCellX;
ImageTCO.Height:=HauteurCell*NbreCellY;
end;
calcul_cellules;
affiche_TCO;
end;
end;
@@ -253,11 +264,13 @@ end;
procedure TFormConfigTCO.FormActivate(Sender: TObject);
begin
EditTailleCellX.Text:=IntToSTR(LargeurCell);
EditTailleCellY.Text:=IntToSTR(HauteurCell);
LabelTailleX.caption:=IntToSTR(LargeurCell);
LabelTailleY.caption:=IntToSTR(HauteurCell);
EditNbCellX.Text:=IntToSTR(NbreCellX);
EditNbCellY.Text:=IntToSTR(NbreCellY);
EditRatio.text:=IntToSTR(RatioC);
checkDessineGrille.Checked:=AvecGrille;
checkCouleur.Checked:=ModeCouleurCanton=1;
labelMaxX.caption:='Max='+intToSTR(MaxCellX);
labelMaxY.caption:='Max='+intToSTR(MaxCellY);
dessine_icones;
@@ -323,7 +336,7 @@ begin
if ColorDialog1.execute then
begin
ClAllume:=ColorDialog1.Color;
ClCanton:=ColorDialog1.Color;
dessine_icones;
end;
end;
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+52 -26
View File
@@ -3,7 +3,7 @@ Unit UnitPrinc;
programme signaux complexes Graphique Lenz
delphi 7 + activeX Tmscomm + clientSocket
********************************************
6/4/2022 14h
24/4/2022 12h
note sur le pilotage des accessoires:
raquette octet sortie
+ 2 = aiguillage droit = sortie 2 de l'adresse d'accessoire
@@ -314,7 +314,7 @@ TFeu = record
var
tempsCli,NbreFeux,pasreponse,AdrDevie,fenetre,Tempo_Aig,Tempo_feu,
NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant,
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur,
ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB,AdrTrain : integer;
Hors_tension2,traceSign,TraceZone,Ferme,parSocketLenz,ackCdm,PremierFD,doubleclic,
@@ -578,7 +578,7 @@ begin
// récupérer les dimensions de l'image d'origine du feu
LgImage:=Formprinc.Image2feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image2feux.Picture.Bitmap.Height;
//zizi
XBlanc:=13; YBlanc:=11;
xViolet:=13; yViolet:=23;
@@ -5206,7 +5206,11 @@ begin
else
begin
// sinon si signal suivant=jaune
if (TestBit(etat,jaune)) then Maj_Etat_Signal(AdrFeu,jaune_cli);
if (TestBit(etat,jaune)) then
begin
Maj_Etat_Signal(AdrFeu,jaune_cli);
if AffSignal then AfficheDebug('400.Mise du feu au jaune cli',clyellow);
end;
end;
end
else
@@ -5216,32 +5220,59 @@ begin
if AffSignal then AfficheDebug('pas d''aiguille déviée',clYellow);
// effacer la signbalisation combinée
feux[index].EtatSignal:=feux[index].EtatSignal and not($3c00);
if TestBit(etat,carre) or testBit(etat,semaphore) or testBit(etat,semaphore_cli )then Maj_Etat_Signal(AdrFeu,jaune)
if TestBit(etat,carre) or testBit(etat,semaphore) or testBit(etat,semaphore_cli )then
begin
Maj_Etat_Signal(AdrFeu,jaune);
if AffSignal then AfficheDebug('Mise du Feu à l''avertissement',clyellow);
end
else
begin
if affsignal then AfficheDebug('test 403',clyellow);
// si signal suivant affiche rappel
if TestBit(etat,rappel_30) or TestBit(etat,rappel_60) then
begin
feux[index].EtatSignal:=0;
if TestBit(etat,rappel_30) then Maj_Etat_Signal(AdrFeu,ral_30);
if TestBit(etat,rappel_30) then
begin
Maj_Etat_Signal(AdrFeu,ral_30);
if affsignal then AfficheDebug('Mise du feu au ralen 30',clyellow);
end;
if TestBit(etat,rappel_60) then
begin
if AffSignal then AfficheDebug('Mise du Feu au ralen 60',clyellow);
Maj_Etat_Signal(AdrFeu,ral_60); // si signal suivant est au rappel60, il faut tester s'il est à l'avertissement aussi
if TestBit(etat,jaune) then Maj_Etat_Signal(AdrFeu,jaune_cli);
end;
end
else
begin
// si le signal suivant est jaune
if TestBit(etat,jaune) then Maj_Etat_Signal(AdrFeu,jaune_cli)
if affsignal then AfficheDebug('test 404',clyellow);
if TestBit(etat,jaune) then
begin
Maj_Etat_Signal(AdrFeu,jaune_cli);
if affsignal then AfficheDebug('401.Mise du feu au jaune cli',clyellow);
end
else
begin
if affsignal then AfficheDebug('test 405',clyellow);
if feux[index].check<>nil then
begin
if feux[index].check.Checked then Maj_Etat_Signal(AdrFeu,blanc);
if affsignal then AfficheDebug('test 406',clyellow);
if feux[index].check.Checked then
begin
Maj_Etat_Signal(AdrFeu,blanc);
if affsignal then AfficheDebug('Mise du feu au blanc',clyellow);
end
else Maj_Etat_Signal(AdrFeu,vert);
end
else
Maj_Etat_Signal(AdrFeu,vert);
begin
Maj_Etat_Signal(AdrFeu,vert);
if affsignal then AfficheDebug('Mise du feu au vert',clyellow);
end;
end;
end;
end;
end;
end;
@@ -5326,6 +5357,7 @@ end;
// transmis dans le tableau Event_det
procedure calcul_zones;
var AdrFeu,AdrDetFeu,Nbre,i,resultat,det1,det2,det3,AdrSuiv,AdrPrec : integer ;
creer_tableau : boolean;
TypeSuiv : tEquipement;
s : string;
@@ -5362,8 +5394,9 @@ begin
With FormDebug.RichEdit do
begin
s:='train '+IntToSTR(i)+' '+intToStr(det2)+' à '+intToStr(det3)+' => Mem '+IntToSTR(det3)+' à '+IntTOStr(AdrSuiv);
Lines.Add(s);
RE_ColorLine(FormDebug.RichEdit,lines.count-1,CouleurTrain[ ((i - 1) mod NbCouleurTrain) +1] );
Lines.Add(s);
index_couleur:=((i - 1) mod NbCouleurTrain) +1;
RE_ColorLine(FormDebug.RichEdit,lines.count-1,CouleurTrain[index_couleur]);
end;
if TraceListe then AfficheDebug(s,clyellow);
Affiche(s,clyellow);
@@ -5394,14 +5427,16 @@ begin
AfficheDebug(intToSTR(event_det_train[i].det[1]),clyellow);
AfficheDebug(intToSTR(event_det_train[i].det[2]),clyellow);
end;
rafraichit;
rafraichit;
rafraichit;
if avecTCO then
begin
begin
zone_TCO(det2,det3,0); // désactivation
zone_TCO(det3,AdrSuiv,1); // activation
// activation
if ModeCouleurCanton=0 then zone_TCO(det3,AdrSuiv,1)
else zone_TCO(det3,AdrSuiv,2); // affichage avec la couleur de index_couleur du train
end;
rafraichit;
rafraichit;
rafraichit;
exit; // sortir absolument
end;
end;
@@ -6871,17 +6906,11 @@ var aspect,i,a,x,y,Bimage,adresse,TailleX,TailleY,orientation : integer;
s : string;
begin
inc(tick);
if sourisclic then inc(Temposouris);
if Tdoubleclic>0 then dec(Tdoubleclic);
if Tempo_init>0 then dec(Tempo_init);
if (Tempo_init=1) and AvecInit then
begin
// TCO
{if avectco then
begin
//créée la fenêtre TCO non modale
FormTCO:=TformTCO.Create(nil);
FormTCO.show;
end; }
if not(ConfigNulle) and not(ferme) and (AvecInitAiguillages) then
begin
Affiche('Positionnement des feux',clYellow);
@@ -6970,9 +6999,6 @@ begin
end;
end;
//if (not(Maj_feux_cours) and (Tempo_chgt_feux=1)) then Maj_feux(); // mise à jour des feux sur chgt aiguillage
//if (not(Maj_feux_cours) and (Tempo_chgt_feux>0)) then dec(Tempo_chgt_feux);
// tempo retombée actionneur
for i:=1 to maxTablo_act do
begin
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+25 -5
View File
@@ -1,6 +1,6 @@
object FormTCO: TFormTCO
Left = 162
Top = 174
Left = 117
Top = 151
Width = 1139
Height = 694
VertScrollBar.Visible = False
@@ -883,7 +883,16 @@ object FormTCO: TFormTCO
Top = 112
Width = 161
Height = 17
Hint = 'Cocher si l'#39'aiguillage est repr'#233'sent'#233' invers'#233
Caption = 'aiguillage invers'#233
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -9
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 9
OnClick = CheckPinvClick
end
@@ -958,17 +967,28 @@ object FormTCO: TFormTCO
Caption = '-'
end
object Tourner90G: TMenuItem
Caption = 'Positionner feu 90'#176' '#224' gauche'
Caption = 'Positionner signal 90'#176' '#224' gauche'
OnClick = Tourner90GClick
end
object Tourner90D: TMenuItem
Caption = 'Positionner feu 90'#176' '#224' droite'
Caption = 'Positionner signal 90'#176' '#224' droite'
OnClick = Tourner90DClick
end
object Pos_vert: TMenuItem
Caption = 'Positionner feu verticalement'
Caption = 'Positionner signal verticalement'
OnClick = Pos_vertClick
end
object N2: TMenuItem
Caption = '-'
end
object Signalgauchedelavoie1: TMenuItem
Caption = 'Signal '#224' gauche de la voie'
OnClick = Signalgauchedelavoie1Click
end
object Signaldroitedelavoie1: TMenuItem
Caption = 'Signal '#224' droite de la voie'
OnClick = Signaldroitedelavoie1Click
end
end
object FontDialog1: TFontDialog
OnShow = FontDialog1Show
+783 -595
View File
File diff suppressed because it is too large Load Diff
Binary file not shown.
BIN
View File
Binary file not shown.
+1 -1
View File
@@ -23,7 +23,7 @@ var
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='3.84'; // sert à la comparaison de la version publiée
Const Version='3.85'; // sert à la comparaison de la version publiée
SousVersion=' '; // en cas d'absence de sous version mettre un espace
implementation
+3
View File
@@ -95,6 +95,9 @@ version 3.83 : Quais pour le TCO.
version 3.84 : Possibilité d'affecter des couleurs différentes pour chaque texte ou adresse de
signal, d'aiguillage ou de détecteur.
Affichage ou non du bandeau de configuration du TCO au démarrage
version 3.85 : Affichage des cantons occupés avec des couleurs différentes par train ou non dans le TCO.
Grille optionnelle sauvegardée dans la configuration du TCO.
Possibilité de déclarer des signaux implantés à droite ou à gauche des voies dans le TCO.