diff --git a/Notice avancée pour les signaux complexes GL.pdf b/Notice avancée pour les signaux complexes GL.pdf index ffabbe3..02fd6d5 100644 Binary files a/Notice avancée pour les signaux complexes GL.pdf and b/Notice avancée pour les signaux complexes GL.pdf differ diff --git a/Notice d'utilisation des signaux_complexes_GL_V9.71.pdf b/Notice d'utilisation des signaux_complexes_GL_V9.74.pdf similarity index 66% rename from Notice d'utilisation des signaux_complexes_GL_V9.71.pdf rename to Notice d'utilisation des signaux_complexes_GL_V9.74.pdf index 88df79c..c1f9507 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V9.71.pdf and b/Notice d'utilisation des signaux_complexes_GL_V9.74.pdf differ diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 893fd3b..317db46 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -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)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 diff --git a/UnitClock.pas b/UnitClock.pas index dad2db7..f1fa070 100644 --- a/UnitClock.pas +++ b/UnitClock.pas @@ -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 diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 2805750..98512a4 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -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 diff --git a/UnitConfig.pas b/UnitConfig.pas index b6673ce..64dfe66 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -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 (iMaxCdeDccpp); + } // trains with ListBoxTrains do diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index 8c829d7..f3a697e 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -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 diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index 127c768..2a145e5 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -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; diff --git a/UnitFicheHoraire.dfm b/UnitFicheHoraire.dfm index bc76610..76866ab 100644 --- a/UnitFicheHoraire.dfm +++ b/UnitFicheHoraire.dfm @@ -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] diff --git a/UnitFicheHoraire.pas b/UnitFicheHoraire.pas index 7c49ce5..bb793ed 100644 --- a/UnitFicheHoraire.pas +++ b/UnitFicheHoraire.pas @@ -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; diff --git a/UnitModifAction.pas b/UnitModifAction.pas index f18b288..e2a9743 100644 --- a/UnitModifAction.pas +++ b/UnitModifAction.pas @@ -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); diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 5c8a279..5f58bba 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -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 diff --git a/UnitTCO.dfm b/UnitTCO.dfm index e853217..2b69089 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -24,8 +24,8 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1005 - 556) + 997 + 549) PixelsPerInch = 96 TextHeight = 13 object LabelZoom: TLabel diff --git a/UnitTCO.pas b/UnitTCO.pas index 62bce9a..949973d 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -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 ncantonsformTCO[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 xScrollBox.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. + diff --git a/verif_version.pas b/verif_version.pas index e9a1cf2..3ee9e55 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -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