unit UnitTCO; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls, Menus, UnitPilote, UnitDebug, ComCtrls ,StrUtils, math, unitconfig, UnitAnalyseSegCDM, Buttons , verif_version ; type TFormTCO = class(TForm) LabelCoord: TLabel; Label2: TLabel; PopupMenu1: TPopupMenu; MenuCouper: TMenuItem; N1: TMenuItem; MenuCopier: TMenuItem; MenuColler: TMenuItem; ScrollBox: TScrollBox; ImageTCO: TImage; Tourner90G: TMenuItem; Tourner90D: TMenuItem; SourisX: TLabel; SourisY: TLabel; Pos_vert: TMenuItem; TrackBarZoom: TTrackBar; Panel1: TPanel; Label6: TLabel; Label7: TLabel; Label10: TLabel; Label11: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label8: TLabel; Label9: TLabel; Label16: TLabel; Label17: TLabel; Label18: TLabel; ButtonSauveTCO: TButton; ButtonRedessine: TButton; Button1: TButton; Button2: TButton; Label19: TLabel; ButtonConfigTCO: TButton; Annulercouper: TMenuItem; N5: TMenuItem; Label20: TLabel; Label3: TLabel; Label21: TLabel; Label22: TLabel; ButtonSimu: TButton; Label24: TLabel; Label25: TLabel; Label26: TLabel; Label27: TLabel; Label28: TLabel; ButtonMasquer: TButton; ButtonAfficheBandeau: TButton; Label29: TLabel; Label30: TLabel; Label31: TLabel; FontDialog1: TFontDialog; N2: TMenuItem; Signalgauchedelavoie1: TMenuItem; Signaldroitedelavoie1: TMenuItem; N3: TMenuItem; Signal1: TMenuItem; N4: TMenuItem; GroupBox1: TGroupBox; Label4: TLabel; EditAdrElement: TEdit; EditTypeImage: TEdit; Label15: TLabel; ButtonFonte: TButton; Label23: TLabel; EditTexte: TEdit; ComboRepr: TComboBox; Label1: TLabel; CheckPinv: TCheckBox; N6: TMenuItem; Inserer: TMenuItem; Supprimer: TMenuItem; LigneDessus: TMenuItem; LigneDessous: TMenuItem; SupprimeLigne: TMenuItem; Colonne: TMenuItem; N7: TMenuItem; Colonnegauche1: TMenuItem; Colonnedroite1: TMenuItem; buttonRaz: TButton; ButtonCalibrage: TButton; ButtonCoulFond: TButton; ColorDialog1: TColorDialog; ShapeCoulFond: TShape; Label5: TLabel; Label32: TLabel; ImagePalette1: TImage; ImagePalette2: TImage; ImagePalette3: TImage; ImagePalette4: TImage; ImagePalette5: TImage; ImagePalette12: TImage; ImagePalette13: TImage; ImagePalette14: TImage; ImagePalette15: TImage; ImagePalette21: TImage; ImagePalette22: TImage; ImagePalette6: TImage; ImagePalette7: TImage; ImagePalette9: TImage; ImagePalette16: TImage; ImagePalette17: TImage; ImagePalette18: TImage; ImagePalette19: TImage; ImagePalette20: TImage; ImagePalette24: TImage; ImagePalette25: TImage; ImagePalette10: TImage; ImagePalette11: TImage; ImagePalette31: TImage; ImagePalette30: TImage; ImagePalette8: TImage; ImageTemp: TImage; ImageTemp2: TImage; outslectionner1: TMenuItem; ButtonDessiner: TButton; ButtonTrajet: TButton; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ImageTCODragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette5EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette2EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette3EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette4EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette4MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette1EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette6EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette6MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette7EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette7MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette8EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette9MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette9EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ButtonSauveTCOClick(Sender: TObject); procedure MenuCouperClick(Sender: TObject); procedure ImageTCOMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageTCOMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageTCOMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure MenuCopierClick(Sender: TObject); procedure MenuCollerClick(Sender: TObject); procedure ButtonRedessineClick(Sender: TObject); procedure grille; procedure EditAdrElementChange(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Maj_TCO(Adresse : integer); procedure ImagePalette10EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette10MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette11EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette11MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonConfigTCOClick(Sender: TObject); procedure ImagePalette30EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette30MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Tourner90GClick(Sender: TObject); procedure Tourner90DClick(Sender: TObject); procedure Pos_vertClick(Sender: TObject); procedure TrackBarZoomChange(Sender: TObject); procedure AnnulercouperClick(Sender: TObject); procedure ImagePalette12EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette12MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette13EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette13MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette14EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette14MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette15EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette15MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure EditTexteChange(Sender: TObject); procedure ButtonSimuClick(Sender: TObject); procedure CheckPinvClick(Sender: TObject); procedure ImagePalette16MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette16EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette17EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette17MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette18EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette18MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette19EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette19MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette20MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette20EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ButtonMasquerClick(Sender: TObject); procedure ButtonAfficheBandeauClick(Sender: TObject); procedure ImagePalette21EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette22EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette21MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette22MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageTCODblClick(Sender: TObject); procedure ComboReprChange(Sender: TObject); procedure ImagePalette1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette2DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette3DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette5DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette12DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette13DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette14DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette15DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette21DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette22DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette6DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette7DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette8DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette9DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette16DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette17DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette18DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette19DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette20DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette10DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette11DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette30DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette31DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette31EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette31MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonFonteClick(Sender: TObject); procedure FontDialog1Show(Sender: TObject); procedure Signaldroitedelavoie1Click(Sender: TObject); procedure Signalgauchedelavoie1Click(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure N3Click(Sender: TObject); procedure LigneDessusClick(Sender: TObject); procedure LigneDessousClick(Sender: TObject); procedure SupprimeLigneClick(Sender: TObject); procedure Colonnegauche1Click(Sender: TObject); procedure Colonnedroite1Click(Sender: TObject); procedure ColonneClick(Sender: TObject); procedure buttonRazClick(Sender: TObject); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure ButtonCalibrageClick(Sender: TObject); procedure ButtonCoulFondClick(Sender: TObject); procedure ColorDialog1Show(Sender: TObject); procedure ImagePalette24DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette24MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette25DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette25EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette25MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure ImagePalette1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure EditTypeImageChange(Sender: TObject); procedure outslectionner1Click(Sender: TObject); procedure ButtonDessinerClick(Sender: TObject); procedure ButtonTrajetClick(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; const maxUndo=30; ZoomMax=50;ZoomMin=15; MaxCellX=150;MaxCellY=70; ClFond_ch='CoulFond'; clVoies_ch='CoulVoies'; clAllume_ch='CoulAllume'; clGrille_ch='CoulGrille'; clTexte_ch='CoulTexte'; clQuai_ch='CoulQuai'; clPiedSignal_ch='CoulPiedSig'; Matrice_ch='Matrice'; Cellule_ch='Cellule'; ClCanton_ch='CoulCanton'; Ratio_ch='Ratio'; AvecGrille_ch='AvecGrille'; ModeCouleurCanton_ch='ModeCouleurCanton'; Graphisme_ch='Graphisme'; // liaisons des voies pour chaque icone par bit (0=NO 1=Nors 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest) Liaisons : array[0..31] of integer= (0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$00,$23,$33,0,0,0,0,0,0) ; type // structure du TCO TTCO = record Adresse : integer; // adresse du détecteur ou de l'aiguillage ou du feu BImage : integer; // 0=rien 1=voie 2=aiguillage gauche gauche ... 30=feu mode : integer; // couleur de voie 0=éteint 1=ClVoies 2=couleur en fonction du train trajet : integer; // décrit le trajet ouvert sur la voie (cas d'un croisement ou d'ue tjd/S) inverse : boolean; // aiguillage piloté inversé repr : integer; // position de la représentation texte 0 = rien 1=centrale 2=Haut 3=Bas Texte : string; // texte de la cellule Fonte : string; // fonte du texte FontStyle : string; // GSIB (Gras Souligné Italique Barré) coulFonte : Tcolor; TailleFonte : integer; CouleurFond : Tcolor; // couleur de fond // pour les signaux seulement PiedFeu : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie x,y : integer; // coordonnées pixels relativés du coin sup gauche du signal pour le décalage par rapport au 0,0 cellule FeuOriente : integer; // orientation du signal : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit liaisons : integer; // quadrants des liaisons end; var clAllume,clVoies,clFond,couleurAdresse,clGrille,cltexte,clQuai,CoulFonte,ClCanton,clPiedSignal : Tcolor; FormTCO: TFormTCO; Forminit,SelectionAffichee,TamponAffecte,entoure,TCO_modifie,clicsouris, clicTCO,piloteAig,BandeauMasque,eval_format,sauve_tco,formConfCellTCOAff, drag,TCOActive,TCOCree,modeTrace,ancienok,dbleClicTCO : boolean; HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel ,AncienYMiniSel,AncienYMaxiSel, Xclic,Yclic,XClicCellInserer,YClicCellInserer,Xentoure,Yentoure,RatioC,ModeCouleurCanton, AncienXClicCell,AncienYClicCell,LargeurCell,HauteurCell,NbreCellX,NbreCellY,NbCellulesTCO, Epaisseur,oldX,oldY,offsetSourisY,offsetSourisX,AvecVerifIconesTCO,indexTrace, largeurCelld2,HauteurCelld2,ancienTraceX,ancienTraceY,rangUndo : integer; titre_Fonte : string; TamponTCO,tco : array of array of TTco ; Undo : array[1..MaxUndo] of record nombre : integer; element : array[1..100] of record x,y,Bimage : integer; texte : string; end; end; // pour copier coller TamponTCO_Org : record x1,y1,x2,y2,NbreCellX,NbreCellY : integer; end; routeTCO : array[1..500] of record x,y : integer; end; // tracé traceXY : Array[1..50] of record x,y : integer; // en coordonnées grille end; rAncien : TRect; PCanvasTCO : Tcanvas; PBitMapTCO,VBm,OldBmp : TBitMap; PScrollBoxTCO : TScrollBox; PImageTCO,PImageTemp : Timage; frXGlob,frYGlob : real; procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY,DimOrgX,DimOrgY : integer); procedure calcul_cellules; procedure sauve_fichier_tco; procedure zone_TCO(det1,det2,mode: integer); procedure efface_entoure; procedure affiche_TCO; procedure affiche_cellule(x,y : integer); procedure _entoure_cell_clic; procedure affiche_texte(x,y : integer); procedure change_fonte; procedure Tourne90G; procedure Tourne90D; procedure Vertical; procedure signalG; procedure signalD; procedure lire_fichier_tco; procedure grise_ligne_tco; procedure change_couleur_fond; function verif_cellule(x,y,Bim : integer) : boolean; procedure dessine_icones; implementation uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO; {$R *.dfm} procedure lire_fichier_tco; var fichier : textfile; s,sa : string; 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 : boolean; function lit_ligne : string ; var c : char; begin repeat readln(fichier,s); s:=Uppercase(s); //Affiche(s,clWhite); c:=#0; if length(s)>0 then c:=s[1]; until ((c<>'/') and (s<>'')) or eof(fichier) ; lit_ligne:=s; end; begin {$I+} try assign(fichier,'tco.cfg'); reset(fichier); except Affiche('Nouveau tco',clyellow); NbreCellX:=35;NbreCellY:=20;LargeurCell:=35;HauteurCell:=35; largeurCelld2:=largeurCell div 2;HauteurCelld2:=HauteurCell div 2; RatioC:=10; ClFond:=$202050; ClVoies:=$0077FF; ClAllume:=$00FFFF; ClGrille:=$404040; ClTexte:=$00FF00; ClQuai:=$808080; clPiedSignal:=$4080FF; ClCanton:=$00FFFF; AvecGrille:=true; Graphisme:=1; SetLength(TCO,NbreCellX+1,NbreCellY+1); SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); for x:=1 to NbreCellX do for y:=1 to NbreCellY do tco[x,y].CouleurFond:=clfond; exit; end; {$I-} x:=1;y:=1;NbreCellX:=0;NbreCellY:=0; RatioC:=10; Graphisme:=1; trouve_clAllume:=false; trouve_CoulFond:=false; trouve_clVoies:=false; trouve_clGrille:=false; trouve_clTexte:=false; trouve_clPiedSignal:=false; trouve_clQuai:=false; trouve_matrice:=false; trouve_ratio:=false; trouve_clCanton:=false; trouve_ModeCanton:=false; trouve_AvecGrille:=false; eval_format:=false; ModeCouleurCanton:=1; AvecGrille:=true; clCanton:=ClYellow; // couleurs repeat s:=lit_ligne; sa:=uppercase(ClFond_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_CoulFond:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clfond:=i; // eval_format:=true; end; sa:=uppercase(clVoies_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clVoies:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clVoies:=i; end; sa:=uppercase(clAllume_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clAllume:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clAllume:=i; end; sa:=uppercase(clGrille_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clGrille:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clGrille:=i; end; sa:=uppercase(clTexte_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clTexte:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clTexte:=i; end; sa:=uppercase(clQuai_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clQuai:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clQuai:=i; end; sa:=uppercase(clPiedSignal_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clPiedSignal:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); clPiedSignal:=i; end; sa:=uppercase(ClCanton_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_clCanton:=true; delete(s,i,length(sa)); val('$'+s,i,erreur); ClCanton:=i; end; sa:=uppercase(ModeCouleurCanton_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_ModeCanton:=true; delete(s,i,length(sa)); val(s,i,erreur); ModeCouleurCanton:=i; end; sa:=uppercase(Graphisme_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); delete(s,i,length(sa)); val(s,i,erreur); if (i<1) or (i>2) then i:=1; Graphisme:=i; end; sa:=uppercase(AvecGrille_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_AvecGrille:=true; delete(s,i,length(sa)); val(s,i,erreur); AvecGrille:=i=1; end; //---------------------------------------------------------------- // taille de la matrice sa:=uppercase(Matrice_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_matrice:=true; delete(s,i,length(sa)); val(s,NbreCellX,erreur); i:=pos(',',s);delete(s,1,i); Val(s,NbreCellY,erreur) end; // ratio sa:=uppercase(Ratio_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); trouve_ratio:=true; delete(s,i,length(sa)); val(s,i,erreur); RatioC:=i; end; until (pos('[MATRICE]',uppercase(s))<>0) or (eof(fichier)); NbCellulesTCO:=NbreCellX*NbreCellY; if (NbreCellX<20) or (NbreCellX>MaxCellX) then begin NbreCellX:=MaxCellX; Affiche('TCO: le nombre de cellules X a été ramené à '+intToSTR(NbreCellX),clred); end; if (NbreCellY<5) or (NbreCellY>MaxCellY) then begin NbreCellY:=MaxCellY; Affiche('TCO: le nombre de cellules Y a été ramené à '+intToSTR(NbreCellX),clred); end; try SetLength(TCO,NbreCellX+1,NbreCellY+1); except Affiche('TCO:Mémoire insuffisante pour'+intToSTR(NbreCellX)+' '+intToSTR(NbreCellY),clred); NbreCellX:=20;NbreCellY:=12; SetLength(TCO,NbreCellX+1,NbreCellY+1); end; try SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); except Affiche('TamponTCO:Mémoire insuffisante',clred); NbreCellX:=20;NbreCellY:=12; SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); end; // lire la matrice while not eof(fichier) do begin s:=lit_ligne; if s[1]<>'/' then begin repeat i:=pos('(',s); if i=0 then begin Affiche(s,clYellow); Affiche('ETCO1',clred);closefile(fichier);exit; end; delete(s,1,i); // compter le nombre de virgules avant le ) npar:=0;i:=0; j:=pos(')',s); repeat i:=posEx(',',s,i+1); inc(npar); until (i>j) or (i=0); if npar<>13 then sauve_tco:=true; // 1 couleur de fond i:=pos(',',s); if i=0 then begin Affiche('ETCO2',clred);closefile(fichier);exit;end; val('$'+copy(s,1,i-1),CoulFonte,erreur); if erreur<>0 then begin Affiche('ETCO3',clred);closefile(fichier);exit;end; if coulFonte=0 then begin coulFonte:=clfond;sauve_tco:=true;end; tco[x,y].CouleurFond:=coulFonte; delete(s,1,i); // 2 Adresse i:=pos(',',s); if i=0 then begin Affiche('ETCO4',clred);closefile(fichier);exit;end; val(copy(s,1,i-1),adresse,erreur); if erreur<>0 then begin Affiche('ETCO5',clred);closefile(fichier);exit;end; tco[x,y].adresse:=adresse; delete(s,1,i); //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; if valeur=23 then begin valeur:=31;sauve_tco:=true;end; // nouvelle version icone 23 passe à 31 tco[x,y].Bimage:=valeur; tco[x,y].liaisons:=liaisons[valeur]; delete(s,1,i); //4 Inverse i:=pos(',',s); if i=0 then begin Affiche('ETCO8',clred);closefile(fichier);exit;end; val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin Affiche('ETCO9',clred);closefile(fichier);exit;end; tco[x,y].inverse:=valeur=1; delete(s,1,i); // 5 FeuOriente i:=pos(',',s); if i=0 then begin Affiche('ETCO10',clred);closefile(fichier);exit;end; val(copy(s,1,i-1),FeuOriente,erreur);if erreur<>0 then begin Affiche('ETCO11',clred);closefile(fichier);exit;end; delete(s,1,i); // 6 PiedFeu i:=pos(',',s); //j:=pos(')',s); //if j0 then begin //Affiche('Feu '+IntToSTR(Adresse)+' aspect='+intToSTR(aspect),clyellow); if FeuOriente<1 then FeuOriente:=1; if FeuOriente>3 then FeuOriente:=3; tco[x,y].FeuOriente:=FeuOriente; tco[x,y].x:=0; tco[x,y].y:=0; if PiedFeu<1 then PiedFeu:=1; if PiedFeu>2 then PiedFeu:=2; TCO[x,y].PiedFeu:=PiedFeu; end; end; // 7 texte optionnel j:=pos(')',s); i:=pos(',',s); tco[x,y].Texte:=''; if j>1 then // le , est avant le ) donc il y a un texte begin if j')') and (s[1]<>',') then begin // style GISB i:=pos(')',s); j:=pos(',',s); if j0 then delete(s,1,i); inc(x); until s=''; end; 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; end; procedure echange(var a,b : integer); var i : integer; begin i:=a; a:=b; b:=i; end; procedure sauve_fichier_tco; var fichier : textfile; s : string; couleurFonte : Tcolor; x,y : integer; begin AssignFile(fichier,'tco.cfg'); rewrite(fichier); Writeln(fichier,'/ Définitions TCO version '+version+sousversion); Writeln(fichier,clFond_ch+'='+IntToHex(clfond,6)); Writeln(fichier,clVoies_ch+'='+IntToHex(ClVoies,6)); Writeln(fichier,clAllume_ch+'='+IntToHex(ClAllume,6)); Writeln(fichier,clGrille_ch+'='+IntToHex(ClGrille,6)); Writeln(fichier,clTexte_ch+'='+IntToHex(ClTexte,6)); Writeln(fichier,clQuai_ch+'='+IntToHex(ClQuai,6)); Writeln(fichier,clPiedSignal_ch+'='+intToHex(clPiedSignal,6)); Writeln(fichier,ClCanton_ch+'='+IntToHex(ClCanton,6)); Writeln(fichier,ModeCouleurCanton_ch+'='+intToSTR(ModeCouleurCanton)); if avecGrille then s:='1' else s:='0'; Writeln(fichier,Avecgrille_ch+'='+s); writeln(fichier,Graphisme_ch+'=',graphisme); writeln(fichier,'/ Taille de la matrice x,y'); writeln(fichier,matrice_ch+'='+IntToSTR(NbreCellX)+','+intToSTR(NbreCellY)); writeln(fichier,'/ Ratio d''affichage celluleX/CelluleY'); writeln(fichier,Ratio_ch+'='+intToSTR(ratioC)); writeln(fichier,'/Matrice TCO'); writeln(fichier,'[Matrice]'); writeln(fichier,'/ couleur fond,adresse,image,inversion aiguillage,Orientation du signal, pied du signal , [texte], representation, fonte, taille fonte, couleur fonte, style, réserve '); for y:=1 to NbreCellY do begin s:=''; for x:=1 to NbreCellX do begin s:=s+'('+intToHex(TCO[x,y].CouleurFond,6)+','+inttostr(TCO[x,y].Adresse)+','+IntToSTR(TCO[x,y].BImage)+','; if TCO[x,y].inverse then s:=s+'1,' else s:=s+'0,'; if TCO[x,y].BImage=30 then begin s:=s+IntToSTR(TCO[x,y].FeuOriente)+','+IntToSTR(TCO[x,y].PiedFeu)+','; end else s:=s+'0,0,'; // texte s:=s+TCO[x,y].Texte+','; // représentation s:=s+intToSTR(TCO[x,y].repr); // NomFonte s:=s+','+TCO[x,y].Fonte; //taille fonte s:=s+','+intToSTR(TCO[x,y].tailleFonte); // couleur fonte couleurfonte:=TCO[x,y].coulFonte; s:=s+','+intTohex(couleurFonte,6); s:=s+','+TCO[x,y].FontStyle; s:=s+',0'; s:=s+')'; end; writeln(fichier,s); end; closefile(fichier); TCO_modifie:=false; Affiche('TCO sauvegardé',clyellow); end; procedure calcul_cellules; begin LargeurCell:=ZoomMax-FormTCO.TrackBarZoom.Position+ZoomMin; //Affiche(intToSTR(largeurcell),clyellow); hauteurCell:=(LargeurCell * RatioC) div 10; largeurCelld2:=largeurCell div 2;HauteurCelld2:=HauteurCell div 2; Epaisseur:=LargeurCell div 7; // épaisseur du trait pour PEN end; procedure entoure_cell_grille(x,y : integer); // redessine le carré de grille de la cellule qui a été altéré par la mise à // jour de la cellule var Xorg,Yorg : integer; begin; if not(AvecGrille) then exit; Xorg:=(x-1)*LargeurCell; Yorg:=(y-1)*HauteurCell; With PcanvasTCO do begin Pen.Color:=clGrille; Pen.mode:=PmCopy; Pen.width:=1; MoveTo(Xorg,YOrg); LineTo(Xorg+LargeurCell,YOrg); LineTo(Xorg+LargeurCell,YOrg+HauteurCell); LineTo(Xorg,YOrg+HauteurCell); LineTo(Xorg,YOrg); end; end; procedure TformTCO.grille; var x,y : integer; begin if not(AvecGrille) then exit; With PCanvasTCO do begin pen.color:=ClGrille; pen.Width:=1; Brush.Color:=ClFond; pen.mode:=PmCopy; // lignes verticales for x:=1 to NbreCellX do begin moveto(x*LargeurCell,1); LineTo(x*LargeurCell,HauteurCell*NbreCelly); end; for y:=1 to NbreCelly do begin moveto(1,y*HauteurCell); LineTo(LargeurCell*NbreCellX,y*HauteurCell); end; end; end; function positionTCO(x,y : integer) : integer; var position,i : integer; begin i:=index_Aig(TCO[x,y].Adresse); position:=aiguillage[i].position ; if (position=0) or (i=0) then begin result:=const_inconnu;exit;end; if TCO[x,y].inverse then begin if position=const_droit then begin result:=const_devie;exit;end; if position=const_devie then begin result:=const_droit;exit;end; result:=const_inconnu; exit; end else result:=position; end; // arc à deux rayons différents procedure D_Arc2R(Canvas: TCanvas; CenterX,CenterY: integer; rayonX,rayonY: Integer; StartDegres, StopDegres: Double); var sinA,cosA : extended; x1,x2,x3,x4: Integer; y1,y2,y3,y4: Integer; begin if StopDegres<0 then setArcDirection(Canvas.Handle,AD_COUNTERCLOCKWISE) else setArcDirection(Canvas.Handle,AD_CLOCKWISE); StartDegres:=startDegres*pisur180; stopDegres:=StartDegres+stopDegres*pisur180; x1:=CenterX - rayonX; y1:=CenterY - rayonY; x2:=CenterX + rayonX; y2:=CenterY + rayonY; SinCos(StartDegres,SinA,CosA); x4:=CenterX + Round(rayonX*CosA); y4:=Centery - Round(rayonY*SinA); SinCos(StopDegres,SinA,CosA); x3:=CenterX + Round(rayonX*CosA); y3:=Centery - Round(rayonY*SinA); Canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; procedure efface_selection; begin if SelectionAffichee then begin //Affiche('efface sélection',clOrange); with formtco.imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille; Brush.Color:=clblue; //FillRect(r); Rectangle(rAncien); end; SelectionAffichee:=false; end; end; // élément de voie horizontale Element 1 procedure dessin_voie(Canvas : Tcanvas;x,y,mode : integer); var Adr, x0,y0,jy1,jy2 : integer; r : Trect; couleur : Tcolor; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; with canvas do begin //Brush.Color:=TCO[x,y].CouleurFond; Pen.Mode:=pmCopy; { r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); } Adr:=TCO[x,y].adresse; // détecteur if adr<>0 then begin if detecteur[Adr].etat then begin brush.Color:=clAllume; pen.color:=clAllume; end else begin pen.color:=TCO[x,y].CouleurFond; brush.color:=TCO[x,y].CouleurFond; end; jy1:=y0+(HauteurCell div 2)-round(6*frYGlob); // pos Y de la bande sup jy2:=y0+(HauteurCell div 2)+round(6*frYGlob); // pos Y de la bande inf if avecGrille then r:=Rect(x0+1,jy1,x0+LargeurCell-1,jy2) else r:=Rect(x0,jy1,x0+LargeurCell,jy2) ; FillRect(r); end; // voie jy1:=y0+(HauteurCell div 2); Pen.Width:=epaisseur; case mode of 0 : couleur:=clVoies; 1 : couleur:=clAllume; 2 : couleur:=couleurtrain[index_couleur]; end; pen.color:=couleur; moveTo(x0,jy1);LineTo(x0+LargeurCell,jy1); end; end; procedure dessin_2L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,jy2,xf,yf,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // partie droite moveto(x0,yf);lineto(xc,yc); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yf);lineto(xc,yc); // partie déviée if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // 2eme partie droite toujours allumée moveto(xc,yc);LineTo(xf,yc); // 1ere partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(x0,yc); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // horizontale complete moveto(x0,yf);lineto(xc,yc); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie horz g en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);LineTo(xc,yc); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,yf);LineTo(xc,yc);LineTo(xf,yc); // trajet déviée end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin fond:=TCO[x,y].CouleurFond; position:=positionTCO(x,y); with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup pen.width:=1; Polygon([point(x0+1,y0+hauteurCell-epaisseur),Point(xc-(epaisseur div 2),jy1),Point(xc-epaisseur-epaisseur,jy1),Point(x0+1,y0+hauteurcell-epaisseur-epaisseur)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jy2:=yc+(Epaisseur div 2); // pos Y de la bande inf r:=rect(x0+1,jy2+1,x0+largeurCell-1,jy2+epaisseur); FillRect(r); end; end; end; // essai courbe procedure dessin_2C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,yc);lineto(xf,yc); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin fond:=TCO[x,y].CouleurFond; position:=positionTCO(x,y); // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell*2+(hauteurCell div 2); x3:=xf;y3:=yc; x4:=x0;y4:=yf; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; pen.width:=1; Polygon([ point(x0+3,yf-epaisseur-5), Point(xc+2*epaisseur,yc-epaisseur), Point(xc-epaisseur,yc-epaisseur)]); //Point(x0+1,y0+hauteurcell-epaisseur-epaisseur)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jy2:=yc+(Epaisseur div 2); // pos Y de la bande inf r:=rect(x0+1,jy2+1,x0+largeurCell-1,jy2+epaisseur); FillRect(r); end; end; end; procedure dessin_2(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_2L(Canvas,x,y,Mode); if graphisme=2 then dessin_2C(Canvas,x,y,Mode); end; procedure dessin_3L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,xf,yf,position : integer; fond : Tcolor; r : Trect; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // partie droite moveto(xc,yc);lineto(xf,y0); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);lineto(xf,y0); // partie déviée if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // première partie gauche toujours allumée moveto(x0,yc);LineTo(xc,yc); // 2eme partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(xf,yc); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // horizontale complete moveto(xc,yc);lineto(xf,y0); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie horz droite en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);LineTo(xf,yc); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,yc);LineTo(xc,yc);LineTo(xf,y0); // partie déviée end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; pen.width:=1; Polygon([point(xc+epaisseur-4,yc+epaisseur-1),point(xc+2*epaisseur-1,yc-epaisseur),point(xc+3*epaisseur,yc-epaisseur),point(xc+2*epaisseur,yc+epaisseur-1)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup r:=rect(x0+1,jy1,x0+largeurCell-1,jy1-epaisseur); FillRect(r); end; end; end; procedure dessin_3C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; fond : Tcolor; r : Trect; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,yc);lineto(xf,yc); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+(largeurcell div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; efface_selection; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; pen.width:=1; x1:=xc-2*epaisseur;y1:=yc+epaisseur-1; x2:=xc+2*epaisseur-2;y2:=yc-epaisseur; x3:=x2+epaisseur;y3:=y2; x4:=x1+epaisseur;y4:=y1; Polygon([point(x1,y1), point(x2,y2), point(x3,y3), point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup r:=rect(x0+1,jy1,x0+largeurCell-1,jy1-epaisseur); FillRect(r); end; end; { with canvas do begin pen.Color:=clwhite; pen.width:=1; moveto(x1,y1);lineto(x2,y2); end; } end; procedure dessin_3(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_3L(Canvas,x,y,Mode); if graphisme=2 then dessin_3C(Canvas,x,y,Mode); end; procedure dessin_4L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // partie droite moveto(xc,yc);lineto(xf,yf); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);lineto(xf,yf); // partie déviée if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // première partie gauche toujours allumée moveto(x0,yc);LineTo(xc,yc); // 2eme partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(xf,yc); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // horizontale complete moveto(xc,yc);lineto(xf,yf); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie horz droite en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);LineTo(xf,yc); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,yc);LineTo(xc,yc);LineTo(xf,yf); // trajet dévié end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc+(epaisseur div 2);y1:=yc-(epaisseur div 2)-1; x2:=x1+8;y2:=y1; x3:=x2+6;y3:=y2+7; x4:=x1+6;y4:=y3; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; // efface le morceau x1:=xc-epaisseur-1;y1:=yc+(epaisseur div 2)+1; x2:=x1+21;y2:=y1+5; r:=rect(x1,y1,x2,y2); rectangle(r); end; end; end; procedure dessin_4C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,yc);lineto(xf,yc); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=yc; x2:=xf+(largeurcell div 3);y2:=yf+2*hauteurcell+(hauteurcell div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc-12;y1:=yc-(epaisseur div 2)-1; x2:=x1+15;y2:=y1; x3:=x2+6;y3:=y2+7; x4:=x1+12;y4:=y3; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; // efface le morceau x1:=xc-2*epaisseur;y1:=yc+(epaisseur div 2)+1; x2:=xc+2*epaisseur+2;y2:=y1+5; r:=rect(x1,y1,x2,y2); rectangle(r); end; end; end; procedure dessin_4(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_4L(Canvas,x,y,Mode); if graphisme=2 then dessin_4C(Canvas,x,y,Mode); end; procedure dessin_5L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // partie droite moveto(x0,y0);lineto(xc,yc); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);lineto(xc,yc); // partie déviée if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // 2eme partie droite toujours allumée moveto(xc,yc);LineTo(xf,yc); // 1ere partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(x0,yc); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xf,yc); // horizontale complete moveto(x0,y0);lineto(xc,yc); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie horz g en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);LineTo(xc,yc); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,y0);LineTo(xc,yc);LineTo(xf,yc); // trajet dévié end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.width:=1; x1:=xc-(epaisseur div 2);y1:=yc+(epaisseur div 2); x2:=x1-epaisseur;y2:=y1; x3:=x2-epaisseur;y3:=y2-epaisseur-1; x4:=x3+epaisseur;y4:=y3; pen.color:=fond; Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.Width:=1; // efface le morceau x1:=xc-(epaisseur div 2)-10;y1:=yc-(epaisseur div 2); x2:=x1+20;y2:=y1-epaisseur; pen.color:=fond; Brush.Color:=fond; r:=rect(x1,y1,x2,y2); rectangle(r); end; end; end; procedure dessin_5C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,yc);lineto(xf,yc); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; // mode rond x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+largeurCell+(largeurcell div 3);y2:=yc; x3:=x0;y3:=y0; x4:=xf;y4:=yc; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.width:=1; x1:=xc+2*epaisseur;y1:=yc+(epaisseur div 2); x2:=x1-3*epaisseur;y2:=y1; x3:=x2;y3:=y2-epaisseur-2; x4:=x3+epaisseur;y4:=y3; pen.color:=fond; Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3)]); end; if position=const_droit then begin // effacement du morceau pen.Width:=1; // efface le morceau x1:=xc-(epaisseur div 2)-15;y1:=yc-(epaisseur div 2); x2:=xf;y2:=y1-epaisseur-2; pen.color:=fond; Brush.Color:=fond; r:=rect(x1,y1,x2,y2-1); rectangle(r); end; end; end; procedure dessin_5(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_5L(Canvas,x,y,Mode); if graphisme=2 then dessin_5C(Canvas,x,y,Mode); end; // coin supérieur gauche (Element 6) procedure dessin_6L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Pen.Width:=epaisseur; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; MoveTo(x0,y0);LineTo(xc,yc);Lineto(x0+largeurCell,yc); end; end; // coin supérieur gauche (Element 6) procedure dessin_6C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+largeurCell+(largeurcell div 3);y2:=yc; x3:=x0;y3:=y0; x4:=xf;y4:=yc; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Pen.Width:=epaisseur; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_6(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_6L(Canvas,x,y,Mode); if graphisme=2 then dessin_6C(Canvas,x,y,Mode); end; // Element 7 procedure dessin_7L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=couleur; Pen.Mode:=pmCopy; Pen.Width:=epaisseur; MoveTo(x0,yc);LineTo(xc,yc);lineto(x0+largeurCell,y0); end; end; procedure dessin_7C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+(largeurcell div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=couleur; Pen.Mode:=pmCopy; Pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_7(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_7L(Canvas,x,y,Mode); if graphisme=2 then dessin_7C(Canvas,x,y,Mode); end; // courbe: droit vers bas -\ Element 8 procedure dessin_8L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; Pen.Mode:=pmCopy; pen.color:=Couleur; pen.Width:=epaisseur; moveto(x0,yc);lineto(xc,yc);lineto(x0+largeurCell,y0+hauteurCell); end; end; procedure dessin_8C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=yc; x2:=xf+(largeurcell div 3);y2:=yf+2*hauteurcell+(hauteurcell div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; Pen.Mode:=pmCopy; pen.color:=Couleur; pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_8(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_8L(Canvas,x,y,Mode); if graphisme=2 then dessin_8C(Canvas,x,y,Mode); end; // courbe bas gauche vers droit Elément 9 procedure dessin_9l(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; pen.width:=epaisseur; MoveTo(x0,y0+hauteurCell);LineTo(xc,yc);LineTo(x0+largeurCell,yc); end; end; // courbe bas gauche vers droit Elément 9 procedure dessin_9c(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; yf:=y0+HauteurCell; // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell*2+(hauteurCell div 2); x3:=xf;y3:=yc; x4:=x0;y4:=yf; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; pen.width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_9(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_9L(Canvas,x,y,Mode); if graphisme=2 then dessin_9C(Canvas,x,y,Mode); end; // élément 10 procedure dessin_10(Canvas : Tcanvas;x,y : integer;Mode : integer); var Adr, x0,y0: integer; r : Trect; fond : Tcolor; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); Adr:=TCO[x,y].adresse; // détecteur if adr<>0 then begin if detecteur[Adr].etat then begin brush.Color:=clAllume; pen.color:=clAllume; end else begin pen.color:=TCO[x,y].CouleurFond; brush.color:=TCO[x,y].CouleurFond; end; // if avecGrille then r:=Rect(x0+1,jy1,x0+LargeurCell-1,jy2) else pen.Width:=epaisseur+3; MoveTo(x0+largeurCell,y0);LineTo(x0,y0+hauteurCell); end; // voie Pen.Width:=epaisseur; case mode of 0 : couleur:=clVoies; 1 : couleur:=clAllume; 2 : couleur:=couleurtrain[index_couleur]; end; pen.color:=couleur; MoveTo(x0+largeurCell,y0);LineTo(x0,y0+hauteurCell); end; end; // élément 11 procedure dessin_11(Canvas : Tcanvas;x,y : integer;Mode : integer); var Adr, x0,y0 : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); Adr:=TCO[x,y].adresse; // détecteur if adr<>0 then begin if detecteur[Adr].etat then begin brush.Color:=clAllume; pen.color:=clAllume; end else begin pen.color:=TCO[x,y].CouleurFond; brush.color:=TCO[x,y].CouleurFond; end; // if avecGrille then r:=Rect(x0+1,jy1,x0+LargeurCell-1,jy2) else pen.Width:=epaisseur+3; MoveTo(x0,y0);LineTo(x0+largeurCell,y0+hauteurCell); end; // voie Pen.Width:=epaisseur; case mode of 0 : couleur:=clVoies; 1 : couleur:=clAllume; 2 : couleur:=couleurtrain[index_couleur]; end; pen.color:=couleur; MoveTo(x0,y0);LineTo(x0+largeurCell,y0+hauteurCell); end; end; // Element 12 procedure dessin_12L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);lineto(xf,yf); // diag complete moveto(xc,yc);lineto(xf,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);lineto(xf,yc); // partie droite if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // première partie haute toujours allumée moveto(x0,y0);LineTo(xc,yc); // 2eme partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(xf,yf); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);lineto(xf,yf); // diag complete moveto(xc,yc);lineto(xf,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie sup en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);LineTo(xf,yf); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,y0);LineTo(xc,yc);LineTo(xf,yc); end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.width:=1; x1:=xc-epaisseur;y1:=yc+(epaisseur div 2)+1; x2:=x1+3*epaisseur;y2:=y1; x3:=x2;y3:=y2+epaisseur; x4:=x1;y4:=y3; pen.color:=fond; Brush.COlor:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.Width:=1; x1:=xc+(epaisseur div 2)-2;y1:=yc-(epaisseur div 2)-1; x2:=x1+epaisseur;y2:=y1; x3:=x2+epaisseur+2;y3:=y2+epaisseur+2; x4:=x3-epaisseur;y4:=y3; pen.color:=fond; Brush.COlor:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; end; end; procedure dessin_12C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,y0);lineto(xf,yf); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+largeurCell+(largeurcell div 3);y2:=yc; x3:=x0;y3:=y0; x4:=xf;y4:=yc; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.width:=1; x1:=xc-2*epaisseur;y1:=yc-(epaisseur); x2:=xc+2*epaisseur;y2:=yc+2; x3:=x2;y3:=yc+(epaisseur div 2)+epaisseur; x4:=x1;y4:=y3; pen.color:=fond; Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau x1:=xc-epaisseur-1;y1:=yc-(2*epaisseur)-1; x2:=x1+epaisseur;y2:=y1; x3:=x2+2*epaisseur+5;y3:=y2+3*epaisseur; x4:=x3-epaisseur;y4:=y3; pen.Width:=1; pen.color:=fond; Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; end; end; procedure dessin_12(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_12L(Canvas,x,y,Mode); if graphisme=2 then dessin_12C(Canvas,x,y,Mode); end; // Elément 13 procedure dessin_13L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yf);lineto(xf,y0); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie horz couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xc,yc); // partie horz if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // première partie basse toujours allumée moveto(x0,yf);LineTo(xc,yc); // 2eme partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(xf,y0); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yf);lineto(xf,y0); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie inf en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);LineTo(x0,yf); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,yc);LineTo(xc,yc);LineTo(xf,y0); end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc-2*epaisseur-5;y1:=yc+(epaisseur div 2)+1; x2:=xc+epaisseur+10;y2:=y1+epaisseur; r:=rect(x1,y1,x2,y2); rectangle(r); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc-(epaisseur div 2)+1;y1:=yc-(epaisseur div 2)-1; x2:=x1-epaisseur-1; x3:=x2-epaisseur;y3:=yc+(epaisseur div 2)+1; x4:=x1-epaisseur-1; polygon([point(x1,y1),point(x2,y1),point(x3,y3),point(x4,y3)]); end; end; end; procedure dessin_13C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,yf);lineto(xf,y0); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+(largeurcell div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc+(epaisseur)+3;y1:=yc-(epaisseur); x2:=xc+2*epaisseur+3;y2:=y1; x3:=xc;y3:=yc+epaisseur; x4:=xc-(3*epaisseur);y4:=y3; polygon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc-(epaisseur div 2);y1:=yc-(2*epaisseur); x2:=xc+epaisseur; x3:=xc-epaisseur-2;y3:=yc+(epaisseur div 2)+1; x4:=xc-2*epaisseur;y4:=y3; polygon([point(x1,y1),point(x2,y1),point(x3,y3),point(x4,y4)]); end; end; end; procedure dessin_13(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_13L(Canvas,x,y,Mode); if graphisme=2 then dessin_13C(Canvas,x,y,Mode); end; // Element 14 procedure dessin_14l(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);lineto(xf,yf); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yc);lineto(xc,yc); // partie droite if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // première partie basse toujours allumée moveto(xf,yf);LineTo(xc,yc); // 2eme partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(x0,y0); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);lineto(xf,yf); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie sup en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);LineTo(xc,yc); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(xf,yf);LineTo(xc,yc);LineTo(x0,yc); end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.width:=1; x1:=xc-2*epaisseur-5;y1:=yc-(epaisseur div 2); x2:=x1+3*epaisseur;y2:=y1-epaisseur; pen.color:=fond; Brush.Color:=fond; r:=rect(x1,y1,x2,y2); rectangle(r); end; if position=const_droit then begin // effacement du morceau pen.Width:=1; x1:=xc-epaisseur-3;y1:=yc-(epaisseur div 2)-1; x2:=x1-epaisseur;y2:=y1; x3:=x2+epaisseur+2;y3:=y2+epaisseur+2; x4:=x3+epaisseur;y4:=y3; pen.color:=fond; Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; end; end; procedure dessin_14c(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,y0);lineto(xf,yf); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=yc; x2:=xf+(largeurcell div 3);y2:=yf+2*hauteurcell+(hauteurcell div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.width:=1; x1:=xc-epaisseur-2;y1:=yc-(epaisseur div 2); x2:=xc+epaisseur;y2:=y1; x3:=xc+3*epaisseur+3;y3:=yc+2*epaisseur; x4:=xc+2*epaisseur+4;y4:=y3; pen.color:=fond; Brush.Color:=fond; r:=rect(x1,y1,x2,y2); Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.Width:=1; x1:=xc-(2*epaisseur)+3;y1:=yc-(epaisseur div 2)-1; x2:=xc-(3*epaisseur)+4;y2:=y1; x3:=xc;y3:=yc+2*epaisseur; x4:=xc+epaisseur;y4:=y3; pen.color:=fond; Brush.Color:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); end; end; end; procedure dessin_14(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_14L(Canvas,x,y,Mode); if graphisme=2 then dessin_14C(Canvas,x,y,Mode); end; // Element 15 procedure dessin_15L(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position : integer; r : Trect; fond : Tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yf);lineto(xf,y0); // diag complete moveto(xc,yc);lineto(xf,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie droite couleur voies pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);lineto(xf,yc); // partie droite if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // première partie basse toujours allumée moveto(x0,yf);LineTo(xc,yc); // 2eme partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(xf,y0); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,yf);lineto(xf,y0); // diag complete moveto(xc,yc);lineto(xf,yc); // partie droite end; if (mode=1) or (mode=2) then with canvas do begin // partie sup en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,yc);LineTo(xf,y0); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,yf);LineTo(xc,yc);LineTo(xf,yc); end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc-epaisseur;y1:=yc-(epaisseur div 2)-1; x2:=xc+epaisseur+10;y2:=yc-epaisseur-3; polygon([point(x1,y1),point(x2,y1),point(x2,y2),point(x1,y2)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; x1:=xc+(epaisseur div 2);y1:=yc+(epaisseur div 2); x2:=x1+epaisseur-1;y2:=yc-(epaisseur div 2); x3:=x1+10; polygon([point(x1,y1),point(x2,y2),point(x3,y2),point(x3,y1)]); end; end; end; procedure dessin_15C(Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : Tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,yf);lineto(xf,y0); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell*2+(hauteurCell div 2); x3:=xf;y3:=yc; x4:=x0;y4:=yf; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; x1:=xc-epaisseur;y1:=yc-(epaisseur div 2)-1; x2:=xc+epaisseur+10;y2:=y1; x3:=xc-epaisseur-5;y3:=yc+epaisseur; x4:=xc-2*epaisseur;y4:=y3; polygon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; x1:=xc+(epaisseur)+epaisseur-1;y1:=yc-(epaisseur); x2:=x1+2*epaisseur;y2:=y1; x3:=xc+(epaisseur);y3:=yc+(2*epaisseur); x4:=xc-epaisseur-1;y4:=y3; polygon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); end; end; end; procedure dessin_15(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_15L(Canvas,x,y,Mode); if graphisme=2 then dessin_15C(Canvas,x,y,Mode); end; // Element 16 procedure dessin_16L(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; Pen.width:=epaisseur; MoveTo(x0,y0);lineTo(xc,yc);LineTo(xc,y0+hauteurCell); end; end; procedure dessin_16C(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin // mode rond // mode rond x1:=x0-(2*largeurCell)-(largeurcell div 2);y1:=y0-(hauteurCell div 3); x2:=x0+(largeurcell div 2);y2:=yf+hauteurcell+(hauteurCell div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; Pen.width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_16(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_16L(Canvas,x,y,Mode); if graphisme=2 then dessin_16C(Canvas,x,y,Mode); end; // Element 17 procedure dessin_17l(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Pen.Width:=epaisseur; Brush.Color:=couleur; pen.color:=couleur; Pen.Mode:=pmCopy; MoveTo(x0+LargeurCell,y0);LineTo(xc,yc);LineTo(xc,y0+hauteurCell); end; end; // Element 17 procedure dessin_17c(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; yf:=y0+HauteurCell; x1:=x0+(largeurcell div 2);y1:=y0-(hauteurCell div 3); x2:=xf+(2*largeurCell)+(largeurcell div 2);y2:=yf+hauteurcell+(hauteurCell div 3); x3:=xf;y3:=y0; x4:=xc;y4:=yf; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Pen.Width:=epaisseur; Brush.Color:=couleur; pen.color:=couleur; Pen.Mode:=pmCopy; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_17(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_17L(Canvas,x,y,Mode); if graphisme=2 then dessin_17C(Canvas,x,y,Mode); end; // Elément 18 procedure dessin_18l(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; Pen.Width:=epaisseur; MoveTo(x0,y0+hauteurCell);LineTo(xc,yc);LineTo(xc,y0); end; end; procedure dessin_18c(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; yf:=y0+HauteurCell; x1:=x0-(2*largeurCell)-(largeurcell div 2);y1:=y0-hauteurCell-(hauteurCell div 3); x2:=x0+(largeurcell div 2);y2:=yf+(hauteurCell div 3); x3:=x0;y3:=yf; x4:=xc;y4:=y0; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=clfond; pen.color:=Couleur; Pen.Mode:=pmCopy; Pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_18(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_18L(Canvas,x,y,Mode); if graphisme=2 then dessin_18C(Canvas,x,y,Mode); end; // Element 19 procedure dessin_19l(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurcell div 2); yc:=y0+(Hauteurcell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; Pen.width:=epaisseur; moveto(xc,y0);LineTo(xc,yc);LineTo(x0+largeurCell,y0+HauteurCell); end; end; procedure dessin_19c(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurcell div 2); yc:=y0+(Hauteurcell div 2); xf:=x0+largeurCell; yf:=y0+HauteurCell; x1:=x0+(largeurcell div 2);y1:=y0-hauteurCell-(hauteurCell div 3); x2:=xf+(2*largeurCell)+(largeurcell div 2);y2:=yf+(hauteurCell div 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; Pen.width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_19(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_19L(Canvas,x,y,Mode); if graphisme=2 then dessin_19C(Canvas,x,y,Mode); end; // Element 20 procedure dessin_20(Canvas : Tcanvas;x,y,mode: integer); var jx1,jx2,x0,y0,xc,adr : integer; r : Trect; couleur : tcolor; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; Pen.Mode:=pmCopy; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); // état détecteur Adr:=TCO[x,y].adresse; if Adr<>0 then begin if detecteur[Adr].etat then begin Brush.Color:=clAllume; pen.color:=clAllume; end else begin couleur:=TCO[x,y].CouleurFond; Brush.Color:=couleur; pen.color:=couleur; end; jx1:=x0+(LargeurCell div 2)-round(6*frxGlob); // pos Y de la bande sup jx2:=x0+(LargeurCell div 2)+round(6*frxGlob); // pos Y de la bande inf if avecGrille then r:=Rect(jx1,y0+1,jx2,y0+HauteurCell-1) else r:=Rect(jx1,y0,jx2,y0+HauteurCell) ; FillRect(r); end; // voie case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=couleur; pen.color:=couleur; jx1:=y0+(HauteurCell div 2); Pen.Width:=epaisseur; MoveTo(xc,y0);LineTo(xc,y0+HauteurCell); end; end; // Element 21 - croisement - TJD procedure dessin_21(Canvas : Tcanvas;x,y,mode : integer); var x0,y0,xc,yc,trajet : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Pen.Width:=1; Brush.Color:=TCO[x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); Brush.Color:=clvoies; pen.color:=clvoies; pen.width:=epaisseur; moveTo(x0,y0+hauteurCell);LineTo(x0+LargeurCell,y0); // diagonale moveTo(x0,yc);LineTo(x0+largeurCell,yc); // horizontale // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[x,y].trajet; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then begin moveTo(x0,yc);LineTo(x0+largeurCell,yc);end; // horizontale if trajet=2 then begin moveTo(x0,y0+hauteurCell);LineTo(x0+LargeurCell,y0);end; // diagonale if trajet=3 then begin moveto(x0,y0+HauteurCell);LineTo(xc,yc);lineTo(x0+largeurCell,yc); end; if trajet=4 then begin moveto(x0,yc);LineTo(xc,yc);lineTo(x0+largeurCell,y0); end; end; end; end; // Element 22 procedure dessin_22(Canvas : Tcanvas;x,y,mode : integer); var x0,y0,xc,yc,trajet : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(LargeurCell div 2); yc:=y0+(hauteurCell div 2); with canvas do begin Pen.Width:=1; Brush.Color:=TCO[x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); Brush.Color:=clvoies; pen.color:=clvoies; pen.width:=epaisseur; moveto(x0,y0);lineTo(x0+largeurCell,y0+hauteurCell); // diagonale moveTo(x0,yc);LineTo(x0+largeurCell,yc); // horizontale // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[x,y].trajet; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then begin moveTo(x0,yc);LineTo(x0+largeurCell,yc);end; // horizontale if trajet=2 then begin moveto(x0,y0);lineTo(x0+largeurCell,y0+hauteurCell);end; // diagonale if trajet=3 then begin moveto(x0,y0);LineTo(xc,yc);lineTo(x0+largeurCell,yc); end; if trajet=4 then begin moveto(x0,yc);LineTo(xc,yc);lineTo(x0+largeurCell,y0+hauteurcell); end; end; end; end; // Element 23 (31) procedure dessin_31(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,x1,x2,jy1,jy2 : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; with canvas do begin Pen.Width:=1; Brush.Color:=TCO[x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); Brush.Color:=clQuai; pen.color:=clQuai; x1:=x0; x2:=x0+largeurCell; jy1:=y0+(HauteurCell div 2)-round(14*frYGlob); // pos Y de la bande sup jy2:=y0+(HauteurCell div 2)+round(14*frYGlob); // pos Y de la bande inf r:=rect(x1,jy1,x2,jy2); rectangle(r); end; end; // Element 24 procedure dessin_24L(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,xf,yf,position : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,y0);lineto(xc,yf); // partie droite moveto(x0,y0);lineto(xc,yc); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(x0,y0);lineto(xc,yc); // partie déviée éteinte if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; // 2eme partie droite toujours allumée moveto(xc,yf);LineTo(xc,yc); // 1ere partie en fonction de la position if position=const_devie then begin pen.color:=clvoies; Brush.Color:=clvoies; end; LineTo(xc,y0); end; end; procedure trajet_devie; begin if mode=0 then with canvas do begin pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,y0);lineto(xc,yf); // verticale complete moveTo(x0,y0);lineto(xc,yc); // partie déviée end; if (mode=1) or (mode=2) then with canvas do begin // partie horz g en couleur de voie pen.color:=clvoies; Brush.Color:=clvoies; moveto(xc,y0);LineTo(xc,yc); if mode=1 then couleur:=ClCanton; if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; Brush.Color:=couleur; moveto(x0,y0);LineTo(xc,yc);LineTo(xc,yf); // trajet déviée end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; //r:=Rect(x0,y0,xf,yf); //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if (position=const_Devie) or (position=const_inconnu) then begin trajet_devie; // affiche la position de la branche déviée end; if (position=const_droit) or (position=const_inconnu) then begin trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; jy1:=yc - Epaisseur-1; jx1:=xc-(Epaisseur div 2); pen.width:=1; Polygon([point(jx1,jy1),Point(jx1+epaisseur,jy1+epaisseur),Point(jx1+epaisseur,jy1-epaisseur),Point(jx1,jy1-epaisseur)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jx1:=xc-(Epaisseur div 2); // pos Y de la bande inf r:=rect(jx1,yc-10,jx1-Epaisseur,yc+10); FillRect(r); end; end; end; // Element 24 procedure dessin_24C(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; moveto(xc,y0);lineto(xc,yf); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton; if mode=2 then couleur:=couleurtrain[index_couleur]; end; end; with canvas do begin pen.color:=couleur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine yc:=y0+(HauteurCell div 2); // y centre xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; // mode rond x1:=x0-(2*largeurCell)-(largeurcell div 2);y1:=y0-(hauteurCell div 3); x2:=x0+(largeurcell div 2);y2:=yf+hauteurcell+(hauteurCell div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; { pen.Width:=1; pen.color:=clyellow; moveto(x1,y1);lineTo(x2,y2); ellipse(x1,y1,x2,y2); } Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; if mode>0 then begin if (position=const_devie) or (position=const_inconnu) then begin trajet_droit; trajet_devie; end; if (position=const_droit) then begin trajet_devie; trajet_droit; end; end else begin trajet_devie; trajet_droit; end; if (position=const_Devie) then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.width:=1; jx1:=xc-(Epaisseur div 2); jy1:=yc - Epaisseur+5; pen.width:=1; Polygon([point(jx1,jy1),Point(jx1+epaisseur,jy1+epaisseur+10),Point(jx1+epaisseur,jy1-epaisseur),Point(jx1,jy1-epaisseur)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jx1:=xc-(Epaisseur div 2); // pos Y de la bande inf r:=rect(jx1,yc-15,jx1-Epaisseur,yf); FillRect(r); end; end; end; procedure dessin_24(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_24L(Canvas,x,y,Mode); if graphisme=2 then dessin_24C(Canvas,x,y,Mode); end; // Element 25 croisement procedure dessin_25(Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xf,yf,xc,yc,trajet : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(LargeurCell div 2); yc:=y0+(hauteurCell div 2); xf:=x0+LargeurCell; yf:=y0+HauteurCell; with canvas do begin Pen.Width:=1; Brush.Color:=TCO[x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); //FillRect(r); Brush.Color:=clvoies; pen.color:=clvoies; pen.width:=epaisseur; moveto(x0,y0);lineTo(xf,yf); // diagonale moveTo(xc,y0);LineTo(xc,yf); // verticale // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[x,y].trajet; case mode of 0: couleur:=clVoies; 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then begin moveTo(xc,y0);LineTo(xc,yf);end; // verticale if trajet=2 then begin moveto(x0,y0);lineTo(xf,yf);end; // diagonale if trajet=3 then begin moveto(x0,y0);LineTo(xc,yc);lineTo(xc,yc); // end; if trajet=4 then begin moveto(xc,y0);LineTo(xc,yc);lineTo(xf,yf); // -\ end; end; end; 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); begin frX:=DimDestX/DimOrgX; frY:=DimDestY/DimOrgY; //Affiche(formatfloat('0.000000',frY),clyellow); end; // Affiche dans le TCO en x,y un signal à 90° d'après l'image transmise // x y en coordonnées pixels procedure Feu_90G(ImageSource : TImage;x,y : integer;FrX,FrY : real); var p : array[0..2] of TPoint; TailleY,TailleX : integer; begin TailleY:=ImageSource.Picture.Height; TailleX:=ImageSource.Picture.Width; // copie à 90°G sans mise à l'échelle dans l'image provisoire p[0].X:=TailleY; //90; p[0].Y:=0; //0; p[1].X:=TailleY; //90; p[1].Y:=TailleX; //49; p[2].X:=0; //0; p[2].Y:=0; //0; // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 90° PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); // copie l'image du signal retournée depuis image temporaire vers tco avec une réduction en mode transparennt TransparentBlt(PcanvasTCO.Handle,x,y,round(TailleY*FrY),round(TailleX*FrX), // destination PImageTemp.Canvas.Handle,0,0,TailleY,TailleX,clBlue); // source - clblue est la couleur de transparence PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; // copie de l'image du signal à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire procedure Feu_90D(ImageSource : TImage;x,y : integer ; FrX,FrY : real); var p : array[0..2] of TPoint; TailleY,TailleX : integer; begin TailleY:=ImageSource.Picture.Height; TailleX:=ImageSource.Picture.Width; // copie à 90°D dans l'image provisoire p[0].X:=0; p[0].Y:=TailleX; //49; p[1].X:=0; p[1].Y:=0; p[2].X:=TailleY; //90; p[2].Y:=TailleX; //49; // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 90° PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); // et copier l'image avec mise à l'échelle tournée sur le TCO TransparentBlt(PcanvasTCO.Handle,x,y,round(tailleY*FrY),round(tailleX*FrX), PImageTemp.Canvas.Handle,0,0,TailleY,TailleX,clBlue); PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; procedure affiche_pied2G_90G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) ); if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-50)*frYR) ); end; end; procedure affiche_pied2G_90D(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,frYR: real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=35;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frYR) ); if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ) ; end; end; procedure affiche_pied_Vertical2G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=12;y1:=35; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ); end; end; procedure affiche_pied3G_90D(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,fryR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=45;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) ); if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ); end; end; procedure affiche_pied3G_90G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1-4)*frX),y+round((y1+0)*frY) ); if pied=1 then LineTo( x+round((x1-4)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-4)*frX),y+round((y1-50)*fryR) ); end; end; procedure affiche_pied_Vertical3G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=12;y1:=42; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ) ; end; end; procedure affiche_pied4G_90G(x,y : integer;FrX,frY : real;piedFeu : integer); var x1,y1 : integer; fryR,ech : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frY) ); if piedFeu=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-50)*frYR) ) ; end; end; procedure affiche_pied4G_90D(x,y : integer;FrX,frY : real;piedfeu: integer); var x1,y1 : integer; ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=55;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) ); if piedFeu=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ); end; end; procedure affiche_pied_Vertical4G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=12;y1:=55; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); end; end; procedure affiche_pied9G_90D(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; var ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=90;y1:=38; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR)) else LineTo( x+round((x1+7)*frX),y+round((y1+40)*fryR)); end; end; procedure affiche_pied5G_90D(x,y : integer;FrX,frY : real;piedFeu : integer); var x1,y1 : integer; ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=66;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+0)*frY) ); if piedFeu=1 then LineTo( x+round((x1+6)*frX),y+round((y1-50)*fryR) ) else LineTo( x+round((x1+6)*frX),y+round((y1+50)*fryR) ); end; end; procedure affiche_pied5G_90G(x,y : integer;FrX,frY : real;piedFeu : integer); var x1,y1 : integer; ech,fryR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frY) ); if piedFeu=1 then LineTo( x+round((x1-6)*frX),y+round((y1+50)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-50)*fryR) ); end; end; procedure affiche_pied_Vertical5G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=12;y1:=65; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); end; end; procedure affiche_pied7G_90D(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=75;y1:=38; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fryR) ) else LineTo( x+round((x1+7)*frX),y+round((y1+38)*fryR) ) ; end; end; procedure affiche_pied7G_90G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech,frYR : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Color:=clPiedSignal; Pen.Width:=2; x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) ); if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+60)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-40)*frYR) ) ; end; end; procedure affiche_pied_Vertical7G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=12;y1:=75; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-40)*frX),y+round((y1+7)*frY) ) ; end; end; procedure affiche_pied9G_90G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; frYR,ech : real; begin ech:=frY;frY:=frX;FrX:=ech; frYR:=frY*ratioC/10; with PcanvasTCO do begin Pen.Color:=clPiedSignal; pen.Width:=2; x1:=0;y1:=12; // segment horizontal moveTo( x+round(x1*frX),y+round(y1*frYR) ); LineTo( x+round((x1-6)*frX),y+round((y1+0)*frYR) ); if pied=1 then LineTo( x+round((x1-6)*frX),y+round((y1+58)*frYR) ) else LineTo( x+round((x1-6)*frX),y+round((y1-40)*frYR) ) ; end; end; procedure affiche_pied_Vertical9G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO do begin Pen.Width:=2; Pen.Color:=clPiedSignal; x1:=12;y1:=90; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-40)*frX),y+round((y1+7)*frY) ) ; end; end; procedure Efface_Cellule(Canvas : Tcanvas;x,y : integer;Mode : TPenMode); var x0,y0 : integer; r : TRect; c : tcolor; begin { if y>1 then begin // si la cellule au dessus contient un feu vertical, ne pas effacer la cellule // if (tco[x,y-1].BImage=12) and (tco[x,y-1].FeuOriente=1) then exit; end; if x9 then exit; //Affiche(IntToSTR(i)+' '+intToSTR(aspect),clred); case aspect of 2 : ImageFeu:=Formprinc.Image2feux; 3 : ImageFeu:=Formprinc.Image3feux; 4 : ImageFeu:=Formprinc.Image4feux; 5 : ImageFeu:=Formprinc.Image5feux; 7 : ImageFeu:=Formprinc.Image7feux; 9 : ImageFeu:=Formprinc.Image9feux; 12 : ImageFeu:=Formprinc.Image2Dir; 13 : ImageFeu:=Formprinc.Image3Dir; 14 : ImageFeu:=Formprinc.Image4Dir; 15 : ImageFeu:=Formprinc.Image5Dir; 16 : ImageFeu:=Formprinc.Image6Dir; else ImageFeu:=Formprinc.Image9feux; end; TailleX:=ImageFeu.picture.BitMap.Width; TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) PiedFeu:=TCO[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/ZoomMax),round(tailleY*HauteurCell/ZoomMax),TailleX,TailleY); x0:=0;y0:=0; // pour les signaux directionnels if orientation=3 then //D begin if aspect=9 then begin x0:=round(10*frX); y0:=HauteurCell-round(tailleX*frY);end; if aspect=7 then begin x0:=round(10*frX); y0:=HauteurCell-round(tailleX*frY);end; if aspect=5 then begin x0:=0; y0:=round((tailleX/2)*frY);end; if aspect=4 then begin x0:=0; y0:=round((tailleX/2)*frY);end; if aspect=3 then begin x0:=0; y0:=round((tailleX/2)*frY);end; if aspect=2 then begin x0:=0; y0:=round((tailleX/2)*frY);end; end; // décalage en X pour mettre la tete du signal alignée sur le bord droit de la cellule pour les signaux tournés à 90G if orientation=2 then begin if aspect=9 then begin x0:=round(10*frX); y0:=HauteurCell-round(tailleX*frY);end; if aspect=7 then begin x0:=round(10*frX); y0:=HauteurCell-round(tailleX*frY);end; if aspect=5 then begin x0:=round(10*frX); y0:=round((tailleX/2)*frY);end; if aspect=4 then begin x0:=round(10*frX); y0:=round((tailleX/2)*frY);end; if aspect=3 then begin x0:=round(8*frX); y0:=round((tailleX/2)*frY);end; if aspect=2 then begin x0:=round(10*frX); y0:=round((tailleX/2)*frY);end; end; // décalage en X pour rapprocher le signal du le bord droit de la cellule pour les feux verticaux if orientation=1 then begin if aspect=9 then begin x0:=0; y0:=0; end; if aspect=7 then begin x0:=0; y0:=0; end; if aspect=5 then begin x0:=round(13*frx); y0:=0;end; if aspect=4 then begin x0:=round(13*frx); y0:=0;end; if aspect=3 then begin x0:=round(13*frx); y0:=0;end; if aspect=2 then begin x0:=round(13*frx); y0:=0;end; end; x0:=x0+xp;y0:=y0+yp; tco[x,y].x:=x0; tco[x,y].y:=y0; // affichage du signal et du pied - orientation verticale if (Orientation=1) then begin // copie avec mise à l'échelle de l'image du signal TransparentBlt(canvasDest.Handle,x0,y0,round(TailleX*frX),round(TailleY*frY), ImageFeu.Canvas.Handle,0,0,TailleX,TailleY,clBlue); PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. case aspect of 9 : affiche_pied_Vertical9G(x0,y0,frX,frY,piedFeu); 7 : affiche_pied_Vertical7G(x0,y0,frX,frY,piedFeu); 5 : affiche_pied_Vertical5G(x0,y0,frX,frY,piedFeu); 4 : affiche_pied_Vertical4G(x0,y0,frX,frY,piedFeu); 3 : affiche_pied_Vertical3G(x0,y0,frX,frY,PiedFeu); 2 : affiche_pied_Vertical2G(x0,y0,frX,frY,PiedFeu); end; end; // affichage du feu et du pieds - orientation 90°G if Orientation=2 then begin Feu_90G(ImageFeu,x0,y0,frX,frY); // ici on passe l'origine du signal // dessiner le pied case aspect of 9 : affiche_pied9G_90G(x0,y0,frX,frY,piedFeu); 7 : affiche_pied7G_90G(x0,y0,frX,frY,piedFeu); 5 : affiche_pied5G_90G(x0,y0,frX,frY,piedFeu); 4 : affiche_pied4G_90G(x0,y0,frX,frY,piedFeu); 3 : affiche_pied3G_90G(x0,y0,frX,frY,piedFeu); 2 : affiche_pied2G_90G(x0,y0,frX,frY,piedFeu); end; end; // affichage du signal et du pied - orientation 90°D if Orientation=3 then begin Feu_90D(ImageFeu,x0,y0,frX,frY); // dessiner le pied case aspect of 9 : affiche_pied9G_90D(x0,y0,frX,frY,piedFeu); 7 : affiche_pied7G_90D(x0,y0,frX,frY,piedFeu); 5 : affiche_pied5G_90D(x0,y0,frX,frY,piedFeu); 4 : affiche_pied4G_90D(x0,y0,frX,frY,piedFeu); 3 : affiche_pied3G_90D(x0,y0,frX,frY,PiedFeu); 2 : affiche_pied2G_90D(x0,y0,frX,frY,PiedFeu); end; end; // allumage des feux du signal ----------------- dessine_feu_mx(canvasDest,x0,y0,frX,frY,adresse,orientation); end; function style(s : string) : TfontStyles; var fs : tFontStyles; begin fs:=[]; if pos('G',s)<>0 then fs:=fs+[fsbold]; if pos('I',s)<>0 then fs:=fs+[fsItalic]; if pos('S',s)<>0 then fs:=fs+[fsUnderline]; if pos('B',s)<>0 then fs:=fs+[fsStrikeout]; style:=fs; 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(x,y : integer); var i,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied : integer; s : string; begin //if tco[x,y].BImage=0 then exit; //Affiche('Affiche_cellule',clLime); PcanvasTCO.pen.Mode:=PmCopy; //pcanvasTCO.Brush.Style:=BsClear; adresse:=tco[x,y].Adresse; BImage:=tco[x,y].BImage; mode:=tco[x,y].mode; repr:=tco[x,y].repr; Xorg:=(x-1)*LargeurCell; Yorg:=(y-1)*HauteurCell; // ------------- affichage de l'adresse ------------------ s:=IntToSTR(adresse); // affiche d'abord l'icone de la cellule et colore la voie si zone ou détecteur actionnée selon valeur mode case Bimage of // 0 : efface_cellule(PCanvasTCO,x,y,pmcopy); 1 : dessin_voie(PCanvasTCO,X,Y,mode); 2 : dessin_2(PCanvasTCO,X,Y,mode); 3 : dessin_3(PCanvasTCO,X,Y,mode); 4 : dessin_4(PCanvasTCO,X,Y,Mode); 5 : dessin_5(PCanvasTCO,X,Y,Mode); 6 : dessin_6(PCanvasTCO,X,Y,Mode); 7 : dessin_7(PCanvasTCO,X,Y,Mode); 8 : dessin_8(PCanvasTCO,X,Y,Mode); 9 : dessin_9(PCanvasTCO,X,Y,mode); 10 : dessin_10(PCanvasTCO,X,Y,mode); 11 : dessin_11(PCanvasTCO,X,Y,mode); 12 : dessin_12(PCanvasTCO,X,Y,mode); 13 : dessin_13(PCanvasTCO,X,Y,mode); 14 : dessin_14(PCanvasTCO,X,Y,mode); 15 : dessin_15(PCanvasTCO,X,Y,mode); 16 : dessin_16(PCanvasTCO,X,Y,mode); 17 : dessin_17(PCanvasTCO,X,Y,mode); 18 : dessin_18(PCanvasTCO,X,Y,mode); 19 : dessin_19(PCanvasTCO,X,Y,mode); 20 : dessin_20(PCanvasTCO,X,Y,mode); 21 : dessin_21(PCanvasTCO,X,Y,mode); 22 : dessin_22(PCanvasTCO,X,Y,mode); 23,31 : dessin_31(PCanvasTCO,X,Y,mode); 24 : dessin_24(PCanvasTCO,X,Y,mode); 25 : dessin_25(PCanvasTCO,X,Y,mode); 30 : dessin_feu(PCanvasTCO,X,Y); end; PCanvasTCO.font.Size:=(LargeurCell div 10)+4 ; //Affiche(intToSTR( (LargeurCell div 30)+6),clyellow); // affiche le texte des aiguillages 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) or (BImage=25)) and (adresse<>0) then begin if adresse<>0 then s:='A'+s else s:=' '; with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; //Brush.Style:=Bsclear; Font.Color:=tco[x,y].coulFonte; Font.Name:='Arial'; Font.Style:=style(tco[x,y].FontStyle); xt:=0;yt:=0; if Bimage=2 then begin xt:=3;yt:=1;end; if Bimage=3 then begin xt:=3;yt:=HauteurCell-round(20*fryGlob);end; if Bimage=4 then begin xt:=3;yt:=1;end; if Bimage=5 then begin xt:=3;yt:=HauteurCell-round(20*fryGlob);end; if Bimage=12 then begin xt:=1;yt:=HauteurCell-round(15*frYGlob);end; if Bimage=13 then begin xt:=LargeurCell-round(30*frXGlob);yt:=HauteurCell-round(15*frYGlob);end; if Bimage=14 then begin xt:=LargeurCell-round(30*frXGlob);yt:=1;end; if Bimage=15 then begin xt:=3;yt:=1;end; if Bimage=21 then begin xt:=3;yt:=1;end; if Bimage=22 then begin xt:=3;yt:=HauteurCell-round(15*frYGlob);end; if Bimage=24 then begin xt:=LargeurCell-round(20*frXGlob);yt:=HauteurCell-round(15*frYGlob);end; if Bimage=25 then begin xt:=1;yt:=HauteurCell-round(15*frYGlob);end; TextOut(xOrg+xt,yOrg+yt,s); end; end; // détecteurs voie horizontale if ((BImage=1) ) and (adresse<>0) then begin // Adresse de l'élément if repr<>0 then with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; Font.Color:=tco[x,y].coulFonte; Font.Name:='Arial'; Font.Style:=style(tco[x,y].FontStyle); xt:=round(15*frXGlob); case repr of 1 : yt:=(HauteurCell div 2)-round(7*fryGlob); // milieu 2 : yt:=1; // haut 3 : yt:=HauteurCell-round(17*frYGlob); // bas end; TextOut(xOrg+xt,Yorg+yt,s); // affiche/efface le nom du train du détecteur s:=' '; case repr of 1,3 : yt:=1; // haut 2 : yt:=HauteurCell-round(17*frYGlob); // bas end; i:=detecteur[adresse].AdrTrain; if i<>0 then begin i:=index_train_adresse(i); if i<>0 then s:=trains[i].nom_train; end; PCanvasTCO.font.Size:=(LargeurCell div 13)+4 ; TextOut(xOrg,Yorg+yt,s+' '); end; end; // autres détecteurs if ((Bimage=7) or (Bimage=8) or (Bimage=9) or (Bimage=10) or (Bimage=17) or (Bimage=20)) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; Font.Name:='Arial'; Font.Style:=style(tco[x,y].FontStyle); Font.Color:=tco[x,y].coulFonte; TextOut(xOrg+round(2*frXGlob),yOrg+round(2*fryGlob),s); end; end; // autres détecteurs if (Bimage=18) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; Font.Name:='Arial'; Font.Style:=style(tco[x,y].FontStyle); Font.Color:=tco[x,y].coulFonte; TextOut(xOrg+round(20*frXGlob),yOrg+HauteurCell-round(14*frYGlob),s); end; end; // autres détecteurs if ((Bimage=6) or (Bimage=11) or (Bimage=16)) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; Font.Color:=tco[x,y].coulFonte;; Font.Style:=style(tco[x,y].FontStyle); Font.Name:='Arial'; TextOut(xOrg+round(28*frXGlob),yOrg+round(2*fryGlob),s); //exit; end; end; // adresse des signaux if (BImage=30) and (adresse<>0) then begin aspect:=feux[index_feu(adresse)].Aspect; oriente:=TCO[x,y].FeuOriente; pied:=TCO[x,y].PiedFeu; xt:=0;yt:=0; if (aspect=9) and (Oriente=1) then begin xt:=LargeurCell-round(25*frXGlob);yt:=2*HauteurCell-round(25*fryGlob);end; if (aspect=9) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=HauteurCell-round(17*frYGlob);end; // orientation G if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell+round(25*frXglob);yt:=1;end; if (aspect=7) and (Oriente=1) then begin xt:=LargeurCell-round(25*frXGlob);yt:=HauteurCell;end; if (aspect=7) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=HauteurCell-round(15*frYGlob);end; if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell+2;yt:=1;end; if (aspect=5) and (Oriente=1) then begin xt:=round(10*frXGlob);yt:=HauteurCell+round(25*fryGlob);end; if (aspect=5) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=HauteurCell ;end; if (aspect=5) and (Oriente=3) then begin xt:=round(10*frXGlob);yt:=-round(14*frYGlob);end; if (aspect=4) and (Oriente=1) then begin xt:=1;yt:=HauteurCell+round(20*fryGlob);end; if (aspect=4) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=HauteurCell;end; if (aspect=4) and (Oriente=3) then begin xt:=round(10*frXGlob);yt:=-round(14*frYGlob);end; if (aspect=3) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frXglob);yt:=1;end; // signal à droite if (aspect=3) and (Oriente=1) and (pied=1) then begin xt:=round(45*frXglob);yt:=1;end; // signal à gauche if (aspect=3) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=-round(14*frYGlob);end; if (aspect=3) and (Oriente=3) then begin xt:=round(10*frXGlob);yt:=HauteurCell;end; if (aspect=2) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frXglob);yt:=1;end; // signal à droite if (aspect=2) and (Oriente=1) and (pied=1) then begin xt:=round(45*frXglob);yt:=1;end; // signal à gauche if (aspect=2) and (Oriente=2) then begin xt:=round(10*frXGlob);yt:=HauteurCell;end; // orientation G if (aspect=2) and (Oriente=3) then begin xt:=round(10*frXGlob);yt:=HauteurCell;end; // orientation D if (aspect>10) and (oriente=1) then begin xt:=1;yt:=HauteurCell-round(14*frYGlob);end; if (aspect>10) and (oriente=2) then begin xt:=LargeurCell-round(15*frXGlob);yt:=0;end; if (aspect>10) and (oriente=3) then begin xt:=LargeurCell-round(15*frXGlob);yt:=0;end; with PCanvasTCO do begin Brush.Color:=tco[x,y].CouleurFond; Font.Color:=tco[x,y].coulFonte; Font.Style:=style(tco[x,y].FontStyle); Font.Name:='Arial'; TextOut(xOrg+xt,yOrg+yt,s); end; end; entoure_cell_grille(x,y); //canvasTCO.TextOut(xOrg+1,yOrg+1,IntToSTR(x)); end; procedure Entoure_cell(x,y : integer); var r : Trect; x0,y0 : integer; begin x0:=(x-1)*LargeurCell+1; y0:=(y-1)*HauteurCell+1; with PcanvasTCO do begin Pen.width:=3; Pen.Color:=clyellow; Brush.Color:=clBlack; Brush.Style:=bsSolid; Pen.Mode:=PmXor; r:=Rect(x0,y0,x0+largeurCell,y0+HauteurCell); Rectangle(r); Pen.width:=1; Pen.Mode:=PmCopy; end; end; procedure efface_entoure; begin if (entoure) then begin Entoure_cell(Xentoure,Yentoure); entoure:=false; end end; procedure _entoure_cell_clic; begin if not(entoure) then begin Entoure_cell(XclicCell,YclicCell); Xentoure:=XClicCell;Yentoure:=YclicCell; entoure:=true; end else begin Entoure_cell(Xentoure,Yentoure); // efface l'ancien // si on clique sur le même on l'efface sans afficher un nouveau if (Xentoure<>XclicCell) or (Yentoure<>YClicCell) then begin Entoure_cell(XclicCell,YclicCell); end else entoure:=false; Xentoure:=XClicCell;Yentoure:=YclicCell; end; end; procedure affiche_texte(x,y : integer); var x0,y0,yt,repr : integer; ss,s : string; begin x0:=(x-1)*Largeurcell; y0:=(y-1)*hauteurcell; //PCanvasTCO.Brush.Style:=bsSolid; if (TCO[x,y].BImage=23) or (TCO[x,y].BImage=31) then PCanvasTCO.Brush.Color:=clQuai else PCanvasTCO.Brush.Color:=tco[x,y].CouleurFond; //PCanvasTCO.pen.color:=clyellow; PcanvasTCO.Font.Color:=tco[x,y].CoulFonte; ss:=tco[x,y].fonte; if ss='' then ss:='Arial'; PcanvasTCO.Font.Name:=ss; ss:=tco[x,y].FontStyle; PcanvasTCO.Font.Style:=style(ss); repr:=tco[x,y].repr; taillefonte:=tco[x,y].TailleFonte; case repr of 0,1 : yt:=(HauteurCell div 2)-round(tailleFonte*fryGlob); // milieu 2 : yt:=1; // haut 3 : yt:=HauteurCell-round(2*TailleFonte*frYGlob); // bas end; if taillefonte=0 then taillefonte:=8; PCanvasTCO.font.Size:=(taillefonte*LargeurCell) div 40; s:=tco[x,y].Texte+' '; PcanvasTCO.Textout(x0+2,y0+yt,s); end; // affiche le tco suivant le tableau TCO procedure Affiche_TCO ; var x,y,x1,y1,x2,y2,DimX,DimY : integer; s : string; r : Trect; coul : tcolor; begin if affevt then affiche('Affiche_tco',clLime); if pImageTCO=nil then exit; DimX:=LargeurCell*NbreCellX; DimY:=HauteurCell*NbreCellY; // DimX DimY maxi 8191 pixels pour les bitmap if (dimX>8192) then begin Affiche('Espace TCO X trop grand',clred); exit; end; if (dimY>8192) then begin Affiche('Espace TCO Y trop grand',clred); exit; end; PImageTCO.Height:=DimY; PImageTCO.Width:=DimX; PBitMapTCO.Height:=DimY; PBitMapTCO.Width:=DimX; //PScrollBoxTCO.HorzScrollBar.Range:=DimX; //PScrollBoxTCO. with formTCO.ScrollBox do begin HorzScrollBar.Range:=DimX; HorzScrollBar.Tracking:=true; HorzScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si onclique sur la trackbar!! VertScrollBar.Range:=DimY; VertScrollBar.Tracking:=true; VertScrollBar.Smooth:=false; end; //formTCO.ScrollBox.Width:=DimX; calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); //Affiche(formatfloat('0.000000',frxGlob),clyellow); //effacer tout with PcanvasTCO do begin Pen.width:=1; Brush.Style:=bsSolid; pen.color:=clyellow; for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin x1:=(x-1)*largeurCell; y1:=(y-1)*hauteurCell; brush.Color:=TCO[x,y].CouleurFond; r:=rect(x1,y1,x1+LargeurCell,y1+HauteurCell); FillRect(r); end; end; //afficher les cellules sauf les signaux for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin if TCO[x,y].BImage<>30 then begin affiche_cellule(x,y); end; end; //afficher les cellules des signaux et les textes pour que les pieds recouvrent le reste et afficher les textes for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin if TCO[x,y].BImage=30 then begin affiche_cellule(x,y); end; s:=Tco[x,y].Texte; if s<>'' then Affiche_texte(x,y); end; if entoure then begin Entoure_cell(Xentoure,Yentoure); end; end; procedure grise_ligne_tco; var x : integer; begin for x:=1 to NbreCellX do begin Affiche_Cellule(x,YClicCell); end; end; procedure TFormTCO.FormCreate(Sender: TObject); begin if affevt then Affiche('FormTCO create',clyellow); if debug=1 then Affiche('Création fenêtre TCO',clLime); offsetSourisY:=-10; offsetSourisX:=-10; caption:='TCO'; AvecGrille:=true; TCO_modifie:=false; rangUndo:=1; XclicCell:=1; YclicCell:=1; xCoupe:=0;yCoupe:=0; indexTrace:=0; KeyPreview:=true; // valide les évènements clavier TrackBarZoom.Tabstop:=false; // permet d'avoir les evts curseurs Buttonredessine.TabStop:=false; ButtonSauveTCO.TabStop:=false; ButtonConfigTCO.TabStop:=false; Buttonmasquer.TabStop:=false; ButtonRaz.TabStop:=false; ButtonDessiner.TabStop:=false; Clfond:=$202050; couleurAdresse:=Cyan; xMiniSel:=99999;yMiniSel:=99999; xMaxiSel:=0;yMaxiSel:=0; SelectionAffichee:=false; ImageTCO.Canvas.font.Name:='Arial'; clAllume:=clYellow; clVoies:=clOrange; clTexte:=ClLime; clGrille:=$404040; // évite le clignotement pendant les affichages mais ne marche pas //DoubleBuffered:=true; comborepr.Enabled:=false; // pour imageTCO incluse dans la scollbox: mettre autosize à true, et ne pas mettre align à alclient. // c'est pour éviter le clignotement lors du glisser déposer des icones. with imageTCO do begin AutoSize:=true; align:=alNone; Top:=0; Left:=0; end; VBm:=TbitMap.Create; // masque Vbm.Width:=100; Vbm.Height:=100; oldbmp:=Tbitmap.Create; oldbmp.width:=100; oldbmp.Height:=100; modeTrace:=false; // pour tracer les voies à la souris //controlStyle:=controlStyle+[csOpaque]; TCOCree:=true; if debug=1 then Affiche('Fin création fenêtre TCO',clLime); end; // trouve le détecteur det dans le TCO et renvoie x et y // si on le trouve pas, renvoie x=0,y=0 procedure trouve_det(det : integer;var x,y : integer); var xc,yc : integer; trouve : boolean; begin yc:=1; repeat xc:=0; repeat inc(xc); trouve:=tco[xc,yc].Adresse=det; until (xc=NbreCellX) or trouve; inc(yc); until (yc=NbreCellY) or trouve; dec(yc); if trouve then begin x:=xc; y:=yc; end else begin x:=0; y:=0; end; end; procedure Erreur_TCO(x,y : integer); var s : string; i,adresse : integer; begin s:='Erreur TCO: '; adresse:=tco[x,y].Adresse; i:=index_aig(adresse); if i=0 then s:=s+'aiguillage '+intToSTR(adresse)+' inconnu'; if i<>0 then s:=s+'position aiguillage '+intToSTR(adresse)+' inconnue'; Affiche(s,clred); end; // allume ou éteint (mode=0 ou 1) la voie, zone de det1 à det2 sur le TCO // si mode=0 : éteint // =1 : couleur détecteur allumé // =2 : couleur de l'index train procedure zone_TCO(det1,det2,mode: integer); var direction,i,j,x,y,xn,yn,ancienY,ancienX,Xdet1,Ydet1,Xdet2,Ydet2,Bimage,adresse, pos,pos2,ir,ax,ay,sx,sy: integer; memtrouve,sortir,horz,diag : boolean; mdl : Tequipement; s : string; begin // trouver le détecteur det1 if debugTCO then AfficheDebug('Zone_TCO det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' mode='+intToSTR(mode)+' couleur='+intToSTR(index_couleur),clyellow); trouve_det(det1,Xdet1,Ydet1); if (Xdet1=0) or (Ydet1=0) then exit; trouve_det(det2,Xdet2,Ydet2); if (Xdet2=0) or (Ydet2=0) then exit; // inverser coordonnées des détecteurs si à l'envers en X if debugTCO then begin AfficheDebug('trouvé '+intToSTR(det1)+' en '+IntToSTR(xDet1)+'/'+intToSTR(ydet1),clyellow); AfficheDebug('trouvé '+intToSTR(det2)+' en '+IntToSTR(xDet2)+'/'+intToSTR(ydet2),clyellow); end; memtrouve:=false; Direction:=1; repeat // boucle de test de direction sortir:=false; x:=xDet1;y:=Ydet1; xn:=x;yn:=y; ir:=1; // index de la route du tco i:=0; if debugTCO then afficheDebug('Direction '+intToSTR(direction),clOrange); if direction=1 then begin // commencer par descendre et à droite ancieny:=ydet1+1; ancienx:=xdet1+1; end; if direction=2 then begin // commencer par monter et à gauche ancieny:=ydet1-1; ancienx:=xdet1-1; end; if direction=3 then begin // commencer par descendre et à droite ancieny:=ydet1+1; ancienx:=xdet1+1; end; if direction=4 then begin // commencer par monter et à droite ancieny:=ydet1-1; ancienx:=xdet1+1; end; // boucle de remplissage du tableau routeTCO de det1 à det2 repeat routeTCO[ir].x:=x; routeTCO[ir].y:=y; if ir<500 then inc(ir); if debugTCO then AfficheDebug('X='+intToSTR(x)+' Y='+IntToSTR(Y)+' AncienX='+intToSTR(ancienX)+' AncienY='+IntToSTR(ancienY),clyellow); // Affiche la cellule en fonction du mode adresse:=TCO[x,y].Adresse ; Bimage:=TCO[x,y].Bimage; // vers case suivante: trouver le trajet pour rejoindre det1 à det2 case Bimage of // voie 1 : begin if debugTCO then begin s:='El 1';if adresse<>0 then s:=s+'adr='+intToStr(adresse); AfficheDebug(s,clyellow); end; if ancienXx) and (ancienY=Y) then begin xn:=x-1;if pos=const_devie then yn:=y+1;end; if (ancienXy) then xn:=x+1; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; 3 : begin //if debugTCO then AfficheDebug('El 3',clyellow); pos:=positionTCO(x,y); if (ancienXx) and (ancienY=Y) then xn:=x-1; if (ancienX>x) and (ancienYx) and (ancienY=Y) then xn:=x-1; if (ancienX>x) and (ancienY>y) then xn:=x-1; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; 5 : begin //if debugTCO then AfficheDebug('El 5',clyellow); pos:=positionTCO(x,y); if (ancienXx) and (ancienY=Y) then begin xn:=x-1;if pos=const_devie then yn:=y-1;end; if (ancienXx) and (ancienY=Y) then begin xn:=x-1;yn:=y-1;end; if (ancienX>x) and (ancienY>y) then begin xn:=x-1;yn:=y-1;end; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; 13 : begin //if debugTCO then AfficheDebug('El 13',clyellow); pos:=positionTCO(x,y); if (ancienXx) and (ancienYy) then begin xn:=x+1;yn:=y-1;end; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; 14 : begin //if debugTCO then AfficheDebug('El 14',clyellow); pos:=positionTCO(x,y); if (ancienXx) and (ancienY>y) then begin xn:=x-1;if pos=const_droit then yn:=y-1;end; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; 15 : begin //if debugTCO then AfficheDebug('El 15',clyellow); pos:=positionTCO(x,y); if (ancienXY) then begin xn:=x+1;if pos=const_droit then yn:=y-1;end; if (ancienX>x) and (ancienYx) and (ancienY=y) then begin xn:=x-1;yn:=y+1;end; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; end; 16 : if ancienX0 then begin j:=Index_Aig(adresse); mdl:=aiguillage[j].modele; if (mdl=tjs) or (mdl=tjd) then begin // tjd ou tjs pos:=aiguillage[j].position; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; if (mdl=tjd) or (mdl=tjs) and (aiguillage[j].EtatTJD=4) then begin j:=Index_Aig(aiguillage[j].Ddroit); pos2:=aiguillage[j].position; // 2eme adresse de la TJD if (pos2=const_inconnu) then begin Erreur_TCO(x,y);exit;end; if (pos=const_droit) and (pos2=const_droit) then begin if ancienXx) and (ancienY=Y) then xn:=x-1; if (ancienXY) then begin xn:=x+1;yn:=y-1;end; if (ancienX>x) and (ancienY0 then begin j:=Index_Aig(adresse); mdl:=aiguillage[j].modele; // tjd ou tjs if (mdl=tjd) or (mdl=tjs) then begin pos:=aiguillage[j].position; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; if (mdl=tjd) or (mdl=tjs) and (aiguillage[j].EtatTJD=4) then begin j:=Index_Aig(aiguillage[j].Ddroit); pos2:=aiguillage[j].position; // 2eme adresse de la TJD if (pos2=const_inconnu) then begin Erreur_TCO(x,y);exit;end; if (pos=const_droit) and (pos2=const_droit) then begin if ancienXx) and (ancienY=Y) then xn:=x-1; if (ancienX>x) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; if (ancienXy) and (ancienX=x) then begin yn:=y-1;if pos=const_devie then xn:=x-1 else xn:=x; end; // on vient d'en haut if (ancienY0 then begin j:=Index_Aig(adresse); mdl:=aiguillage[j].modele; // tjd ou tjs if (mdl=tjd) or (mdl=tjs) then begin pos:=aiguillage[j].position; if (pos=const_inconnu) then begin Erreur_TCO(x,y);exit;end; if (mdl=tjd) or (mdl=tjs) and (aiguillage[j].EtatTJD=4) then begin j:=Index_Aig(aiguillage[j].Ddroit); pos2:=aiguillage[j].position; // 2eme adresse de la TJD if (pos2=const_inconnu) then begin Erreur_TCO(x,y);exit;end; if (pos=const_droit) and (pos2=const_droit) then begin if ancienXx) and (ancienY>Y) then begin xn:=x-1;yn:=yn-1;end; if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; end; end else begin // fausse route, sortir //if DebugTCO then // AfficheDebug('Sortie de calcul route TCO par élement '+intToSTR(Bimage)+' inconnu en x='+intToSTR(x)+' y='+intToSTR(y)+' sur route '+intToSTR(det1)+' à '+intToSTR(det2),clOrange); sortir:=true; end; end; inc(i); if adresse=det2 then memTrouve:=true; ancienX:=X; ancienY:=y; x:=xn; y:=yn; until (memTrouve) or (i>NbCellulesTCO) or (x>NbreCellX) or (y>NbreCellY) or (x=0) or (y=0) or sortir; inc(direction) until (direction=5) or memtrouve ; //Affiche(intToSTR(x),clLime); if i>NbCellulesTCO then begin // fausse route, sortir if DebugTCO then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); exit; end; if not(MemTrouve) then begin if DebugTCO then AfficheDebug('Pas de liaison entre '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); exit; end; dec(ir); // et affichage de la route for i:=1 to ir do begin x:=routeTCO[i].x; y:=routeTCO[i].y; Tco[x,y].mode:=mode; //Affiche(intToSTR(x)+' '+intToSTR(y),clorange); bimage:=TCO[x,y].BImage; adresse:=TCO[x,y].Adresse; tco[x,y].trajet:=0; // croisement if (bimage=21) and (i>1) then begin j:=index_aig(adresse); mdl:=aiguillage[j].modele; ax:=routeTCO[i-1].x; ay:=routeTCO[i-1].y; sx:=routeTCO[i+1].x; // suivant sy:=routeTCO[i+1].y; if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[x,y].trajet:=1; // de gauche à droite if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=0) then tco[x,y].trajet:=1; // de droite à gauche if (ax-x=-1) and (ay-y=1) and (sx-x=1) and (sy-y=-1) then tco[x,y].trajet:=2; // de bas gauche vers haut droit if (ax-x=1) and (ay-y=-1) and (sx-x=-1) and (sy-y=1) then tco[x,y].trajet:=2; // de haut droit vers bas gauche if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=-1) then tco[x,y].trajet:=4; // de gauche vers haut droite if (ax-x=1) and (ay-y=-1) and (sx-x=-1) and (sy-y=0) then tco[x,y].trajet:=4; // de haut droite vers gauche if (ax-x=-1) and (ay-y=1) and (sx-x=1) and (sy-y=0) then tco[x,y].trajet:=3; // de bas gauche vers droite if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=1) then tco[x,y].trajet:=3; // de gauche vers haut droite if tco[x,y].trajet=0 then affiche('Erreur 50 TCO',clred); end; // croisement if (bimage=22) and (i>1) then begin j:=index_aig(adresse); mdl:=aiguillage[j].modele; ax:=routeTCO[i-1].x; // précédent ay:=routeTCO[i-1].y; sx:=routeTCO[i+1].x; // suivant sy:=routeTCO[i+1].y; if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[x,y].trajet:=1; // de gauche à droite if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=0) then tco[x,y].trajet:=1; // de droite à gauche if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[x,y].trajet:=2; // de haut gauche vers bas droit if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[x,y].trajet:=2; // de bas droit vers haut gauche if (ax-x=1) and (ay-y=0) and (sx-x=-1) and (sy-y=-1) then tco[x,y].trajet:=3; // de droit vers en haut à gauche if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=0) then tco[x,y].trajet:=3; // de haut à gauche vers droit if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=0) then tco[x,y].trajet:=4; // de bas à droite vers gauche if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=1) then tco[x,y].trajet:=4; // de gauche vers en bas a droite if tco[x,y].trajet=0 then affiche('Erreur 51 TCO',clred); end; // croisement if (bimage=25) and (i>1) then begin j:=index_aig(adresse); mdl:=aiguillage[j].modele; ax:=routeTCO[i-1].x; // précédent ay:=routeTCO[i-1].y; sx:=routeTCO[i+1].x; // suivant sy:=routeTCO[i+1].y; if (ax-x=0) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[x,y].trajet:=1; // de haut à bas if (ax-x=0) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[x,y].trajet:=1; // de bas à haut if (ax-x=-1) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[x,y].trajet:=2; // de haut gauche vers bas droit if (ax-x=1) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[x,y].trajet:=2; // de bas droit vers haut gauche if (ax-x=-1) and (ay-y=1) and (sx-x=0) and (sy-y=1) then tco[x,y].trajet:=3; // de haut gauche vers bas if (ax-x=0) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[x,y].trajet:=3; // de bas vers haut gauche if (ax-x=0) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[x,y].trajet:=4; // de haut vers bas droite if (ax-x=-1) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[x,y].trajet:=4; // de bas droit vers haut if tco[x,y].trajet=0 then affiche('Erreur 52 TCO',clred); end; Affiche_cellule(x,y); end; end; procedure dessine_icones; var w,h,ancH,ancW : integer; begin with formTCO do begin ancw:=LargeurCell; AncH:=hauteurCell; HauteurCell:=ImagePalette1.Height; LargeurCell:=ImagePalette1.Width; // dessiner les icônes epaisseur:=5; // effacer le fond des icones w:=ImagePalette1.width; h:=ImagePalette1.height; with ImagePalette1.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette2.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette3.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette4.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette5.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette6.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette7.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette8.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette9.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette10.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette11.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette12.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette13.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette14.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette15.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette16.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette17.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette18.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette19.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette20.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette21.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette22.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette24.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette25.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; with ImagePalette31.Canvas do begin Pen.Color:=clFond; Brush.color:=clFond; Rectangle(0,0,w,h); end; dessin_5(ImagePalette5.Canvas,1,1,0); //posX,posY,état,position dessin_2(ImagePalette2.Canvas,1,1,0); dessin_3(ImagePalette3.Canvas,1,1,0); dessin_4(ImagePalette4.Canvas,1,1,0); dessin_voie(ImagePalette1.canvas,1,1,0); dessin_6(ImagePalette6.canvas,1,1,0); dessin_7(ImagePalette7.canvas,1,1,0); dessin_8(ImagePalette8.canvas,1,1,0); dessin_9(ImagePalette9.canvas,1,1,0); dessin_10(ImagePalette10.Canvas,1,1,0); dessin_11(ImagePalette11.Canvas,1,1,0); dessin_12(ImagePalette12.Canvas,1,1,0); dessin_13(ImagePalette13.Canvas,1,1,0); dessin_14(ImagePalette14.Canvas,1,1,0); dessin_15(ImagePalette15.Canvas,1,1,0); dessin_16(ImagePalette16.canvas,1,1,0); dessin_17(ImagePalette17.canvas,1,1,0); dessin_18(ImagePalette18.canvas,1,1,0); dessin_19(ImagePalette19.canvas,1,1,0); dessin_20(ImagePalette20.canvas,1,1,0); dessin_21(ImagePalette21.canvas,1,1,0); dessin_22(ImagePalette22.canvas,1,1,0); dessin_31(ImagePalette31.canvas,1,1,0); dessin_24(ImagePalette24.canvas,1,1,0); dessin_25(ImagePalette25.canvas,1,1,0); end; LargeurCell:=ancW; HauteurCell:=ancH; end; procedure TFormTCO.FormActivate(Sender: TObject); var s : string; begin if affevt then Affiche('Form TCO activate',clyellow); if not(Forminit) then begin FormInit:=true; Button1.Visible:=not(Diffusion); Button2.Visible:=not(Diffusion); ButtonCalibrage.Visible:=not(diffusion); ButtonSimu.Visible:=not(Diffusion); ImageTemp.Visible:=not(Diffusion); ImageTemp2.Visible:=not(Diffusion); ButtonTrajet.visible:=not(diffusion); SourisX.Visible:=not(Diffusion); SourisY.Visible:=not(Diffusion); ButtonAfficheBandeau.visible:=false; TrackBarZoom.Max:=ZoomMax; TrackBarZoom.Min:=ZoomMin; HauteurCell:=ImagePalette1.Height; LargeurCell:=ImagePalette1.Width; largeurCelld2:=largeurCell div 2;HauteurCelld2:=HauteurCell div 2; calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); dessine_icones; s:='Voie'; ImagePalette6.Hint:=s;ImagePalette6.ShowHint:=true; ImagePalette7.Hint:=s;ImagePalette7.ShowHint:=true; ImagePalette8.Hint:=s;ImagePalette8.ShowHint:=true; ImagePalette9.Hint:=s;ImagePalette9.ShowHint:=true; ImagePalette10.Hint:=s;ImagePalette10.ShowHint:=true; ImagePalette11.Hint:=s;ImagePalette11.ShowHint:=true; ImagePalette16.Hint:=s;ImagePalette16.ShowHint:=true; ImagePalette17.Hint:=s;ImagePalette17.ShowHint:=true; ImagePalette18.Hint:=s;ImagePalette18.ShowHint:=true; ImagePalette19.Hint:=s;ImagePalette19.ShowHint:=true; s:='Voie pouvant porter un détecteur'; ImagePalette1.Hint:=s;ImagePalette1.ShowHint:=true; ImagePalette20.Hint:=s;ImagePalette20.ShowHint:=true; s:='Aiguillage'; ImagePalette2.Hint:=s;ImagePalette2.ShowHint:=true; ImagePalette3.Hint:=s;ImagePalette3.ShowHint:=true; ImagePalette4.Hint:=s;ImagePalette4.ShowHint:=true; ImagePalette5.Hint:=s;ImagePalette5.ShowHint:=true; ImagePalette12.Hint:=s;ImagePalette12.ShowHint:=true; ImagePalette13.Hint:=s;ImagePalette13.ShowHint:=true; ImagePalette14.Hint:=s;ImagePalette14.ShowHint:=true; ImagePalette15.Hint:=s;ImagePalette15.ShowHint:=true; ImagePalette24.Hint:=s;ImagePalette24.ShowHint:=true; s:='Croisement ou TJD ou TJS'; ImagePalette21.Hint:=s;ImagePalette21.ShowHint:=true; ImagePalette22.Hint:=s;ImagePalette22.ShowHint:=true; ImagePalette25.Hint:=s;ImagePalette25.ShowHint:=true; NbCellulesTCO:=NbreCellX*NbreCellY; ImageTCO.Width:=LargeurCell*NbreCellX; ImageTCO.Height:=HauteurCell*NbreCellY; ImageTCO.Picture.Create; ImageTCO.Picture.Bitmap.Height:=HauteurCell*NbreCellY; ImageTCO.Picture.BitMap.Width:=LargeurCell*NbreCellX; PCanvasTCO:=FormTCO.ImageTCO.Picture.Bitmap.Canvas; PBitMapTCO:=FormTCO.ImageTCO.Picture.Bitmap; PImageTCO:=FormTCO.ImageTCO; PImageTemp:=FormTCO.ImageTemp; PImageTemp.Canvas.Rectangle(0,0,PImageTemp.Width,PimageTemp.Height); With ImagePalette30 do begin Picture.Bitmap.TransparentMode:=tmAuto; Picture.Bitmap.TransparentColor:=clblue; Transparent:=true; Picture.Bitmap:=Formprinc.Image9feux.Picture.Bitmap; end; //Affiche_tco par r trackBarZoom.Position:=(ZoomMax+Zoommin) div 2; ScrollBox.Width:=clientWidth-80; //ScrollBox.Width:=clientWidth-200; if MasqueBandeauTCO then begin ButtonAfficheBandeau.visible:=true; BandeauMasque:=true; Panel1.Hide; ScrollBox.Height:=ClientHeight-30; end else begin BandeauMasque:=false; Panel1.show; ScrollBox.Height:=ClientHeight-Panel1.Height-30; end; end; TCOActive:=true; end; // vérifie que les icones adjacentes sont cohérentes function verif_cellule(x,y,Bim : integer) : boolean; var res,verif : boolean; Bimz,i,bl : integer; begin result:=true; verif:=false; if (bim=23) or (bim>=30) or (AvecVerifIconesTCO=0) then exit; //exit; res:=true; bl:=liaisons[Bim]; for i:=0 to 7 do begin //Affiche(IntToHex(bl,2),clyellow); // NO if testbit(bl,i) then begin if (i=0) then begin if (x>1) and (y>1) then begin Bimz:=tco[x-1,y-1].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],4) ) then res:=false; end; if x>1 then begin Bimz:=tco[x-1,y].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],2) then res:=false; end; if y>1 then begin Bimz:=tco[x,y-1].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],6) then res:=false; end; if verif and not(res) then affiche('NO 0',clred); end; // N if (i=1) then begin if (y>1) then begin Bimz:=tco[x,y-1].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],5) ) then res:=false; end; if verif and not(res) then affiche('N 1',clred); end; // NE if (i=2) then begin if (x1) then begin Bimz:=tco[x+1,y-1].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],6) ) then res:=false; end; if (x=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],0) then res:=false; end; if (y>1) then begin Bimz:=tco[x,y-1].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],4) then res:=false; end; if verif and not(res) then affiche('NE 2',clred); end; // E if (i=3) then begin if (x=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],7) ) then res:=false; end; if verif and not(res) then affiche('E 3',clred); end; // SE if (i=4) then begin if (x=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],0) ) then res:=false; end; if (x=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],6) then res:=false; end; if (y=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],2) then res:=false; end; if verif and not(res) then affiche('SE 4',clred); end; // S if (i=5) then begin if (y=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],1) ) then res:=false; end; if verif and not(res) then affiche('S 5',clred); end; // SO if (i=6) then begin if (x>1) and (y=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],2) ) then res:=false; end; if x>1 then begin Bimz:=tco[x-1,y].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],4) then res:=false; end; if (y=1) and (bimz<=25) and (bimz<>23) and testbit(liaisons[bimZ],0) then res:=false; end; if verif and not(res) then affiche('SO 6',clred); end; // O if (i=7) then begin if (x>1) then begin Bimz:=tco[x-1,y].BImage; if (bimz>=1) and (bimz<=25) and (bimz<>23) and not( testbit(liaisons[bimZ],3) ) then res:=false; end; if verif and not(res) then affiche('O 7',clred); end; end; end; //if res=true then Affiche('oui',ClLime) else Affiche('non',clred); result:=res; end; procedure Annule; var x,y,xu,yu,Xplace,yplace,adresse,i : integer; begin if TamponAffecte then begin NbreCellX:=TamponTCO_org.NbreCellX; NbreCellY:=TamponTCO_org.NbreCellY; if (xCoupe<>0) and (ycoupe<>0) then begin for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do // rectangle de la sélection for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do begin xPlace:=xCoupe+x-TamponTCO_Org.x1; // destination yPlace:=yCoupe+y-TamponTCO_Org.y1; if (xPlace<=NbreCellX) and (yPlace<=NbreCellY) then begin tco[xPlace,yPlace]:=tamponTCO[x,y]; if tco[xPlace,yPlace].Bimage=30 then begin adresse:=tco[xPlace,yPlace].Adresse; end; end; end; end; Affiche_TCO; tamponaffecte:=false; exit; end; // restaure par le tampon undo le tracé if rangUndo>1 then begin dec(rangUndo); for i:=1 to undo[rangUndo].nombre do begin with undo[rangUndo].element[i] do begin xu:=x; yu:=y; if (xu<=NbreCellX) and (yu<=NbreCellY) then begin tco[xu,yu].BImage:=Bimage; tco[xu,yu].Texte:=texte; end; end; end; Affiche_tco; exit; end; end; procedure stop_modetrace; begin modetrace:=false; FormTCO.Caption:='TCO'; screen.cursor:=crDefault; modeTrace:=false; IndexTrace:=0; traceXY[1].x:=0;traceXY[1].y:=0; traceXY[2].x:=0;traceXY[2].y:=0; affiche_tco; if debugTCO then Affiche('------------',clYellow); FormTCO.Caption:='TCO'; screen.cursor:=crDefault; end; procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); var s,d : integer; procede : boolean; begin if affevt then Affiche('TCO.FormKeyDown',clOrange); procede:=false; //Affiche(intToSTR(key),clyellow); case Key of VK_right : if XClicCellFormTCO.ScrollBox.Width then scrollBox.HorzScrollBar.Position:=s+largeurCell; procede:=true; end else exit; VK_left : if XClicCell>1 then begin dec(XClicCell); d:=(xClicCell-1)*largeurCell; s:=scrollBox.HorzScrollBar.Position; if d<=s then begin s:=s-largeurCell; if sFormTCO.ScrollBox.Height then scrollBox.VertScrollBar.Position:=s+HauteurCell; procede:=true; end else exit; VK_up : if YClicCell>1 then begin dec(YClicCell); d:=(yClicCell-1)*HauteurCell; s:=scrollBox.VertScrollBar.Position; if d'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,5)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_5(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=5; // image 5 tco[XClicCell,YClicCell].liaisons:=liaisons[5]; tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette2EndDrag(Sender,Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,2)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=2; // image 2 tco[xClicCell,YClicCell].CoulFonte:=clYellow; dessin_2(ImageTCO.Canvas,XClicCell,YClicCell,0); tco[XClicCell,YClicCell].liaisons:=liaisons[2]; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette2); end; procedure TFormTCO.ImagePalette3EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,3)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; tco[xClicCell,YClicCell].CoulFonte:=clYellow; dessin_3(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=3; // image 3 tco[XClicCell,YClicCell].liaisons:=liaisons[3]; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette3); end; procedure TFormTCO.ImagePalette4EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,4)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_4(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=4; // image 4 tco[XClicCell,YClicCell].liaisons:=liaisons[4]; tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette4MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette4); end; procedure TFormTCO.ImagePalette5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette5); end; procedure TFormTCO.ImagePalette1EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(target=ImageTCO) then exit; if (x=0) and (y=0) then exit; drag:=false; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,1)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_voie(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=1; // image 1 tco[xClicCell,YClicCell].CoulFonte:=clYellow; tco[XClicCell,YClicCell].Adresse:=0; tco[XClicCell,YClicCell].liaisons:=liaisons[1]; EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette6EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,6)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_6(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=6; // image 6 tco[XClicCell,YClicCell].liaisons:=liaisons[6]; tco[XClicCell,YClicCell].Adresse:=0; tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette6MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette6); end; procedure TFormTCO.ImagePalette7EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,7)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_7(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=7; // image 7 tco[XClicCell,YClicCell].liaisons:=liaisons[7]; tco[XClicCell,YClicCell].Adresse:=0; tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette7MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette7); end; procedure TFormTCO.ImagePalette8EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,8)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true;; dessin_8(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=8; // image 8 tco[XClicCell,YClicCell].liaisons:=liaisons[8]; tco[XClicCell,YClicCell].Adresse:=0; tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette8); end; procedure TFormTCO.ImagePalette9MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette9); end; procedure TFormTCO.ImagePalette12MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette12); end; procedure TFormTCO.ImagePalette13MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette13); end; procedure TFormTCO.ImagePalette14MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette14); end; procedure TFormTCO.ImagePalette15MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette15); end; procedure TFormTCO.ImagePalette16MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette16); end; procedure TFormTCO.ImagePalette17MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette17); end; procedure TFormTCO.ImagePalette18MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette18); end; procedure TFormTCO.ImagePalette19MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette19); end; procedure TFormTCO.ImagePalette21MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette21); end; procedure TFormTCO.ImagePalette22MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette22); end; procedure TFormTCO.ImagePalette9EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,9)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_9(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=9; // image 9 tco[XClicCell,YClicCell].liaisons:=liaisons[9]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; entoure_cell_grille(XClicCell,YClicCell); _entoure_cell_clic; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette12EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,12)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_12(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=12; // image 12 tco[XClicCell,YClicCell].liaisons:=liaisons[12]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette13EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); imageTCO.repaint; efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,13)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_13(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=13; // image 13 tco[XClicCell,YClicCell].liaisons:=liaisons[13]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette14EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,14)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_14(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=14; // image 14 tco[XClicCell,YClicCell].liaisons:=liaisons[14]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette15EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,15)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_15(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=15; // image 15 tco[XClicCell,YClicCell].liaisons:=liaisons[15]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette16EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,16)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_16(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=16; // image 16 tco[XClicCell,YClicCell].liaisons:=liaisons[16]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette17EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,17)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_17(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=17; // image 17 tco[XClicCell,YClicCell].liaisons:=liaisons[17]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette18EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,18)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_18(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=18; // image 18 tco[XClicCell,YClicCell].liaisons:=liaisons[18]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette19EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,19)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_19(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=19; // image 19 tco[XClicCell,YClicCell].liaisons:=liaisons[19]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette21EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,21)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_21(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=21; tco[XClicCell,YClicCell].liaisons:=liaisons[21]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette22EndDrag(Sender, Target: TObject; X,Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,22)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_22(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=22; tco[XClicCell,YClicCell].liaisons:=liaisons[22]; tco[XClicCell,YClicCell].Adresse:=0; // rien tco[xClicCell,YClicCell].CoulFonte:=clYellow; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ButtonSauveTCOClick(Sender: TObject); begin sauve_fichier_tco; defocusControl(ButtonSauveTCO,true); end; procedure TFormTCO.MenuCollerClick(Sender: TObject); var x,y,xPlace,yPlace : integer; begin if TamponAffecte then begin for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do // rectangle de la sélection for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do begin xPlace:=XclicCell+x-TamponTCO_Org.x1; // destination yPlace:=YclicCell+y-TamponTCO_Org.y1; if (xPlace<=NbreCellX) and (yPlace<=NbreCellY) then tco[xPlace,yPlace]:=tamponTCO[x,y]; end; end; Affiche_TCO; TCO_modifie:=true; end; procedure copier; var x,y : integer; begin if SelectionAffichee then begin TamponTCO_org.NbreCellX:=NbreCellX; TamponTCO_org.NbreCellY:=NbreCellY; TamponTCO_Org.x1:=XminiSel div LargeurCell +1; TamponTCO_Org.x2:=XmaxiSel div LargeurCell +1; TamponTCO_Org.y1:=yminiSel div HauteurCell +1; TamponTCO_Org.y2:=ymaxiSel div HauteurCell +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[x,y]; TamponAffecte:=true; end; end; procedure TFormTCO.MenuCopierClick(Sender: TObject); begin copier; end; // supprimer la sélection procedure TFormTCO.MenuCouperClick(Sender: TObject); var x,y,XCell1,YCell1,xCell2,yCell2 : integer; begin TamponTCO_org.NbreCellX:=NbreCellX; TamponTCO_org.NbreCellY:=NbreCellY; // couper sans sélection : on coupe une seule cellule if not(SelectionAffichee) then begin tamponTCO[XclicCell,YclicCell]:=tco[XclicCell,YclicCell]; // pour pouvoir faire annuler couper TamponTCO_org.x1:=XclicCell;TamponTCO_org.y1:=YclicCell; TamponTCO_org.x2:=XclicCell;TamponTCO_org.y2:=YclicCell; tco[XclicCell,YClicCell].Adresse:=0; tco[XclicCell,YClicCell].Bimage:=0; tco[XclicCell,YClicCell].liaisons:=0; tco[XclicCell,YClicCell].Texte:=''; efface_entoure; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TamponAffecte:=true; xCoupe:=XclicCell;yCoupe:=YclicCell; Affiche_tco; exit; end; TCO_modifie:=true; copier; SelectionAffichee:=false; xCell1:=XminiSel div LargeurCell +1; xCell2:=XmaxiSel div LargeurCell +1; yCell1:=yminiSel div HauteurCell +1; yCell2:=ymaxiSel div HauteurCell +1; xCoupe:=XCell1;yCoupe:=yCell1; for y:=yCell1 to yCell2 do for x:=xCell1 to xCell2 do begin tco[x,y].Adresse:=0; tco[x,y].BImage:=0; tco[x,y].liaisons:=0; tco[x,y].Texte:=''; //Affiche('Efface cellules '+IntToSTR(X)+' '+intToSTR(y),clyellow); efface_entoure; efface_cellule(ImageTCO.Canvas,X,Y,PmCopy); if avecGrille then grille; end; end; procedure TFormTCO.AnnulercouperClick(Sender: TObject); begin Annule; end; // renvoie un élément du TCO par l'icone en fonction du tracé désiré 4 // exemple : deux lignes qui se croisent renvoie un croisement // el = élement à remplacer // Bim = élément d'origine // quadrant du tracé (1=N 2=NE 3=Est 4=SE ) // premier : si c'est le premier élément // dernier : si c'est le dernier élément function replace(x,y,el,quadrant : integer;premier,dernier : boolean) : integer; var bim,BimS : integer; begin if debugTCO then Affiche('Quadrant '+intToSTR(quadrant),clred); result:=0; bim:=tco[x,y].BImage; // élément d'origine case bim of 0 : result:=el; 1 : begin if quadrant=2 then begin if premier then begin if testbit(tco[x+1,y].liaisons,3) then result:=3 else result:=7; end; if dernier then begin if testbit(tco[x-1,y].liaisons,3) then result:=2 else result:=9; end; if not(premier) and not(dernier) then result:=21; end; if quadrant=4 then begin if dernier then begin if not(testbit(tco[x-1,y].liaisons,3)) then result:=6; if testbit(tco[x-1,y].liaisons,3) then result:=5; end; if premier then begin if testbit(tco[x+1,y].liaisons,7) then result:=4 ; if not(testbit(tco[x+1,y].liaisons,7)) then result:=8; end; if not(premier) and not(dernier) then begin if testbit(tco[x-1,y].liaisons,3) and testbit(tco[x+1,y].liaisons,7) then result:=22; if not(testbit(tco[x-1,y].liaisons,3)) and testbit(tco[x+1,y].liaisons,7) then result:=12; if not(testbit(tco[x+1,y].liaisons,7)) and testbit(tco[x-1,y].liaisons,3) then result:=14; end; end; if quadrant=3 then result:=1; end; 2 : begin if quadrant=2 then begin if premier then result:=21; if dernier then result:=2; if not(premier) and not(dernier) then result:=21; end; if quadrant=3 then result:=2; end; 3 : begin if quadrant=2 then begin if premier then result:=3; if dernier then result:=21; if not(premier) and not(dernier) then result:=21; end; if quadrant=3 then result:=3; end; 4 : begin if quadrant=4 then begin if premier then result:=4; if dernier then result:=22; if not(premier) and not(dernier) then result:=22; end; if quadrant=3 then result:=4; end; 5 : begin if quadrant=4 then begin if premier then result:=22; if dernier then result:=5; if not(premier) and not(dernier) then result:=22; end; if quadrant=3 then result:=5; end; 6 : begin if quadrant=3 then begin if premier then result:=6; if dernier then result:=5; if not(premier) and not(dernier) then result:=5; end; if quadrant=4 then begin if premier then result:=12; if dernier then result:=6; if not(premier) and not(dernier) then result:=12; end; end; 7 : begin if quadrant=3 then begin if premier then result:=3; if dernier then result:=7; if not(premier) and not(dernier) then result:=3; end; if quadrant=2 then begin if premier then result:=7; if dernier then result:=13; if not(premier) and not(dernier) then result:=13; end; end; 8 : begin if quadrant=3 then begin if premier then result:=4; if dernier then result:=8; if not(premier) and not(dernier) then result:=4; end; if quadrant=4 then begin if premier then result:=8; if dernier then result:=14; if not(premier) and not(dernier) then result:=14; end; end; 9 : begin if quadrant=3 then begin if premier then result:=9; if dernier then result:=2; if not(premier) and not(dernier) then result:=2; end; if quadrant=2 then begin if premier then result:=15; if dernier then result:=9; if not(premier) and not(dernier) then result:=15; end; end; 10 : begin if quadrant=2 then result:=10; if quadrant=3 then begin if premier then begin if testbit(tco[x+1,y-1].liaisons,6) then result:=15 else result:=9;end else if dernier then begin if testbit(tco[x-1,y+1].liaisons,2) then result:=13 else result:=7;end else if not(premier) and not(dernier) then begin if (testbit(tco[x-1,y+1].liaisons,2)) and (testbit(tco[x+1,y-1].liaisons,6)) then result:=21; if not(testbit(tco[x-1,y+1].liaisons,2)) and (testbit(tco[x+1,y-1].liaisons,6)) then result:=3; if testbit(tco[x-1,y+1].liaisons,2) and not(testbit(tco[x+1,y-1].liaisons,6)) then result:=2; end; end; if quadrant=5 then begin if premier then result:=17; if dernier then result:=18; end; end; 11 : begin if quadrant=1 then result:=19; if quadrant=3 then begin if dernier then begin if testbit(tco[x-1,y-1].liaisons,4) then result:=14 else result:=8;end else if premier then begin if testbit(tco[x+1,y+1].liaisons,0) then result:=12 else result:=6;end else if not(premier) and not(dernier) then begin if (testbit(tco[x-1,y-1].liaisons,4)) and (testbit(tco[x+1,y+1].liaisons,0)) then result:=22; if not(testbit(tco[x-1,y-1].liaisons,4)) and (testbit(tco[x+1,y+1].liaisons,0)) then result:=4; if testbit(tco[x-1,y-1].liaisons,4) and not(testbit(tco[x+1,y+1].liaisons,0)) then result:=5; end; end; if (quadrant=4) then result:=11; if quadrant=5 then begin if dernier then result:=19; if premier then result:=16; if not(premier) and not(dernier) then result:=25; end; end; 12 : begin if quadrant=4 then result:=12; if quadrant=3 then begin if dernier then result:=22; if premier then result:=12; if not(premier) and not(dernier) then result:=22; end; end; 13 : begin if quadrant=2 then result:=13; if quadrant=3 then begin if dernier then result:=13; if premier then result:=21; if not(premier) and not(dernier) then result:=21; end; end; 14 : begin if quadrant=4 then result:=14; if quadrant=3 then begin if dernier then result:=14; if premier then result:=22; if not(premier) and not(dernier) then result:=22; end; end; 15 : begin if quadrant=2 then result:=15; if quadrant=3 then begin if dernier then result:=21; if premier then result:=15; if not(premier) and not(dernier) then result:=21; end; end; 16 : begin if quadrant=4 then begin if dernier then result:=16; end; if quadrant=5 then begin if testbit(tco[x,y-1].liaisons,5) then result:=24 else result:=16; end; end; 17 : begin if quadrant=2 then result:=17; if quadrant=5 then result:=17; end; 18 : begin if quadrant=2 then result:=18; if quadrant=5 then result:=18; end; 19 : begin if quadrant=4 then result:=19; if quadrant=5 then result:=19; end; 20 : begin if (quadrant=2) then begin if premier and not(testbit(tco[x,y-1].liaisons,5)) then result:=17; if dernier then result:=18; end; if quadrant=4 then begin if dernier then begin if (testbit(tco[x,y-1].liaisons,5)) and not(testbit(tco[x+1,y+1].liaisons,0)) then result:=24; if (testbit(tco[x,y-1].liaisons,5)) and (testbit(tco[x+1,y+1].liaisons,0)) then result:=25; if not(testbit(tco[x,y-1].liaisons,5)) and not(testbit(tco[x+1,y+1].liaisons,0)) then result:=16; end; if premier then begin if (testbit(tco[x-1,y-1].liaisons,4)) then result:=25; if not(testbit(tco[x-1,y-1].liaisons,4)) then result:=19; end; if not(premier) and not(dernier) then result:=25; end; if quadrant=5 then result:=20; end; 21 : result:=21; 22 : result:=22; 24 : begin if quadrant=4 then begin if dernier then begin if testbit(tco[x+1,y+1].liaisons,0) then result:=25 ; if not(testbit(tco[x+1,y+1].liaisons,0)) then result:=24 ; end; if premier then result:=25; if not(premier) and not(dernier) then result:=25; end; if quadrant=5 then result:=24; end; 25 : result:=25; end; tco[x,y].coulFonte:=clyellow; 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; i,Bimage,xt,yt,xf,yf : integer; s : string; begin if button=mbLeft then begin if affEvt then Affiche('TCO Souris clicG enfoncée',clYellow); if dbleClicTCO then begin dbleClicTCO:=false;exit;end; clicsouris:=true; GetCursorPos(Position); Position:=formTCO.ImageTCO.screenToCLient(Position); //Affiche(IntToSTR(position.x),clyellow); Xclic:=position.X;YClic:=position.Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; TempoSouris:=2 ; // démarre la tempo souris // clic en mode dessin if modeTrace then begin if indextrace=0 then begin inc(indexTrace); traceXY[indexTrace].x:=XClicCell; traceXY[indexTrace].y:=YclicCell; exit; end; if indextrace=1 then begin // vérifier coordonnées valides if ( abs(XClicCell-traceXY[1].x)=abs(YClicCell-traceXY[1].y) ) or ( XClicCell-traceXY[1].x=0 ) or ( YClicCell-traceXY[1].y=0 ) then begin traceXY[2].x:=XClicCell; traceXY[2].y:=YclicCell; xf:=XClicCell; yf:=YclicCell; // si origine=destination, annuler if (traceXY[1].x=traceXY[2].x) and (traceXY[1].y=traceXY[2].y) then begin indexTrace:=1; traceXY[2].x:=0;traceXY[2].y:=0; exit; end; // premier tracé indextrace:=1; if traceXY[1].y=traceXY[2].y then begin yt:=traceXY[1].y; if traceXY[1].x>traceXY[2].x then echange(traceXY[1].x,traceXY[2].x); // tracé horizontal (vers la droite) i:=1; for xt:=traceXY[1].x to traceXY[2].x do begin stocke_undo(i,xt,yt); // stocke les points de la ligne entière dessinée inc(i); Bimage:=replace(xt,yt,1,3,xt=traceXY[1].x,xt=traceXY[2].x); tco[xt,yt].BImage:=Bimage; tco[xt,yt].liaisons:=liaisons[Bimage]; end; maj_undo(i-1); // stocke le nombre de points de la ligne affiche_tco; end else begin if traceXY[1].x=traceXY[2].x then begin xt:=traceXY[1].x; if traceXY[1].y>traceXY[2].y then echange(traceXY[1].y,traceXY[2].y); // tracé vertical (le bas) (quadrant 5) i:=1; for yt:=traceXY[1].y to traceXY[2].y do begin stocke_undo(i,xt,yt); inc(i); Bimage:=replace(xt,yt,20,5,yt=traceXY[1].y,yt=traceXY[2].y); tco[xt,yt].BImage:=Bimage; tco[xt,yt].liaisons:=liaisons[Bimage]; end; maj_undo(i-1); affiche_tco; end // indice 1 doit toujours < que indice 2 // tracé diagonal vers en bas à droite (quadrant 4) else begin if (traceXY[1].x>traceXY[2].x) then begin echange(traceXY[1].x,traceXY[2].x); echange(traceXY[1].y,traceXY[2].y); end; if (traceXY[1].y0 then begin exit;end; // Affiche('*',cllime); SourisX.Caption:=IntToSTR(x); SourisY.Caption:=IntToSTR(y); //affiche(intToSTR(x),clorange); cellX:=x div largeurCell+1; cellY:=y div hauteurCell+1; //Affiche('Cellx='+IntToSTR(Cellx)+' Celly='+intToSTR(Celly)+' AncienCellx='+IntToSTR(AncienXClicCell)+' AncienCelly='+intToSTR(AncienYClicCell),clorange); if (AncienXClicCell=CellX) and (AncienYClicCell=CellY) then exit; AncienXClicCell:=CellX; AncienYClicCell:=CellY; //Affiche('cellX='+IntToSTR(Cellx)+' cellY='+intToSTR(cellY),clyellow); if CellX>NbreCellX then exit; if CellY>NbreCellY then exit; Bimage:=tco[cellX,cellY].BImage; if modeTrace then begin if indexTrace>0 then begin begin with ImageTCO.canvas do begin Pen.Mode:=pmXor; Pen.Color:=clwhite; Pen.Width:=2; // efface le précédent if traceXY[indextrace+1].x<>0 then begin if debugTCO then Affiche('Efface précédent',clyellow); if ancienok then Pen.color:=clyellow else pen.color:=clGray; MoveTo(traceXY[indexTrace].x*largeurCell-LargeurCelld2,traceXY[indexTrace].y*hauteurCell-HauteurCelld2); LineTo(ancienTraceX*largeurcell-largeurCelld2,ancienTraceY*HauteurCell-HauteurCelld2); end; if debugTCO then Affiche('Trace',clyellow); ancienTraceX:=cellx; ancienTraceY:=celly; ok:=( abs(cellX-traceXY[indexTrace].x)=abs(cellY-traceXY[indexTrace].y) ) or ( cellX-traceXY[indexTrace].x=0 ) or ( cellY-traceXY[indexTrace].y=0 ) ; if (ancienok=false) and ok then screen.cursor:=crUpArrow; if ancienok and (ok=false) then screen.cursor:=crNoDrop; Ancienok:=ok; if ok then Pen.color:=clyellow else pen.color:=clGray; MoveTo(traceXY[indexTrace].x*largeurCell-LargeurCelld2,traceXY[indexTrace].y*hauteurCell-HauteurCelld2); LineTo(cellX*largeurCell-largeurCelld2,CellY*hauteurCell-HauteurCelld2); if ok then begin traceXY[indextrace+1].x:=cellX; traceXY[indextrace+1].y:=cellY; end; end; end; end; exit; end; if not(clicsouris) or (temposouris>0) then exit; //Affiche('haaa',clyellow); xMiniSel:=(XclicCell-1)*LargeurCell; yMiniSel:=(YclicCell-1)*HauteurCell; xMaxiSel:=(cellX-1)*LargeurCell; yMaxiSel:=(cellY-1)*HauteurCell; 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 then with imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille; Brush.Color:=clblue; Rectangle(rAncien); end; if piloteAig then begin SelectionAffichee:=false;piloteAig:=false;exit;end; r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+largeurCell,yMaxiSel+hauteurCell); XSel1:=Xminisel div largeurCell + 1; YSel1:=Yminisel div hauteurCell + 1; XSel2:=Xmaxisel div largeurCell + 1; YSel2:=Ymaxisel div hauteurCell + 1; //Affiche(intToSTR(Xsel1)+' '+intToStr(Ysel1)+' '+intToSTR(Xsel2)+' '+intToStr(Ysel2),clYellow); // Affiche le nouveau rectangle de sélection Rancien:=r; with imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille; Brush.Color:=clblue; //FillRect(r); Rectangle(r); end; SelectionAffichee:=true; //Affiche('Sélection affichée',clLime); if entoure then begin Entoure_cell(Xentoure,Yentoure);entoure:=false;end; // efface end; procedure TFormTCO.ImageTCOMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if affevt then Affiche('Souris clic relachée',clyellow); clicsouris:=false; end; procedure TFormTCO.ButtonRedessineClick(Sender: TObject); begin Affiche_TCO; defocusControl(ButtonRedessine,true); end; // changement de l'adresse d'un élément procedure TFormTCO.EditAdrElementChange(Sender: TObject); var Adr,erreur,index : integer; begin //Affiche('Chgt adresse',clyellow); if clicTCO or not(formConfCellTCOAff) then exit; Val(EditAdrElement.Text,Adr,erreur); if (erreur<>0) or (Adr<0) or (Adr>2048) then Adr:=0; if Adr=0 then tco[XClicCell,YClicCell].repr:=2; efface_entoure; tco[XClicCell,YClicCell].Adresse:=Adr; //formConfCellTCO.editAdrElement.Text:=intToSTR(Adr); tco_Modifie:=true; // si signal if tco[XClicCell,YClicCell].BImage=30 then begin index:=Index_feu(adr); if index=0 then exit else begin //Affiche('Signal '+intToSTR(Adr),clyellow); affiche_tco; end; end; Affiche_cellule(XclicCell,YclicCell); end; // mise à jour des cellules de l'adresse "adresse" procedure TFormTCO.Maj_TCO(Adresse : integer); var x,y: integer; begin for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin if tco[x,y].Adresse=Adresse then begin affiche_cellule(x,y); entoure_cell_grille(x,y); end; end; end; procedure TFormTCO.Button1Click(Sender: TObject); begin Detecteur[569].etat:=true; Maj_tco(569); end; procedure TFormTCO.Button2Click(Sender: TObject); begin Detecteur[569].etat:=false; Maj_tco(569); end; procedure TFormTCO.ImagePalette10EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(target=ImageTCO) then exit; if (x=0) and (y=0) then exit; drag:=false; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,10)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_10(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=10; tco[XClicCell,YClicCell].liaisons:=liaisons[10]; tco[xClicCell,YClicCell].CoulFonte:=clYellow; tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette11EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(target=ImageTCO) then exit; if (x=0) and (y=0) then exit; drag:=false; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,11)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; dessin_11(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=11; tco[XClicCell,YClicCell].liaisons:=liaisons[11]; tco[xClicCell,YClicCell].CoulFonte:=clYellow; tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette10MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette10); end; procedure TFormTCO.ImagePalette11MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette11); end; procedure TFormTCO.ButtonConfigTCOClick(Sender: TObject); begin TformconfigTCO.create(self); formconfigTCO.showmodal; formconfigTCO.close; defocusControl(ButtonConfigTCO,true); end; procedure TFormTCO.ImagePalette30EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; stocke_undo(1,XClicCell,YClicCell); maj_undo(1); efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); tco[XClicCell,YClicCell].BImage:=30; tco[XClicCell,YClicCell].liaisons:=0; tco[XClicCell,YClicCell].Adresse:=0; tco[XClicCell,YClicCell].FeuOriente:=1; tco[XClicCell,YClicCell].PiedFeu:=1; tco[XClicCell,YClicCell].coulFonte:=clWhite; tco[XClicCell,YClicCell].x:=0; tco[XClicCell,YClicCell].y:=0; // ne pas convertir l'adresse sinon evt changement du composant et on écrase l'aspect EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); Dessin_feu(ImageTCO.Canvas,XClicCell,YClicCell); end; procedure TFormTCO.ImagePalette30MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); var l,h : integer; begin l:=Formprinc.Image9feux.width; //57 h:=Formprinc.Image9feux.height; //105 ImagePalette30.BeginDrag(true); BitBlt(OldBmp.Canvas.Handle,0,0,LargeurCell,HauteurCell,ImageTCO.Canvas.Handle,offsetSourisX,offsetSourisY,SRCCOPY); drag:=true; oldx:=offsetSourisX;oldy:=offsetSourisY; with formTCO.ImageTemp2.Canvas do begin pen.Color:=clfond; brush.Color:=clblack; Rectangle(0,0,91,91); end; TransparentBlt(formTCO.ImageTemp2.canvas.Handle,0,0,largeurCell,HauteurCell, // destination avec mise à l'échelle //50,50 ok 51,51 nok formprinc.Image9feux.Canvas.Handle,0,0,50,90,clblue); formtco.ImageTCO.repaint; formTCO.ImageTemp:=formTCO.ImageTemp2; BitBlt(formTCO.ImageTemp.canvas.Handle,0,0,20,20,formTCO.ImageTemp2.canvas.Handle,0,0,SRCCOPY); formtco.ImageTCO.repaint; end; procedure Tourne90G; var BImage : integer; begin if actualize then exit; BImage:=TCO[XClicCell,YClicCell].Bimage; if Bimage<>30 then exit; TCO_modifie:=true; // effacement de l'ancien signal if tco[XClicCell,YClicCell].FeuOriente=3 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; if tco[XClicCell,YClicCell].FeuOriente=2 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); Efface_Cellule(PCanvasTCO,xClicCell-1,yClicCell,PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[XClicCell,YClicCell].FeuOriente=1 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,PmCopy); end; tco[XClicCell,YClicCell].FeuOriente:=2; // signal orienté à 90° gauche Affiche_TCO; actualise; // met à jour la fenetre de config de la cellule end; procedure TFormTCO.Tourner90GClick(Sender: TObject); begin tourne90G; end; procedure tourne90D; var BImage,aspect,adresse : integer; begin if actualize then exit; BImage:=TCO[XClicCell,YClicCell].Bimage; if Bimage<>30 then exit; TCO_modifie:=true; adresse:=TCO[XClicCell,YClicCell].Adresse; aspect:=feux[index_feu(adresse)].Aspect; if aspect=0 then aspect:=9; // ancien signal orienté orienté 90D if tco[XClicCell,YClicCell].FeuOriente=3 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; // ancien signal orienté orienté 90G if tco[XClicCell,YClicCell].FeuOriente=2 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[XClicCell,YClicCell].FeuOriente=1 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,PmCopy); end; tco[XClicCell,YClicCell].FeuOriente:=3; // feu orienté à 90° droit //dessin_feu(PCanvasTCO,XclicCell,YClicCell); Affiche_TCO; actualise; // met à jour la fenetre de config de la cellule end; procedure TFormTCO.Tourner90DClick(Sender: TObject); begin tourne90D; end; procedure vertical; var BImage ,aspect,Adresse : integer; begin if actualize then exit; BImage:=TCO[XClicCell,YClicCell].Bimage; // si c'est autre chose qu'un signal, sortir if Bimage<>30 then exit; TCO_modifie:=true; adresse:=TCO[XClicCell,YClicCell].Adresse; aspect:=feux[index_feu(adresse)].Aspect; if aspect=0 then aspect:=9; // effacement de l'ancien signal // ancien signal orienté orienté 90D if tco[XClicCell,YClicCell].FeuOriente=3 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; // ancien signal orienté orienté 90G if tco[XClicCell,YClicCell].FeuOriente=2 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(PCanvasTCO,xClicCell+1,yClicCell,PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[XClicCell,YClicCell].FeuOriente=1 then begin Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); Efface_Cellule(PCanvasTCO,xClicCell,yClicCell+1,PmCopy); end; tco[XClicCell,YClicCell].FeuOriente:=1; // signal orienté à 180° //dessin_feu(PCanvasTCO,XclicCell,YClicCell); affiche_tco; actualise; // met à jour la fenetre de config de la cellule end; procedure TFormTCO.Pos_vertClick(Sender: TObject); begin vertical; end; procedure TFormTCO.TrackBarZoomChange(Sender: TObject); begin if affevt then Affiche('TrackVBarZoomChange',clyellow); calcul_cellules; Affiche_TCO; SelectionAffichee:=false; tabstop:=false; defocusControl(trackbarZoom,true); { Affiche(intToSTR(FormTCO.ScrollBox.HorzScrollBar.Range),clyellow); with formTCO.imagetCO.Canvas do begin moveTo(0,0); pen.Color:=clwhite; LineTo(FormTCO.ScrollBox.HorzScrollBar.Range,100); lineTo(0,300); end; } end; procedure TFormTCO.EditTexteChange(Sender: TObject); begin if clicTCO then exit; if affevt then Affiche('TCO.EditTextChange',clOrange); PCanvasTCO.Brush.Color:=Clfond; efface_entoure; if Tco[XClicCell,YClicCell].texte='' then begin Tco[XClicCell,YClicCell].CoulFonte:=clTexte; Tco[XClicCell,YClicCell].TailleFonte:=8; end; Tco[XClicCell,YClicCell].Texte:=EditTexte.Text; formConfCellTCO.EditTexteCCTCO.Text:=EditTexte.Text; TCO_modifie:=true; // affiche_texte(XClicCell,YClicCell); end; procedure TFormTCO.ButtonSimuClick(Sender: TObject); begin aiguillage[Index_Aig(1)].position:=const_droit; aiguillage[Index_Aig(2)].position:=const_devie; aiguillage[Index_Aig(3)].position:=const_droit; aiguillage[Index_Aig(4)].position:=const_devie; aiguillage[Index_Aig(5)].position:=const_devie; aiguillage[Index_Aig(8)].position:=const_devie; aiguillage[Index_Aig(9)].position:=const_droit; aiguillage[Index_Aig(7)].position:=const_devie; aiguillage[Index_Aig(12)].position:=const_devie; aiguillage[Index_Aig(20)].position:=const_droit; aiguillage[Index_Aig(21)].position:=const_droit; aiguillage[Index_Aig(26)].position:=const_devie; aiguillage[Index_Aig(28)].position:=const_droit; index_couleur:=1; aiguillage[Index_Aig(81)].position:=const_droit; aiguillage[Index_Aig(82)].position:=const_droit; aiguillage[Index_Aig(120)].position:=const_droit; aiguillage[Index_Aig(119)].position:=const_droit; aiguillage[Index_Aig(116)].position:=const_droit; aiguillage[Index_Aig(117)].position:=const_devie; zone_TCO(530,520,1); zone_TCO(515,517,1); zone_tco(518,523,1); zone_tco(522,527,1); zone_tco(599,527,1); end; procedure TFormTCO.CheckPinvClick(Sender: TObject); var Bimage : integer; begin if clicTCO then exit; if actualize then exit; if (xClicCell=0) or (xClicCell>NbreCellX) or (yClicCell=0) or (yClicCell>NbreCelly) then exit; Bimage:=Tco[xClicCell,yClicCell].Bimage; if (bimage=2) or (bimage=3) or (bimage=4) or (bimage=5) or (bimage=12) or (bimage=13) or (bimage=14) or (bimage=15) then begin TCO[xClicCell,yClicCell].inverse:=CheckPinv.checked; TCO_modifie:=true; end; end; procedure TFormTCO.ButtonMasquerClick(Sender: TObject); begin Panel1.Hide; ButtonAfficheBandeau.visible:=true; ScrollBox.Height:=ClientHeight-40; //ScrollBox.Anchors:=[akLeft,AkTop,AkRight,akBottom]; BandeauMasque:=true; defocusControl(ButtonMasquer,true); end; procedure TFormTCO.ButtonAfficheBandeauClick(Sender: TObject); begin Panel1.Show; ButtonAfficheBandeau.visible:=false; ScrollBox.Height:=ClientHeight-Panel1.Height-40; BandeauMasque:=false; end; procedure TFormTCO.ImageTCODblClick(Sender: TObject); var Bimage,Adresse,i : integer; tjdC : boolean; begin if affEvt then Affiche('Double clic',clYellow); clicsouris:=false; Bimage:=Tco[xClicCell,yClicCell].BImage; Adresse:=Tco[xClicCell,yClicCell].Adresse; if adresse=0 then exit; // double clic sur détecteur : inversion if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and (adresse<>0) then begin detecteur[adresse].etat:=not(detecteur[adresse].etat); Affiche_tco; end; tjdC:=false; // commande tjd/c if (Bimage=21) or (Bimage=22) or (Bimage=25) then begin tjdC:=(aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs); end; // commande 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=24) or TJDc then begin aiguille:=Adresse; i:=Index_aig(Adresse); if i=0 then begin Affiche('Aiguillage '+intToSTR(adresse)+' non configuré pour pilotage',clOrange); exit; end; TformAig.create(nil); formAig.showmodal; formAig.close; piloteAig:=true; end; // commande de signal if Bimage=30 then begin AdrPilote:=adresse; i:=Index_feu(adresse); if i=0 then exit; TFormPilote.Create(Self); with formPilote do begin show; ImagePilote.top:=40;ImagePilote.left:=220; ImagePilote.Parent:=FormPilote; ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto; ImagePilote.Picture.Bitmap.TransparentColor:=clblue; ImagePilote.Transparent:=true; ImagePilote.Picture.BitMap:=feux[i].Img.Picture.Bitmap; LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(Adresse); feux[0].EtatSignal:=feux[i].EtatSignal; LabelNbFeux.Visible:=False; EditNbreFeux.Visible:=false; GroupBox1.Visible:=true; GroupBox2.Visible:=true; efface_entoure; SelectionAffichee:=false; if feux[i].aspect>10 then begin GroupBox1.Visible:=false; GroupBox2.Visible:=false; LabelNbFeux.Visible:=true; EditNbreFeux.Visible:=true; EditNbreFeux.Text:='1'; end else begin LabelNbFeux.Visible:=False; EditNbreFeux.Visible:=false; GroupBox1.Visible:=true; GroupBox2.Visible:=true; end; end; end; clicsouris:=false; dbleClicTCO:=true; end; procedure TFormTCO.ComboReprChange(Sender: TObject); begin if clicTCO then exit; tco[XClicCell,YClicCell].Repr:=comborepr.ItemIndex; efface_entoure; SelectionAffichee:=false; formConfCellTCO.ComboRepr.ItemIndex:=ComboRepr.ItemIndex; defocusControl(ComboRepr,true); affiche_tco; end; procedure TFormTCO.ImagePalette1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette2DragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette3DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette4DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette5DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette12DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette13DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette14DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette15DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette21DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette22DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette31DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette24DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette25DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette20DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette31EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; TCO_modifie:=true; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); Dessin_31(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=31; tco[XClicCell,YClicCell].liaisons:=0; tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,24)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_24(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=24; tco[XClicCell,YClicCell].liaisons:=liaisons[24]; tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette25EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,25)) then exit; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); TCO_modifie:=true; Dessin_25(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=25; tco[XClicCell,YClicCell].liaisons:=liaisons[25]; tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette20EndDrag(Sender, Target: TObject; X, Y: Integer); begin if not(Target is TImage) then exit; if (Target as TImage).Name<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; BitBlt(imageTCO.canvas.handle,oldx,oldy,LargeurCell,HauteurCell,oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure; imageTCO.repaint; Xclic:=X;YClic:=Y; XclicCell:=Xclic div largeurCell +1; YclicCell:=Yclic div hauteurCell +1; if not(verif_cellule(XclicCell,YclicCell,20)) then exit; TCO_modifie:=true; efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); Dessin_20(ImageTCO.Canvas,XClicCell,YClicCell,0); stocke_undo(1,XClicCell,YClicCell); maj_undo(1); tco[XClicCell,YClicCell].BImage:=20; tco[XClicCell,YClicCell].liaisons:=liaisons[20]; tco[XClicCell,YClicCell].Adresse:=0; EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage); end; procedure TFormTCO.ImagePalette31MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette31); end; procedure TFormTCO.ImagePalette24MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette24); end; procedure TFormTCO.ImagePalette25MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette25); end; procedure TFormTCO.ImagePalette20MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette20); end; procedure TFormTCO.ImagePalette6DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette7DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette8DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette9DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette16DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette17DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette18DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette19DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette10DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette11DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette30DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure change_fonte; var s,ss : string; fs : TFontStyles; begin s:='Fonte et couleur pour la cellule ('+intToSTR(xClicCell)+','+intToSTR(YClicCell)+') Texte: '; ss:=tco[xClicCell,YClicCell].Texte; if ss='' then s:=s+inttoSTR(tco[xClicCell,YClicCell].Adresse) else s:=s+ss; titre_fonte:=s; With FormTCO do begin FontDialog1.Font.Name:=tco[XclicCell,YclicCell].Fonte; FontDialog1.Font.Color:=tco[XclicCell,YclicCell].CoulFonte; FontDialog1.Font.Size:=tco[XclicCell,YclicCell].taillefonte; fs:=[]; s:=tco[XclicCell,YclicCell].FontStyle; if pos('G',s)<>0 then fs:=fs+[fsbold]; if pos('I',s)<>0 then fs:=fs+[fsItalic]; if pos('S',s)<>0 then fs:=fs+[fsUnderline]; if pos('B',s)<>0 then fs:=fs+[fsStrikeout]; FontDialog1.Font.Style:=fs; if FontDialog1.execute then begin tco[XclicCell,YclicCell].Fonte:=FontDialog1.Font.Name; tco[XclicCell,YclicCell].CoulFonte:=FontDialog1.Font.Color; tco[XclicCell,YclicCell].taillefonte:=FontDialog1.Font.Size; fs:=FontDialog1.Font.Style; s:=''; if fsBold in fs then s:=s+'G'; if fsItalic in fs then s:=s+'I'; if fsUnderline in fs then s:=s+'S'; if fsStrikeout in fs then s:=s+'B'; tco[XclicCell,YclicCell].FontStyle:=s; affiche_tco; end; end; end; procedure TFormTCO.ButtonFonteClick(Sender: TObject); begin change_fonte; end; procedure TFormTCO.FontDialog1Show(Sender: TObject); begin SetWindowText(FontDialog1.Handle,pchar(titre_Fonte)); end; procedure TFormTCO.ColorDialog1Show(Sender: TObject); begin SetWindowText(ColorDialog1.Handle,pchar(titre_couleur)); end; procedure signalD; begin if actualize then exit; if TCO[XClicCell,YClicCell].Bimage=30 then begin TCO[XClicCell,YClicCell].PiedFeu:=2; Affiche_TCO; TCO_modifie:=true; actualise; // met à jour la fenetre de config de la cellule end; end; procedure TFormTCO.Signaldroitedelavoie1Click(Sender: TObject); begin signalD; end; procedure signalG; begin if actualize then exit; if TCO[XClicCell,YClicCell].Bimage=30 then begin TCO[XClicCell,YClicCell].PiedFeu:=1; Affiche_TCO; TCO_modifie:=true; actualise; // met à jour la fenetre de config de la cellule end; end; procedure TFormTCO.Signalgauchedelavoie1Click(Sender: TObject); begin signalG; end; procedure TFormTCO.PopupMenu1Popup(Sender: TObject); var oriente,piedFeu : integer; begin if affevt then Affiche('on popup',clyellow); // if modetrace then Abort; PopUpMenu1.Items[9][0].Caption:='Ligne au dessus de la '+intToSTR(YclicCell); PopUpMenu1.Items[9][1].Caption:='Ligne en dessous de la '+intToSTR(YclicCell); PopUpMenu1.Items[9][3].Caption:='Colonne à gauche de la '+intToSTR(XclicCell); PopUpMenu1.Items[9][4].Caption:='Colonne à droite de la '+intToSTR(XclicCell); PopUpMenu1.Items[10][0].Caption:='Ligne '+intToSTR(YclicCell); PopUpMenu1.Items[10][1].Caption:='Colonne '+intToSTR(XclicCell); // grise ou non l'entrée signal du menu if tco[XClicCell,YClicCell].Bimage=30 then begin PopUpMenu1.Items[6].Enabled:=true; oriente:=tco[XClicCell,YClicCell].Feuoriente; if oriente=1 then begin PopUpMenu1.Items[6][0].checked:=false; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=true; end; if oriente=2 then begin PopUpMenu1.Items[6][0].checked:=true; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=false; end; if oriente=3 then begin PopUpMenu1.Items[6][0].checked:=false; PopUpMenu1.Items[6][1].checked:=true; PopUpMenu1.Items[6][2].checked:=false; end; PiedFeu:=tco[XClicCell,YClicCell].PiedFeu; if PiedFeu=1 then begin PopUpMenu1.Items[6][4].checked:=true; PopUpMenu1.Items[6][5].checked:=false; end; if PiedFeu=2 then begin PopUpMenu1.Items[6][4].checked:=false; PopUpMenu1.Items[6][5].checked:=true; end; end else PopUpMenu1.Items[6].Enabled:=false; end; procedure TFormTCO.N3Click(Sender: TObject); begin actualise; FormConfCellTCO.show; FormConfCellTCO.BringToFront; end; procedure TFormTCO.LigneDessusClick(Sender: TObject); var x,y : integer; begin if NbreCellY>=MaxCellY then exit; TamponAffecte:=false; SetLength(TCO,NbreCellX+1,NbreCellY+2); // ajoute une ligne en Y SetLength(TamponTCO,NbreCellX+1,NbreCellY+2); for y:=NbreCellY-1 downto YClicCell do begin for x:=1 to NbreCellX do begin tco[x,y+1]:=tco[x,y]; end; end; for x:=1 to NbreCellX do begin tco[x,YClicCell].Adresse:=0; tco[x,YClicCell].BImage:=0; tco[x,YClicCell].inverse:=false; tco[x,YClicCell].repr:=0; tco[x,YClicCell].texte:=''; tco[x,YClicCell].fonte:=''; tco[x,YClicCell].CouleurFond:=Clfond; tco[x,YClicCell].PiedFeu:=0; tco[x,YClicCell].FeuOriente:=0; end; inc(NbreCellY); affiche_TCO; end; procedure TFormTCO.LigneDessousClick(Sender: TObject); var x,y : integer; begin if NbreCellY>=MaxCellY then exit; TamponAffecte:=false; SetLength(TCO,NbreCellX+1,NbreCellY+2); // ajoute une ligne en Y SetLength(TamponTCO,NbreCellX+1,NbreCellY+2); // ajoute une ligne en Y for y:=NbreCellY downto YClicCell+1 do begin for x:=1 to NbreCellX do tco[x,y+1]:=tco[x,y]; end; for x:=1 to NbreCellX do begin tco[x,YClicCell+1].Adresse:=0; tco[x,YClicCell+1].BImage:=0; tco[x,YClicCell+1].inverse:=false; tco[x,YClicCell+1].repr:=0; tco[x,YClicCell+1].texte:=''; tco[x,YClicCell+1].fonte:=''; tco[x,YClicCell+1].Couleurfond:=Clfond; tco[x,YClicCell+1].PiedFeu:=0; tco[x,YClicCell+1].FeuOriente:=0; end; inc(NbreCellY); affiche_TCO; end; procedure TFormTCO.SupprimeLigneClick(Sender: TObject); var x,y : integer; begin if NbreCellY<=1 then exit; TamponAffecte:=false; // tampon de sauvegarde TamponTCO_Org.NbreCellX:=NbreCellX; TamponTCO_Org.NbreCellY:=NbreCellY; TamponTCO_Org.x1:=1; TamponTCO_Org.x2:=NbreCellX; TamponTCO_Org.y1:=1; TamponTCO_Org.y2:=NbreCellY; 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[x,y]; end; //TamponAffecte:=true; // supression ligne for y:=YClicCell to NbreCellY-1 do begin for x:=1 to NbreCellX do tco[x,y]:=tco[x,y+1]; end; for x:=1 to NbreCellX do begin tco[x,NbreCellY].Adresse:=0; tco[x,NbreCellY].BImage:=0; tco[x,NbreCellY].inverse:=false; tco[x,NbreCellY].repr:=0; tco[x,NbreCellY].texte:=''; tco[x,NbreCellY].fonte:=''; tco[x,NbreCellY].Couleurfond:=Clfond; tco[x,NbreCellY].PiedFeu:=0; tco[x,NbreCellY].FeuOriente:=0; end; dec(NbreCellY); SetLength(TCO,NbreCellX+1,NbreCellY+1); // ajuste la taille du tableau SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); // ajoute une ligne en Y affiche_TCO; end; procedure TFormTCO.Colonnegauche1Click(Sender: TObject); var x,y : integer; begin if NbreCellX>=MaxCellX then exit; TamponAffecte:=false; SetLength(TCO,NbreCellX+2,NbreCellY+1); // ajoute taille X SetLength(TamponTCO,NbreCellX+2,NbreCellY+1); for x:=NbreCellX downto XClicCell do begin for y:=1 to NbreCellY do tco[x+1,y]:=tco[x,y]; end; for y:=1 to NbreCellY do begin tco[XClicCell,y].Adresse:=0; tco[XClicCell,y].BImage:=0; tco[XClicCell,y].inverse:=false; tco[XClicCell,y].repr:=0; tco[XClicCell,y].texte:=''; tco[XClicCell,y].fonte:=''; tco[XClicCell,y].Couleurfond:=Clfond; tco[XClicCell,y].PiedFeu:=0; tco[XClicCell,y].FeuOriente:=0; end; inc(NbreCellX); affiche_TCO; end; procedure TFormTCO.Colonnedroite1Click(Sender: TObject); var x,y : integer; begin if NbreCellX>=MaxCellX then exit; TamponAffecte:=false; SetLength(TCO,NbreCellX+2,NbreCellY+1); // ajoute taille X SetLength(TamponTCO,NbreCellX+2,NbreCellY+1); // ajoute taille X for x:=NbreCellX downto XClicCell+1 do begin for y:=1 to NbreCellY do tco[x+1,y]:=tco[x,y]; end; for y:=1 to NbreCellY do begin tco[XClicCell+1,y].Adresse:=0; tco[XClicCell+1,y].BImage:=0; tco[XClicCell+1,y].inverse:=false; tco[XClicCell+1,y].repr:=0; tco[XClicCell+1,y].texte:=''; tco[XClicCell+1,y].fonte:=''; tco[XClicCell+1,y].Couleurfond:=Clfond; tco[XClicCell+1,y].PiedFeu:=0; tco[XClicCell+1,y].FeuOriente:=0; end; inc(NbreCellX); affiche_TCO; end; // suppression colonne procedure TFormTCO.ColonneClick(Sender: TObject); var x,y : integer; begin if NbreCellX<=1 then exit; TamponAffecte:=false; // tampon de sauvegarde TamponTCO_Org.NbreCellX:=NbreCellX; TamponTCO_Org.NbreCellY:=NbreCellY; TamponTCO_Org.x1:=1; TamponTCO_Org.x2:=NbreCellX; TamponTCO_Org.y1:=1; TamponTCO_Org.y2:=NbreCellY; 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[x,y]; // TamponAffecte:=true; // supression colonne for x:=xClicCell to NbreCellx-1 do begin for y:=1 to NbreCelly do begin tco[x,y]:=tco[x+1,y]; end; end; for y:=1 to NbreCellY do begin tco[NbreCellx,y].Adresse:=0; tco[NbreCellx,y].BImage:=0; tco[NbreCellx,y].inverse:=false; tco[NbreCellx,y].repr:=0; tco[NbreCellx,y].texte:=''; tco[NbreCellx,y].fonte:=''; tco[NbreCellx,y].CouleurFond:=Clfond; tco[NbreCellx,y].PiedFeu:=0; tco[NbreCellx,y].FeuOriente:=0; end; dec(NbreCellX); SetLength(TCO,NbreCellX+1,NbreCellY+1); // ajuste taille SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); // ajuste taille affiche_TCO; end; procedure TFormTCO.buttonRazClick(Sender: TObject); var x,y : integer; begin for x:=1 to NbreCellx do for y:=1 to NbreCelly do tco[x,y].mode:=0; Affiche_TCO; defocusControl(buttonRaz,true); end; procedure TFormTCO.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var i,maxi : integer; begin if affevt then Affiche('FormMouseWheel',clOrange); i:=FormTCO.TrackBarZoom.Position; if WheelDelta>0 then begin if (i<=ZoomMin) then begin FormTCO.TrackBarZoom.Position:=ZoomMin; exit; end; dec(i); end else begin if (i>=ZoomMax) then begin FormTCO.TrackBarZoom.Position:=ZoomMax; exit; end; inc(i); end; // positionner la trackbar zoom FormTCO.TrackBarZoom.Position:=i; calcul_cellules; Affiche_TCO; SelectionAffichee:=false; //positionner les trackbar du scrollbox sur la position cliquée de la souris {GetCursorPos(Position); x:=position.x div largeurCell +1 ; y:=position.Y div HauteurCell +1 ; } maxi:=ScrollBox.HorzScrollBar.Range-ScrollBox.ClientWidth; i:=round(xClicCell*maxi/NbreCellx); ScrollBox.HorzScrollBar.position:=i; maxi:=ScrollBox.VertScrollBar.Range-ScrollBox.ClientHeight; i:=round(yClicCell*maxi/NbreCelly); ScrollBox.VertScrollBar.position:=i; end; procedure TFormTCO.ButtonCalibrageClick(Sender: TObject); var x,y : integer; begin x:=0; y:=0; calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); with imageTCO.Canvas do begin pen.color:=clyellow; moveTo( round(x),round(y*frYGlob) ); LineTo( round((x+LargeurCell)),round(y+HauteurCell*ratioC/10) ); end; Affiche(formatfloat('0.000000',fryglob),clyellow); end; procedure change_couleur_fond; var cs : string; x,y,xmini,ymini,xmaxi,ymaxi : integer; modeselection : boolean; begin xmini:=(XminiSel div LargeurCell) +1; ymini:=(YminiSel div HauteurCell) +1; xmaxi:=(XmaxiSel div LargeurCell) +1; ymaxi:=(YmaxiSel div HauteurCell) +1; modeSelection:=xmini0) or not(Bimage in[0..22,24..25,30,31]) then begin exit; end; TCO_modifie:=true; tco[XClicCell,YClicCell].Bimage:=Bimage; formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage); actualise; // pour mise à jour de l'image de la fenetre FormConfCellTCO efface_entoure; affiche_cellule(XClicCell,YClicCell); end; procedure TFormTCO.outslectionner1Click(Sender: TObject); begin xminiSel:=0; yminiSel:=0; xMaxiSel:=(NbreCellX-1)*LargeurCell; yMaxiSel:=(NbreCellY-1)*HauteurCell; rAncien:=rect(xminiSel,YminiSel,xmaxiSel+LargeurCell,YMaxiSel+HauteurCell); SelectionAffichee:=true; with imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille; Brush.Color:=clblue; Rectangle(rAncien); end; end; procedure TFormTCO.ButtonDessinerClick(Sender: TObject); begin if not(modetrace) then begin modetrace:=true; indexTrace:=0; traceXY[1].x:=0; traceXY[1].y:=0; traceXY[2].x:=0; traceXY[2].x:=0; FormTCO.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.'; screen.cursor:=crUpArrow; end else stop_modetrace; defocusControl(buttonDessiner,true); end; procedure TFormTCO.ButtonTrajetClick(Sender: TObject); var c : Tcanvas; begin c:=FormTCO.ImageTCO.canvas; //efface_cellule(c,5,1,pmcopy); TCO[5,1].Adresse:=1;dessin_2(c,5,1,1); TCO[7,1].Adresse:=1;dessin_3(c,7,1,1); TCO[9,1].Adresse:=1;dessin_4(c,9,1,1); TCO[11,1].Adresse:=1;dessin_5(c,11,1,1); TCO[5,3].Adresse:=1;dessin_12(c,5,3,1); TCO[7,3].Adresse:=1;dessin_13(c,7,3,1); TCO[9,3].Adresse:=1;dessin_14(c,9,3,1); TCO[11,3].Adresse:=1;dessin_15(c,11,3,1); TCO[5,5].Adresse:=1;dessin_24(c,5,5,1); end; end.