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

V8.1

Browse Source
This commit is contained in:
f1iwq2
2023-09-19 17:48:46 +02:00
parent 4d427e81ff
commit 6b945b5dbd
15 changed files with 1337 additions and 963 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice d'utilisation des signaux_complexes_GL_V8.pdf → Notice d'utilisation des signaux_complexes_GL_V8.1.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=0
R=0
Q=1
R=1
S=0
T=0
U=0
Signaux_complexes_GL.~dpr
-42
View File
@@ -1,42 +0,0 @@
program Signaux_complexes_GL;
uses
Forms,
UnitPrinc in 'UnitPrinc.pas' {FormPrinc},
UnitDebug in 'UnitDebug.pas' {FormDebug},
verif_version in 'verif_version.pas' {FormVersion},
UnitPilote in 'UnitPilote.pas' {FormPilote},
UnitSimule in 'UnitSimule.pas' {FormSimulation},
UnitTCO in 'UnitTCO.pas' {FormTCO},
UnitConfig in 'UnitConfig.pas' {FormConfig},
UnitConfigTCO in 'UnitConfigTCO.pas' {FormConfigTCO},
UnitSR in 'UnitSR.pas' {FormSR},
Unit_Pilote_aig in 'Unit_Pilote_aig.pas' {FormAig},
UnitConfigCellTCO in 'UnitConfigCellTCO.pas' {FormConfCellTCO},
UnitCDF in 'UnitCDF.pas' {FormCDF},
Unitplace in 'Unitplace.pas' {FormPlace},
UnitPareFeu in 'UnitPareFeu.pas',
UnitAnalyseSegCDM in 'UnitAnalyseSegCDM.pas' {FormAnalyseCDM},
Importation in 'Importation.pas' {FormImportation};
{$R *.res}
begin
// la form TCO ne doit pas etre créée ici!!
Application.Initialize;
Application.CreateForm(TFormPrinc, FormPrinc);
Application.CreateForm(TFormVersion, FormVersion);
Application.CreateForm(TFormPilote, FormPilote);
Application.CreateForm(TFormSimulation, FormSimulation);
Application.CreateForm(TFormConfig, FormConfig);
Application.CreateForm(TFormConfigTCO, FormConfigTCO);
Application.CreateForm(TFormSR, FormSR);
Application.CreateForm(TFormAig, FormAig);
Application.CreateForm(TFormConfCellTCO, FormConfCellTCO);
Application.CreateForm(TFormCDF, FormCDF);
Application.CreateForm(TFormPlace, FormPlace);
Application.CreateForm(TFormDebug, FormDebug);
Application.CreateForm(TFormAnalyseCDM, FormAnalyseCDM);
Application.CreateForm(TFormImportation, FormImportation);
Application.Run;
end.
UnitConfig.dfm
+19 -6
View File
@@ -1,6 +1,6 @@
object FormConfig: TFormConfig
Left = 164
Top = 114
Left = 178
Top = 109
Hint = 'Modifie la configuration selon les s'#233'lections choisies'
BorderStyle = bsDialog
Caption = 'Configuration g'#233'n'#233'rale'
@@ -1662,7 +1662,7 @@ object FormConfig: TFormConfig
end
object CheckVerifVersion: TCheckBox
Left = 8
Top = 48
Top = 56
Width = 249
Height = 17
Caption = 'V'#233'rifications de nouvelle version au d'#233'marrage'
@@ -1670,7 +1670,7 @@ object FormConfig: TFormConfig
end
object CheckInfoVersion: TCheckBox
Left = 8
Top = 64
Top = 72
Width = 241
Height = 17
Caption = 'Information sur la version actuelle'
@@ -1687,7 +1687,7 @@ object FormConfig: TFormConfig
end
object CheckAvecTCO: TCheckBox
Left = 8
Top = 88
Top = 96
Width = 73
Height = 17
Hint = 'Affiche le TCO au d'#233'marrage'
@@ -1709,7 +1709,7 @@ object FormConfig: TFormConfig
end
object CheckBandeauTCO: TCheckBox
Left = 8
Top = 104
Top = 112
Width = 129
Height = 17
Hint = 'Masque le bandeau de param'#233'trage du TCO au d'#233'marrage'
@@ -1731,6 +1731,19 @@ object FormConfig: TFormConfig
OnChange = EditLAYChange
OnExit = EditLAYExit
end
object CheckBoxAffMemo: TCheckBox
Left = 8
Top = 40
Width = 233
Height = 17
Hint =
'Affiche la fenetre '#224' la position m'#233'moris'#233'e depuis le menu "Sauve' +
'garder la configuration de la fen'#234'tre"'
Caption = 'Afficher la fen'#234'tre sur la position m'#233'moris'#233'e'
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
end
object GroupBox6: TGroupBox
Left = 312
UnitConfig.pas
+142 -55
View File
@@ -365,6 +365,7 @@ type
N1: TMenuItem;
N2: TMenuItem;
outcopierentatquetexte1: TMenuItem;
CheckBoxAffMemo: TCheckBox;
procedure ButtonAppliquerEtFermerClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -588,6 +589,7 @@ MasqueBandeauTCO_ch='MasqueBandeauTCO';
CDM_ch='CDM';
Serveur_interface_ch='Serveur_interface';
fenetre_ch='Fenetre';
AffMemoFenetre_ch='AffMemoFenetre';
Tempo_aig_ch='Tempo_Aig';
Nb_cantons_Sig_ch='Nb_cantons_Sig';
Tempo_Feu_ch='Tempo_Feu';
@@ -605,6 +607,12 @@ Nba_ch='NombreAdresses';
nation_ch='Nation';
nom_dec_pers_ch='Nom_dec_pers';
Nom_fich_TCO_ch='Nom_fichier_TCO';
LargeurF_ch='LargeurF';
HauteurF_ch='HauteurF';
OffsetXF_ch='OffsetX';
OffsetYF_ch='OffsetY';
etatF_ch='EtatF';
PosSplitter_ch='Splitter';
// sections de config
section_aig_ch='[section_aig]';
@@ -627,7 +635,7 @@ var
ligneclicAig,AncLigneClicAig,ligneClicSig,AncligneClicSig,EnvAigDccpp,AdrBaseDetDccpp,
ligneClicBr,AncligneClicBr,ligneClicAct,AncLigneClicAct,Adressefeuclic,NumTrameCDM,
Algo_localisation,Verif_AdrXpressNet,ligneclicTrain,AncligneclicTrain,AntiTimeoutEthLenz,
ligneDCC,decCourant : integer;
ligneDCC,decCourant,AffMemoFenetre : integer;
ack_cdm,clicliste,config_modifie,clicproprietes,confasauver,trouve_MaxPort,
modif_branches,ConfigPrete,trouve_section_dccpp,trouve_section_trains,
@@ -1642,6 +1650,13 @@ begin
// copie_commentaire;
s:='/ Fichier de configuration de signaux_complexes_GL version '+version+sousversion;
writeln(fichierN,s);
writeln(fichierN,largeurF_ch+'=',largeurF);
writeln(fichierN,hauteurF_ch+'=',hauteurF);
writeln(fichierN,OffsetXF_ch+'=',OffsetXF);
writeln(fichierN,OffsetYF_ch+'=',OffsetYF);
writeln(fichierN,EtatF_ch+'=',EtatF);
writeln(fichierN,PosSplitter_ch+'=',PosSplitter);
writeln(fichierN,AvecVerifIconesTCO_ch+'=',AvecVerifIconesTCO);
writeln(fichierN,Algo_localisation_ch+'=',Algo_localisation);
writeln(fichierN,Avec_roulage_ch+'=',avecRoulage);
@@ -1708,6 +1723,9 @@ begin
// plein écran
writeln(fichierN,Fenetre_ch+'=',fenetre);
// mémo
writeln(fichierN,AffMemoFenetre_ch+'=',AffMemoFenetre);
// Nombre maxi de détecteurs considérés distants
writeln(fichierN,nb_det_dist_ch+'=',Nb_Det_Dist);
@@ -2759,6 +2777,55 @@ end;
if (i>0) and (i<11) then NomfichierTCO[i]:=s;
end;
sa:=uppercase(LargeurF_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,LargeurF,erreur);
end;
sa:=uppercase(HauteurF_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,HauteurF,erreur);
end;
sa:=uppercase(OffsetXF_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,OffsetXF,erreur);
end;
sa:=uppercase(OffsetYF_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,OffsetYF,erreur);
end;
sa:=uppercase(EtatF_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,EtatF,erreur);
end;
sa:=uppercase(PosSplitter_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
delete(s,i,length(sa));
val(s,PosSplitter,erreur);
end;
sa:=uppercase(Filtrage_det_ch)+'=';
i:=pos(sa,s);
if i=1 then
@@ -2804,7 +2871,7 @@ end;
if (TailleFonte<8) or (tailleFonte>25) then taillefonte:=10;
with FormPrinc.FenRich do
begin
clear;
//clear;
Font.Size:=TailleFonte;
end;
end;
@@ -2994,6 +3061,16 @@ end;
if fenetre=1 then Formprinc.windowState:=wsMaximized;
end;
// mémo fenetre
sa:=uppercase(AffMemoFenetre_ch)+'=';
i:=pos(sa,s);
if i=1 then
begin
inc(nv);
delete(s,i,length(sa));
val(s,AffMemoFenetre,erreur);
end;
// Nombre de cantons avant signal
sa:=uppercase(Nb_cantons_Sig_ch)+'=';
i:=pos(sa,s);
@@ -3339,7 +3416,6 @@ begin
if not(trouve_verif_version) then s:=verif_version_ch;
if not(trouve_fonte) then s:=fonte_ch;
Nb_Det_Dist:=3;
// initialisation des aiguillages avec des valeurs par défaut
for i:=1 to NbreMaxiAiguillages do
@@ -3363,7 +3439,6 @@ begin
Detecteur[i].IndexTrain:=0;
Ancien_detecteur[i]:=false;
end;
//Affiche('Lecture du fichier de configuration '+NomConfig,clyellow);
try
assign(fichier,NomConfig);
@@ -3444,6 +3519,18 @@ begin
if not(trouve_section_aig) then Affiche('Manque section '+section_aig_ch,clred);
if not(trouve_section_sig) then Affiche('Manque section '+section_sig_ch,clred);
if not(trouve_section_branche) then Affiche('Manque section '+section_branches_ch,clred);
// fenetre
{
if largeurF>0 then formPrinc.width:=LargeurF;
if HauteurF>0 then formPrinc.Height:=hauteurF;
formPrinc.left:=offsetXF;
formPrinc.top:=offsetYF;
if (PosSplitter>0) and (PosSPlitter<formPrinc.Width) then
begin
formprinc.fenRich.Width:=PosSplitter;
//positionne_elements(PosSplitter);
end;}
end;
@@ -3574,6 +3661,7 @@ begin
LanceCDM:=CheckLanceCDM.Checked;
if CheckFenEt.checked then fenetre:=1 else fenetre:=0;
if CheckBoxAffMemo.checked then AffMemoFenetre:=1 else AffMemoFenetre:=0;
AvecTCO:=CheckAvecTCO.checked;
MasqueBandeauTCO:=CheckBandeauTCO.checked;
@@ -3714,6 +3802,7 @@ begin
EditDroit_BD.ReadOnly:=false;
Edit_HG.ReadOnly:=false;
CheckBoxAffMemo.Checked:=AffMemoFenetre=1;
EditNbCantons.text:=intToSTR(Nb_cantons_Sig);
EditTempoFeu.Text:=IntToSTR(Tempo_feu);
EditNbDetDist.text:=IntToSTR(Nb_Det_dist);
@@ -8160,7 +8249,7 @@ begin
Affiche('Erreur 10.41: Discordance de déclaration aiguillage '+intToSTR(adr)+': '+intToSTR(adr2),clred);
ok:=false;
end;
// tjs ou tjs à 4 états
if (((model2=tjs) or (model2=tjd)) and (aiguillage[index2].EtatTJD=4)) then
begin
@@ -8316,64 +8405,62 @@ begin
// 9. vérifier la cohérence TCO
if avecTCO then
begin
indexTCO:=1;
for y:=1 to NbreCellY[indexTCO] do
for x:=1 to NbreCellX[indexTCO] do
begin
i:=TCO[indexTCO,x,y].BImage;
adr:=TCO[indexTCO,x,y].adresse;
if i=Id_signal then
begin
if index_Signal(adr)=0 then
begin
Affiche('Un signal '+IntToSTR(adr)+' est déclaré dans le TCO['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred);
ok:=false;
end;
end;
if (i=21) or (i=22) or (i=23) or (i=25) then
begin
if (adr<>0) and (tco[indexTCO,x,y].pont<>0) then
begin
Affiche('Erreur 48 TCO : la cellule '+intToSTR(x)+'/'+intToSTR(y)+' d''adresse '+intToSTR(Adr)+' est décrite comme un croisement ou TJD/S car elle présente une adresse',clred);
Affiche('mais la cellule représente un pont',clred);
ok:=false;
end;
end;
if isAigTCO(i) then
for indexTCO:=1 to NbreTCO do
for y:=1 to NbreCellY[indexTCO] do
for x:=1 to NbreCellX[indexTCO] do
begin
i:=TCO[indexTCO,x,y].BImage;
adr:=TCO[indexTCO,x,y].adresse;
if (index_aig(adr)=0) and (adr<>0) then
if i=Id_signal then
begin
Affiche('Un aiguillage '+IntToSTR(adr)+' est déclaré dans le TCO['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred);
ok:=false;
end;
end;
if (i=1) or (i=6) or (i=7) or (i=8) or (i=9) or (i=16) or (i=17) or (i=18) or (i=19) or (i=20) or (i=10) or (i=11) then
begin
adr:=TCO[indexTCO,x,y].adresse;
if adr<>0 then
begin
j:=1;
repeat
trouveSuiv:=adr=Adresse_detecteur[j];
inc(j);
until (j>NDetecteurs) or trouveSuiv;
if not(trouveSuiv) then
if index_Signal(adr)=0 then
begin
Affiche('Un détecteur '+IntToSTR(adr)+' est déclaré dans le TCO['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred);
Affiche('Un signal '+IntToSTR(adr)+' est déclaré dans le TCO'+intToSTR(indexTCO)+' ['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred);
ok:=false;
end;
end;
end;
if not(verif_cellule(indexTCO,x,y,i)) then
begin
Affiche('TCO: Erreur de proximité composants incompatibles: cellules TCO['+intToSTR(x)+','+intToSTR(y)+'] ',clred);
ok:=false;
end;
if (i=21) or (i=22) or (i=23) or (i=25) then
begin
if (adr<>0) and (tco[indexTCO,x,y].pont<>0) then
begin
Affiche('Erreur 48 TCO'+intToSTR(indexTCO)+' ['+intToSTR(x)+','+intToSTR(y)+'] d''adresse '+intToSTR(Adr)+' décrite comme un croisement ou TJD/S car elle présente une adresse',clred);
Affiche('mais la cellule représente un pont',clred);
ok:=false;
end;
end;
end;
if isAigTCO(i) then
begin
adr:=TCO[indexTCO,x,y].adresse;
if (index_aig(adr)=0) and (adr<>0) then
begin
Affiche('Un aiguillage '+IntToSTR(adr)+' est déclaré dans le TCO'+intToSTR(indexTCO)+' ['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred);
ok:=false;
end;
end;
if (i=1) or (i=6) or (i=7) or (i=8) or (i=9) or (i=16) or (i=17) or (i=18) or (i=19) or (i=20) or (i=10) or (i=11) then
begin
adr:=TCO[indexTCO,x,y].adresse;
if adr<>0 then
begin
j:=1;
repeat
trouveSuiv:=adr=Adresse_detecteur[j];
inc(j);
until (j>NDetecteurs) or trouveSuiv;
if not(trouveSuiv) then
begin
Affiche('Un détecteur '+IntToSTR(adr)+' est déclaré dans le TCO '+intToSTR(indexTCO)+' ['+intToSTR(x)+','+intToSTR(y)+'] mais absent de la configuration',clred);
ok:=false;
end;
end;
end;
if not(verif_cellule(indexTCO,x,y,i)) then
begin
Affiche('TCO: Erreur de proximité composants incompatibles: cellules TCO'+intToSTR(indexTCO)+' ['+intToSTR(x)+','+intToSTR(y)+'] ',clred);
ok:=false;
end;
end;
end;
// 11 Divers
UnitConfigCellTCO.dfm
+4 -3
View File
@@ -59,7 +59,8 @@ object FormConfCellTCO: TFormConfCellTCO
'Centrale'
'Haut'
'Bas'
'R'#233'parti')
'R'#233'parti'
'Centr'#233)
end
object ButtonFonte: TButton
Left = 160
@@ -290,8 +291,8 @@ object FormConfCellTCO: TFormConfCellTCO
TabOrder = 5
end
object GroupBoxAction: TGroupBox
Left = 56
Top = 176
Left = 24
Top = 184
Width = 249
Height = 105
Caption = 'Action'
UnitConfigCellTCO.pas
+17 -17
View File
@@ -150,7 +150,7 @@ begin
GroupBoxAction.visible:=false;
end;
end;
if (Bimage=1) or (Bimage=10) or (Bimage=11) or (Bimage=20) then
begin
@@ -339,9 +339,8 @@ begin
end;
end;
// aiguillage
if ((BImage=2) or (BImage=3) or (BImage=4) or (BImage=5) or (BImage=12) or (BImage=13) or (BImage=14) or
(BImage=15) or (BImage=21) or (BImage=22) or (BImage>=24) ) and (Bimage<50) then
// aiguillage ou TJD
if IsAigTCO(Bimage) then
formConfCellTCO.checkPinv.Enabled:=true
else formConfCellTCO.checkPinv.Enabled:=false;
@@ -600,20 +599,21 @@ begin
end;
// copie la cellule cliquée du TCO pour la mettre dans la imagePaletteCC
procedure copie_cellule(index : integer);
begin
// affiche l'icone cliquée dans la fenetre -----------------------------------------------
// pour que le stretchBlt soit visible, il faut mettre à jour la taille du bitmap
with FormConfCellTCO.ImagePaletteCC.Picture.Bitmap do
begin
width:=iconeX;
Height:=iconeY;
end;
// affiche l'icone cliquée dans la fenetre -----------------------------------------------
// pour que le stretchBlt soit visible, il faut mettre à jour la taille du bitmap
with FormConfCellTCO.ImagePaletteCC.Picture.Bitmap do
begin
width:=iconeX;
Height:=iconeY;
end;
// destination masque avec mise à l'échelle
StretchBlt(FormConfCellTCO.ImagePaletteCC.canvas.Handle,0,0,iconeX,iconeY,
PcanvasTCO[index].Handle,(XclicCell[index]-1)*largeurCell[index],(YclicCell[index]-1)*hauteurCell[index],largeurCell[index],hauteurCell[index],srccopy);
FormConfCellTCO.ImagePaletteCC.repaint; // obligatoire sinon il ne s'affiche pas
// destination masque avec mise à l'échelle
StretchBlt(FormConfCellTCO.ImagePaletteCC.canvas.Handle,0,0,iconeX,iconeY,
PcanvasTCO[index].Handle,(XclicCell[index]-1)*largeurCell[index],(YclicCell[index]-1)*hauteurCell[index],largeurCell[index],hauteurCell[index],srccopy);
FormConfCellTCO.ImagePaletteCC.repaint; // obligatoire sinon il ne s'affiche pas
end;
procedure TFormConfCellTCO.ImagePaletteCCMouseDown(Sender: TObject;
@@ -816,9 +816,9 @@ begin
begin
x:=XClicCell[IndexTCOCourant];
y:=yClicCell[IndexTCOCourant];
tco[IndexTCOCourant,X,Y].PiedFeu:=3;
tco[IndexTCOCourant,x,y].PiedFeu:=3;
efface_cellule(indexTCOCourant,PCanvasTCO[indexTCOcourant],x,y,pmcopy);
affiche_cellule(IndexTCOCourant,x,Y);
affiche_cellule(IndexTCOCourant,x,y);
actualise(indexTCOCourant);
end;
end;
UnitConfigTCO.pas
+17 -14
View File
@@ -245,13 +245,13 @@ begin
end
else NbreCellY[indexTCO]:=my;
if LargeurCell[indexTCO]*NbreCellX[indexTCO]>8192 then
if ZoomMax*NbreCellX[indexTCO]>8192 then
begin
LabelErreur.caption:='Erreur: nombre de cellules X';
ok:=false;
end;
if HauteurCell[indexTCO]*NbreCellY[indexTCO]>8192 then
if ZoomMax*NbreCellY[indexTCO]>8192 then
begin
LabelErreur.caption:='Erreur: nombre de cellules Y';
ok:=false;
@@ -434,37 +434,36 @@ end;
procedure TFormConfigTCO.BitBtnOkClick(Sender: TObject);
var ok : boolean;
index,i,x,y,erreur : integer;
i,x,y,erreur : integer;
s : string;
begin
ok:=true;
index:=indexTCOCourant;
if verif_config_TCO(indexTCOCourant) then
begin
with FormTCO[index].ImageTCO do
with FormTCO[indexTCOCourant].ImageTCO do
begin
Width:=LargeurCell[index]*NbreCellX[index];
Height:=HauteurCell[index]*NbreCellY[index];
Width:=LargeurCell[indexTCOCourant]*NbreCellX[indexTCOCourant];
Height:=HauteurCell[indexTCOCourant]*NbreCellY[indexTCOCourant];
end;
try
begin
SetLength(TCO[index],NbreCellX[index]+1,NbreCellY[index]+1);
SetLength(TCO[indexTCOCourant],NbreCellX[indexTCOCourant]+1,NbreCellY[indexTCOCourant]+1);
init_tampon_copiercoller;
end;
except
LabelErreur.caption:='TCO Mémoire insuffisante';
NbreCellX[index]:=20;NbreCellY[index]:=12;
SetLength(TCO[index],NbreCellX[index]+1,NbreCellY[index]+1);
NbreCellX[indexTCOCourant]:=20;NbreCellY[indexTCOCourant]:=12;
SetLength(TCO[indexTCOCourant],NbreCellX[indexTCOCourant]+1,NbreCellY[indexTCOCourant]+1);
init_tampon_copiercoller;
ok:=false;
end;
for y:=1 to NbreCellY[index] do
for x:=1 to NbreCellX[index] do
for y:=1 to NbreCellY[indexTCOCourant] do
for x:=1 to NbreCellX[indexTCOCourant] do
begin
if tco[index,x,y].CouleurFond=0 then tco[index,x,y].CouleurFond:=clfond;
if tco[indexTCOCourant,x,y].CouleurFond=0 then tco[indexTCOCourant,x,y].CouleurFond:=clfond;
end;
if RadioButtonLignes.Checked then
@@ -501,7 +500,7 @@ begin
calcul_cellules(IndexTCOcourant);
affiche_TCO(indexTCOcourant);
dessine_icones(index);
dessine_icones(indexTCOCourant);
LabelErreur.caption:='';
close;
end;
@@ -537,11 +536,13 @@ end;
procedure TFormConfigTCO.RadioButtonLignesClick(Sender: TObject);
begin
if not(clicConf) then TCO_modifie:=true;
graphisme:=1;
end;
procedure TFormConfigTCO.RadioButtonCourbesClick(Sender: TObject);
begin
if not(clicConf) then TCO_modifie:=true;
graphisme:=2;
end;
procedure TFormConfigTCO.FormCreate(Sender: TObject);
@@ -563,6 +564,8 @@ begin
ColWidths[2]:=15;
Cells[0,0]:='Num';
Cells[1,0]:='Nom fichier';
Cells[2,0]:='X';
end;
end;
UnitPrinc.dfm
+517 -499
View File
File diff suppressed because it is too large Load Diff
UnitPrinc.pas
+283 -172
View File
@@ -1,5 +1,5 @@
Unit UnitPrinc;
// 07/09 22h
// 13/9 11h
(********************************************
Programme signaux complexes Graphique Lenz
Delphi 7 + activeX Tmscomm + clientSocket
@@ -58,11 +58,7 @@ type
TFormPrinc = class(TForm)
Timer1: TTimer;
LabelTitre: TLabel;
ScrollBox1: TScrollBox;
ClientSocketInterface: TClientSocket;
GroupBox1: TGroupBox;
EditAdresse: TEdit;
Label2: TLabel;
MainMenu1: TMainMenu;
Interface1: TMenuItem;
MenuConnecterUSB: TMenuItem;
@@ -104,13 +100,7 @@ type
Config: TMenuItem;
Codificationdesactionneurs1: TMenuItem;
OuvrirunfichiertramesCDM1: TMenuItem;
Panel1: TPanel;
BoutonRaf: TButton;
ButtonArretSimu: TButton;
ButtonDroit: TButton;
LabelEtat: TLabel;
ButtonAffTCO: TButton;
ButtonLanceCDM: TButton;
Affichefentredebug1: TMenuItem;
StaticText: TStaticText;
PopupMenuFenRich: TPopupMenu;
@@ -118,40 +108,17 @@ type
Etatdessignaux1: TMenuItem;
N6: TMenuItem;
Apropos1: TMenuItem;
ButtonDevie: TButton;
GroupBox2: TGroupBox;
ButtonEcrCV: TButton;
ButtonLitCV: TButton;
EditCV: TEdit;
Label3: TLabel;
LabelVCV: TLabel;
EditVal: TEdit;
PopupMenuFeu: TPopupMenu;
Proprits1: TMenuItem;
N8: TMenuItem;
Vrifierlacohrence: TMenuItem;
GroupBox3: TGroupBox;
loco: TButton;
ButtonLocCV: TButton;
EditAdrTrain: TEdit;
Label4: TLabel;
Label5: TLabel;
EditVitesse: TEdit;
ComboTrains: TComboBox;
LabelFonction: TLabel;
EditNumFonction: TEdit;
ButtonFonction: TButton;
EditFonc01: TEdit;
Label6: TLabel;
Etatdeszonespartrain1: TMenuItem;
N7: TMenuItem;
Demanderversiondelacentrale1: TMenuItem;
Demanderlaversiondelacentrale1: TMenuItem;
RepriseDCC1: TMenuItem;
BoutonRazTrains: TButton;
Demandetataccessoires1: TMenuItem;
LancerCDMrail1: TMenuItem;
TrackBarVit: TTrackBar;
ButtonEnv: TButton;
EditEnvoi: TEdit;
Roulage1: TMenuItem;
@@ -161,18 +128,10 @@ type
Button1: TButton;
Evenementsdetecteurspartrain1: TMenuItem;
RazResa: TMenuItem;
SBMarcheArretLoco: TSpeedButton;
Label1: TLabel;
LabelNbTrains: TLabel;
SplitterH: TSplitter;
Panel2: TPanel;
FenRich: TRichEdit;
SplitterV: TSplitter;
Vrifiernouvelleversion1: TMenuItem;
N9: TMenuItem;
Analyser1: TMenuItem;
Coller1: TMenuItem;
ButtonAffAnalyseCDM: TButton;
Affiche_fenetre_CDM: TMenuItem;
ImageSignal20: TImage;
COs1: TMenuItem;
@@ -206,7 +165,50 @@ type
CO81: TMenuItem;
CO91: TMenuItem;
CO101: TMenuItem;
Panel2: TPanel;
FenRich: TRichEdit;
SplitterV: TSplitter;
ScrollBox1: TScrollBox;
GroupBox1: TGroupBox;
Label2: TLabel;
EditAdresse: TEdit;
ButtonDroit: TButton;
ButtonDevie: TButton;
GroupBox3: TGroupBox;
Label4: TLabel;
Label5: TLabel;
LabelFonction: TLabel;
Label6: TLabel;
SBMarcheArretLoco: TSpeedButton;
loco: TButton;
EditAdrTrain: TEdit;
EditVitesse: TEdit;
ComboTrains: TComboBox;
EditNumFonction: TEdit;
ButtonFonction: TButton;
EditFonc01: TEdit;
TrackBarVit: TTrackBar;
Panel1: TPanel;
Label1: TLabel;
LabelNbTrains: TLabel;
BoutonRaf: TButton;
ButtonArretSimu: TButton;
ButtonAffTCO: TButton;
ButtonLanceCDM: TButton;
ButtonLocCV: TButton;
BoutonRazTrains: TButton;
ButtonAffAnalyseCDM: TButton;
ButtonCDM: TButton;
GroupBox2: TGroupBox;
Label3: TLabel;
LabelVCV: TLabel;
ButtonEcrCV: TButton;
ButtonLitCV: TButton;
EditCV: TEdit;
EditVal: TEdit;
Affichagenormal1: TMenuItem;
N14: TMenuItem;
Sauvegarderla1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -316,6 +318,9 @@ type
procedure CO91Click(Sender: TObject);
procedure CO101Click(Sender: TObject);
procedure ButtonCDMClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Affichagenormal1Click(Sender: TObject);
procedure Sauvegarderla1Click(Sender: TObject);
private
{ Déclarations privées }
procedure DoHint(Sender : Tobject);
@@ -505,7 +510,8 @@ var
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,NbrePN,ServeurInterfaceCDM,index_couleur,
ServeurRetroCDM,TailleFonte,Nb_Det_Dist,Tdoubleclic,algo_Unisemaf,fA,fB,
etape,idEl,avecRoulage,intervalle_courant,filtrageDet0,SauvefiltrageDet0,
TpsTimeoutSL,formatY,OsBits,NbreDecPers,NbDecodeur,NbDecodeurdeBase : integer;
TpsTimeoutSL,formatY,OsBits,NbreDecPers,NbDecodeur,NbDecodeurdeBase,
LargeurF,HauteurF,OffsetXF,OffsetYF,etatF,PosSplitter : integer;
ack,portCommOuvert,traceTrames,AffMem,CDM_connecte,dupliqueEvt,affiche_retour_dcc,
Raz_Acc_signaux,AvecInit,AvecTCO,terminal,Srvc_Aig,Srvc_Det,Srvc_Act,MasqueBandeauTCO,
@@ -762,6 +768,7 @@ procedure inverse_image(imageDest,ImageSrc : Timage) ;
function extract_int(s : string) : integer;
Procedure Menu_tco(i : integer);
procedure Affiche_fenetre_TCO(i : integer);
procedure positionne_elements(i : integer);
implementation
@@ -2088,6 +2095,41 @@ begin
else Feux[rang].checkFB:=nil;
end;
procedure Affiche_signaux;
var i : integer;
begin
i:=(Formprinc.ScrollBox1.Width div (largImg+5)) -1;
if i=NbreImagePLigne then exit;
NbreImagePLigne:=i;
for i:=1 to NbreFeux do
begin
with Feux[i].img do
begin
Top:=(HtImg+espY+20)*((i-1) div NbreImagePLigne); // détermine les points d'origine
Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne));
repaint;
end;
with Feux[i].lbl do
begin
Top:=HtImg+((HtImg+EspY+20)*((i-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne));
repaint;
end;
if feux[i].FeuBlanc then
with Feux[i].checkFB do
begin
Top:=HtImg+15+((HtImg+EspY+20)*((i-1) div NbreImagePLigne));
Left:=10+ (LargImg+5)*((i-1) mod (NbreImagePLigne));
repaint;
end;
end;
end;
// ajoute en bout de chaine le checksum d'une trame (pour XpressNet)
Function Checksum(s : string) : string;
var i : integer;
@@ -4494,7 +4536,7 @@ begin
TailleX:=ImageFeu.picture.BitMap.Width;
Orientation:=tco[indextco,x,y].FeuOriente;
// réduction variable en fonction de la taille des cellules
calcul_reduction(frx,fry,round(TailleX*LargeurCell[indexTCO]/ZoomMax),round(tailleY*HauteurCell[indexTCO]/ZoomMax),TailleX,TailleY);
calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]);
// décalage en X pour mettre la tete du feu alignée sur le bord droit de la cellule pour les feux tournés à 90G
Dessine_feu_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indextco,x,y].y,frx,fry,adresse,orientation);
end;
@@ -11999,12 +12041,30 @@ begin
Result:='mac non trouvée';
end;
procedure positionne_elements(i : integer);
begin
with formprinc do
begin
GroupBox1.Left:=i+12;
GroupBox2.Left:=i+12;
GroupBox3.Left:=i+12;
ScrollBox1.Left:=i+12;
ScrollBox1.width:=panel2.Width-i-5;
Panel1.Left:=GroupBox1.Left+GroupBox1.Width+5;
Panel1.top:=9;
GroupBox1.Top:=5;
Affiche_signaux;
if not(avec_Splitter) then Panel2.Width:=i;
end;
end;
// démarrage principal du programme signaux_complexes
procedure TFormPrinc.FormCreate(Sender: TObject);
var i,j,index : integer;
var i,index,OrgMilieu : integer;
s : string;
begin
AF:='Client TCP-IP CDM Rail ou USB - système XpressNet DCC++ Version '+Version+sousVersion+' beta test';
AF:='Client TCP-IP CDM Rail ou USB - système XpressNet DCC++ Version '+Version+sousVersion;
Caption:=AF;
TraceSign:=True;
configPrete:=false; // form config prete
@@ -12058,7 +12118,7 @@ begin
etape:=1;
affevt:=false;
EvtClicDet:=false;
avec_splitter:=false;
avec_splitter:=true;
Algo_localisation:=1; // normal
AntiTimeoutEthLenz:=0;
Verif_AdrXpressNet:=1;
@@ -12102,90 +12162,7 @@ begin
VertScrollBar.Smooth:=false;
end;
with panel2 do
begin
Panel2.Top:=32;
Panel2.Left:=8;
Width:=610;
Height:=520;
Anchors:=[akLeft,akTop,akRight,akBottom];
end;
if avec_splitter then
begin
with Fenrich do
begin
parent:=panel2;
Align:=alLeft;
left:=0;
top:=0;
width:=panel2.Width-20;
height:=520;
Anchors:=[akLeft,akTop,akRight,akBottom];
end;
with splitterV do
begin
Parent:=panel2;
Left:=FenRich.left+FenRich.Width+1;
//Align:=Fenrich.Align;
//MinSize:=200;
Visible:=true;
end;
with panel2 do
begin
//align:=alLeft;
//Left:=SplitterV.left+10;
end;
with ScrollBox1 do
begin
//Parent:=formprinc;
//align:=alclient;
Anchors:=[];
top:=200;
end;
splitterH.Visible:=false;
{ with splitterH do
begin
Parent:=formprinc;
//top:=FenRich.top+FenRich.height+1;
Width:=FenRich.width;
Align:=alBottom;
MinSize:=200;
Visible:=true;
end;
}
end
else
begin
splitterV.Visible:=false;
splitterH.Visible:=false;
with panel2 do
begin
Anchors:=[akLeft,akTop,akRight,akBottom];
end;
with Fenrich do
begin
parent:=panel2;
Align:=alLeft;
left:=0;
top:=0;
width:=panel2.Width;
height:=panel2.Height;
Anchors:=[akLeft,akTop,akRight,akBottom];
end;
end;
// pour Rad studio------------------------
FenRich.Height:=Height-150;
ScrollBox1.Height:=Height-280;
StaticText.AutoSize:=true;
StaticText.Top:=panel2.Height+Panel2.Top+6;
//----------------------------------------
ferme:=false;
CDM_connecte:=false;
@@ -12198,7 +12175,6 @@ begin
NumTrameCDM:=0;
protocole:=1;
procetape(''); //1
for i:=1 to NbMemZone do
begin
Ancien_detecteur[i]:=false;
@@ -12211,10 +12187,12 @@ begin
Application.HintPause:=400;
//visible:=true; // rend la form visible plus tot
for i:=1 to MaxCdeDccpp do CdeDccpp[i]:='';
// lecture fichiers de configuration
procetape('Lecture de la configuration');
lit_config;
Menu_tco(NbreTCO);
procetape('Lecture du TCO');
for i:=1 to NbreTCO do
@@ -12269,8 +12247,94 @@ begin
intToSTR(ecran[i+1].larg)+' '+intToSTR(ecran[i+1].haut),clyellow); }
end;
OrgMilieu:=formprinc.width div 2;
with Panel2 do
begin
left:=5;
//Align:=AlLeft; // si on ne met pas AlignLeft, alors le splitter n'est pas accrochable
top:=formprinc.LabelTitre.Height+20;
width:=formprinc.width-30;
height:=formprinc.Height-StatusBar1.Height-StaticText.Height-LabelTitre.Height-90;
//height:=400;
Anchors:=[akLeft,akTop,akRight,akBottom];
end;
if avec_splitter then
begin
with Fenrich do
begin
left:=5;
Align:=AlLeft; // si on ne met pas AlignLeft, alors le splitter n'est pas accrochable
top:=formprinc.LabelTitre.Height+20;
width:=(OrgMilieu)-left-10;
//height:=formprinc.Height-StatusBar1.Height-StaticText.Height-LabelTitre.Height-90;
Anchors:=[akLeft,akTop,akRight,akBottom];
end;
with splitterV do
begin
Left:=FenRich.left+FenRich.Width-25;
MinSize:=200;
Parent:=Panel2;
align:=fenrich.align; // dessine le splitter à droite de la fenetre Fenrich
Visible:=true;
end;
with ScrollBox1 do
begin
Parent:=Panel2;
Anchors:=[akTop,akRight,akBottom];
width:=panel2.Width-SplitterV.Width-5;
height:=panel2.Height-groupBox3.height-groupBox3.top-25;
top:=GroupBox3.Top+GroupBox3.Height+5;
end;
positionne_elements(splitterV.left);
end
// ---------sans splitter -------------
else
begin
splitterV.Visible:=false;
with Fenrich do
begin
// parent:=paànel2;
Align:=alLeft;
left:=5;
top:=0;
width:=panel2.Width-orgMilieu-10;
height:=panel2.Height;
//Anchors:=[akLeft,akTop,akRight,akBottom];
GroupBox1.Left:=orgMilieu+12;
GroupBox3.Left:=orgMilieu+12;
ScrollBox1.Left:=orgMilieu+12;
ScrollBox1.width:=panel2.Width-orgMilieu-5;
ScrollBox1.top:=GroupBox3.Top+GroupBox3.Height+5;
ScrollBox1.Anchors:=[akTop,akRight,akBottom];
Panel1.Left:=GroupBox1.Left+GroupBox1.Width+5;
end;
end;
// pour Rad studio------------------------
//FenRich.Height:=Height-150;
//ScrollBox1.Height:=Height-280;
StaticText.AutoSize:=true;
StaticText.Top:=panel2.Height+Panel2.Top+4;
//----------------------------------------
if (PosSplitter>0) and (PosSPlitter<formPrinc.Width) and (AffMemoFenetre=1) then
begin
fenRich.Width:=PosSplitter;
positionne_elements(PosSplitter);
end;
for index:=1 to nbreTCO do
//for j:=1 to 2 do
begin
begin
IndexTCOCreate:=index;
@@ -12279,23 +12343,18 @@ begin
formTCO[index].Caption:='TCO'+intToSTR(index);
end;
{
i:=0;
repeat
sleep(100);
application.processmessages;
inc(i);
until (TcoCree) or (i>20);
TcoCree:=false;
TcoCree:=false;
Application.processmessages;
if avecTCO then
begin
//if NbreTCO=1 then FormTCO.show // créer fiche dynamique (projet/fichier)
//else
begin
Affiche_Fenetre_TCO(index);
end;
end;
//tcocree:=true;
}
if avecTCO then Affiche_Fenetre_TCO(index);
//tcocree:=true;
end;
if debug=1 then Affiche('Initialisations',clLime);
@@ -12380,7 +12439,6 @@ begin
end;
//DoubleBuffered:=true;
{
aiguillage[index_aig(1)].position:=const_droit;
@@ -12438,9 +12496,11 @@ begin
ReadOnly:=true;
end; }
//Affiche(GetMACAddress,clred);
formPrinc.left:=-1000;
ConfCellTCO:=false;
if debug=1 then Affiche('Fini',clLime);
end;
@@ -12521,7 +12581,7 @@ begin
end;
if confasauver then sauve_config;
if sauve_tco then sauve_fichiers_tco;
Application.ProcessMessages;
//Application.ProcessMessages;
end;
// timer à 100 ms
@@ -12533,6 +12593,23 @@ var aspect,i,a,x,y,Bimage,combine,adresse,TailleX,TailleY,orientation,indexTCO :
s : string;
begin
inc(tick);
if (tick=10) then
begin
// fenetre
if AffMemoFenetre=1 then
begin
if largeurF>0 then formPrinc.width:=LargeurF;
if HauteurF>0 then formPrinc.Height:=hauteurF;
formPrinc.left:=offsetXF;
formPrinc.top:=offsetYF;
if (PosSplitter>0) and (PosSPlitter<formPrinc.Width) then
begin
fenRich.Width:=PosSplitter;
positionne_elements(PosSplitter);
end;
end;
end;
if (tick=30) or (tick=100) then
begin
// raz du flag "fenetre confcellTCO affichée"
@@ -12635,7 +12712,7 @@ begin
TailleX:=ImageFeu.picture.BitMap.Width;
Orientation:=TCO[indexTCO,x,y].FeuOriente;
// réduction variable en fonction de la taille des cellules
calcul_reduction(frx,fry,round(TailleX*LargeurCell[indexTCO]/ZoomMax),round(tailleY*HauteurCell[indexTCO]/ZoomMax),TailleX,TailleY);
calcul_reduction(frx,fry,LargeurCell[indexTCO],HauteurCell[indexTCO]);
Dessine_feu_mx(PCanvasTCO[indexTCO],tco[indexTCO,x,y].x,tco[indexTCO,x,y].y,frx,fry,adresse,orientation);
end;
end;
@@ -15022,19 +15099,12 @@ end;
procedure TFormPrinc.SplitterVMoved(Sender: TObject);
var pdroite : integer;
begin
Affiche(intToSTR(splitterV.Left),clred);
exit;
//fenrich.width:=splitterV.left;
if not(avec_splitter) then exit;
//Affiche('splittermoved',clyellow);
pdroite:=SplitterV.Left+40;
panel2.Width:=pdroite;
var i : integer;
begin
i:=SplitterV.Left;
//Affiche(IntToSTR(i),clred);
if i<200 then SplitterV.Left:=201;
positionne_elements(SplitterV.Left);
end;
procedure TFormPrinc.PopupMenuFeuPopup(Sender: TObject);
@@ -15171,7 +15241,6 @@ begin
for i:=1 to NbreTCO do
begin
HautTCO:=HautEcran;
for e:=1 to NombreEcrans do
begin
@@ -15179,9 +15248,9 @@ begin
begin
with formtco[i] do
begin
windowState:=wsNormal;
show;
BringToFront;
windowState:=wsNormal;
show;
BringToFront;
end;
inc(CeTCO[e]);
@@ -15230,7 +15299,6 @@ begin
for i:=1 to NbreTCO do
begin
HautTCO:=HautEcran;
for e:=1 to NombreEcrans do
begin
@@ -15437,15 +15505,17 @@ end;
procedure Affiche_Fenetre_TCO(i : integer);
var e : integer;
begin
if i>NbreTCO then exit;
formTCO[i].show;
formTCO[i].BringToFront;
if (i<1) or (i>NbreTCO) then exit;
e:=ecranTCO[i];
if e>Screen.MonitorCount then exit;
if e>Screen.MonitorCount then e:=1;
formTCO[i].show;
formTCO[i].BringToFront;
formTCO[i].Left:=Ecran[e].x0;
formTCO[i].Top:=Ecran[e].y0;
formTCO[i].windowState:=wsMaximized;
end;
procedure TFormPrinc.AfficherTCO11Click(Sender: TObject);
@@ -15756,7 +15826,8 @@ end;
procedure TFormPrinc.NouveauTCO1Click(Sender: TObject);
begin
var i : integer;
begin
if NbreTCO>=10 then
begin
Affiche('Nombre maximum de TCO atteint',clred);
@@ -15766,14 +15837,25 @@ begin
TCOActive:=false;
inc(nbreTCO);
IndexTCOCreate:=nbreTCO;
formTCO[nbreTCO]:=TformTCO.Create(self);
formTCO[NbreTCO]:=nil;
try
formTCO[nbreTCO]:=TformTCO.Create(self);
except
Affiche('Erreur 6800 Impossible de créer la fenêtre du TCO',clred);
exit;
end;
formTCO[nbreTCO].Name:='FormTCO'+intToSTR(nbreTCO);
formTCO[nbreTCO].Caption:='TCO'+intToSTR(nbreTCO);
Forminit[nbreTCO]:=false;
init_TCO(nbreTCO);
menu_tco(NbreTCO);
TCO_modifie:=true;
config_modifie:=true;
formTCO[nbreTCO].show; // génère formActivate ce qui implique que le nom de la form soit à jour, et que le TCO soit initialisé
end;
procedure Supprimer_TCO(TcoS : integer);
@@ -15789,8 +15871,9 @@ begin
TCOActive:=false;
Affiche('Suppression du TCO '+intToSTR(Tcos),clOrange);
//FormTCO[tcos].close;
FormTCO[tcos].Release; // pas free FreeInstance; // annuler le pointeur et raz les mémoires de la form
FormTCO[tcos].close;
FormTCO[tcos].free; // annuler le pointeur et raz les mémoires de la form
for i:=tCos to SauvNbreTCO-1 do
begin
@@ -15818,8 +15901,8 @@ begin
HauteurCell[i]:=HauteurCell[i+1];
EcranTCO[i]:=EcranTCO[i+1];
Forminit[i]:=false;
end;
setlength(TCO[SauvNbreTCO],0);
dec(SauvNbreTCO);
Menu_tco(SauvNbreTCO);
@@ -15890,5 +15973,33 @@ begin
cdmDevant:=not(cdmDevant);
end;
procedure TFormPrinc.FormResize(Sender: TObject);
begin
// pour éviter de coincer le splitter à gauche fenetre réduite et on le glisse complètement à gauche
splitterV.Left:=FenRich.left+FenRich.Width-5;
end;
procedure TFormPrinc.Affichagenormal1Click(Sender: TObject);
begin
FenRich.Width:=panel2.Width div 2;
splitterV.Left:=FenRich.left+FenRich.Width-5;
positionne_elements(splitterV.Left);
end;
procedure TFormPrinc.Sauvegarderla1Click(Sender: TObject);
begin
LargeurF:=width;
HauteurF:=Height;
OffsetXF:=left;
OffsetYF:=top;
etatF:=0;
PosSplitter:=splitterV.Left;
AffMemoFenetre:=1;
sauve_config;
end;
end.
UnitTCO.dfm
+55 -42
View File
@@ -1,8 +1,8 @@
object FormTCO: TFormTCO
Left = 118
Top = 115
Left = 84
Top = 164
Width = 1209
Height = 580
Height = 575
VertScrollBar.Visible = False
Caption = 'c'
Color = clBtnFace
@@ -23,7 +23,7 @@ object FormTCO: TFormTCO
OnMouseWheel = FormMouseWheel
DesignSize = (
1193
542)
536)
PixelsPerInch = 96
TextHeight = 13
object LabelZoom: TLabel
@@ -56,7 +56,7 @@ object FormTCO: TFormTCO
Left = 10
Top = 15
Width = 943
Height = 330
Height = 325
HorzScrollBar.Smooth = True
HorzScrollBar.Tracking = True
VertScrollBar.Smooth = True
@@ -68,12 +68,12 @@ object FormTCO: TFormTCO
TabOrder = 1
DesignSize = (
939
326)
321)
object ImageTCO: TImage
Left = 48
Top = 25
Width = 642
Height = 143
Height = 138
Anchors = [akLeft, akTop, akRight, akBottom]
AutoSize = True
ParentShowHint = False
@@ -93,11 +93,11 @@ object FormTCO: TFormTCO
Height = 311
Anchors = [akTop, akRight]
Ctl3D = True
Max = 50
Min = 20
Max = 100
Min = 15
Orientation = trVertical
ParentCtl3D = False
Position = 20
Position = 78
TabOrder = 0
TabStop = False
TickMarks = tmTopLeft
@@ -105,7 +105,7 @@ object FormTCO: TFormTCO
end
object Panel1: TPanel
Left = 2
Top = 360
Top = 355
Width = 1085
Height = 185
Anchors = [akLeft, akRight, akBottom]
@@ -979,78 +979,78 @@ object FormTCO: TFormTCO
end
object GroupBox1: TGroupBox
Left = 16
Top = 8
Top = 0
Width = 185
Height = 153
Height = 169
Caption = 'Configuration cellule'
Font.Charset = ANSI_CHARSET
Font.Color = clBackground
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Height = -15
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
TabOrder = 7
object Label41: TLabel
Left = 8
Top = 16
Width = 120
Height = 20
Top = 24
Width = 103
Height = 16
Caption = 'Adresse de l'#39#233'l'#233'ment: '
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
end
object Label71: TLabel
Left = 8
Top = 38
Width = 111
Height = 20
Top = 46
Width = 93
Height = 16
Caption = 'Image de l'#39#233'l'#233'ment: '
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
end
object Label230: TLabel
Left = 56
Top = 64
Width = 32
Height = 20
Top = 72
Width = 27
Height = 16
Caption = 'Texte'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
end
object Label65: TLabel
Left = 8
Top = 88
Width = 89
Height = 20
Top = 96
Width = 75
Height = 16
Caption = 'position du texte'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -15
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
end
object ShapeCoulFond: TShape
Left = 160
Top = 130
Top = 146
Width = 18
Height = 18
end
object EditAdrElement: TEdit
Left = 144
Top = 12
Top = 20
Width = 33
Height = 21
Font.Charset = ANSI_CHARSET
@@ -1065,7 +1065,7 @@ object FormTCO: TFormTCO
end
object EditTypeImage: TEdit
Left = 144
Top = 36
Top = 44
Width = 33
Height = 21
Font.Charset = ANSI_CHARSET
@@ -1080,7 +1080,7 @@ object FormTCO: TFormTCO
end
object ButtonFonte: TButton
Left = 8
Top = 64
Top = 72
Width = 41
Height = 17
Caption = 'Fonte'
@@ -1089,19 +1089,31 @@ object FormTCO: TFormTCO
end
object EditTexte: TEdit
Left = 88
Top = 60
Top = 70
Width = 89
Height = 21
Font.Charset = ANSI_CHARSET
Font.Color = clBackground
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
OnChange = EditTexteChange
end
object ComboRepr: TComboBox
Left = 88
Top = 84
Top = 96
Width = 89
Height = 21
Style = csDropDownList
Font.Charset = ANSI_CHARSET
Font.Color = clBackground
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 13
ParentFont = False
TabOrder = 4
TabStop = False
OnChange = ComboReprChange
@@ -1110,19 +1122,20 @@ object FormTCO: TFormTCO
'Centrale'
'Haut'
'Bas'
'R'#233'parti')
'R'#233'parti'
'Centr'#233)
end
object CheckPinv: TCheckBox
Left = 8
Top = 110
Top = 126
Width = 113
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.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
ParentShowHint = False
@@ -1132,7 +1145,7 @@ object FormTCO: TFormTCO
end
object ButtonCoulFond: TButton
Left = 80
Top = 130
Top = 146
Width = 81
Height = 18
Caption = 'Couleur de fond'
UnitTCO.pas
+250 -103
View File
@@ -407,11 +407,12 @@ type
end;
const
MaxCellX=150;MaxCellY=70;
licone=35;
hicone=35;
maxUndo=30;
ZoomMax=50;ZoomMin=15;
MaxCellX=150;MaxCellY=70;
ZoomMax=(8191 div MaxCellX)-1; // pour ne pas dépasser un canvas de 8191 pixel maxi
ZoomMin=15;
ClFond_ch='CoulFond';
clVoies_ch='CoulVoies';
clAllume_ch='CoulAllume';
@@ -434,7 +435,7 @@ const
// liaisons des voies pour chaque icone par bit (0=NO 1=Nord 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest)
Liaisons : array[0..52] of integer=
// 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
// 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
(0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$66,$23,$33,$26,$62,$32,$31,0,0,
// 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
$64,$13,$46, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ;
@@ -467,7 +468,6 @@ type
var
clAllume,clVoies,clFond,couleurAdresse,clGrille,cltexte,clQuai,CoulFonte,ClCanton,clPiedSignal : Tcolor;
//FormTCO: TFormTCO;
formTCO : array[1..10] of TformTCO;
TamponAffecte,TCO_modifie,clicsouris,
@@ -477,7 +477,7 @@ var
HtImageTCO,LargImageTCO,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris,
XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel,AncienYMiniSel,AncienYMaxiSel,
Xclic,Yclic,XClicCellInserer,YClicCellInserer,RatioC,ModeCouleurCanton,
AncienXClicCell,AncienYClicCell,
AncienXClicCell,AncienYClicCell,TCODrag,
Epaisseur,oldX,oldY,offsetSourisY,offsetSourisX,AvecVerifIconesTCO,indexTrace,IndexTCOCourant,
ancienTraceX,ancienTraceY,rangUndo,NbreTCO,IndexTCOCreate: integer;
@@ -524,7 +524,7 @@ var
AvecGrille,SelectionAffichee,forminit,modeTrace,entoure : array[1..10] of boolean;
procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer);
procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY : integer);
procedure calcul_cellules(indextco : integer);
procedure sauve_fichiers_tco;
procedure zone_TCO(indexTCO,det1,det2,mode: integer);
@@ -560,6 +560,8 @@ uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO ;
{$R *.dfm}
// renvoie l'index du tco d'après le nom de la forme (TCO1 TCO2)
// ne fonctionne que si t est un composant dont on peut remonter jusqu'à la form parent
// Exemple : si T est un popup menu, ca ne marche pas!!!
function index_TCO(t : Tobject) : integer;
var s : string;
trouve : boolean;
@@ -568,7 +570,7 @@ var s : string;
begin
s:=(t as Tcomponent).name;
// Affiche(s,clWhite);
// popup menu ne marche pas!!!
f:=getparentForm(t as Tcontrol);
s:=(f as Tcomponent).Name;
//Affiche(s,clYellow);
@@ -603,45 +605,45 @@ end;
procedure Init_TCO(indexTCO : integer);
var x,y : integer;
begin
sauve_tco:=true;
Affiche('Nouveau tco '+intToSTr(indexTCO),clyellow);
NbreCellX[indexTCO]:=35;NbreCellY[indexTCO]:=20;LargeurCell[indexTCO]:=35;HauteurCell[indexTCO]:=35;
largeurCelld2[indexTCO]:=largeurCell[indexTCO] div 2;HauteurCelld2[indexTCO]:=HauteurCell[indexTCO] div 2;
EcranTCO[indexTCO]:=1;
RatioC:=10;
ClFond:=$000040;
ClVoies:=$0077FF;
ClAllume:=$00FFFF;
ClGrille:=$404040;
ClTexte:=$00FF00;
ClQuai:=$808080;
clPiedSignal:=$4080FF;
ClCanton:=$00FFFF;
AvecGrille[indexTCO]:=true;
Graphisme:=1;
SetLength(TCO[indexTCO],NbreCellX[indexTCO]+2,NbreCellY[indexTCO]+2); // +2 pour éviter les erreurs d'index sur +1 et -1
init_tampon_copiercoller;
sauve_tco:=true;
Affiche('Nouveau tco '+intToSTr(indexTCO),clyellow);
NbreCellX[indexTCO]:=35;NbreCellY[indexTCO]:=20;LargeurCell[indexTCO]:=35;HauteurCell[indexTCO]:=35;
largeurCelld2[indexTCO]:=largeurCell[indexTCO] div 2;HauteurCelld2[indexTCO]:=HauteurCell[indexTCO] div 2;
EcranTCO[indexTCO]:=1;
RatioC:=10;
ClFond:=$000040;
ClVoies:=$0077FF;
ClAllume:=$00FFFF;
ClGrille:=$404040;
ClTexte:=$00FF00;
ClQuai:=$808080;
clPiedSignal:=$4080FF;
ClCanton:=$00FFFF;
AvecGrille[indexTCO]:=true;
Graphisme:=1;
SetLength(TCO[indexTCO],NbreCellX[indexTCO]+2,NbreCellY[indexTCO]+2); // +2 pour éviter les erreurs d'index sur +1 et -1
init_tampon_copiercoller;
for x:=1 to NbreCellX[indexTCO] do
for y:=1 to NbreCellY[indexTCO] do
with tco[indextco,x,y] do
begin
CouleurFond:=clfond;
Adresse:=0;
Bimage:=0;
repr:=0;
Texte:='';
fonte:='Arial';
fontSTyle:='';
piedFeu:=0;
x:=0;
y:=0;
FeuOriente:=0;
Liaisons:=0;
Epaisseur:=0;
Buttoir:=0;
end;
end;
for x:=1 to NbreCellX[indexTCO] do
for y:=1 to NbreCellY[indexTCO] do
with tco[indextco,x,y] do
begin
CouleurFond:=clfond;
Adresse:=0;
Bimage:=0;
repr:=0;
Texte:='';
fonte:='Arial';
fontSTyle:='';
piedFeu:=0;
x:=0;
y:=0;
FeuOriente:=0;
Liaisons:=0;
Epaisseur:=0;
Buttoir:=0;
end;
end;
procedure lire_fichier_tco(indexTCO : integer);
var fichier : textfile;
@@ -797,7 +799,7 @@ begin
trouve_ModeCanton:=true;
delete(s,i,length(sa));
val(s,i,erreur);
ModeCouleurCanton:=i;
ModeCouleurCanton:=i;
end;
sa:=uppercase(Graphisme_ch)+'=';
@@ -1083,7 +1085,6 @@ begin
inc(y);x:=1;
end;
closefile(fichier);
e:=sizeof(Tco) div 1024;
//Affiche('Dimensions du tco : '+intToSTR(NbreCellX)+'x'+intToSTR(NbreCellY)+' / '+IntToSTR(e)+'Ko',clyellow);
if not(trouve_clPiedSignal) then clPiedSignal:=Clvoies;
@@ -1179,8 +1180,12 @@ begin
end;
procedure calcul_cellules(indexTCO : integer);
var pos : integer;
begin
LargeurCell[indexTCO]:=ZoomMax-FormTCO[indexTCO].TrackBarZoom.Position+ZoomMin;
pos:=ZoomMax-FormTCO[indexTCO].TrackBarZoom.Position+ZoomMin;
//Affiche('Position TrackBar°'+intToSTR(indexTCO)+'='+intToSTR(pos),clyellow);
LargeurCell[indexTCO]:=pos;
//Affiche('LargeurCell TCO N°'+intToSTR(indexTCO)+'='+intToSTR(largeurcell[indexTCO]),clyellow);
hauteurCell[indexTCO]:=(LargeurCell[indexTCO] * RatioC) div 10;
largeurCelld2[indexTCO]:=largeurCell[indexTCO] div 2;
@@ -1436,9 +1441,13 @@ var b,x0,y0,xt,yt,repr,taillefont,tf : integer;
ss,s : string;
c : Tcanvas;
begin
x0:=(x-1)*LargeurCell[indexTCO];
y0:=(y-1)*hauteurCell[indexTCO];
//PCanvasTCO.Brush.Style:=bsSolid;
s:=tco[indextco,x,y].Texte;
// if s='' then exit;
c:=PcanvasTCO[indextco];
b:=tco[indextco,x,y].BImage;
@@ -1454,15 +1463,8 @@ begin
repr:=tco[indextco,x,y].repr;
taillefont:=tco[indextco,x,y].TailleFonte;
case repr of
0,1 : yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // milieu
2 : yt:=1; // haut
3 : yt:=hauteurCell[indexTCO]-round(2*TailleFont*fryGlob[indexTCO]); // bas
end;
s:=tco[indextco,x,y].Texte;
xt:=0;
if b=52 then xt:=6 else s:=s+' ';
xt:=0;yt:=0;
if taillefont=0 then taillefont:=8;
tf:=(taillefont*LargeurCell[indexTCO]) div 40;
@@ -1471,9 +1473,21 @@ begin
//affiche(intToSTR(taillefont*LargeurCell[indexTCO] div 40),clyellow);
// champ texte
case repr of
0,1 : yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // milieu
2 : yt:=1; // haut
3 : yt:=hauteurCell[indexTCO]-round(2*TailleFont*fryGlob[indexTCO]); // bas
5 : begin // double centré
xt:=(largeurCell[indexTCO] div 2)-(round(length(s)*(taillefont)*frxGlob[indexTCO]) div 3);
yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // texte centré
end;
end;
if b=Id_Quai then xt:=6;
if (b<>Id_Quai) and (b<>Id_action) then s:=s+' ';
if repr=4 then texte_reparti(s,indextco,x,y,tf) else
c.Textout(x0+xt,y0+yt,s);
//PcanvasTCO[indextco].Textout(x0+xt,y0+yt,s);
end;
@@ -1667,8 +1681,6 @@ begin
end;
end;
// sert de référence11
procedure dessin_2L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,jy2,xf,yf,position,jy1,ep : integer;
@@ -4809,20 +4821,20 @@ begin
if TCOActive then
begin
tco[indexTCO,x,y].repr:=5;
act:=tco[indexTCO,x,y].PiedFeu;
if act=1 then
begin
s:='TCO'+intToSTR(tco[indexTCO,x,y].FeuOriente);
tco[indexTCO,x,y].texte:=s;
tco[indexTCO,x,y].repr:=1;
tco[indexTCO,x,y].TailleFonte:=8;
tco[indexTCO,x,y].FontStyle:='G';
end;
if act=2 then
begin
s:=' SC';
s:='SC';
tco[indexTCO,x,y].texte:=s;
tco[indexTCO,x,y].repr:=1;
tco[indexTCO,x,y].TailleFonte:=8;
tco[indexTCO,x,y].FontStyle:='G';
end;
@@ -4830,7 +4842,6 @@ begin
begin
s:='CDM';
tco[indexTCO,x,y].texte:=s;
tco[indexTCO,x,y].repr:=1;
tco[indexTCO,x,y].TailleFonte:=8;
tco[indexTCO,x,y].FontStyle:='G';
end;
@@ -7111,10 +7122,12 @@ begin
end;
// calcul des facteurs de réductions X et Y pour l'adapter à l'image de destination
procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer);
procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY : integer);
begin
frX:=DimDestX/DimOrgX;
frY:=DimDestY/DimOrgY;
//frX:=DimDestX/DimOrgX;
//frY:=DimDestY/DimOrgY;
frx:=DimDestX/50;
fry:=DimDestY/50;
//Affiche(formatfloat('0.000000',frY),clyellow);
end;
@@ -7529,14 +7542,17 @@ end;
// Dessine un signal dans le canvasDest en x,y , dont l'adresse se trouve à la cellule x,y
procedure dessin_Signal(indexTCO : integer;CanvasDest : Tcanvas;x,y : integer );
var index,x0,y0,xp,yp,orientation,adresse,aspect,PiedFeu,TailleX,TailleY : integer;
var index,x0,y0,xp,yp,orientation,adresse,aspect,PiedFeu,TailleX,TailleY,larg,haut : integer;
ImageFeu : Timage;
frX,frY : real;
begin
if (x>NbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x<1) or (y<1) then exit;
xp:=(x-1)*LargeurCell[indexTCO];
yp:=(y-1)*hauteurCell[indexTCO];
larg:=LargeurCell[indexTCO];
haut:=hauteurCell[indexTCO];
xp:=(x-1)*larg;
yp:=(y-1)*haut;
Adresse:=tco[indextco,x,y].Adresse;
Orientation:=tco[indextco,x,y].FeuOriente;
@@ -7570,7 +7586,7 @@ begin
PiedFeu:=tco[indextco,x,y].PiedFeu; // gauche ou droite de la voie
// réduction variable en fonction de la taille des cellules. 50 est le Zoom Maxi
calcul_reduction(frx,fry,round(TailleX*LargeurCell[indexTCO]/ZoomMax),round(tailleY*hauteurCell[indexTCO]/ZoomMax),TailleX,TailleY);
calcul_reduction(frx,fry,Larg,haut);
x0:=0;y0:=0; // pour les signaux directionnels
if orientation=3 then //D
@@ -8012,7 +8028,7 @@ begin
calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO],ZoomMax,ZoomMax);
calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]);
//Affiche(formatfloat('0.000000',frxGlob[indexTCO]),clyellow);
//effacer tout
@@ -8095,6 +8111,7 @@ begin
Buttonmasquer.TabStop:=false;
ButtonRaz.TabStop:=false;
ButtonDessiner.TabStop:=false;
TrackBarZoom.position:=78;
Clfond:=$000040;
couleurAdresse:=Cyan;
@@ -9176,17 +9193,14 @@ begin
ImageTemp.Visible:=not(Diffusion);
ImageTemp2.Visible:=not(Diffusion);
ButtonAfficheBandeau.visible:=false;
TrackBarZoom.Max:=ZoomMax;
TrackBarZoom.Min:=ZoomMin;
hauteurCell[indexTCO]:=ImagePalette1.Height;
LargeurCell[indexTCO]:=ImagePalette1.Width;
LargeurCelld2[indexTCO]:=LargeurCell[indexTCO] div 2;hauteurCelld2[indexTCO]:=hauteurCell[indexTCO] div 2;
calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO],ZoomMax,ZoomMax);
calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]);
dessine_icones(indexTCO);
NbCellulesTCO[indexTCO]:=NbreCellX[indexTCO]*NbreCellY[indexTCO];
ImageTCO.Width:=LargeurCell[indexTCO]*NbreCellX[indexTCO];
ImageTCO.Height:=hauteurCell[indexTCO]*NbreCellY[indexTCO];
@@ -9202,12 +9216,11 @@ begin
PImageTemp[indextco]:=FormTCO[indextco].ImageTemp;
PImageTemp[indextco].Canvas.Rectangle(0,0,PImageTemp[indextco].Width,PimageTemp[indextco].Height);
//Affiche_tco
with trackBarZoom do
begin
Position:=(ZoomMax+Zoommin) div 2;
//left:=clLarge-50;
end;
//déclenche l'Affiche_tco
TrackBarZoom.Max:=ZoomMax;
TrackBarZoom.Min:=ZoomMin;
TrackBarZoom.position:=34;
// height est la taille utile de la fenetre = taille fenetre-32
clLarge:=formTCO[indexTCO].Width;
@@ -9562,23 +9575,82 @@ begin
end;
end;
procedure selection_bleue(indexTCO,cellX,cellY : integer);
var XSel1,YSel1,XSel2,YSel2,xMiniSelP,yminiSelP,xMaxiSelP,ymaxiSelP : integer;
r : Trect;
begin
// zone de sélection bleue en coords pixels
xMiniSel:=(Xentoure[indexTCO]-1)*LargeurCell[indexTCO];;
yMiniSel:=(Yentoure[indexTCO]-1)*HauteurCell[indexTCO];;
xMaxiSel:=(cellX-1)*LargeurCell[indexTCO];
yMaxiSel:=(cellY-1)*hauteurCell[indexTCO];
xminiSelP:=min(xminiSel,xMaxiSel);
yminiSelP:=min(yminiSel,yMaxiSel);
xmaxiSelP:=max(xminiSel,xMaxiSel);
ymaxiSelP:=max(yminiSel,yMaxiSel);
xminiSel:=xMiniSelP;
yminiSel:=yMiniSelP;
xMaxiSel:=xMaxiSelP;
yMaxiSel:=yMaxiSelP;
//Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange);
// efface l'ancien rectangle de sélection
if SelectionAffichee[indexTCO] then
with formTCO[indexTCO].ImageTCO.canvas do
begin
Pen.Mode:=PmXor;
Pen.color:=clGrille;
Brush.Color:=clblue;
Rectangle(rAncien);
end;
if piloteAig then begin SelectionAffichee[indexTCO]:=false;piloteAig:=false;exit;end;
r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]);
XSel1:=Xminisel div LargeurCell[indexTCO] + 1;
YSel1:=Yminisel div hauteurCell[indexTCO] + 1;
XSel2:=Xmaxisel div LargeurCell[indexTCO] + 1;
YSel2:=Ymaxisel div hauteurCell[indexTCO] + 1;
//Affiche(intToSTR(Xsel1)+' '+intToStr(Ysel1)+' '+intToSTR(Xsel2)+' '+intToStr(Ysel2),clYellow);
// Affiche le nouveau rectangle de sélection
Rancien:=r;
with formTCO[indexTCO].ImageTCO.canvas do
begin
Pen.Mode:=PmXor;
Pen.color:=clGrille;
Brush.Color:=clblue;
//FillRect(r);
Rectangle(r);
end;
SelectionAffichee[indexTCO]:=true;
end;
// pour avoir les evts keydown, il faut dévalider les propriétés tabstop des boutons de la form.
procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
var s,d,indexTCO : integer;
var s,d,indexTCO,x,y : integer;
procede : boolean;
begin
if affevt then Affiche('TCO.FormKeyDown',clOrange);
if not(auto_tcurs) then exit;
indexTCO:=index_TCO(Sender);
procede:=false; // indicateur on a tapé une touche de curseur
//Affiche(intToSTR(key),clyellow);
if auto_tcurs then
x:=XClicCell[indexTCO];
y:=YClicCell[indexTCO];
with formTCO[indexTCO] do
begin
if not(ssShift in Shift) then
case Key of
VK_right : if XClicCell[indexTCO]<NbreCellX[indexTCO] then
VK_right : if x<NbreCellX[indexTCO] then
begin
Affiche('droit sans shift',clred);
inc(XClicCell[indexTCO]);
d:=(xClicCell[indexTCO]+1)*LargeurCell[indexTCO];
s:=scrollBox.HorzScrollBar.Position;
@@ -9627,15 +9699,80 @@ begin
stop_modetrace(indexTCO);
end;
VK_DELETE : couper(indexTCO);
end;
if (ssShift in Shift) then
case key of
VK_right : begin
if XClicCell[indexTCO]<NbreCellX[indexTCO] then
begin
inc(XClicCell[indexTCO]);
d:=(xClicCell[indexTCO]+1)*LargeurCell[indexTCO];
s:=scrollBox.HorzScrollBar.Position;
if d-s>ScrollBox.Width then scrollBox.HorzScrollBar.Position:=s+LargeurCell[indexTCO];
procede:=true;
end
else exit;
selection_bleue(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]);
exit;
end;
VK_down : begin
if YClicCell[indexTCO]<NbreCellY[indexTCO] then
begin
inc(YClicCell[indexTCO]);
d:=(yClicCell[indexTCO]+1)*hauteurCell[indexTCO];
s:=scrollBox.VertScrollBar.Position;
if d-s>ScrollBox.Height then scrollBox.VertScrollBar.Position:=s+hauteurCell[indexTCO];
procede:=true;
end
else exit;
selection_bleue(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]);
exit;
end;
VK_up : begin
if YClicCell[indexTCO]>1 then
begin
dec(YClicCell[indexTCO]);
d:=(yClicCell[indexTCO]-1)*hauteurCell[indexTCO];
s:=scrollBox.VertScrollBar.Position;
if d<s then
begin
s:=s-hauteurCell[indexTCO];
if s<hauteurCell[indexTCO] then s:=0;
scrollBox.VertScrollBar.Position:=s;
end;
procede:=true;
end
else exit;
selection_bleue(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]);
exit;
end;
VK_left : begin
if XClicCell[indexTCO]>1 then
begin
dec(XClicCell[indexTCO]);
d:=(xClicCell[indexTCO]-1)*LargeurCell[indexTCO];
s:=scrollBox.HorzScrollBar.Position;
if d<=s then
begin
s:=s-LargeurCell[indexTCO];
if s<LargeurCell[indexTCO] then s:=0;
scrollBox.HorzScrollBar.Position:=s;
end;
procede:=true;
end
else exit;
selection_bleue(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]);
exit;
end;
end;
end;
if (ssCtrl in Shift) and (Key = Ord('Z')) then
begin
annule(indexTCO);
exit;
end;
if (ssCtrl in Shift) and (Key = Ord('Z')) then
begin
annule(indexTCO);
exit;
end;
//VK_delete : affiche('delete',clorange);
if procede then
@@ -9711,6 +9848,7 @@ begin
StretchBlt(Vbm.Handle,0,0,LargeurCell[indexTCO],hauteurCell[indexTCO], // destination masque avec mise à l'échelle
image.Canvas.Handle,0,0,l,h,srccopy);
drag:=true;
TCODrag:=indexTCO;
oldx:=offsetSourisX;oldy:=offsetSourisY;
end;
@@ -9719,9 +9857,15 @@ procedure TFormTCO.ImageTCODragOver(Sender, Source: TObject; X, Y: Integer;State
var indexTCO,xl,yl : integer;
begin
indexTCO:=Index_tco(sender);
if affevt then Affiche('TCO'+intToSTR(IndexTCO)+' DragOver',clyellow);
if TCODrag<>indexTCO then
begin
accept:=false;
exit; // le drag source et destination sont diférents
end;
xl:=x+offsetSourisX;
yl:=y+offsetSourisY;
// Accept:=source is TImage;
Accept:=source is TImage;
if drag then
begin
BitBlt(PImageTCO[indexTCO].canvas.handle,oldx,oldy,LargeurCell[indexTCO],hauteurCell[indexTCO],oldbmp.canvas.handle,0,0,SRCCOPY); // remettre la sauvegarde du bitmap à l'ancienne position souris
@@ -10591,7 +10735,7 @@ begin
show;
BringToFront;
end;
if (i=3) and (CDMhd<>0) then ShowWindow(CDMhd,SW_MAXIMIZE);
if (i=3) and (CDMhd<>0) then begin ShowWindow(CDMhd,SW_MAXIMIZE);end;
end;
TempoSouris:=2 ; // démarre la tempo souris
@@ -10738,7 +10882,6 @@ begin
Pen.Mode:=PmXor;
Pen.color:=clGrille;
Brush.Color:=clblue;
//FillRect(r);
Rectangle(rAncien);
end;
SelectionAffichee[n]:=false;
@@ -10848,6 +10991,7 @@ begin
if not(clicsouris) or (temposouris>0) then exit;
// zone de sélection bleue en coordonnées souris
xMiniSel:=(XclicCell[indexTCO]-1)*LargeurCell[indexTCO];
yMiniSel:=(YclicCell[indexTCO]-1)*hauteurCell[indexTCO];
xMaxiSel:=(cellX-1)*LargeurCell[indexTCO];
@@ -10864,6 +11008,7 @@ begin
yMaxiSel:=yMaxiSelP;
//Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange);
//Affiche('XclicCell='+intToSTR(XclicCell[indexTCO])+' YclicCell='+intToSTR(XclicCell[indexTCO]),clorange);
// efface l'ancien rectangle de sélection
if SelectionAffichee[indexTCO] then
@@ -11233,8 +11378,9 @@ end;
procedure TFormTCO.TrackBarZoomChange(Sender: TObject);
var indextco : integer;
begin
if affevt then Affiche('TrackVBarZoomChange',clyellow);
if affevt then Affiche('TrackBarZoomChange',clyellow);
indexTCO:=index_tco(sender);
// Affiche(intToSTR(TrackBarZoom.position),clred);
calcul_cellules(indexTCO);
Affiche_TCO(indexTCO);
SelectionAffichee[indexTCO]:=false;
@@ -11907,20 +12053,22 @@ begin
if NbreCellY[indexTCO]<=1 then exit;
TamponAffecte:=false;
// tampon de sauvegarde
TamponTCO_org.numTCO:=indexTCO;
TamponTCO_Org.NbreCellX:=NbreCellX[indexTCO];
TamponTCO_Org.NbreCellY:=NbreCellY[indexTCO];
TamponTCO_Org.x1:=1;
TamponTCO_Org.x2:=NbreCellX[indexTCO];
TamponTCO_Org.y1:=1;
TamponTCO_Org.y2:=NbreCellY[indexTCO];
TamponTCO_Org.y1:=YClicCell[indexTCO];
TamponTCO_Org.y2:=YClicCell[indexTCO];
xcoupe:=1;ycoupe:=1;
for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do
for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do
begin
//Affiche(intToSTR(x)+' '+intToSTR(y),clyellow);
tampontco[x,y]:=tco[indextco,x,y];
end;
//TamponAffecte:=true;
end;
TamponAffecte:=true;
// supression ligne
for y:=YClicCell[indexTCO] to NbreCellY[indexTCO]-1 do
@@ -12029,15 +12177,15 @@ begin
// tampon de sauvegarde
TamponTCO_Org.NbreCellX:=NbreCellX[indexTCO];
TamponTCO_Org.NbreCellY:=NbreCellY[indexTCO];
TamponTCO_Org.x1:=1;
TamponTCO_Org.x2:=NbreCellX[indexTCO];
TamponTCO_Org.x1:=xClicCell[indexTCO];
TamponTCO_Org.x2:=xClicCell[indexTCO];
TamponTCO_Org.y1:=1;
TamponTCO_Org.y2:=NbreCellY[indexTCO];
xcoupe:=1;ycoupe:=1;
for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do
for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do
tampontco[x,y]:=tco[indextco,x,y];
// TamponAffecte:=true;
TamponAffecte:=true;
// supression colonne
for x:=xClicCell[indexTCO] to NbreCellx[indexTCO]-1 do
@@ -12128,7 +12276,7 @@ begin
x:=0;
y:=0;
indexTCO:=index_tco(sender);
calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO],ZoomMax,ZoomMax);
calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]);
with imageTCO.Canvas do
begin
pen.color:=clyellow;
@@ -12201,7 +12349,6 @@ procedure TFormTCO.ImagePalette1MouseDown(Sender: TObject;Button: TMouseButton;
begin
debut_drag(ImagePalette1);
end;
procedure TFormTCO.FormDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
@@ -12267,7 +12414,7 @@ begin
traceXY[1].y:=0;
traceXY[2].x:=0;
traceXY[2].x:=0;
FormTCO[indexTCO].Caption:='** Mode dessin ** Clic droit pour lever le pointeur. Touche Echap pour quitter le mode tracé. CTRL-Z ou annuler pour annuler les derniers tracés.';
FormTCO[indexTCO].Caption:='TCO'+intToSTR(indexTCO)+' ** Mode dessin ** Clic droit pour lever le pointeur. Touche Echap pour quitter le mode tracé. CTRL-Z ou annuler pour annuler les derniers tracés.';
screen.cursor:=crUpArrow;
end
else stop_modetrace(indexTCO);
verif_version.pas
+25 -6
View File
@@ -25,7 +25,7 @@ var
verifVersion,notificationVersion : boolean;
date_creation : string;
Const Version='8.0'; // sert à la comparaison de la version publiée
Const Version='8.1'; // sert à la comparaison de la version publiée
SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace
function GetCurrentProcessEnvVar(const VariableName: string): string;
@@ -125,6 +125,18 @@ var description,s,s2,s3,Version_p,Url,LocalFile,nomfichier,nombre_tel,date_creat
taille : longint;
comm : array[1..10] of string;
function supprime_anti(s : string) : string;
var i : integer;
begin
// supprimer tous les \ dans la chaine
i:=0;
repeat
i:=posEx('\',s,i+1);
if i<>0 then delete(s,i,1);
until i=0;
result:=s;
end;
function extrait_champ(ss : string) : string;
var i,j : integer;
begin
@@ -133,9 +145,16 @@ var description,s,s2,s3,Version_p,Url,LocalFile,nomfichier,nombre_tel,date_creat
i:=pos(ss,s);
if i<>0 then
begin
i:=posEx('":',s,i+1);
//delete(s,1,i+1);i:=0;
i:=posEx('"',s,i+1);
i:=posEx('"',s,i+1);
j:=posex('"',s,i+1);
j:=i;
// ne pas tenir compte du \" qui correspond à un " effectif dans la chaîne
repeat
j:=posex('"',s,j+1);
until s[j-1]<>'\' ;
result:=copy(s,i+1,j-i-1);
end;
end;
@@ -150,7 +169,6 @@ var description,s,s2,s3,Version_p,Url,LocalFile,nomfichier,nombre_tel,date_creat
begin
i:=posEx(':',s,i+1);
j:=posEx(',',s,i+1);
//j:=posex('"',s,i+1);
result:=copy(s,i+1,j-i-1);
end;
end;
@@ -171,6 +189,7 @@ begin
while not(eof(fichier)) and (not(trouve_version) or not(trouve_zip)) do
begin
readln(fichier,s);
s:=utf8Decode(s);
//Affiche(s,clyellow);
// adresse de téléchargement
@@ -206,7 +225,7 @@ begin
description:=extrait_champ('body');
if description<>'' then
begin
description:=utf8Decode(description);
//description:=utf8Decode(description);
i:=1 ; j:=1;
// couper en chaînes
while j<>0 do
@@ -226,7 +245,7 @@ begin
end;
end;
comm[i]:=description;
comm[i]:=supprime_anti(description);
ncomm:=i;
end;
versions.txt
+4
View File
@@ -183,6 +183,10 @@ version 7.3 : Correction d'un bug sur le pilotage des aiguillages via CDM rail
version 8.0 : Gestion des voies chevauchantes (ponts) et des buttoirs dans le TCO.
Création d'un bouton "action" dans les TCOs.
Possibilité d'utiliser jusqu'à 10 TCOs.
version 8.1 : Gestion d'un splitter sur l'affichage principal pour séparer l'écran à la demande.
Possibilité de sauvegarder les paramètres de la fenêtre principale.
Améliorations diverses.