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

V9.74

Browse Source
This commit is contained in:
f1iwq2
2025-01-11 18:47:43 +01:00
parent 40d91f9ca8
commit 95cf06b007
16 changed files with 467 additions and 304 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Notice avancée pour les signaux complexes GL.pdf
BIN
View File
Binary file not shown.
Notice d'utilisation des signaux_complexes_GL_V9.71.pdf → Notice d'utilisation des signaux_complexes_GL_V9.74.pdf
BIN
View File
Binary file not shown.
UnitAnalyseSegCDM.pas
+12 -10
View File
@@ -856,7 +856,7 @@ begin
end;
end;
// coordonnées image en CDM
// coordonnées fenêtre image en CDM
procedure inv_coords(var x,y : integer);
begin
x:=x-(cadre div 2);
@@ -866,7 +866,7 @@ begin
y:=ymaxiCDM-(round(y*1000/reducY));
end;
// coordonnées CDM en image
// coordonnées CDM en fenêtre image
procedure Coords(var x,y : integer);
begin
x:=(round( (x - xMiniCDM) * reducX/1000 )) + (cadre div 2);
@@ -925,6 +925,7 @@ begin
end;
// trouve si le point x,y est sur l'arc de centre CentreX,Y de rayon ..
// deb = debug affichage
function point_sur_arc(x,y,CentreX,centreY,rayon : integer;StartDegres,StopDegres : single;deb : boolean) : boolean;
var a : single;
cosA,SinA : extended;
@@ -944,7 +945,7 @@ begin
StopDegres:=-StopDegres;
end;
StartDegres:=StartDegres*pisur180; //+3*pi/4;
StartDegres:=StartDegres*pisur180;
StopDegres:=StartDegres+StopDegres*pisur180;
a:=startDegres;
repeat
@@ -954,12 +955,12 @@ begin
yArc:=CentreY-round(rayon*sinA);
trouve:=(abs(x-xArc)<precision_clic) and (abs(y-yArc)<precision_clic);
if deb then
begin
Affiche(intToSTR(x-xArc)+' / '+intToSTR(y-yARc),clyellow);
canvas.Pen.Color:=clred;
canvas.MoveTo(xArc,yArc);Canvas.LineTo(Xarc+3,yArc+3);
end;
if deb then
begin
Affiche(intToSTR(x-xArc)+' / '+intToSTR(y-yARc),clyellow);
canvas.Pen.Color:=clred;
canvas.MoveTo(xArc,yArc);Canvas.LineTo(Xarc+3,yArc+3);
end;
a:=a+0.02;
until (trouve) or (a>StopDegres);
result:=trouve;
@@ -1068,9 +1069,10 @@ begin
end;
end;
// trace une ligne en coordonnées CDM
procedure ligneCDM(canvas: Tcanvas;x1,y1,x2,y2 : integer);
begin
coords(x1,y1);
coords(x1,y1); // transforme en coordonnées fenêtre
coords(x2,y2);
with canvas do
begin
UnitClock.pas
+4 -1
View File
@@ -330,6 +330,7 @@ begin
DrawMinSteps;
end;
// sur la fermeture de SC, l'horloge provoque une exception
procedure calcul_pos_horloge;
begin
if not assigned(formclock) or (formclock=nil) or fermeSC then exit;
@@ -341,7 +342,9 @@ begin
formclock.height:=HauteurFC;
end;
OffsetYFC:=(formprinc.top+formPrinc.height)-FormClock.height-28;
try OffsetYFC:=(formprinc.top+formPrinc.height)-FormClock.height-28;
except exit;
end;
OffsetXFC:=(formprinc.left+formPrinc.width)-formClock.width;
// écart entre fenetre principale et clock
UnitConfig.dfm
+1 -1
View File
@@ -683,7 +683,7 @@ object FormConfig: TFormConfig
Top = 8
Width = 633
Height = 505
ActivePage = TabSheetFonctions
ActivePage = TabAvance
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
UnitConfig.pas
+18 -19
View File
@@ -707,14 +707,14 @@ type
procedure tbCde_onchange(Sender : Tobject);
end;
Tliste = record
Nom : string;
aide : string;
typ : (Simple,PickList,titre);
masque : string;
variable : pointer;
typeVar : (rien3,entier,bool,chaine);
textePL1,textePL2 : string;
Tliste = record // liste des paramètres avancés de la ValueListEditor
Nom : string; // Nom de la variable
aide : string; // pour le hint
typ : (Simple,PickList,titre); // type d'entrée : simple=entier picklist=combobox titre=texte sans variable associée
masque : string; // masque de saisie des entiers
variable : pointer; // pointeur sur la variable à modifier
typeVar : (rien3,entier,bool,chaine); // type de la variable à modifier
textePL1,textePL2 : string; // texte des comboBox si typ est picklist
end;
const
@@ -2554,17 +2554,18 @@ begin
end;
// trier les aiguillages par adresses croissantes
// et complète les aiguillages triples
// et complète les aiguillages triples (créée aiguillahe homologue)
procedure trier_aig;
var i,j,adr : integer;
temp : TAiguillage;
s : string;
begin
// trouve les aig triple
// attribue les index
i:=1;
while (i<MaxAiguillage) do
begin
// trouve les aiguillages triples
if aiguillage[i].modele=triple then
begin
j:=index_aig(aiguillage[i].adrTriple); // adresse de l'aiguillage homologue triple
@@ -2589,6 +2590,7 @@ begin
inc(i);
end;
// tri du tableau d'aiguillages
for i:=1 to MaxAiguillage-1 do
begin
for j:=i+1 to MaxAiguillage do
@@ -2685,7 +2687,7 @@ begin
end;
end;
// trouve les id des routes des trains
// trouve les id des routesPref des trains et le stocke dedans
procedure compile_id_routes;
var t1,t2,r1,r2,Id,nr : integer;
route1 : tUneroute;
@@ -6756,7 +6758,7 @@ begin
'3 pour les petits réseaux jusque 5 ou 6 pour les grands' ;
typ:= Simple ;
masque:= '0';
masque:= '0'; // 1 chiffre
variable:=@Nb_Det_Dist;
typeVar:=entier;
end;
@@ -7812,7 +7814,7 @@ begin
comboBoxNation.Items.add('Française');
comboBoxNation.Items.add('Belge');
// actionneurs actions
// actions
ListBoxActions.Clear;
longestLength:=0;
for i:=1 to maxTablo_act do
@@ -7935,12 +7937,6 @@ begin
// Styles (Embarcadero Dephi11)
// remplir la combobox avec les styles disponibles
{for s in TStyleManager.StyleNames do
begin
cs:=lowercase(s);
ComboStyle.Items.Add(s);
end; }
for i:=0 to nombreStyles do
begin
ComboStyle.Items.Add(Style[i].NomStyle);
@@ -7989,6 +7985,7 @@ begin
PageControl.ActivePage:=Formconfig.TabSheetCDM; // force le premier onglet sur la page
couleurs_config;
formconfig.LabelInfo.Caption:='';
end;
// décode un morceau d'une chaine d'aiguillage ('P5S')
@@ -15731,6 +15728,7 @@ begin
end;
// et DCC
{
i:=1;
RichCdeDCCpp.clear;
repeat
@@ -15741,6 +15739,7 @@ begin
end;
inc(i);
until (CdeDccpp[i]='') or (i>MaxCdeDccpp);
}
// trains
with ListBoxTrains do
UnitConfigCellTCO.dfm
+3 -2
View File
@@ -662,7 +662,7 @@ object FormConfCellTCO: TFormConfCellTCO
object ImageListIcones: TImageList
Left = 160
Bitmap = {
494C010121002200040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600
494C010121002200040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000009000000001002000000000000090
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@@ -1854,6 +1854,7 @@ object FormConfCellTCO: TFormConfCellTCO
000000000000F56F000000000000F56F000000000000F54F000000000000FB6F
000000000000FFFF000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000}
0000000000000000000000000000000000000000000000000000000000000000
000000000000}
end
end
UnitConfigCellTCO.pas
+2 -1
View File
@@ -254,6 +254,7 @@ begin
with formConfCellTCO do
begin
// ramener la coordonnée cliquée à l'origine du canton
{
if (Bimage>=Id_cantonH) and (Bimage<=Id_cantonH+9) then
begin
H:=true;
@@ -266,7 +267,7 @@ begin
end;
XclicCell[indexTCO]:=XclicC;
YclicCell[indexTCO]:=YclicC;
}
idCanton:=index_canton(indexTCO,xclicC,yclicC);
GroupBoxOrientation.visible:=false;
UnitFicheHoraire.dfm
+4 -4
View File
@@ -1,7 +1,7 @@
object FormFicheHoraire: TFormFicheHoraire
Left = 358
Top = 169
Width = 617
Width = 623
Height = 377
Caption = 'Fiche horaire'
Color = clBtnFace
@@ -15,8 +15,8 @@ object FormFicheHoraire: TFormFicheHoraire
OnActivate = FormActivate
OnCreate = FormCreate
DesignSize = (
609
346)
607
321)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
@@ -60,7 +60,7 @@ object FormFicheHoraire: TFormFicheHoraire
object StringGridFO: TStringGrid
Left = 8
Top = 16
Width = 593
Width = 601
Height = 233
ColCount = 4
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing]
UnitFicheHoraire.pas
+29 -29
View File
@@ -120,9 +120,8 @@ end;
procedure TFormFicheHoraire.FormCreate(Sender: TObject);
var i,champ,ligne,col,erreur : integer;
f : textFile ;
s,ss,v : string;
s,ss,v,nomTrain : string;
ver : single;
MRect : Trect;
begin
// cells[colonne,ligne]
with stringGridFO do
@@ -143,7 +142,7 @@ begin
ColWidths[ColRoute]:=100;
ColWidths[ColHDep]:=60;
ColWidths[ColVitDem]:=60;
ColWidths[ColSens]:=50;
ColWidths[ColSens]:=60;
ColWidths[ColArret]:=60;
Cells[ColLigne,0]:='Ligne';
@@ -154,7 +153,7 @@ begin
Cells[ColSens,0]:='Sens'+#13+'(N/R)';
Cells[ColArret,0]:='Forcer arrêt'+#13+'O/N';
RowHeights[0]:=22;
RowHeights[0]:=30;
// numéroter les lignes et fixer la hauteur des lignes
for i:=1 to RowCount-1 do
@@ -199,9 +198,9 @@ begin
if col=ColTrain then // nom du train
begin
if champ=0 then begin affiche('Erreur 17',clred);closefile(f);end;
ss:=copy(s,1,champ-1);
stringGridFO.Cells[col,ligne]:=ss;
grilleHoraire[ligne].NomTrain:=ss;
NomTrain:=copy(s,1,champ-1);
stringGridFO.Cells[col,ligne]:=NomTrain;
grilleHoraire[ligne].NomTrain:=NomTrain;
if champ<>0 then delete(s,1,champ);
end;
@@ -260,8 +259,8 @@ begin
inc(ligne);
end;
end;
until eof(f) or (ligne>MaxHoraire);
Nombre_horaires:=ligne-1;
until eof(f) or (nomTrain='') or (ligne>MaxHoraire);
Nombre_horaires:=ligne-2;
closefile(f);
couleurs_Fiche;
@@ -337,29 +336,30 @@ begin
{$IF CompilerVersion >= 28.0}
d12:=true;
{$IFEND}
//Affiche(intToSTR(arow)+' '+intToSTR(aCol),clYellow);
// couleur de fond
couleur:=$E0E0E0;
if d12 then couleur:=canvas.Pixels[1,1];
with grid.canvas do
if Arow=0 then
begin
Brush.Color := couleur;
inc(Rect.top); inc(Rect.left); // rend visible les quadrillages
FillRect(Rect);
end;
if d12 then couleur:=grid.canvas.Pixels[35,6] else couleur:=$E0E0E0;
with grid.canvas do
begin
Brush.Color := couleur;
inc(Rect.top); inc(Rect.left); // rend visible les quadrillages
FillRect(Rect);
end;
DRect:=Rect;
// calcule, ajuste et positionne la ligne de l'espace vertical nécessaire
DrawText(Grid.Canvas.Handle,Pchar(S),Length(S),DRect,DT_CALCRECT or DT_CENTER);
// if the text height is greater than the row height, increase the row height
if (DRect.Bottom - DRect.Top) > Grid.RowHeights[ARow] then Grid.RowHeights[ARow]:=DRect.Bottom - DRect.Top
// changer la hauteur de la cellule provoque son redessinage
else
begin
DRect.Right:=Rect.Right;
Grid.Canvas.FillRect(DRect);
DrawText(Grid.Canvas.Handle, Pchar(S), Length(S), DRect, DT_CENTER);
DRect:=Rect;
// calcule, ajuste et positionne la ligne de l'espace vertical nécessaire
DrawText(Grid.Canvas.Handle,Pchar(S),Length(S),DRect,DT_CALCRECT or DT_CENTER);
// si la hauteur du texte est plus grande que la hauteur de la ligne, augmenter la hauteur de la ligne
if (DRect.Bottom-DRect.Top)>Grid.RowHeights[ARow] then Grid.RowHeights[ARow]:=DRect.Bottom-DRect.Top
// changer la hauteur de la cellule provoque son redessinage
else
begin
DRect.Right:=Rect.Right;
Grid.Canvas.FillRect(DRect);
DrawText(Grid.Canvas.Handle, Pchar(S), Length(S), DRect, DT_CENTER);
end;
end;
end;
UnitModifAction.pas
+2 -2
View File
@@ -352,7 +352,7 @@ begin
end;
procedure TFormModifAction.ComboBoxFamilleChange(Sender: TObject);
var i,n,famille : integer;
var i,famille : integer;
s : string;
begin
ListBoxOper.Clear;
@@ -1711,7 +1711,7 @@ begin
end;
procedure TFormModifAction.SpinEditEtatopChange(Sender: TObject);
var i,o,erreur,op : integer;
var i,erreur,op : integer;
begin
if (ligneclicAct<0) or clicliste then exit;
val(SpinEditEtatop.text,i,erreur);
UnitPrinc.pas
+194 -132
View File
@@ -1481,7 +1481,7 @@ var path,ext : string;
DirList : TStrings;
ok : boolean;
Sr : TSearchRec;
commande,chem,s : string;
chem,s : string;
nombre,i,j : integer;
Style1 : tStyle;
{$IF CompilerVersion >= 28.0}
@@ -1863,6 +1863,186 @@ begin
end;
end;
function GetMACAdress: tstrings;
var
NCB: PNCB;
Adapter: PAdapterStatus;
RetCode: Ansichar;
s : tstrings;
I: integer;
Lenum: PlanaEnum;
_SystemID: string;
begin
Result:=nil;
_SystemID:='';
Getmem(NCB,SizeOf(TNCB));
Fillchar(NCB^,SizeOf(TNCB),0);
Getmem(Lenum,SizeOf(TLanaEnum));
Fillchar(Lenum^,SizeOf(TLanaEnum),0);
Getmem(Adapter,SizeOf(TAdapterStatus));
Fillchar(Adapter^,SizeOf(TAdapterStatus),0);
Lenum.Length := chr(0);
NCB.ncb_command := chr(NCBENUM);
NCB.ncb_buffer := Pointer(Lenum);
NCB.ncb_length := SizeOf(Lenum);
RetCode := Netbios(NCB);
s:=TstringList.Create;
i:=0;
repeat
Fillchar(NCB^,SizeOf(TNCB), 0);
Ncb.ncb_command:=chr(NCBRESET);
Ncb.ncb_lana_num:=lenum.lana[I];
RetCode:=Netbios(Ncb);
Fillchar(NCB^,SizeOf(TNCB), 0);
Ncb.ncb_command:=chr(NCBASTAT);
Ncb.ncb_lana_num:=lenum.lana[I];
// Must be 16
Ncb.ncb_callname:='* ';
Ncb.ncb_buffer:=Pointer(Adapter);
Ncb.ncb_length:=SizeOf(TAdapterStatus);
RetCode:=Netbios(Ncb);
//---- calc _systemId de la mac-address[2-5] XOR mac-address[1]...
if (RetCode=chr(0)) or (RetCode=chr(6)) then
begin
_SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[1]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[2]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[3]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[4]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[5]),2);
s.add(_SystemID);
//Affiche(_systemID,clYellow);
end;
Inc(i);
until (i>=Ord(Lenum.Length)) ;//or (_SystemID<>'00-00-00-00-00-00');
FreeMem(NCB);
FreeMem(Adapter);
FreeMem(Lenum);
result:=s;
end;
// ex2
function GetAdapterInfo(Lana: AnsiChar): String;
var
Adapter: TAdapterStatus;
Ncb: Tncb;
begin
FillChar(Ncb,SizeOf(Ncb),0);
Ncb.ncb_command:=Char(NCBRESET);
Ncb.ncb_lana_num:=Lana;
if Netbios(@Ncb)<>Char(NRC_GOODRET) then
begin
Result:='mac non trouvée';
Exit;
end;
FillChar(NCB,SizeOf(Ncb), 0);
NCB.ncb_command:=Char(NCBASTAT);
NCB.ncb_lana_num:=Lana;
NCB.ncb_callname:='*';
FillChar(Adapter,SizeOf(Adapter), 0);
NCB.ncb_buffer:=@Adapter;
NCB.ncb_length:=SizeOf(Adapter);
if Netbios(@Ncb)<>Char(NRC_GOODRET) then
begin
Result:='mac non trouvée';
Exit;
end;
Result:=
IntToHex(Byte(Adapter.adapter_address[0]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[1]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[2]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[3]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[4]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[5]),2);
end;
function GetMACAddress: string;
var
AdapterList: TLanaEnum;
Ncb: Tncb;
begin
FillChar(Ncb,SizeOf(NCB),0);
NCB.ncb_command:=Char(NCBENUM);
NCB.ncb_buffer:=@AdapterList;
NCB.ncb_length:=SizeOf(AdapterList);
Netbios(@NCB);
if Byte(AdapterList.length)>0 then
Result:=GetAdapterInfo(AdapterList.lana[0])
else
Result:='mac non trouvée';
end;
procedure envoie_infos;
var ts : tstrings;
s,cmd : string;
retour,i,erreur : integer;
f : textFile;
begin
s:='';
cmd:='/c vol c: >vol.txt'; // /c ferme la fenetre en fin d'exec /k ne ferme pas
// si on fait un runas au lieu de open, çà ouvre une fenetre de demande admin sur les postes non admin
// ou dont le niveau d'utilisateur est bas dans le profil
retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.Exe'),PChar(cmd),nil,SW_SHOWNORMAL);
if retour<=32 then
begin
ShowMessage(SysErrorMessage(GetLastError));
end
else
begin
assignfile(f,'vol.txt');
{$I-}
reset(f);
erreur:=IoResult;
{$I+}
if erreur=0 then
begin
readln(f,s);
readln(f,s);
closefile(f);
i:=pos('-',s);
if i>4 then
begin
i:=i-4;
s:=copy(s,i,9)+' ';
end;
end;
end;
ts:=GetMACAdress;
for i:=0 to ts.Count-1 do
begin
s:=s+ts[i]+' ';
end;
Affiche(s,clyellow);
s:=DateToStr(date)+' '+TimeToStr(Time)+' V'+versionSC;
Affiche(s,clyellow);
//Affiche(GetCurrentDir,clyellow);
s:='NbreTCO='+intToSTR(nbreTCO);
s:=s+' Nbrecantons='+intToSTR(ncantons);
s:=s+' NbreTrains='+intToSTR(n_trains);
s:=s+' NbreHoraires='+intToSTR(Nombre_horaires);
s:=s+' NbreAig='+intToSTR(maxaiguillage);
s:=s+' NbreSignaux='+intToSTR(NbreSignaux);
s:=s+' NbreActions='+intToSTR(maxTablo_act);
s:=s+' NbrePN='+intToSTR(NbrePN);
s:=s+' Nbrefonctions='+intToSTR(NbreFL);
s:=s+' NbrePeriph='+intToSTR(NbPeriph);
Affiche(s,clyellow);
end;
procedure fin_preliminaire;
var i,j : integer;
@@ -1907,24 +2087,15 @@ begin
interface_ou_cdm; // démarrer l'interface , génère les evts détecteurs ; ou cdm
//envoie_infos;
formprinc.SetFocus;
s:='Fin du préliminaire';
procetape(s);
end;
// envoi une chaine à un périphérique COM/USB en fonction de l'interface
// non utilisé
{
procedure envoi_usb(interf : Tinterface;s : string);
begin
case interf of
_interface : MSCommUSBInterface.Output:=s;
periph1 : MSCommCde1.Output:=s;
periph2 : MSCommCde2.Output:=s;
end;
end; }
// renvoie une chaine ASCI Hexa affichable à partir d'une chaîne
function chaine_HEX(s: string) : string;
var i : integer;
@@ -4856,7 +5027,7 @@ begin
end;
if (aspect=rappel_60) then // rappel 60
begin
Signaux[i].EtatSignal:=Signaux[i].EtatSignal and not($1Cff); // cas du rappel 60: efface les bits 0 1 2 3 4 5 6 7 10 11 et 12 1 1100 1111 0000
Signaux[i].EtatSignal:=Signaux[i].EtatSignal and not($1cff); // cas du rappel 60: efface les bits 0 1 2 3 4 5 6 7 10 11 et 12 1 1100 1111 0000
end;
if (aspect=aspect8) then // ral_60_jaune_cli décodeur LDT
begin
@@ -8288,7 +8459,7 @@ begin
if (A='Z') or (a=#0) then typeGenS:=det else typeGenS:=aig;
suivant_alg3:=adr;
if nivDebug=3 then Affichedebug('le port de destination de la tjd 2 états est '+IntToSTR(adr)+a,clyellow);
trouve_actionneurs_aig(index,adr,TypeGenS);
trouve_actionneurs_aig(index,adr,TypeGenS);
typeGen:=TypeGenS;
exit;
end;
@@ -17625,7 +17796,7 @@ begin
//Affiche(repertoire,clorange);
retour:=ShellExecute(Formprinc.Handle,'open',
Pchar('cdr.exe'),
Pchar(s), // paramètre
Pchar(s), // paramètre : -f armentieres.lay -COMIPC
PChar(repertoire) // répertoire
,SW_SHOWNORMAL);
if retour>32 then
@@ -18028,122 +18199,9 @@ begin
Maj_Signaux(false);
end;
// renvoyer date heure, MAC, version SC , verif_version, avec_roulage
// ex 1
function GetMACAdress: string;
var
NCB: PNCB;
Adapter: PAdapterStatus;
RetCode: Ansichar;
I: integer;
Lenum: PlanaEnum;
_SystemID: string;
begin
Result:='';
_SystemID:='';
Getmem(NCB,SizeOf(TNCB));
Fillchar(NCB^,SizeOf(TNCB),0);
Getmem(Lenum,SizeOf(TLanaEnum));
Fillchar(Lenum^,SizeOf(TLanaEnum),0);
Getmem(Adapter,SizeOf(TAdapterStatus));
Fillchar(Adapter^,SizeOf(TAdapterStatus),0);
Lenum.Length := chr(0);
NCB.ncb_command := chr(NCBENUM);
NCB.ncb_buffer := Pointer(Lenum);
NCB.ncb_length := SizeOf(Lenum);
RetCode := Netbios(NCB);
i:=0;
repeat
Fillchar(NCB^,SizeOf(TNCB), 0);
Ncb.ncb_command:=chr(NCBRESET);
Ncb.ncb_lana_num:=lenum.lana[I];
RetCode:=Netbios(Ncb);
Fillchar(NCB^,SizeOf(TNCB), 0);
Ncb.ncb_command:=chr(NCBASTAT);
Ncb.ncb_lana_num:=lenum.lana[I];
// Must be 16
Ncb.ncb_callname:='* ';
Ncb.ncb_buffer:=Pointer(Adapter);
Ncb.ncb_length:=SizeOf(TAdapterStatus);
RetCode:=Netbios(Ncb);
//---- calc _systemId de la mac-address[2-5] XOR mac-address[1]...
if (RetCode=chr(0)) or (RetCode=chr(6)) then
begin
_SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[1]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[2]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[3]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[4]),2) + '-' +
IntToHex(Ord(Adapter.adapter_address[5]),2);
end;
Inc(i);
until (i>=Ord(Lenum.Length)) or (_SystemID<>'00-00-00-00-00-00');
FreeMem(NCB);
FreeMem(Adapter);
FreeMem(Lenum);
GetMacAdress:=_SystemID;
end;
// ex2
function GetAdapterInfo(Lana: AnsiChar): String;
var
Adapter: TAdapterStatus;
Ncb: Tncb;
begin
FillChar(Ncb,SizeOf(Ncb),0);
Ncb.ncb_command:=Char(NCBRESET);
Ncb.ncb_lana_num:=Lana;
if Netbios(@Ncb)<>Char(NRC_GOODRET) then
begin
Result:='mac non trouvée';
Exit;
end;
FillChar(NCB,SizeOf(Ncb), 0);
NCB.ncb_command:=Char(NCBASTAT);
NCB.ncb_lana_num:=Lana;
NCB.ncb_callname:='*';
FillChar(Adapter,SizeOf(Adapter), 0);
NCB.ncb_buffer:=@Adapter;
NCB.ncb_length:=SizeOf(Adapter);
if Netbios(@Ncb)<>Char(NRC_GOODRET) then
begin
Result:='mac non trouvée';
Exit;
end;
Result:=
IntToHex(Byte(Adapter.adapter_address[0]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[1]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[2]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[3]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[4]),2) + '-' +
IntToHex(Byte(Adapter.adapter_address[5]),2);
end;
function GetMACAddress: string;
var
AdapterList: TLanaEnum;
Ncb: Tncb;
begin
FillChar(Ncb,SizeOf(NCB),0);
NCB.ncb_command:=Char(NCBENUM);
NCB.ncb_buffer:=@AdapterList;
NCB.ncb_length:=SizeOf(AdapterList);
Netbios(@NCB);
if Byte(AdapterList.length)>0 then
Result:=GetAdapterInfo(AdapterList.lana[0])
else
Result:='mac non trouvée';
end;
// renvoyer date heure, MAC, version SC , verif_version
// ex 1 ... renvoie celui de la virtual box
// positionne les composants de la fenêtre principale
// i : position X du splitter
@@ -19047,6 +19105,7 @@ begin
end;
{$ELSE}
// composant TclientSocket
ClientSocketInterface:=tClientSocket.Create(nil);
ClientSocketInterface.OnRead:=ClientSocketInterfaceRead;
ClientSocketInterface.onConnect:=ClientSocketInterfaceConnect;
@@ -19341,6 +19400,7 @@ begin
}
procetape('Fin des initialisations');
// vérifier si le fichier de segments existe
@@ -19354,7 +19414,7 @@ begin
end
else Affiche_fenetre_CDM.Enabled:=false;
//Affiche(GetMACAddress,clred);
//formPrinc.left:=-1000;
ConfCellTCO:=false;
if debug=1 then Affiche('Fini',clLime);
@@ -21988,6 +22048,8 @@ begin
Affiche('Taille des actionneurs PN: '+intToSTR(SizeOf(Tablo_PN) )+' octets',clorange);
Affiche('Taille du tableau d''évènements détecteurs '+intToSTR(SizeOf(event_det) )+' octets',clorange);
Affiche(' ',clyellow);
envoie_infos;
end;
// cliqué droit sur un signal puis sur le menu propriétés
UnitTCO.dfm
+2 -2
View File
@@ -24,8 +24,8 @@ object FormTCO: TFormTCO
OnKeyPress = FormKeyPress
OnMouseWheel = FormMouseWheel
DesignSize = (
1005
556)
997
549)
PixelsPerInch = 96
TextHeight = 13
object LabelZoom: TLabel
UnitTCO.pas
+157 -90
View File
@@ -1448,7 +1448,8 @@ begin
end;
end;
// remplit la base des cantons avec les éléments adjacents, et des détecteurs adjacents
// remplit les informations du canton avec les éléments adjacents, et des détecteurs adjacents
// et vérifie si le canton ne contient pas de case incorrecte
// Cantons uniquement TCO1
// i : indexCanton
// remplit les champs horizontal, el1,el2,typ1,typ2,sens1,sens2 de canton[]
@@ -1514,6 +1515,36 @@ begin
Affiche('Erreur 210 : Le canton '+intToSTR(canton[i].numero)+' dans le tco '+intToSTR(t)+' dispose de deux détecteurs contigus d''adresses identiques: '+intToSTR(canton[i].el1),clred);
end;
// vérifie si le canton a une case incorrecte
if horz then
begin
t:=Id_cantonH;
for j:=x to x+n-1 do
begin
if not iscantonH(tco[indexTCO,j,y].BImage) then
begin
Affiche('Correction canton '+intToSTR(canton[i].numero)+' en x='+intToSTR(j),clCyan);
tco[indexTCO,j,y].BImage:=t;
TCO_modifie:=true;
end;
inc(t);
end;
end
else
begin
t:=Id_cantonV;
for j:=y to y+n-1 do
begin
if not iscantonV(tco[indexTCO,x,j].BImage) then
begin
Affiche('Correction canton '+intToSTR(canton[i].numero)+' en y='+intToSTR(j),clCyan);
tco[indexTCO,x,j].BImage:=t;
TCO_modifie:=true;
end;
inc(t);
end;
end;
//Affiche(intToSTR(xCanton)+' '+intToStr(yCanton),clyellow);
end;
@@ -1820,7 +1851,9 @@ var fichier : textfile;
Bim,nv,x,y,i,j,m,adresse,valeur,erreur,FeuOriente,PiedFeu,tailleFont,e,NPar : integer;
trouve_CoulFond,trouve_clVoies,trouve_clAllume,trouve_clGrille,trouve_clCanton,
trouve_clTexte,trouve_clQuai,trouve_matrice,trouve_ratio,trouve_ModeCanton,
trouve_AvecGrille,trouve_clPiedSignal,cuc,trouve_clCantonOccupe,trouve_clCantonLibre : boolean;
trouve_AvecGrille,trouve_clPiedSignal,cuc,trouve_clCantonOccupe,trouve_clCantonLibre,
LecCanton : boolean;
function lit_ligne : string ;
var c : char;
begin
@@ -2198,7 +2231,8 @@ begin
// 3 Bimage
i:=pos(',',s);
if i=0 then begin Affiche('ETCO6',clred);closefile(fichier);exit;end;
val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin Affiche('ETCO7',clred);closefile(fichier);exit;end;
val(copy(s,1,i-1),valeur,erreur);
if erreur<>0 then begin Affiche('ETCO7',clred);closefile(fichier);exit;end;
// anciens id
if valeur=30 then begin valeur:=Id_signal;sauve_tco:=true;end;
if valeur=31 then begin valeur:=id_Quai;sauve_tco:=true;end;
@@ -2206,11 +2240,14 @@ begin
if valeur<=34 then tco[indexTCO,x,y].liaisons:=liaisons[valeur] else tco[indexTCO,x,y].liaisons:=0;
Bim:=valeur;
cuc:=false;
// cantons
if (valeur=Id_CantonH) or (valeur=Id_CantonV) then
begin
if ncantons<MaxCantons then
begin
cuc:=true; // id canton
cuc:=true; // mémo id canton
LecCanton:=true; // mis à 1, et mis à 0 quand on a trouvé la fin de canton
inc(nCantons);
// le numéro de canton est lu plus loin
canton[ncantons].x:=x;
@@ -2255,7 +2292,10 @@ begin
// affiche(inttostr(piedfeu),clyellow);
//Affiche('indexcanton='+intToSTR(ncantons)+' numcanton lu='+intToSTR(piedFeu),clOrange);
tco[indexTCO,x,y].NumCanton:=PiedFeu;
if cuc then canton[ncantons].numero:=piedFeu;
if cuc then
begin
canton[ncantons].numero:=piedFeu;
end;
end;
// si c'est un signal, remplir les paramètres du signal
@@ -2283,10 +2323,10 @@ begin
tco[indexTCO,x,y].FeuOriente:=FeuOriente; // paramètre de l'action
if PiedFeu=AcBouton_bistable then
begin
BoutonTCO[Adresse].existe:=true;
BoutonTCO[Adresse].idtco:=IndexTCO;
BoutonTCO[Adresse].x:=x;
BoutonTCO[Adresse].y:=y;
BoutonTCO[adresse].existe:=true;
BoutonTCO[adresse].idtco:=IndexTCO;
BoutonTCO[adresse].x:=x;
BoutonTCO[adresse].y:=y;
end;
end;
@@ -2546,6 +2586,15 @@ begin
//Affiche(intToSTR(LargeurCell[indexTCO])+' '+intToSTR(epaisseur),clyellow);
end;
procedure affiche_info(id,x,y : integer;s : string);
begin
FormInfo.LabelInfo.caption:=s;
FormInfo.Top:=FormTCO[id].top+y-FormTCO[id].ScrollBox.vertScrollBar.Position+20;
FormInfo.Left:=FormTCO[id].left+x-FormTCO[id].ScrollBox.HorzScrollBar.Position+50;
if formInfo.left+formInfo.Width>formTCO[id].Left+formTCO[id].Width then
formInfo.left:=formTCO[id].Width-formInfo.Width;
FormInfo.Show;
end;
// renvoie la position de l'aiguillage en position x,y du tco indextco
function positionTCO(indexTCO,x,y : integer) : integer;
@@ -2825,8 +2874,15 @@ begin
style:=fs;
end;
function Taille_Fonte(tf : integer) : integer;
var Larg : integer;
begin
Larg:=LargeurCell[indexTCOCourant];
result:=((Larg*tf) div 40)+1;
end;
procedure affiche_texte(indextco,x,y : integer);
var b,x0,y0,xt,yt,repr,taillefont,largCell,hautCell,tf : integer;
var b,x0,y0,xt,yt,repr,largCell,hautCell,tf,tailleFont : integer;
ss,s,nf : string;
c : Tcanvas;
r : Trect;
@@ -2866,13 +2922,15 @@ begin
c.Font.Style:=style(ss);
repr:=tco[indextco,x,y].repr;
taillefont:=tco[indextco,x,y].TailleFonte;
xt:=round(5*frXGlob[indexTCO]);yt:=0;
taillefont:=tco[indextco,x,y].TailleFonte;
if taillefont=0 then taillefont:=8;
tf:=(taillefont*LargeurCell[indexTCO]) div 40;
c.font.Size:=tf;
//c.font.Size:=taille_fonte(tco[indextco,x,y].TailleFonte);
if b=id_action then c.Brush.Color:=couleurAction;
if b=Id_cantonH then
@@ -2893,9 +2951,9 @@ begin
end;
case repr of
0,1 : yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // au milieu
0,1 : yt:=(hauteurCell[indexTCO] div 2)-(round(c.textHeight(s) div 2)); // au milieu Y
2 : yt:=1; // haut
3 : yt:=hauteurCell[indexTCO]-round(2*TailleFont*fryGlob[indexTCO]); // bas
3 : yt:=hauteurCell[indexTCO]-round(2*c.textWidth(s)); // bas
5 : begin // double centré XY
r.Left:=x0;
r.Top:=y0+3;
@@ -2914,8 +2972,11 @@ begin
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.pen.color:=clLime;c.Moveto(X0,y0);c.lineto(x0,y0+c.textHeight(s));
if repr=4 then texte_reparti(s,indextco,x,y,c.font.size) else
c.Textout(x0+xt,y0+yt,s);
// texte encadré
if tco[indextco,x,y].buttoir=1 then
@@ -4339,7 +4400,7 @@ begin
Brush.Color:=Couleur;
pen.color:=Couleur;
Pen.Mode:=pmCopy;
if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur;
MoveTo(x0,y0+hauteurCell[indexTCO]);lineto(xc,yc);
if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur;
@@ -5178,7 +5239,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer;
end;
end;
begin
x0:=(x-1)*LargeurCell[indexTCO]; // x origine
y0:=(y-1)*hauteurCell[indexTCO]; // y origine
@@ -6314,17 +6375,17 @@ begin
end;
end;
end;
if etatTJD=2 then
begin
if position1=const_droit then
with canvas do
if position1=const_droit then
with canvas do
begin
moveTo(x0,yf);LineTo(xf,y0);
moveTo(x0,yc);LineTo(xf,yc);
end;
if position1=const_devie then
with canvas do
if position1=const_devie then
with canvas do
begin
// donne l'équation de droite y=ax+b passant par les points (x1,y1) (x2,y2)
droite(xc,yc,xf,y0,a1,b1);
@@ -6614,7 +6675,7 @@ begin
end;
end;
end;
end;
// Element 51 (quai)
@@ -8239,19 +8300,19 @@ begin
if etatTJD=2 then
begin
if position1=const_droit then
with canvas do
if position1=const_droit then
with canvas do
begin
moveTo(xc,y0);LineTo(xc,yf);
moveTo(x0,y0);LineTo(xf,yf);
end;
if position1=const_devie then
with canvas do
if position1=const_devie then
with canvas do
begin
// donne l'équation de droite y=ax+b passant par les points (x1,y1) (x2,y2)
droite(x0,y0,xf,yf,a1,b1);
//gauche
moveTo(xc,yf); LineTo(xc,yc+epaisseur);
moveTo(xc,yf); LineTo(xc,yc+epaisseur);
LineTo(xc-epaisseur,round((xc-epaisseur)*a1+b1) ); LineTo(x0,y0);
//droite
moveTo(xc,y0);
@@ -8261,7 +8322,7 @@ begin
end;
end;
end;
end;
// Element 26
@@ -9120,7 +9181,7 @@ begin
pen.color:=fond;
Brush.Color:=fond;
pen.width:=epaisseur div 2;
moveTo(xc,y0);LineTo(xc,yf);
moveTo(xc,y0);LineTo(xc,yf);
end;
end;
end;
@@ -9463,7 +9524,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position,ep : integer;
begin
pen.color:=couleur;
if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur;
moveto(xf,y0);lineto(xc,yc);
moveto(xf,y0);lineto(xc,yc);
if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur;
lineto(xc,yf);
end;
@@ -9561,7 +9622,7 @@ end;
procedure dessin_32C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer);
var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer;
fond : tcolor;
procedure trajet_droit;
begin
couleur:=clvoies[indexTCO];
@@ -11218,6 +11279,8 @@ begin
end;
end;
// affiche la cellule x et y en cases
// index est utilisé pour accéder au tableau du tracé de la fonction zone_tco
procedure affiche_cellule(indexTCO,x,y : integer);
@@ -11479,7 +11542,7 @@ begin
s:=s+' '+format('%d',[adrTr]);
end;
PCanvasTCO[indexTCO].font.Size:=PCanvasTCO[indexTCO].font.Size+1;
//PCanvasTCO[indexTCO].font.Size:=taille_fonte(; //PCanvasTCO[indexTCO].font.Size+1;
xt:=Xorg-1;
yt:=yOrg+HautCell-round(2*fryGlob[indexTCO]);
{$IF CompilerVersion >= 28.0}
@@ -12420,7 +12483,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienx:=x;ancieny:=y;
dec(x);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
inc(x);
end;
// essayer dévié
@@ -12428,7 +12491,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
AncienX:=x;AncienY:=y;
dec(x);dec(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
end;
if (position=const_inconnu) and posaig then sortir:=true;
end;
@@ -12449,7 +12512,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
inc(x);inc(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
dec(x);dec(y);
end;
// essayer dévié
@@ -12494,7 +12557,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
dec(x);dec(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
inc(x);inc(y);
end;
// essayer dévié
@@ -12503,7 +12566,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
// essai dévié
ancienX:=x;ancienY:=y;
dec(x);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
end;
if (position=const_inconnu) and posaig then sortir:=true;
end;
@@ -12784,7 +12847,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
dec(x);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
end;
end
else // pas mode 13
@@ -13168,7 +13231,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
dec(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
inc(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13394,7 +13457,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
dec(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
inc(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13419,7 +13482,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
ancienX:=x;ancienY:=y;
inc(y);
// essayer droit
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
dec(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13442,7 +13505,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
inc(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
dec(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13466,7 +13529,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
ancienX:=x;ancienY:=y;
inc(x);inc(y);
// essayer droit
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
dec(x);dec(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13491,7 +13554,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
dec(x);inc(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
inc(x);dec(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13515,7 +13578,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
dec(x);dec(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
inc(x);inc(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -13537,7 +13600,7 @@ var i,ir,adresse,But,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iter
begin
ancienX:=x;ancienY:=y;
inc(x);dec(y);
el_tco(ancienx,ancienY,x,y,train,ir);
el_tco(ancienx,ancienY,x,y,train,ir);
dec(x);inc(y);
end;
if not(memtrouve) and not(sortir) and (not(posaig) or (posAig and (position=const_devie))) then
@@ -14750,18 +14813,19 @@ 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,x,y : integer;
var s,d,indexTCO : integer;
procede : boolean;
begin
if affevt then Affiche('TCO.FormKeyDown',clOrange);
indexTCO:=index_TCO(Sender);
//Affiche('Avant xClicCell='+intToSTR(XClicCell[indexTCO]),clCyan);
if (RadioGroupSel.ItemIndex=1) and (Key=Vk_Escape) then
begin
if Rect_select.NumTCO=indexTCO then affiche_rectangle(IndexTCO,Rect_select);
Rect_select.NumTCO:=0;
selectionAffichee[indexTCO]:=false;
exit;
if Rect_select.NumTCO=indexTCO then affiche_rectangle(IndexTCO,Rect_select);
Rect_select.NumTCO:=0;
selectionAffichee[indexTCO]:=false;
exit;
end;
if not(auto_tcurs) or (RadioGroupSel.ItemIndex=1) then exit;
@@ -14769,9 +14833,6 @@ begin
procede:=false; // indicateur on a tapé une touche de curseur
//Affiche(intToSTR(key),clyellow);
x:=XClicCell[indexTCO];
y:=YClicCell[indexTCO];
with formTCO[indexTCO] do
begin
if not(ssShift in Shift) then
@@ -14779,6 +14840,7 @@ begin
VK_right : if x<NbreCellX[indexTCO] then
begin
inc(XClicCell[indexTCO]);
// Affiche('Incrémente',clLime);
d:=(xClicCell[indexTCO]+1)*LargeurCell[indexTCO];
s:=scrollBox.HorzScrollBar.Position;
if d-s>ScrollBox.Width then scrollBox.HorzScrollBar.Position:=s+LargeurCell[indexTCO];
@@ -14904,10 +14966,11 @@ begin
exit;
end;
//VK_delete : affiche('delete',clorange);
//VK_delete : affiche('delete',clorange);
if procede then
begin
_entoure_cell_clic(indexTCO);
//Affiche('xClicCell='+intToSTR(XClicCell[indexTCO]),clYellow);
clicTCO:=true;
formTCO[indexTCO].EditAdrElement.Text:=IntToSTR(tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Adresse);
actualise(indexTCO);
@@ -15052,7 +15115,7 @@ indexTCO,i,xclic,Yclic,bim,nc,maxi,libre : integer;
begin
if not(Target is TImage) then exit;
s:=(Target as TImage).Name;
if copy(s,1,8)<>'ImageTCO' then exit;
if copy(s,1,8)<>'ImageTCO' then exit; // si le composant de destination n'est pas ImageTCO, sortir
if (x=0) and (y=0) then exit;
drag:=0;
indexTCO:=Index_tco(sender);
@@ -15065,7 +15128,7 @@ begin
Yclic:=Y div hauteurCell[indexTCO] +1;
XclicCell[indexTCO]:=Xclic;
YClicCell[indexTCO]:=Yclic;
//Affiche('XXX='+intToSTR(x),clyellow);
//if not(verif_cellule(indexTCO,Xclic,Yclic,icone)) then exit;
// interdit de déposer sur un canton
if isCanton(tco[IndexTCO,Xclic,Yclic].BImage) then exit;
@@ -15119,10 +15182,7 @@ begin
s:='Un canton doit être déposé sur un élément horizontal ou vertical d''au moins 3 cases';
formTCO[indexTCO].Caption:=s;
Affiche_TCO(indexTCO);
FormInfo.LabelInfo.caption:=s;
FormInfo.Top:=Y+20;
FormInfo.Left:=X+50;
FormInfo.Show;
Affiche_info(indexTCO,x,y,s);
exit;
end;
@@ -15135,10 +15195,7 @@ begin
s:='Un canton doit être déposé sur un élément horizontal ou vertical d''au moins 3 cases';
formTCO[indexTCO].Caption:=s;
Affiche_TCO(indexTCO);
FormInfo.LabelInfo.caption:=s;
FormInfo.Top:=Y+20;
FormInfo.Left:=X+50;
FormInfo.Show;
Affiche_info(indexTCO,x,y,s);
exit;
end;
end;
@@ -15149,10 +15206,7 @@ begin
s:='Un canton doit être déposé sur un élément horizontal ou vertical d''au moins 3 cases';
formTCO[indexTCO].Caption:=s;
Affiche_TCO(indexTCO);
FormInfo.LabelInfo.caption:=s;
FormInfo.Top:=Y+20;
FormInfo.Left:=X+50;
FormInfo.Show;
Affiche_info(indexTCO,x,y,s);
exit;
end;
end;
@@ -15163,16 +15217,13 @@ begin
canton[Ncantons+1].x:=Xclic;
canton[Ncantons+1].y:=Yclic;
canton[Ncantons+1].Ntco:=indexTCO;
renseigne_canton(Ncantons+1,Bim=1);
renseigne_canton(Ncantons+1,Bim=1);
if (canton[Ncantons+1].typ1<>det) and (canton[Ncantons+1].typ2<>det) then
begin
s:='Un canton doit avoir un détecteur comme élément adjacent';
formTCO[indexTCO].Caption:=s;
Affiche_TCO(indexTCO);
FormInfo.LabelInfo.caption:=s;
FormInfo.Top:=Y+20;
FormInfo.Left:=X+50;
FormInfo.Show;
Affiche_info(indexTCO,x,y,s);
exit;
end;
@@ -16054,7 +16105,7 @@ end;
// évènement qui se produit quand on clique gauche ou droit
procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var position : Tpoint;
Numcanton,xt,yt,bt,indexTCO,i,n,adresse,Bimage,xf,yf,xclic,yclic,el1,el2,senscanton,larg,haut,
Numcanton,xt,yt,bt,indexTCO,i,j,n,adresse,Bimage,xf,yf,xclic,yclic,el1,el2,senscanton,larg,haut,
indexTrain,idcantonOrg,idcantonDest,AdrTrain,sens,etat : integer;
tel1,tel2 : tequipement;
s : string;
@@ -16344,7 +16395,7 @@ begin
// action
if (Bimage=id_action) and not(ConfCellTCO) then
begin
i:=tco[indextco,xclic,yclic].piedfeu;
i:=tco[indextco,xclic,yclic].piedfeu; // type d'action
n:=tco[indextco,xclic,yclic].feuoriente;
//Affiche('Clic bouton action i='+intToSTR(i)+' n='+intToSTR(n),clYellow);
case i of
@@ -16382,20 +16433,39 @@ begin
AcAff_horloge : affiche_horloge;
AcBouton_bistable:
begin
adresse:=tco[indextco,xclic,yclic].Adresse;
if (adresse<=0) or (adresse>100) then exit;
etat:=boutonTCO[adresse].etat;
inc(etat);
if etat=2 then etat:=0;
boutonTCO[adresse].etat:=etat;
dessin_Action(indexTCO,pcanvasTCO[indextco],xclic,yclic);
// explorer tous les tco pour voir s'il y un autre bouton tco avec la même adresse
for i:=1 to NbreTCO do
for y:=1 to NbreCellY[i] do
for x:=1 to NbreCellX[i] do
begin
if tco[i,x,y].BImage=Id_Action then
begin
if tco[i,x,y].PiedFeu=acBouton_bistable then
begin
j:=tco[indextco,xclic,yclic].Adresse;
if j=adresse then
begin
dessin_Action(i,pcanvasTCO[i],x,y);
end;
end;
end;
end;
end;
end;
end;
TempoSouris:=2 ; // démarre la tempo souris
TempoSouris:=2 ; // démarre la tempo clic souris
// clic en mode dessin
if modeTrace[indexTCO] then
@@ -16504,7 +16574,7 @@ begin
for xt:=traceXY[1].x to traceXY[2].x do
begin
stocke_undo(indexTCO,i,xt,yt);
inc(i);
inc(i);
Bimage:=replace(indexTCO,xt,yt,10,NordEst,xt=traceXY[1].x,xt=traceXY[2].x);
tco[indextco,xt,yt].BImage:=Bimage;
tco[indextco,xt,yt].liaisons:=liaisons[Bimage];
@@ -17220,7 +17290,7 @@ begin
c:=c.GetParentComponent; // scrollBox
c:=c.GetParentComponent; // formTCO
indexTCO:=index_tco(c);
tourne90G(indextco);
tourne90G(indextco);
end;
procedure tourne90D(indexTCO : integer);
@@ -17496,7 +17566,7 @@ begin
// double clic sur détecteur : inversion
//if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and (adresse<>0) then
if not(isAigTCO(Bimage)) and (adresse<>0) then
if not(isAigTCO(Bimage)) and (adresse<>0) then
begin
if EvtClicDet then event_detecteur(adresse,not(detecteur[adresse].etat),'')
else detecteur[adresse].etat:=not(detecteur[adresse].etat);
@@ -17855,7 +17925,7 @@ begin
end;
procedure TFormTCO.ButtonFonteClick(Sender: TObject);
begin
begin
change_fonte(index_tco(sender));
end;
@@ -18370,7 +18440,6 @@ begin
change_couleur_fond(index_tco(sender));
end;
procedure TFormTCO.FormKeyPress(Sender: TObject; var Key: Char);
begin
if affevt then Affiche('TCO.FormKeyPress',clOrange);
@@ -18951,16 +19020,13 @@ begin
// vérifier si le sens de dépose est compatible avec le sens du canton
if (canton[idcantonDest].SensCirc<>0) and (canton[idcantonDest].SensCirc<>sens) then
begin
begin
s:='Le sens de circulation du canton '+intToSTR(canton[idcantonDest].numero)+' ne permet pas de positionner le train dans ce sens';
formTCO[indexTCO].Caption:=s;
//Affiche(intToSTR(ypix),clred);
Affiche_TCO(indexTCO);
FormInfo.LabelInfo.caption:=s;
FormInfo.Top:=Ypix-ScrollBox.VertScrollBar.Position;
FormInfo.Left:=Xpix-ScrollBox.HorzScrollBar.Position;
FormInfo.Show;
Affiche_info(indexTCO,xpix,ypix,s);
exit;
end;
@@ -19070,3 +19136,4 @@ end;
end.
verif_version.pas
+31 -11
View File
@@ -26,7 +26,7 @@ var
f : text;
Const
VersionSC ='9.71'; // sert à la comparaison de la version publiée
VersionSC ='9.74'; // sert à la comparaison de la version publiée
SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace
// pour unzip
SHCONTCH_NOPROGRESSBOX=4;
@@ -83,6 +83,7 @@ var
begin
Result:=False;
t:=0;
// l'utilisation de TfileStream.Create inplique que le répertoire de destination soit libre de droits
Try Fs:=TFileStream.Create(s,fmCreate);
//hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if DebugVV then Affiche('TFileStream.Create ok',clLime);
@@ -121,9 +122,13 @@ begin
finally
InternetCloseHandle(hSession);
end;
finally
fs.Free;
except
begin
Affiche('Le fichier de vérification des versions n''a pas pu être créé car le répertoire ',clred);
Affiche(ExtractFilePath(s)+' n''a pas les droits requis',clred);
end;
end;
fs.Free;
end;
procedure log(s : string;couleur : Tcolor);
@@ -214,7 +219,7 @@ end;
// renvoie le numéro de version depuis le site github, et télécharge... etc
function verifie_version : real;
var description,s,s2,s3,Version_p,Url,LocalFile,nomfichier,date_creation_ang : string;
trouve_version,trouve_zip,zone_comm,LocZip : boolean;
faire,trouve_version,trouve_zip,zone_comm,LocZip : boolean;
fichier : text;
i,j,erreur,Ncomm,i2,l : integer;
V_utile,V_publie : real;
@@ -272,20 +277,37 @@ var description,s,s2,s3,Version_p,Url,LocalFile,nomfichier,date_creation_ang : s
begin
//Affiche('vérifie version',clLime);
// URL de l'API github des dernières releases
Url:='https://api.github.com/repos/f1iwq2/signaux_complexes_gl/releases/latest';
LocalFile:='page.txt';
// l'utilisation de TfileStream.Create inplique que le répertoire de destination soit libre de droits,
// ce qui ne marche pas pour c:\program files (x64)\signaux_complexes.
// Le fichier page.txt est donc mis dans C:\Users\moi\AppData\Roaming\signaux_complexes qui lui a tous les droits
// fabrication du nom de fichier destinataire et son chemin
LocalFile:=SysUtils.GetEnvironmentVariable('APPDATA');
if LocalFile<>'' then LocalFile:=IncludeTrailingPathDelimiter(LocalFile)+'Signaux_complexes';
if not(directoryExists(LocalFile)) then MkDir(LocalFile);
LocalFile:=LocalFile+'\page.txt';
if Debug=1 then Affiche('fichier page: '+LocalFile,clOrange);
//
trouve_version:=false;
DebugVV:=false;
trouve_zip:=false;
zone_comm:=false;
essai:=false;
Ncomm:=0;
if DebugVV then Affiche('Lancement DownloadURL_NOCache',clYellow);
if DownloadURL_NOCache(Url,localFile,taille) then
//if true then
faire:=essai;
if not(essai) then
begin
faire:=DownloadURL_NOCache(Url,localFile,taille);
end;
if faire then
begin
if not(FileExists(localfile)) then
begin
Affiche('Erreur fichier dépot non écrit. Vérifiez les droits du répertoire ',clred);
Affiche('Erreur fichier dépot absent. Vérifiez les droits du répertoire ',clred);
Affiche(GetCurrentDir,clred);
Affiche('Voir la notice page 9 : Refus de modification des fichiers du dossier par Windows',clred);
result:=0;
@@ -395,7 +417,7 @@ begin
V_Publie:=StrToFloat(s,FormatSettings);
V_utile:=StrToFloat(s2,FormatSettings);
if (V_utile<V_publie) or ((V_utile=V_publie) and (SousVersion<SV_publie)) then
if essai or (V_utile<V_publie) or ((V_utile=V_publie) and (SousVersion<SV_publie)) then
begin
FormVersion.Top:=10;
FormVersion.Left:=10;
@@ -413,8 +435,6 @@ begin
// récupérer depuis la variable d'environnement windows USERPROFILE le repertoire de la session ouverte
s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\'+Nomfichier;
essai:=false;
// s3=url complete avecnom de fichier ex : 'https://github.com/f1iwq2/Signaux_complexes_GL/releases/download/V8.51/signaux_complexes_V8.51.zip'
// s=répertoire+fichier de téléchargement ex : 'C:\Users\moi\Downloads\signaux_complexes_V8.51.zip'
if not(essai) then
versions.txt
+8
View File
@@ -297,6 +297,14 @@ version 9.7 : Boutons dans le TCO int
Correction bug PN sur mémoires de zones.
version 9.71 : Nouveaux styles d'affichages pour les versions D12.
Création des opérateurs NonOU et NonET dans les fonctions
version 9.72 : Correction de l'affichage de la fiche horaire.
Nouvel installeur
version 9.73 : Changement de l'algorithme du fichier de vérification de versions.
Nouvel installeur
version 9.74 : Correction suppression routes préférentielles des trains