unit UnitTCO; // ne pas utiliser les éléments 30 et 31 qui sont les anciens signaux et quais 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) PopupMenu1: TPopupMenu; MenuCouper: TMenuItem; N1: TMenuItem; MenuCopier: TMenuItem; MenuColler: TMenuItem; ScrollBox: TScrollBox; ImageTCO: TImage; Tourner90G: TMenuItem; Tourner90D: TMenuItem; Pos_vert: TMenuItem; TrackBarZoom: TTrackBar; PanelBas: TPanel; Label1: TLabel; Label2: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; Label3: TLabel; Label4: TLabel; Label10: TLabel; Label11: TLabel; Label50: TLabel; ButtonSauveTCO: TButton; LabelZoom: TLabel; ButtonConfigTCO: TButton; Annulercouper: TMenuItem; N5: TMenuItem; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; ButtonSimu: TButton; Label16: TLabel; Label17: TLabel; Label18: TLabel; Label19: TLabel; Label20: TLabel; ButtonMasquer: TButton; Label21: TLabel; Label22: TLabel; Label51: TLabel; FontDialog1: TFontDialog; N2: TMenuItem; Signalgauchedelavoie1: TMenuItem; Signaldroitedelavoie1: TMenuItem; N3: TMenuItem; Signal1: TMenuItem; N4: TMenuItem; GroupBox1: TGroupBox; Label41: TLabel; EditAdrElement: TEdit; EditTypeImage: TEdit; Label71: TLabel; ButtonFonte: TButton; Label230: TLabel; EditTexte: TEdit; ComboRepr: TComboBox; Label65: 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; Label24: TLabel; Label25: 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; ImagePalette51: TImage; ImagePalette50: TImage; ImagePalette8: TImage; ImageTemp: TImage; ImageTemp2: TImage; Toutslectionner1: TMenuItem; ButtonDessiner: TButton; ImagePalette26: TImage; Label26: TLabel; ImagePalette23: TImage; Label23: TLabel; Label27: TLabel; ImagePalette27: TImage; ImagePalette28: TImage; Label28: TLabel; Label29: TLabel; ImagePalette29: TImage; Label32: TLabel; ImagePalette32: TImage; Label33: TLabel; ImagePalette33: TImage; Label34: TLabel; ImagePalette34: TImage; ImagePalette52: TImage; Label52: TLabel; ButtonAffSC: TButton; RadioGroupSel: TRadioGroup; MainMenuTCO: TMainMenu; MenuTCO: TMenuItem; SauvegarderleTCO1: TMenuItem; N8: TMenuItem; DessinerleTCO1: TMenuItem; ConfigurationduTCO1: TMenuItem; Bandeau: TMenuItem; Affichage1: TMenuItem; Mosaquehorizontale1: TMenuItem; Mosaqueverticale1: TMenuItem; N10: TMenuItem; AfficherSignauxComplexes1: TMenuItem; Signalvertical180: TMenuItem; RafrachirleTCO1: TMenuItem; //TimerTCO: TTimer; 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 EditAdrElementChange(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); 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 ImagePalette50EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette50MouseDown(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 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 ImagePalette50DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure PanelBasDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette51DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette51EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette51MouseDown(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 Toutslectionner1Click(Sender: TObject); procedure ButtonDessinerClick(Sender: TObject); procedure ImagePalette26DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette26EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette26MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette23EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette23DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette23MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette27DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette27MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette27EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette28DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette28EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette28MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette29DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette29EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette29MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette32DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette32EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette33DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette33EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette33MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImagePalette34DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette34EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette34MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure EditAdrElementClick(Sender: TObject); procedure ImagePalette52DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ImagePalette52EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ImagePalette52MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ButtonAffSCClick(Sender: TObject); procedure RadioGroupSelClick(Sender: TObject); procedure SauvegarderleTCO1Click(Sender: TObject); procedure DessinerleTCO1Click(Sender: TObject); procedure ConfigurationduTCO1Click(Sender: TObject); procedure Redessine1Click(Sender: TObject); procedure BandeauClick(Sender: TObject); procedure Mosaquehorizontale1Click(Sender: TObject); procedure Mosaqueverticale1Click(Sender: TObject); procedure AfficherSignauxComplexes1Click(Sender: TObject); procedure Signalvertical180Click(Sender: TObject); private { Déclarations privées } function index_TCOMainMenu : integer; public { Déclarations publiques } end; const MaxCellX=150;MaxCellY=70; licone=26; // largeur icone du bas 35 hicone=licone; Xicones=40; //début de la zone icones maxUndo=30; ZoomMax=(8191 div MaxCellX)-1; // pour ne pas dépasser un canvas de 8191 pixel maxi ZoomMin=15; ClFond_ch='CoulFond'; clVoies_ch='CoulVoies'; clAllume_ch='CoulAllume'; clGrille_ch='CoulGrille'; clTexte_ch='CoulTexte'; clQuai_ch='CoulQuai'; clPiedSignal_ch='CoulPiedSig'; Matrice_ch='Matrice'; Cellule_ch='Cellule'; ClCanton_ch='CoulCanton'; Ratio_ch='Ratio'; EvtClicDet_ch='EvtClicDet'; AvecGrille_ch='AvecGrille'; ModeCouleurCanton_ch='ModeCouleurCanton'; Graphisme_ch='Graphisme'; Ecran_ch='Ecran'; Epaisseur_voies_ch='EpVoies'; ZoomInit_ch='ZoomInit'; XYInit_ch='XYInit'; Id_signal=50; Id_Quai=51; Id_action=52; // liaisons des voies pour chaque icone par bit (0=NO 1=Nord 2=NE 3=Est 4=SE 5=S 6=SO 7=Ouest) Liaisons : array[0..52] of integer= // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 (0,$88,$c8,$8c,$98,$89,$9,$84,$90,$48,$44,$11,$19,$c4,$91,$4c,$21,$24,$42,$12,$22,$cc,$99,$66,$23,$33,$26,$62,$32,$31,0,0, // 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 $64,$13,$46, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ; type // structure d'une cellule du TCO TTCO = record Adresse : integer; // adresse du détecteur ou de l'aiguillage ou du feu OU si action sortie : adresse BImage : integer; // icone: 0=rien 1=voie 2=aiguillage gauche ... 50=feu mode : integer; // couleur de voie 0=éteint 1=ClVoies 2=couleur dans le champ train train : integer; // numéro du train trajet : integer; // décrit le trajet ouvert sur la voie (cas d'un croisement ou d'une tjd/S) inverse : boolean; // aiguillage piloté inversé repr : integer; // position de la représentation texte 0 = rien 1=centré 2=Haut 3=Bas 4=réparti 5=double centré 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 ou action PiedFeu : integer; // type de pied au signal : signal à gauche=1 ou à droite=2 de la voie OU si action: type d'action x,y : integer; // coordonnées pixels relativés du coin sup gauche du signal pour le décalage par rapport au 0,0 cellule Xundo,Yundo : integer; // coordonnées x,y de la cellule pour le undo FeuOriente : integer; // orientation du signal : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit / OU si action : numéro du TCO etc liaisons : integer; // quadrants des liaisons epaisseurs : integer; // épaisseur des liaisons : si le bit n est à 1 : liaison fine pont : integer; // définition du pont : si le bit n est à 1 : pont (bits symétriques) buttoir : integer; // définition des buttoirs : si le bit n est à 1 : buttoir sortie : integer; // si action sortie : état end; // Outil graphique de sélection Trect_Select= record NumTCO : integer; // affectation du rectangle à ce tco Gd, // grand rectangle rN,rE,rS,rO,rNE,rNO,rSE,rSO : Trect; // 8 poignées end; var couleurAdresse,cltexte,CoulFonte : Tcolor; formTCO : array[1..10] of TformTCO; // pointeur vers forms TamponAffecte,TCO_modifie,clicsouris,prise_N, clicTCO,piloteAig,BandeauMasque,eval_format,sauve_tco,prise_droit,prise_haut, prise_bas,prise_gauche,prise_NE,prise_NO,prise_SE,prise_SO,ligneAffiche,colonneAffiche, drag,TCOActive,TCOCree,ancienok,dbleClicTCO,auto_tcurs,EvtClicDet : boolean; HtImageTCO,LargImageTCO,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris,ligne_supprime, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel,AncienYMiniSel,AncienYMaxiSel, Xclic,Yclic,XClicCellInserer,YClicCellInserer,RatioC,ModeCouleurCanton, AncienXClicCell,AncienYClicCell,TCODrag,epaisseur_voies,Ax,Ay,TpsBougeSouris, Epaisseur,oldX,oldY,offsetSourisY,offsetSourisX,AvecVerifIconesTCO,indexTrace,IndexTCOCourant, ancienTraceX,ancienTraceY,rangUndo,NbreTCO,IndexTCOCreate,deltaXrect,deltaYrect, CellX,CellY,AncienXclic,AncienYclic,xCadre1,yCadre1,xCadre2,yCadre2,colonne_supprime : integer; titre_Fonte,s90,s91,s93,s94,s100,s101 : string; // structure de tous les tco TCO : array[1..10] of array of array of TTco ; // tampon undo Undo : array[1..MaxUndo] of record nombre : integer; element : array[1..100] of TTCO ; end; // pour copier coller TamponTCO : array of array of TTco ; TamponTCO_Org : record numTCO,x1,y1,x2,y2,NbreCellX,NbreCellY : integer; end; Rect_select : Trect_Select; Sauv_rect_select : Trect; // tracé du train dans les TCO Trace_Train : array[1..10] of record train : array[1..Max_Trains] of record nombre : integer; route : array[1..500] of record x,y : integer; end; end; end; // tracé en mode dessin traceXY : Array[1..50] of record x,y : integer; // en coordonnées grille end; rAncien : TRect; OldBmp : TBitMap; PScrollBoxTCO : TScrollBox; // liste des variables par tco largeurCelld2,HauteurCelld2,NbCellulesTCO,NbreCellX,NbreCellY,LargeurCell,HauteurCell, Xentoure,Yentoure,XclicCell,YclicCell,EcranTCO,clGrille,clFond,ClAllume,ClVoies, ClCanton,clPiedSignal,ClQuai,ClBarriere,ZoomInit,Xinit,Yinit : array[1..10] of integer; PcanvasTCO : array[1..10] of Tcanvas; PBitMapTCO : array[1..10] of TbitMap; PImageTCO,PImageTemp : array[1..10] of Timage; frXGlob,frYGlob : array[1..10] of real; NomFichierTCO : array[1..10] of string; AvecGrille,SelectionAffichee,forminit,modeTrace,entoure : array[1..10] of boolean; procedure calcul_reduction(Var frx,fry : real;DimDestX,DimDestY : integer); procedure calcul_cellules(indextco : integer); procedure sauve_fichiers_tco; procedure zone_TCO(indexTCO,det1,det2,train,mode: integer); procedure _entoure_cell_clic(indexTCO: integer); procedure Affiche_TCO(indexTCO : integer) ; procedure affiche_cellule(indexTCO,x,y : integer); procedure efface_entoure(indexTCO : integer); procedure affiche_texte(indextco,x,y : integer); procedure change_fonte(indexTCO : integer); procedure Tourne90G(indexTCO : integer); procedure Tourne90D(indexTCO : integer); procedure Maj_TCO(indexTCO,Adresse : integer); procedure Vertical(indexTCO : integer); procedure signalG(indexTCO : integer); procedure signalD(indexTCO : integer); procedure lire_fichier_tco(indexTCO : integer); procedure change_couleur_fond(indexTCO : integer); function verif_cellule(IndexTCO,x,y,Bim : integer) : boolean; procedure dessine_icones(indexTCO : integer); procedure echange(var a,b : integer); procedure Efface_Cellule(indextco : integer;Canvas : Tcanvas;x,y : integer;Mode : TPenMode); procedure dessine_icone(indexTCO : integer;PCanvasTCO : tcanvas;Bimage,X,Y,mode : integer); function IsAigTCO(i : integer) : boolean; function index_TCO(t : Tobject) : integer; procedure Init_TCO(indexTCO : integer); procedure init_tampon_copiercoller; procedure efface_trajet(det,train : integer); Procedure Texte_aig_fond(adresse : integer); procedure Maj_Aig_TCO(indexTCO : integer); procedure encadre_ligne; procedure encadre_colonne; implementation uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO ; {$R *.dfm} // renvoie l'index du tco d'après le nom de la forme (TCO1 TCO2) // ne fonctionne que si t est un composant dont on peut remonter jusqu'à la form parent // attention : si T est un popup menu, ca ne marche pas!!! function index_TCO(t : Tobject) : integer; var s : string; trouve : boolean; f : tcustomform; i,erreur : integer; begin //s:=(t as Tcomponent).name; // Affiche(s,clWhite); f:=getparentForm(t as Tcontrol); s:=(f as Tcomponent).Name; //Affiche(s,clYellow); i:=0; repeat inc(i); trouve:=s[i] in ['0'..'9']; until trouve or (i>=length(s)); if trouve then begin delete(s,1,i-1); val(s,result,erreur); end else result:=0; end; // le tampon est aussi grand que le x/y du plus grand TCO procedure init_tampon_copiercoller; begin SetLength(TamponTCO,MaxCellX+2,MaxCellY+2); end; // affiche le rectangle de sélection graphique Procedure Affiche_Rectangle(IndexTCO : integer;r : Trect_Select); begin if indexTCO<1 then exit; with PCanvasTCO[IndexTCO] do begin with pen do begin Mode:=PmXor; color:=clWhite; width:=1; end; Brush.Color:=clblue; Rectangle(r.Gd); // Grand rectangle Rectangle(r.rN); // rectangle poignée haut Rectangle(r.rE); Rectangle(r.rO); Rectangle(r.rS); Rectangle(r.rNE); Rectangle(r.rNO); Rectangle(r.rSO); Rectangle(r.rSE); end; end; // calcule les poignées du rectangle de sélection graphique procedure Init_rectangle(IndexTCO : integer;var r : Trect_Select); var xp,yp : integer; begin with r do begin // poignée nord (haut) xp:=(r.Gd.right+r.Gd.Left) div 2; yp:=r.Gd.Top; rn.Left:=xp-5; rn.top:=yp-5; rn.Right:=xp+5; rn.Bottom:=yp+5; // poignée droite xp:=r.Gd.Right; yp:=(r.Gd.Bottom+r.Gd.top) div 2; rE.Left:=xp-5; re.top:=yp-5; re.Right:=xp+5; re.Bottom:=yp+5; // poignée bas xp:=(r.gd.right+r.gd.Left) div 2; yp:=r.gd.Bottom; rS.Left:=xp-5; rs.top:=yp-5; rs.Right:=xp+5; rs.Bottom:=yp+5; // poignée gauche xp:=r.gd.Left; yp:=(r.gd.Bottom+r.gd.top) div 2; rO.Left:=xp-5; rO.top:=yp-5; ro.Right:=xp+5; ro.Bottom:=yp+5; // nord est xp:=r.gd.right; yp:=r.gd.top; rNE.Left:=xp-5; rNE.top:=yp-5; rNE.Right:=xp+5; rNE.Bottom:=yp+5; // sud est xp:=r.gd.right; yp:=r.gd.bottom; rSE.Left:=xp-5; rSE.top:=yp-5; rSE.Right:=xp+5; rSE.Bottom:=yp+5; // sud ouest xp:=r.gd.left; yp:=r.gd.bottom; rSO.Left:=xp-5; rSO.top:=yp-5; rSO.Right:=xp+5; rSO.Bottom:=yp+5; // nord ouest xp:=r.gd.left; yp:=r.gd.top; rNO.Left:=xp-5; rNO.top:=yp-5; rNO.Right:=xp+5; rNO.Bottom:=yp+5; end; end; // Accroche les poignées et bouge le rectangle de sélection graphique procedure Accroche_Rectangle_selection(indexTCO,x,y : integer); var dx,dy : integer; r : Trect; rien : boolean; begin rien:=not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_haut) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO); // poignée haut r:=Rect_Select.rN; if ((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_haut then begin screen.cursor:=crSizeNS; //if (not(prise_droit) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then if (rien and clicsouris) or prise_haut then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); if y=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_droit) then begin screen.cursor:=crSizeWE; //if (not(prise_haut) and not(prise_bas) and not(prise_gauche) and not(prise_NE) and not(prise_NO) and not(prise_SE) and not(prise_SO)) and clicsouris then if (rien and clicsouris) or prise_droit then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_droit:=true; if x>rect_select.Gd.Left then begin rect_Select.gd.right:=x; end else begin // inversion rect_Select.gd.left:=x; end; init_rectangle(indexTCO,rect_select); Affiche_Rectangle(indexTCO,rect_Select); end; exit; end; // poignée bas r:=Rect_Select.rS; if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_bas) then begin screen.cursor:=crSizeNS; if (rien and clicsouris) or prise_bas then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_bas:=true; if y>rect_select.Gd.top then begin rect_Select.gd.bottom:=y; end else begin // inversion rect_Select.gd.top:=y; end; init_rectangle(indexTCO,rect_select); Affiche_Rectangle(indexTCO,rect_Select); end; exit; end; // poignée gauche r:=Rect_Select.rO; if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_gauche) then begin screen.cursor:=crSizeWE; if (rien and clicsouris) or prise_gauche then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_gauche:=true; if x=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NE) then begin screen.cursor:=crSizeNESW; if (rien and clicsouris) or prise_NE then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_NE:=true; rect_Select.gd.right:=x; rect_Select.gd.top:=y; init_rectangle(indexTCO,rect_select); Affiche_Rectangle(indexTCO,rect_Select); end; exit; end; // poignée NO r:=Rect_Select.rNO; if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_NO) then begin screen.cursor:=crSizeNWSE; if (rien and clicsouris) or prise_NO then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_NO:=true; rect_Select.gd.left:=x; rect_Select.gd.top:=y; init_rectangle(indexTCO,rect_select); Affiche_Rectangle(indexTCO,rect_Select); end; exit; end; // poignée SE r:=Rect_Select.rSE; if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SE) then begin screen.cursor:=crSizeNWSE; if (rien and clicsouris) or prise_SE then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_SE:=true; rect_Select.gd.right:=x; rect_Select.gd.bottom:=y; init_rectangle(indexTCO,rect_select); Affiche_Rectangle(indexTCO,rect_Select); end; exit; end; // poignée SO r:=Rect_Select.rSO; if (((x>=r.left) and (x<=r.Right) and (y>=r.top) and (y<=r.bottom)) or prise_SO) then begin screen.cursor:=crSizeNESW; if (rien and clicsouris) or prise_SO then begin // efface l'ancien Affiche_Rectangle(IndexTCO,Rect_select); prise_SO:=true; rect_Select.gd.left:=x; rect_Select.gd.bottom:=y; init_rectangle(indexTCO,rect_select); Affiche_Rectangle(indexTCO,rect_Select); end; exit; end; // selec rectangle : bouger en toutes directions r:=Rect_select.Gd; if ((y>r.top) and (yr.Left) and (x0 then c:=s[1]; until ((c<>'/') and (s<>'')) or eof(fichier) ; lit_ligne:=s; end; begin //Affiche(GetCurrentDir,clYellow); {$I+} try // assign(fichier,fichierTCO[indexTCO]); assign(fichier,NomfichierTCO[indexTCO]); reset(fichier); except init_tco(indexTCO); exit; end; {$I-} if debug=1 then Affiche('Lecture tco '+intToSTr(indexTCO)+' '+NomfichierTCO[indexTCO],clyellow); x:=1;y:=1;NbreCellX[indexTCO]:=0;NbreCellY[indexTCO]:=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[indexTCO]:=true; clCanton[indexTCO]:=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[indexTCO]:=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[indexTCO]:=i; end; sa:=uppercase(ZoomInit_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); delete(s,i,length(sa)); val(s,i,erreur); ZoomInit[indexTCO]:=i; end; sa:=uppercase(XYInit_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); delete(s,i,length(sa)); val(s,i,erreur); XInit[indexTCO]:=i; delete(s,1,erreur); val(s,i,erreur); YInit[indexTCO]:=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[indexTCO]:=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[IndexTCO]:=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[indexTCO]:=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[indexTCO]:=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[indexTCO]:=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(Ecran_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; EcranTCO[indexTCO]:=i; end; sa:=uppercase(Epaisseur_voies_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>10) then i:=5; Epaisseur_voies:=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[indexTCO]:=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[indexTCO],erreur); i:=pos(',',s);delete(s,1,i); Val(s,NbreCellY[indexTCO],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; // evt clic det sa:=uppercase(EvtClicDet_ch)+'='; i:=pos(sa,s); if i<>0 then begin inc(nv); delete(s,i,length(sa)); val(s,i,erreur); EvtClicDet:=i=1; end; until (pos('[MATRICE]',uppercase(s))<>0) or (eof(fichier)); NbCellulesTCO[indexTCO]:=NbreCellX[indexTCO]*NbreCellY[indexTCO]; if (NbreCellX[indexTCO]<20) or (NbreCellX[indexTCO]>MaxCellX) then begin NbreCellX[indexTCO]:=MaxCellX; Affiche('TCO: le nombre de cellules X a été ramené à '+intToSTR(NbreCellX[indexTCO]),clred); end; if (NbreCellY[indexTCO]<5) or (NbreCellY[indexTCO]>MaxCellY) then begin NbreCellY[indexTCO]:=MaxCellY; Affiche('TCO: le nombre de cellules Y a été ramené à '+intToSTR(NbreCellX[indexTCO]),clred); end; try SetLength(TCO[indexTCO],MaxCellX+2,MaxCellY+2) except Affiche('TCO:Mémoire insuffisante pour'+intToSTR(MaxCellX)+' '+intToSTR(MaxCellY),clred); NbreCellX[indexTCO]:=20;NbreCellY[indexTCO]:=12; SetLength(TCO[indexTCO],NbreCellX[indexTCO]+2,NbreCellY[indexTCO]+2); end; try init_tampon_copiercoller; except Affiche('TamponTCO:Mémoire insuffisante',clred); NbreCellX[indexTCO]:=20;NbreCellY[indexTCO]:=12; init_tampon_copiercoller; end; // lire la matrice while not eof(fichier) do begin lit_ligne; s:=so; 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<15 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[indexTCO];sauve_tco:=true;end; tco[indexTCO,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[indexTCO,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=30 then begin valeur:=Id_signal;sauve_tco:=true;end; if valeur=31 then begin valeur:=51;sauve_tco:=true;end; tco[indexTCO,x,y].Bimage:=valeur; tco[indexTCO,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[indexTCO,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>4 then FeuOriente:=1; tco[indexTCO,x,y].FeuOriente:=FeuOriente; tco[indexTCO,x,y].x:=0; tco[indexTCO,x,y].y:=0; if PiedFeu<1 then PiedFeu:=1; if PiedFeu>2 then PiedFeu:=2; tco[indexTCO,x,y].PiedFeu:=PiedFeu; end; end; // si c'est une action, remplir les paramètres de l'action if tco[indexTCO,x,y].Bimage=Id_action then begin tco[indexTCO,x,y].PiedFeu:=PiedFeu; // quelle action tco[indexTCO,x,y].FeuOriente:=FeuOriente; // paramètre de l'action end; // 7 texte optionnel j:=pos(')',s); i:=pos(',',s); tco[indexTCO,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 j=13 then begin delete(s,1,1); // supprimer la virgule val(s,i,erreur); tco[indexTCO,x,y].epaisseurs:=i; i:=pos(')',s); j:=pos(',',s);if j=14 then begin delete(s,1,1); // supprimer la virgule val(s,i,erreur); tco[indexTCO,x,y].pont:=i; i:=pos(')',s); j:=pos(',',s);if j=15 then begin delete(s,1,1); // supprimer la virgule val(s,i,erreur); tco[indexTCO,x,y].buttoir:=i; //if i<>0 then tco[indexTCO,x,y].Adresse:=0; // pas d'adresse dans un buttoir i:=pos(')',s); j:=pos(',',s);if j=16 then begin delete(s,1,1); // supprimer la virgule val(s,i,erreur); tco[indexTCO,x,y].sortie:=i; delete(s,1,erreur-1); end; i:=pos(')',s); if i<>0 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; // donne l'équation de droite y=ax+b passant par les points (x1,y1) (x2,y2) procedure droite(x1,y1,x2,y2: integer;var a,b: double); begin if x2<>x1 then a:=(y2-y1)/(x2-x1) else a:=99999; b:=y1-a*x1; end; procedure sauve_fichiers_tco; var fichier : textfile; s : string; couleurFonte : Tcolor; x,y,i : integer; begin //x:=formconfig.MemoNomTCO.Lines.Count; //if x<0 then for i:=1 to NbreTCO do begin AssignFile(fichier,nomfichierTCO[i]); rewrite(fichier); Writeln(fichier,'/ Définitions TCO version '+version+sousversion); writeln(fichier,ZoomInit_ch+'=',ZoomInit[i]); writeln(fichier,XYInit_ch+'=',XInit[i],',',Yinit[i]); Writeln(fichier,clFond_ch+'='+IntToHex(clfond[i],6)); Writeln(fichier,clVoies_ch+'='+IntToHex(ClVoies[i],6)); Writeln(fichier,clAllume_ch+'='+IntToHex(ClAllume[i],6)); Writeln(fichier,clGrille_ch+'='+IntToHex(ClGrille[i],6)); Writeln(fichier,clTexte_ch+'='+IntToHex(ClTexte,6)); Writeln(fichier,clQuai_ch+'='+IntToHex(ClQuai[i],6)); Writeln(fichier,clPiedSignal_ch+'='+intToHex(clPiedSignal[i],6)); Writeln(fichier,ClCanton_ch+'='+IntToHex(ClCanton[i],6)); Writeln(fichier,ModeCouleurCanton_ch+'='+intToSTR(ModeCouleurCanton)); if avecGrille[i] then s:='1' else s:='0'; Writeln(fichier,Avecgrille_ch+'='+s); writeln(fichier,Graphisme_ch+'=',graphisme); writeln(fichier,Ecran_ch+'=',EcranTCO[i]); writeln(fichier,Epaisseur_voies_ch+'=',Epaisseur_voies); if EvtClicDet then s:='1' else s:='0'; Writeln(fichier,EvtClicDet_ch+'='+s); writeln(fichier,matrice_ch+'='+IntToSTR(NbreCellX[i])+','+intToSTR(NbreCellY[i])); 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, épaisseurs, pont, buttoir '); for y:=1 to NbreCellY[i] do begin s:=''; for x:=1 to NbreCellX[i] do begin s:=s+'('+intToHex(tco[i,x,y].CouleurFond,6)+','+inttostr(tco[i,x,y].Adresse)+','+IntToSTR(tco[i,x,y].BImage)+','; if tco[i,x,y].inverse then s:=s+'1,' else s:=s+'0,'; s:=s+IntToSTR(tco[i,x,y].FeuOriente)+','+IntToSTR(tco[i,x,y].PiedFeu)+','; // texte s:=s+tco[i,x,y].Texte+','; // représentation s:=s+intToSTR(tco[i,x,y].repr); // NomFonte s:=s+','+tco[i,x,y].Fonte; //taille fonte s:=s+','+intToSTR(tco[i,x,y].tailleFonte); // couleur fonte couleurfonte:=tco[i,x,y].coulFonte; s:=s+','+intTohex(couleurFonte,6); s:=s+','+tco[i,x,y].FontStyle; s:=s+','+intToSTR(tco[i,x,y].epaisseurs); s:=s+','+intToSTR(tco[i,x,y].pont); s:=s+','+intToSTR(tco[i,x,y].buttoir); s:=s+','+intToSTR(tco[i,x,y].sortie); s:=s+')'; end; writeln(fichier,s); end; closefile(fichier); Affiche('TCO '+nomFichierTCO[i]+' sauvegardé',clyellow); end; TCO_modifie:=false; end; // calcule les Hauteur et Largeur des cellules en fonction du Zoom procedure calcul_cellules(indexTCO : integer); var pos : integer; begin if affevt then affiche('Calcul_cellules',clyellow); pos:=ZoomMax-ZoomInit[indexTCO]+ZoomMin; //Affiche('Position TrackBar°'+intToSTR(indexTCO)+'='+intToSTR(pos),clyellow); LargeurCell[indexTCO]:=pos; //Affiche('LargeurCell TCO N°'+intToSTR(indexTCO)+'='+intToSTR(largeurcell[indexTCO]),clyellow); hauteurCell[indexTCO]:=(LargeurCell[indexTCO] * RatioC) div 10; largeurCelld2[indexTCO]:=largeurCell[indexTCO] div 2; HauteurCelld2[indexTCO]:=HauteurCell[indexTCO] div 2; //Affiche(intToSTR(LargeurCell[indexTCO])+' '+intToSTR(epaisseur),clyellow); end; procedure entoure_cell_grille(indexTCO,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[indexTCO]) then exit; Xorg:=(x-1)*LargeurCell[indexTCO]; Yorg:=(y-1)*HauteurCell[indexTCO]; With PcanvasTCO[indexTCO] do begin Pen.Color:=clGrille[IndexTCO]; Pen.mode:=PmCopy; Pen.width:=1; MoveTo(Xorg,YOrg); LineTo(Xorg+LargeurCell[indexTCO],YOrg); LineTo(Xorg+LargeurCell[indexTCO],YOrg+HauteurCell[indexTCO]); LineTo(Xorg,YOrg+HauteurCell[indexTCO]); LineTo(Xorg,YOrg); end; end; function positionTCO(indexTCO,x,y : integer) : integer; var position,i : integer; begin i:=index_Aig(tco[indextco,x,y].Adresse); position:=aiguillage[i].position ; if (position=0) or (i=0) then begin result:=const_inconnu;exit;end; if tco[indextco,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 elliptique à deux rayons différents procedure D_Arc2R(Canvas: TCanvas; CentreX,CentreY: integer; rayonX,rayonY: Integer; StartDegres, StopDegres: Double); var sinA,cosA : extended; x1,x2,x3,x4,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:=CentreX - rayonX; y1:=CentreY - rayonY; x2:=CentreX + rayonX; y2:=CentreY + rayonY; SinCos(StartDegres,SinA,CosA); x4:=CentreX + round(rayonX*CosA); y4:=Centrey - Round(rayonY*SinA); SinCos(StopDegres,SinA,CosA); x3:=CentreX + round(rayonX*CosA); y3:=Centrey - round(rayonY*SinA); Canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; // affiche la sélection bleue des cellules procedure affiche_selection(indexTCO : integer); var r : Trect; begin with PImageTCO[indexTCO].Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[IndexTCO]; Brush.Color:=clblue; //FillRect(r); r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]); Rectangle(r); end; end; procedure efface_selection(indexTCO : integer); begin if SelectionAffichee[indexTCO] then begin //Affiche('efface sélection',clOrange); with formtco[indexTCO].imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[IndexTCO]; Brush.Color:=clblue; //FillRect(r); Rectangle(rAncien); end; SelectionAffichee[indexTCO]:=false; end; end; // élément de voie horizontale Element 1 procedure dessin_1(indexTCO: integer;Canvas : Tcanvas;x,y,mode : integer); var Adr,yf,xf,x0,y0,jy1,jy2,ep,xc,yc,but : integer; r : Trect; couleur : Tcolor; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*HauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(HauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+HauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; but:=tco[indextco,x,y].buttoir; with canvas do begin //Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Mode:=pmCopy; // buttoir if but<>0 then begin case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,7) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; if testBit(but,7) then begin moveTo(x0,yc);LineTo(xc,yc); end; if testBit(but,3) then begin moveTo(xc,yc);LineTo(xf,yc); end; Pen.Width:=epaisseur; pen.Color:=Clred; moveto(xc,yc+round(7*fryGlob[indexTCO])); LineTo(xc,yc-round(7*fryGlob[indexTCO])); exit; end; // détecteur Adr:=tco[indextco,x,y].adresse; if adr<>0 then begin pen.Width:=1; if detecteur[Adr].etat then begin brush.Color:=clAllume[indexTCO]; pen.color:=clAllume[indexTCO]; end else begin pen.color:=tco[indextco,x,y].CouleurFond; brush.color:=tco[indextco,x,y].CouleurFond; end; jy1:=y0+(HauteurCell[indexTCO] div 2)-round(7*fryGlob[indexTCO]); // pos Y de la bande sup jy2:=y0+(HauteurCell[indexTCO] div 2)+round(7*fryGlob[indexTCO]); // pos Y de la bande inf if avecGrille[indexTCO] then r:=Rect(x0+1,jy1,xf-1,jy2) else r:=Rect(x0,jy1,x0+LargeurCell[indexTCO],jy2) ; FillRect(r); end; case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,7) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(x0,yc);LineTo(xf,yc); end; end; // renvoie vrai si l'élément i est un aiguillage ou une TJD/S ou un croisement function IsAigTCO(i : integer) : boolean; begin result:=((i=2) or (i=3) or (i=4) or (i=5) or (i=12) or (i=13) or (i=14) or (i=15) or ((i>=21) and (i<=34) )) ; end; // écrit le texte réparti sur plusieurs lignes. // ne fonctionne qu'avec certaines fontes // x,y : en cellules // tf=taille fonte Procedure Texte_reparti(s : string;indexTCO,x,y,tf : integer); var c : Tcanvas; st : array[1..10] of string; haut,larg,i,l,PixelLength,NombreMots,yl : integer; begin if (s='') or (indexTCO=0) then exit; // supprimer les espaces en fin i:=Length(s); if s[i]=' ' then begin repeat dec(i); until (s[i]<>' ') or (i=1); delete(s,i+1,length(s)-i); end; // découper la chaine s dans le tableau st if tf=0 then tf:=8; c:=PcanvasTCO[indexTCO]; i:=1;l:=length(s);NombreMots:=1; repeat i:=pos(' ',s); if i=0 then st[NombreMots]:=s else st[NombreMots]:=copy(s,1,i-1); delete(s,1,i); inc(NombreMots); until (i>l) or (i=0); dec(NombreMots); PixelLength:=tf; // x y en cellules larg:=LargeurCell[indexTCO]; haut:=HauteurCell[indexTCO]; l:=0; // compteur de lignes i:=1; // faire une ligne repeat s:=''; repeat s:=s+st[i]+' '; inc(i); //Affiche(s+' '+intToSTR(tf*length(s+st[i])),clyellow); until (round(0.8*tf*length(s+st[i]))>larg) or (i>NombreMots); //yl:=(y-1)*round((l*tf)); delete(s,length(s),1); yl:=round(1.5*l*tf)+((y-1)*haut); PCanvasTCO[indexTCO].TextOut((x-1)*larg+5,yl+3,s); inc(l); until (i>NombreMots); 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; procedure affiche_texte(indextco,x,y : integer); var b,x0,y0,xt,yt,repr,taillefont,tf : integer; ss,s,nf : string; c : Tcanvas; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; //PCanvasTCO.Brush.Style:=bsSolid; s:=tco[indextco,x,y].Texte; // if s='' then exit; c:=PcanvasTCO[indextco]; b:=tco[indextco,x,y].BImage; if (b=51) then PCanvasTCO[indextco].Brush.Color:=clQuai[indexTCO] else PCanvasTCO[indextco].Brush.Color:=tco[indextco,x,y].CouleurFond; c.Font.Color:=tco[indextco,x,y].CoulFonte; nf:=tco[indextco,x,y].fonte; if nf='' then ss:='Arial'; c.Font.Name:=nf; ss:=tco[indextco,x,y].FontStyle; c.Font.Style:=style(ss); repr:=tco[indextco,x,y].repr; taillefont:=tco[indextco,x,y].TailleFonte; xt:=0;yt:=0; if taillefont=0 then taillefont:=8; tf:=(taillefont*LargeurCell[indexTCO]) div 40; c.font.Size:=tf; if b=id_action then c.Brush.Color:=ClGray; //affiche(intToSTR(taillefont*LargeurCell[indexTCO] div 40),clyellow); // champ texte //Affiche(nf+' '+intToSTR(tf)+' '+s,clred); case repr of 0,1 : yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // au milieu 2 : yt:=1; // haut 3 : yt:=hauteurCell[indexTCO]-round(2*TailleFont*fryGlob[indexTCO]); // bas 5 : begin // double centré XY xt:=(largeurCell[indexTCO] div 2)-(round(length(s)*(taillefont)*frxGlob[indexTCO]) div 2); yt:=(hauteurCell[indexTCO] div 2)-round(tailleFont*fryGlob[indexTCO]); // texte centré end; end; if b=Id_Quai then xt:=6; if (b<>Id_Quai) and (b<>Id_action) then s:=s+' '; if repr=4 then texte_reparti(s,indextco,x,y,tf) else c.Textout(x0+xt,y0+yt,s); end; procedure dessin_2L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy2,xf,yf,position,jy1,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin fond:=tco[indextco,x,y].CouleurFond; position:=positionTCO(indexTCO,x,y); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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; jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup pen.width:=1; Polygon([point(x0+1,y0+hauteurCell[indexTCO]-epaisseur),Point(xc-(epaisseur div 2),jy1),Point(xc-epaisseur-epaisseur,jy1),Point(x0+1,y0+hauteurCell[indexTCO]-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[indexTCO]-1,jy2+epaisseur); FillRect(r); end; end; end; // courbe procedure dessin_2C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin fond:=tco[indextco,x,y].CouleurFond; position:=positionTCO(indexTCO,x,y); ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell[indexTCO]*2+(hauteurCell[indexTCO] 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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[indexTCO]-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[indexTCO]-1,jy2+epaisseur); FillRect(r); end; end; end; procedure dessin_2(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_2L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_2C(indexTCO,Canvas,x,y,Mode); end; procedure dessin_3L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,xf,yf,position,ep : integer; fond : Tcolor; r : Trect; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,y0);lineto(xc,yc); if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yc); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin fond:=tco[indextco,x,y].CouleurFond; position:=positionTCO(indexTCO,x,y); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(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[indexTCO]-1,jy1-epaisseur); FillRect(r); end; end; end; procedure dessin_3C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,jy1,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4,ep : integer; fond : Tcolor; r : Trect; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+(LargeurCell[indexTCO] div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; position:=positionTCO(indexTCO,x,y); fond:=tco[indextco,x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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[indexTCO]-1,jy1-epaisseur); FillRect(r); end; end; end; procedure dessin_3(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_3L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_3C(indexTCO,Canvas,x,y,Mode); end; procedure dessin_4L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,yf);lineto(xc,yc); if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yc); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin fond:=tco[indextco,x,y].CouleurFond; position:=positionTCO(indexTCO,x,y); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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+round(0.3*epaisseur);y1:=yc-(epaisseur div 2)-1; x2:=x1+epaisseur;y2:=y1; x3:=x2+epaisseur;y3:=y2+epaisseur; x4:=x1+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; // efface le morceau x1:=xc-epaisseur-1;y1:=yc+(epaisseur div 2)+1; x2:=x1+25;y2:=y1+5; r:=rect(x1,y1,x2,y2); rectangle(r); end; end; end; procedure dessin_4C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc; x2:=xf+(LargeurCell[indexTCO] div 3);y2:=yf+2*hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; position:=positionTCO(indexTCO,x,y); fond:=tco[indextco,x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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+8; x4:=x1+12;y4:=y3; Polygon([point(xc-round(2.1*epaisseur),yc-epaisseur-1),point(xc,yc-epaisseur-1),point(xc+3*epaisseur,yc+epaisseur),point(xc+round(2.0*epaisseur),yc+epaisseur)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; // efface le morceau x1:=xc-3*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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_4L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_4C(indexTCO,Canvas,x,y,Mode); end; procedure dessin_5L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin fond:=tco[indextco,x,y].CouleurFond; position:=positionTCO(indexTCO,x,y); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTCO,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2)+4; x2:=xf+LargeurCell[indexTCO]+(LargeurCell[indexTCO] 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_5L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_5C(indexTCO,Canvas,x,y,Mode); end; // coin supérieur gauche (Element 6) procedure dessin_6L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Pen.Width:=epaisseur; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Lineto(x0+LargeurCell[indexTCO],yc); end; end; // coin supérieur gauche (Element 6) procedure dessin_6C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+LargeurCell[indexTCO]+(LargeurCell[indexTCO] div 3);y2:=yc; x3:=x0;y3:=y0; x4:=xf;y4:=yc; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; if testbit(ep,0) or testbit(ep,3) then pen.Width:=epaisseur div 2 else 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_6L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_6C(indexTCO,Canvas,x,y,Mode); end; // Element 7 procedure dessin_7L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=couleur; Pen.Mode:=pmCopy; if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0+LargeurCell[indexTCO],y0); end; end; procedure dessin_7C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+(LargeurCell[indexTCO] div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=couleur; Pen.Mode:=pmCopy; if testbit(ep,2) or testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_7(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_7L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_7C(indexTCO,Canvas,x,y,Mode); end; // courbe: droit vers bas -\ Element 8 procedure dessin_8L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; Pen.Mode:=pmCopy; pen.color:=Couleur; if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); end; end; procedure dessin_8C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc; x2:=xf+(LargeurCell[indexTCO] div 3);y2:=yf+2*hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; Pen.Mode:=pmCopy; pen.color:=Couleur; if testbit(ep,7) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_8(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_8L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_8C(indexTCO,Canvas,x,y,Mode); end; // courbe bas gauche vers droit Elément 9 procedure dessin_9l(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(x0,y0+hauteurCell[indexTCO]);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(x0+LargeurCell[indexTCO],yc); end; end; // courbe bas gauche vers droit Elément 9 procedure dessin_9c(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell[indexTCO]*2+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yc; x4:=x0;y4:=yf; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,6) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_9(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_9L(indexTCO,Canvas,x,y,Mode); if graphisme=2 then dessin_9C(indexTCO,Canvas,x,y,Mode); end; // élément 10 procedure dessin_10(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var Adr,but,x0,y0,xc,yc,xf,yf,ep: integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; but:=tco[indextco,x,y].buttoir; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); if but<>0 then begin case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,2) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; if testBit(but,2) then begin moveTo(xf,y0);LineTo(xc,yc); end; if testBit(but,6) then begin moveTo(x0,yf);LineTo(xc,yc); end; Pen.Width:=epaisseur; pen.Color:=Clred; moveto(xc-round(5*frxGlob[indexTCO]),yc-round(5*fryGlob[indexTCO])); LineTo(xc+round(5*frxGlob[indexTCO]),yc+round(5*fryGlob[indexTCO])); exit; end; Adr:=tco[indextco,x,y].adresse; // détecteur if adr<>0 then begin if detecteur[Adr].etat then begin brush.Color:=clAllume[indexTCO]; pen.color:=clAllume[indexTCO]; end else begin pen.color:=tco[indextco,x,y].CouleurFond; brush.color:=tco[indextco,x,y].CouleurFond; end; pen.Width:=epaisseur+3; MoveTo(x0+LargeurCell[indexTCO],y0);LineTo(x0,y0+hauteurCell[indexTCO]); end; // voie case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,6) or testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(x0+LargeurCell[indexTCO],y0);LineTo(x0,y0+hauteurCell[indexTCO]); end; end; // élément 11 procedure dessin_11(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var Adr, x0,y0,xc,yc,xf,yf,ep,but : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; but:=tco[indextco,x,y].buttoir; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; if testbit(but,0) or testbit(but,4) then begin case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,0) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; if testBit(but,0) then begin moveTo(x0,y0);LineTo(xc,yc); end; if testBit(but,4) then begin moveTo(xf,yf);LineTo(xc,yc); end; Pen.Width:=epaisseur; pen.Color:=Clred; moveto(xc+round(5*frxGlob[indexTCO]),yc-round(5*fryGlob[indexTCO])); LineTo(xc-round(5*frxGlob[indexTCO]),yc+round(5*fryGlob[indexTCO])); exit; end; Adr:=tco[indextco,x,y].adresse; // détecteur if adr<>0 then begin if detecteur[Adr].etat then begin brush.Color:=clAllume[indexTCO]; pen.color:=clAllume[indexTCO]; end else begin pen.color:=tco[indextco,x,y].CouleurFond; brush.color:=tco[indextco,x,y].CouleurFond; end; pen.Width:=epaisseur+3; MoveTo(x0,y0);LineTo(x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); end; // voie case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,0) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(x0,y0);LineTo(x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); end; end; // Element 12 procedure dessin_12L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTCO,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+LargeurCell[indexTCO]+(LargeurCell[indexTCO] div 3);y2:=yc; x3:=x0;y3:=y0; x4:=xf;y4:=yc; position:=positionTCO(indexTCO,x,y); fond:=tco[indextco,x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_12L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_12C(indexTco,Canvas,x,y,Mode); end; // Elément 13 procedure dessin_13L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,y0); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yc); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(xf,y0);lineto(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+(LargeurCell[indexTCO] div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_13L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_13C(indexTco,Canvas,x,y,Mode); end; // Element 14 procedure dessin_14l(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; moveto(x0,y0);lineto(xf,yf); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; 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[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; 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[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc; x2:=xf+(LargeurCell[indexTCO] div 3);y2:=yf+2*hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_14L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_14C(indexTco,Canvas,x,y,Mode); end; // Element 15 procedure dessin_15L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position,ep : integer; fond : Tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,y0); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yc); // partie droite end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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:=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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : Tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,y0); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell[indexTCO]*2+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yc; x4:=x0;y4:=yf; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_15L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_15C(indexTco,Canvas,x,y,Mode); end; // Element 16 procedure dessin_16L(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,0) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur ; MoveTo(x0,y0);lineTo(xc,yc);LineTo(xc,y0+hauteurCell[indexTCO]); end; end; procedure dessin_16C(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,0) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_16(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_16L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_16C(indexTco,Canvas,x,y,Mode); end; // Element 17 procedure dessin_17l(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; Pen.Mode:=pmCopy; if testbit(ep,2) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(x0+LargeurCell[indexTCO],y0);LineTo(xc,yc);LineTo(xc,y0+hauteurCell[indexTCO]); end; end; // Element 17 procedure dessin_17c(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xf;y3:=y0; x4:=xc;y4:=yf; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; Pen.Mode:=pmCopy; if testbit(ep,2) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_17(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_17L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_17C(indexTco,Canvas,x,y,Mode); end; // Elément 18 procedure dessin_18l(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(x0,y0+hauteurCell[indexTCO]);LineTo(xc,yc);LineTo(xc,y0); end; end; procedure dessin_18c(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 2.5); x3:=x0;y3:=yf; x4:=xc;y4:=y0; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=clfond[indexTCO]; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_18(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_18L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_18C(indexTco,Canvas,x,y,Mode); end; // Element 19 procedure dessin_19l(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,1) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);LineTo(xc,yc);LineTo(x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); end; end; procedure dessin_19c(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Width:=1; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; if testbit(ep,1) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; canvas.Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure dessin_19(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_19L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_19C(indexTco,Canvas,x,y,Mode); end; // Element 20 procedure dessin_20(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var jx1,jx2,x0,y0,xc,xf,yf,yc,adr,ep,but : integer; r : Trect; couleur : tcolor; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; but:=tco[indextco,x,y].buttoir; with canvas do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Pen.Mode:=pmCopy; if but<>0 then begin case mode of 0 : couleur:=clVoies[indexTCO]; 1 : couleur:=clAllume[indexTCO]; 2 : couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; pen.color:=couleur; if testbit(ep,1) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; if testBit(but,1) then begin moveTo(xc,y0);LineTo(xc,yc); end; if testBit(but,5) then begin moveTo(xc,yc);LineTo(xc,yf); end; Pen.Width:=epaisseur; pen.Color:=Clred; moveto(x0+round(20*fryGlob[indexTCO]),yc); LineTo(xf-round(20*fryGlob[indexTCO]),yc); exit; end; // état détecteur Adr:=tco[indextco,x,y].adresse; if Adr<>0 then begin if detecteur[Adr].etat then begin Brush.Color:=clAllume[indexTCO]; pen.color:=clAllume[indexTCO]; end else begin couleur:=tco[indextco,x,y].CouleurFond; Brush.Color:=couleur; pen.color:=couleur; end; jx1:=x0+(LargeurCell[indexTCO] div 2)-round(7*frxGlob[indexTCO]); // pos Y de la bande sup jx2:=x0+(LargeurCell[indexTCO] div 2)+round(7*frxGlob[indexTCO]); // pos Y de la bande inf if avecGrille[indexTCO] then r:=Rect(jx1,y0+1,jx2,y0+hauteurCell[indexTCO]-1) else r:=Rect(jx1,y0,jx2,y0+hauteurCell[indexTCO]) ; FillRect(r); end; // voie case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; if testbit(ep,1) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(xc,y0);LineTo(xc,y0+hauteurCell[indexTCO]); end; end; // Element 21 - croisement - TJD procedure dessin_21(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); var yp,x1,x2,y1,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep,pont : integer; a1,b1,a2,b2 : double; md : tequipement; procedure horizontale; begin with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(x0,yc);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xf,yc); end; end; procedure diagonale; begin with canvas do begin if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(x0,yf);LineTo(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xf,y0); end; end; procedure TjdHaut; begin x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+(LargeurCell[indexTCO] div 3)+3;y2:=yc; x3:=x0;y3:=yc; x4:=xf;y4:=y0; with canvas do begin if testbit(ep,2) or testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure TjdBas; begin x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; x2:=xf+xf-x1;y2:=yf+hauteurCell[indexTCO]*2+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yc; x4:=x0;y4:=yf; with canvas do begin if testbit(ep,6) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; pont:=tco[indextco,x,y].pont; with canvas do begin Pen.Width:=1; Brush.Color:=clvoies[indexTCO]; pen.color:=clvoies[indexTCO]; horizontale; diagonale; md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; if (md=tjd) or (md=tjs) then begin tjdbas; tjdhaut; end; // horizontale if testbit(pont,3) or testbit(pont,7) then begin // dessiner le pont pen.color:=clfond[indexTCO]; yp:=yc-(epaisseur); moveto(x0+5,yp);lineTo(xf-5,yp); yp:=yc+(epaisseur); moveto(x0+5,yp);lineTo(xf-5,yp); // barrières du pont pen.color:=clBarriere[indexTCO]; pen.Width:=epaisseur div 2; moveto(x0+5,yp);lineTo(xf-5,yp); yp:=yc-(epaisseur); moveto(x0+5,yp);lineTo(xf-5,yp); end; // diagonale if testbit(pont,2) or testbit(pont,6) then begin pen.color:=clfond[indexTCO]; droite(xf,y0,x0,yf,a1,b1); // droite a2,b2 // passant par x2,y2 a2:=a1; // masquage sup x2:=xf-round(24*frxGlob[indexTCO]);y2:=y0+round(12*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(6*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // barrière sup pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; x2:=xf-round(24*frxGlob[indexTCO]);y2:=y0+round(12*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(6*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // masquage inf pen.Width:=epaisseur; pen.color:=clFond[indexTCO]; x2:=xf-round(7*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(16*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // barrière inf pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; //x2:=xf-round(10*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); x2:=xf-round(7*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(22*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); end; // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[indextco,x,y].trajet; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then horizontale; // horizontale if trajet=2 then diagonale; // diagonale if trajet=3 then // SO C E /- begin { if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yc);} tjdbas; end; if trajet=4 then // -/ O C NE begin {if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);LineTo(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,y0);} tjdhaut; end; end; end; end; // Element 22 procedure dessin_22(indexTCO : integer;Canvas : Tcanvas;x,y,mode : integer); var pont,yp,x1,y1,x2,y2,x3,y3,x4,y4,x0,y0,xc,yc,xf,yf,trajet,ep : integer; md : tequipement; a1,b1,a2,b2 : double; procedure horizontale; begin with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(x0,yc);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xf,yc); end; end; procedure diagonale; begin with canvas do begin if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(x0,y0);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xf,yf); end; end; procedure TJDbas; begin x1:=x0-LargeurCell[indexTCO]-(LargeurCell[indexTCO] div 3);y1:=yc; x2:=xf+(LargeurCell[indexTCO] div 3);y2:=yf+2*hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin if testbit(ep,7) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure TJDHaut; begin x1:=x0-(LargeurCell[indexTCO] div 3);y1:=y0-2*hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 2); x2:=xf+LargeurCell[indexTCO]+(LargeurCell[indexTCO] div 3);y2:=yc; x3:=x0;y3:=y0; x4:=xf;y4:=yc; with canvas do begin if testbit(ep,0) or testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; pont:=tco[indextco,x,y].pont; with canvas do begin Pen.Width:=1; Brush.Color:=tco[indextco,x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); Brush.Color:=clvoies[indexTCO]; pen.color:=clvoies[indexTCO]; pen.width:=epaisseur; diagonale; horizontale; md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; if (md=tjd) or (md=tjs) then begin TJDbas; TJDHaut; end; // horizontale if testbit(pont,3) or testbit(pont,7) then begin // dessiner le pont pen.color:=clFond[indexTCO]; yp:=yc-(epaisseur); moveto(x0+5,yp);lineTo(xf-5,yp); yp:=yc+(epaisseur); moveto(x0+5,yp);lineTo(xf-5,yp); // barrières du pont pen.color:=clBarriere[indexTCO]; pen.Width:=epaisseur div 2; moveto(x0+5,yp);lineTo(xf-5,yp); yp:=yc-(epaisseur); moveto(x0+5,yp);lineTo(xf-5,yp); end; // diagonale if testbit(pont,0) or testbit(pont,4) then begin pen.color:=clfond[indexTCO]; droite(x0,y0,xf,yf,a1,b1); // droite a2,b2 // passant par x2,y2 a2:=a1; // masquage G x2:=x0+round(8*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(18*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // barrière pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; x2:=x0+round(8*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(18*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // masquage D pen.Width:=epaisseur; pen.color:=clfond[indexTCO]; x2:=x0+round(20*frxGlob[indexTCO]);y2:=y0+round(11*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(8*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); pen.width:=epaisseur div 2; pen.color:=clwhite; x2:=x0+round(20*frxGlob[indexTCO]);y2:=y0+round(11*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(8*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); end; // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[indextco,x,y].trajet; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then horizontale; if trajet=2 then diagonale; if trajet=3 then // NO centre E \- begin { if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);LineTo(xc,yc); if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yc);} tjdhaut; end; if trajet=4 then // O C SE -\ begin { if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yc);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yf); } tjdbas; end; end; end; end; // Element 51 (quai) procedure dessin_51(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,x1,x2,jy1,jy2 : integer; r : Trect; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; with canvas do begin Pen.Width:=1; Brush.Color:=tco[indextco,x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); Brush.Color:=clQuai[indexTCO]; pen.color:=clQuai[indexTCO]; x1:=x0; x2:=x0+LargeurCell[indexTCO]; jy1:=y0+(hauteurCell[indexTCO] div 2)-round(14*fryGlob[indexTCO]); // pos Y de la bande sup jy2:=y0+(hauteurCell[indexTCO] div 2)+round(14*fryGlob[indexTCO]); // pos Y de la bande inf r:=rect(x1,jy1,x2,jy2); rectangle(r); end; end; // action procedure dessin_52(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xf,yf,act : integer; r : Trect; s : string; begin x0:=(x-1)*LargeurCell[indexTCO]+2; y0:=(y-1)*hauteurCell[indexTCO]+2; xf:=x0+LargeurCell[indexTCO]-4; yf:=y0+HauteurCell[indexTCO]-4; with canvas do begin Pen.Width:=1; Brush.Color:=clGray; pen.color:=clwhite; r:=rect(x0,y0,xf,yf); rectangle(r); if TCOActive then begin s:=tco[indexTCO,x,y].Fonte; if s='' then tco[indexTCO,x,y].Fonte:='Arial'; //s:=tco[indexTCO,x,y].texte; s:=''; if s='' then tco[indexTCO,x,y].repr:=5; // centré en X et Y act:=tco[indexTCO,x,y].PiedFeu; if act=1 then begin if s='' then s:='TCO'+intToSTR(tco[indexTCO,x,y].FeuOriente); // feuoriente contient le numéro du TCO tco[indexTCO,x,y].texte:=s; tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; end; if act=2 then begin if s='' then s:='SC'; tco[indexTCO,x,y].texte:=s; tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; end; if act=3 then begin if s='' then s:='CDM'; tco[indexTCO,x,y].texte:=s; tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; end; if act=4 then begin if s='' then s:=intToSTR(tco[indexTCO,x,y].adresse); tco[indexTCO,x,y].texte:=s; tco[indexTCO,x,y].TailleFonte:=8; tco[indexTCO,x,y].FontStyle:='G'; end; //tf:=(tco[indexTCO,x,y].TailleFonte*LargeurCell[indexTCO]) div 40; //tf:=(8*LargeurCell[indexTCO]) div 40;; //Font.Color:=clwhite; //font.Name:='Arial'; //texte_reparti(s,indexTCO,x,y,tf); affiche_texte(indextco,x,y); end; end; end; // Element 24 procedure dessin_24L(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); ep:=tco[indextco,x,y].epaisseurs; fond:=tco[indextco,x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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; 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(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); // partie droite end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] 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:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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; // Element 23 croisement procedure dessin_23(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x1,x2,y1,y2,xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont : integer; a1,b1,a2,b2 : double; md : tEquipement; procedure verticale; begin with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(xc,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xc,yf); end; end; procedure diagonale; begin with canvas do begin if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(xf,y0);LineTo(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(x0,yf); end; end; procedure tjd_d; begin x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xf;y3:=y0; x4:=xc;y4:=yf; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin if testbit(ep,2) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure tjd_G; begin x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 2.5); x3:=x0;y3:=yf; x4:=xc;y4:=y0; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; pont:=tco[indextco,x,y].pont; with canvas do begin Pen.Width:=1; Brush.Color:=tco[indextco,x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); Brush.Color:=clvoies[indexTCO]; pen.color:=clvoies[indexTCO]; pen.width:=epaisseur; diagonale; verticale; md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; if (md=tjd) or (md=tjs) then begin tjd_G; tjd_D; end; // verticale if testbit(pont,1) or testbit(pont,5) then begin // masquages pen.color:=clfond[indexTCO]; xp:=xc-(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); xp:=xc+(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); // barrières du pont pen.color:=clBarriere[indexTCO]; pen.Width:=epaisseur div 2; xp:=xc-(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); xp:=xc+(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); end; // diagonale if testbit(pont,2) or testbit(pont,6) then begin pen.color:=clfond[indexTCO]; droite(xf,y0,x0,yf,a1,b1); // droite a2,b2 // passant par x2,y2 a2:=a1; // masquage G x2:=xf-round(21*frxGlob[indexTCO]);y2:=y0+round(12*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(6*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // barrière pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; x2:=xf-round(21*frxGlob[indexTCO]);y2:=y0+round(12*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(6*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // masquage D pen.Width:=epaisseur; pen.color:=clFond[indexTCO]; x2:=xf-round(10*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(16*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // barrière pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; x2:=xf-round(10*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=x0+round(16*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); end; // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[indextco,x,y].trajet; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then verticale; if trajet=2 then diagonale; if trajet=3 then // NE C S begin {if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xc,yf);} tjd_d; end; if trajet=4 then // N C SO begin {if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);LineTo(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(x0,yf);} tjd_g; end; end; end; end; procedure dessin_24(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_24L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_24C(indexTco,Canvas,x,y,Mode); end; // Element 25 croisement procedure dessin_25(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var xp,x0,y0,x3,y3,x4,y4,xf,yf,xc,yc,trajet,ep,pont,x1,x2,y1,y2 : integer; a1,b1,a2,b2 : double; md : tEquipement; procedure verticale; begin with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(xc,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xc,yf); end; end; procedure diagonale; begin with canvas do begin if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveTo(x0,y0);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; LineTo(xf,yf); end; end; procedure tjd_g; begin x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin if testbit(ep,0) or testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; procedure tjd_d; begin x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+round(hauteurCell[indexTCO] / 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin if testbit(ep,1) or testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; xc:=x0+(LargeurCell[indexTCO] div 2); yc:=y0+(hauteurCell[indexTCO] div 2); xf:=x0+LargeurCell[indexTCO]; yf:=y0+hauteurCell[indexTCO]; ep:=tco[indextco,x,y].epaisseurs; pont:=tco[indextco,x,y].pont; with canvas do begin Pen.Width:=1; Brush.Color:=tco[indextco,x,y].CouleurFond; //r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); //FillRect(r); Brush.Color:=clvoies[indexTCO]; pen.color:=clvoies[indexTCO]; pen.width:=epaisseur; verticale; diagonale; md:=aiguillage[index_aig(tco[indextco,x,y].Adresse)].modele; if (md=tjd) or (md=tjs) then begin tjd_g; tjd_d; end; // verticale if testbit(pont,1) or testbit(pont,5) then begin // masquages pen.color:=clfond[indexTCO]; xp:=xc-(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); xp:=xc+(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); // barrières du pont pen.color:=clBarriere[indexTCO]; pen.Width:=epaisseur div 2; xp:=xc-(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); xp:=xc+(epaisseur); moveto(xp,y0+epaisseur);lineTo(xp,yf-epaisseur); end; // diagonale if testbit(pont,0) or testbit(pont,4) then begin pen.color:=clfond[indexTCO]; droite(x0,y0,xf,yf,a1,b1); // droite a2,b2 // passant par x2,y2 a2:=a1; // masquage G x2:=x0+round(8*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(18*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // barrière pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; x2:=x0+round(8*frxGlob[indexTCO]);y2:=y0+round(18*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(18*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); // masquage D pen.Width:=epaisseur; pen.color:=clfond[indexTCO]; x2:=x0+round(20*frxGlob[indexTCO]);y2:=y0+round(11*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(8*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); pen.width:=epaisseur div 2; pen.color:=clBarriere[indexTCO]; x2:=x0+round(20*frxGlob[indexTCO]);y2:=y0+round(11*fryGlob[indexTCO]); b2:=y2-a2*x2; x1:=xf-round(8*frxGlob[indexTCO]); y1:=round(a2*x1+b2); moveto(x1,y1);lineTo(x2,y2); end; // regarder d'ou on vient de la route du tco if mode>0 then begin trajet:=tco[indextco,x,y].trajet; case mode of 0: couleur:=clVoies[indexTCO]; 1: couleur:=ClCanton[indexTCO]; 2: couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; Brush.Color:=couleur; pen.color:=couleur; if trajet=1 then verticale; if trajet=2 then diagonale; if trajet=3 then // NO C S begin {if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);LineTo(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xc,yf);} tjd_g; end; if trajet=4 then begin {if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);LineTo(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yf);} tjd_d; end; end; end; end; // Element 26 procedure dessin_26L(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,yf);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,y0); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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; jy1:=yc - 2*Epaisseur-1; jx1:=xc- (Epaisseur div 2); pen.width:=1; Polygon([point(jx1,jy1),Point(jx1+epaisseur,jy1),Point(jx1+epaisseur,jy1+epaisseur),Point(jx1,jy1+2*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)+1; r:=rect(jx1,yc-15,jx1+Epaisseur,yc+10); FillRect(r); end; end; end; // Element 26 procedure dessin_26C(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xf;y3:=y0; x4:=xc;y4:=yf; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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),Point(jx1+epaisseur,jy1+epaisseur),Point(jx1,jy1+4*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); r:=rect(jx1+1,yc-15,jx1+Epaisseur,yf); FillRect(r); end; end; end; procedure dessin_26(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_26L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_26C(indexTco,Canvas,x,y,Mode); end; // Element 27 procedure dessin_27L(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,jx2,jy2,jx3,jy3,xc,yc,jx1,jy1,xf,yf,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);lineto(xc,yc); // verticale complete if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(x0,yf); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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+2; jx2:=jx1+epaisseur;jy2:=jy1-epaisseur; jx3:=jx2;jy3:=yc+2*epaisseur; pen.width:=1; Polygon([point(jx1,jy1),Point(jx2,jy2),Point(jx3,jy3),Point(jx1,jy3)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jx1:=xc-(Epaisseur div 2); r:=rect(jx1,yc-3*epaisseur,jx1-Epaisseur,yf); FillRect(r); end; end; end; // Element 27c procedure dessin_27C(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,jx2,jy2,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep, jx3,jy3 : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 3);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=xc;y2:=yf+round(hauteurCell[indexTCO] / 2.9); x3:=x0;y3:=yf; x4:=xc;y4:=y0; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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; jx2:=jx1+epaisseur;jy2:=jy1-3*epaisseur; jx3:=jx2;jy3:=yc+2*epaisseur; pen.width:=1; Polygon([point(jx1,jy1),Point(jx2,jy2),Point(jx3,jy3),Point(jx1,jy3)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jx1:=xc-(Epaisseur div 2); r:=rect(jx1,yc-3*epaisseur,jx1-Epaisseur,yf); FillRect(r); end; end; end; procedure dessin_27(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_27L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_27C(indexTco,Canvas,x,y,Mode); end; // Element 28 procedure dessin_28L(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,jx2,jy2,jx3,jy3,xc,yc,jx1,jy1,xf,yf,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineTo(xf,yf); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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; jx1:=xc-(Epaisseur div 2); jy1:=yc + (Epaisseur div 2); jx2:=jx1+epaisseur;jy2:=jy1+epaisseur; jx3:=jx2;jy3:=yc+2*epaisseur; pen.width:=1; Polygon([point(jx1,jy1),Point(jx2,jy2),Point(jx3,jy3),Point(jx1,jy3)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jx1:=xc+(Epaisseur div 2)+1; r:=rect(jx1,yc-3*epaisseur,jx1+Epaisseur,yf); FillRect(r); end; end; end; // Element 28 procedure dessin_28C(indexTCO : integer;Canvas : Tcanvas;x,y,mode: integer); var x0,y0,xc,yc,jx1,jy1,jx2,jy2,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep, jx3,jy3 : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(xc,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; // mode rond x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+(hauteurCell[indexTCO] div 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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 - (2*Epaisseur ); jx2:=jx1+epaisseur;jy2:=yc+epaisseur; jx3:=jx2;jy3:=yc+2*epaisseur; pen.width:=1; Polygon([point(jx1,jy1),Point(jx2,jy2),Point(jx3,jy3),Point(jx1,jy3)]); end; if position=const_droit then begin // effacement du morceau pen.color:=fond; Brush.Color:=fond; pen.Width:=1; jx1:=xc+(Epaisseur div 2); r:=rect(jx1,yc-3*epaisseur,jx1+Epaisseur,yf); FillRect(r); end; end; end; procedure dessin_28(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_28L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_28C(indexTco,Canvas,x,y,Mode); end; // Element 29 procedure dessin_29L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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)+1;y1:=yc-epaisseur; x2:=x1+epaisseur;y2:=y1; x3:=x2;y3:=y2+4*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);y1:=yc+(epaisseur div 2); x2:=x1+epaisseur;y2:=y1+epaisseur; x3:=x2;y3:=y2+(epaisseur div 2); x4:=x1;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_29C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; ep:=tco[indextco,x,y].epaisseurs; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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-round(epaisseur*1);y1:=yc-round(2.2*epaisseur); x2:=xc+round(epaisseur*0.7);y2:=y1; x3:=x2-round(epaisseur*0.2);y3:=yc+round(1.8*epaisseur); x4:=x1;y4:=yc-round(1.5*epaisseur); 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-round(epaisseur*2.3);y1:=yc-round(epaisseur*1.4); x2:=x1+3*epaisseur;y2:=y1+3*epaisseur; x3:=x2;y3:=y2+(epaisseur div 2); x4:=x1;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_29(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_29L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_29C(indexTco,Canvas,x,y,Mode); end; // Elément 32 procedure dessin_32L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,y0);lineto(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,y0);lineto(xc,yc); if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,yf); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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-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_32C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,y0);lineto(xc,yc); if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(x0,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,5) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+hauteurCell[indexTCO]+(hauteurCell[indexTCO] div 3); x3:=xf;y3:=y0; x4:=xc;y4:=yf; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; Pen.Width:=epaisseur; Brush.Color:=clVoies[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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-round(0.7*epaisseur);y1:=yc-round(1.6*epaisseur); x2:=xc+round(0.9*epaisseur);y2:=y1; x3:=xc-round(0.3*epaisseur);y3:=yc+round(1.4*epaisseur); x4:=xc-round(0.7*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+round(2.8*epaisseur);y1:=yc-(2*epaisseur); x2:=xc+(4*epaisseur); x3:=xc+(1*epaisseur);y3:=yc+(epaisseur); x4:=xc-round(0.2*epaisseur);y4:=y3; polygon([point(x1,y1),point(x2,y1),point(x3,y3),point(x4,y4)]); end; end; end; procedure dessin_32(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_32L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_32C(indexTco,Canvas,x,y,Mode); end; // Element 33 procedure dessin_33L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(xf,yf);lineto(xc,yc); if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,y0); end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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-(3*epaisseur); x2:=xc-(epaisseur div 2);y2:=yc+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-round(1.3*epaisseur);y1:=yc-(2*epaisseur) ; x2:=xc+round(0.6*epaisseur);y2:=y1; x3:=xc+round(2.5*epaisseur);y3:=yc+(epaisseur div 2); x4:=xc+round(1.2*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_33c(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,0) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,y0);lineto(xc,yc); if testbit(ep,4) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,yf); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0+(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=xf+(2*LargeurCell[indexTCO])+(LargeurCell[indexTCO] div 2);y2:=yf+(hauteurCell[indexTCO] div 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; ep:=tco[indextco,x,y].epaisseurs; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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-round(1.5*epaisseur);y1:=yc-round(2.5*epaisseur); x2:=xc-round(0.6*epaisseur);y2:=y1; x3:=xc+round(1.3*epaisseur);y3:=yc+2*epaisseur; x4:=xc+round(0.4*epaisseur);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-round(1.3*epaisseur);y1:=yc-(2*epaisseur); x2:=xc+round(0.9*epaisseur);y2:=y1; x3:=xc+round(3.5*epaisseur);y3:=yc+2*epaisseur; x4:=xc+round(2.9*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_33(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_33L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_33C(indexTco,Canvas,x,y,Mode); end; // Element 34 procedure dessin_34L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : Tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,y0); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);lineto(xc,yc); // diag complete if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xc,y0); // partie droite end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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+round(0.5*epaisseur);y1:=yc-round(3*epaisseur); x2:=xc+round(1.5*epaisseur);y2:=yc+epaisseur; 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-round(0.5*epaisseur);y1:=yc-round(2*epaisseur); x2:=xc+round(0.5*epaisseur);y2:=y1; x3:=x2;y3:=yc-round(1.3*epaisseur); x4:=x1;y4:=yc-round(0.3*epaisseur); polygon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); end; end; end; procedure dessin_34C(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : Tcolor; procedure trajet_droit; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_droit then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; moveto(x0,yf);lineto(xc,yc); if testbit(ep,2) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; lineto(xf,y0); end; end; procedure trajet_devie; begin couleur:=clvoies[indexTCO]; if mode>0 then begin if position=const_devie then begin if mode=1 then couleur:=clcanton[indexTCO]; if mode=2 then couleur:=couleurTrain[TCO[IndexTCO,x,y].train]; end; end; with canvas do begin pen.color:=couleur; if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; Arc(x1,y1,x2,y2,x3,y3,x4,y4); //courbe end; end; begin x0:=(x-1)*LargeurCell[indexTCO]; // x origine y0:=(y-1)*hauteurCell[indexTCO]; // y origine yc:=y0+(hauteurCell[indexTCO] div 2); // y centre xc:=x0+(LargeurCell[indexTCO] div 2); // x centre xf:=x0+LargeurCell[indexTCO]; // x fin yf:=y0+hauteurCell[indexTCO]; // y fin // mode rond x1:=x0-(2*LargeurCell[indexTCO])-(LargeurCell[indexTCO] div 2);y1:=y0-hauteurCell[indexTCO]-(hauteurCell[indexTCO] div 3); x2:=x0+(LargeurCell[indexTCO] div 2);y2:=yf+(hauteurCell[indexTCO] div 3); x3:=x0;y3:=yf; x4:=xc;y4:=y0; position:=positionTCO(indexTco,x,y); fond:=tco[indextco,x,y].CouleurFond; ep:=tco[indextco,x,y].epaisseurs; 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[indexTCO]; Pen.Color:=clVoies[indexTCO]; 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+round(0.1*epaisseur);y1:=yc-round(1*epaisseur); x2:=xc+round(2*epaisseur);y2:=y1; x3:=xc-round(0.5*epaisseur);y3:=yc+round(3*epaisseur); x4:=xc-round(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-round(2.3*epaisseur);y1:=yc-round(2*epaisseur); x2:=xc+round(epaisseur);y2:=y1; x3:=x2;y3:=yc-round(2*epaisseur); x4:=x1;y4:=yc+round(1.1*epaisseur); polygon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); end; end; end; procedure dessin_34(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_34L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_34C(indexTco,Canvas,x,y,Mode); 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 : integer); begin //frX:=DimDestX/DimOrgX; //frY:=DimDestY/DimOrgY; frx:=DimDestX/ZoomMax; fry:=DimDestY/ZoomMax; //Affiche(formatfloat('0.000000',frY),clyellow); end; procedure Feu_180(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); var p : array[0..2] of TPoint; TailleY,TailleX : integer; begin TailleY:=ImageSource.Picture.Height+0; TailleX:=ImageSource.Picture.Width+0; // copie à 180° sans mise à l'échelle dans l'image provisoire // il y a un décalage observé par la fonction PlgBlt d'1 pixel quand on tourne de 180°. Les corrections +1 et -1 servent à corriger cet effet. // coin supérieur gauche NO p[0].X:=TailleX+1; p[0].Y:=TailleY+1; // coin supérieur droit NE p[1].X:=0; p[1].Y:=TailleY; // coin inférieur gauche SO p[2].X:=TailleX+1; p[2].Y:=0; {with PImageTemp[index].Canvas do begin pen.Color:=clred; moveTO(00,0);lineTo(100,0); moveto(0,00);lineto(0,100); end; } if inverse then begin inverse_image(FormTCO[index].ImageTemp2,ImageSource); // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 180° PlgBlt(PImageTemp[Index].Canvas.Handle,p,FormTCO[index].ImageTemp2.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); end else // source facultatif PlgBlt(PImageTemp[index].Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); TransparentBlt(PcanvasTCO[index].Handle,x-1,y,round(TailleX*FrX),round(TailleY*FrY), // destination PImageTemp[index].Canvas.Handle,0,0,TailleX,TailleY,clBlue); // source - clblue est la couleur de transparence 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(index : integer;ImageSource : TImage;x,y : integer;FrX,FrY : real;inverse : boolean); 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; //&& parent pour l'index if inverse then begin inverse_image(FormTCO[index].ImageTemp2,ImageSource); // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 90° PlgBlt(PImageTemp[Index].Canvas.Handle,p,FormTCO[index].ImageTemp2.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); end else PlgBlt(PImageTemp[index].Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); //PimageTemp.Visible:=true; // copie l'image du signal retournée depuis image temporaire vers tco avec une réduction en mode transparennt TransparentBlt(PcanvasTCO[index].Handle,x,y,round(TailleY*FrY),round(TailleX*FrX), // destination PImageTemp[index].Canvas.Handle,0,0,TailleY,TailleX,clBlue); // source - clblue est la couleur de transparence PImageTCO[index].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(index : integer;ImageSource : TImage;x,y : integer ; FrX,FrY : real;inverse : boolean); 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; if inverse then begin inverse_image(FormTCO[index].ImageTemp2,ImageSource); // copie l'image du signal depuis imagesource vers image temporaire à la même échelle mais retournée à 90° PlgBlt(PImageTemp[index].Canvas.Handle,p,FormTCO[index].ImageTemp2.Canvas.Handle,0,0,TailleX,TailleY,0,0,0); end else PlgBlt(PImageTemp[index].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[index].Handle,x,y,round(tailleY*FrY),round(tailleX*FrX), PImageTemp[index].Canvas.Handle,0,0,TailleY,TailleX,clBlue); PImageTCO[index].Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. end; procedure affiche_pied2_180(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; x1:=13;y1:=-3; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); end; end; procedure affiche_pied3_180(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; x1:=13;y1:=-3; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); end; end; procedure affiche_pied4_180(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; x1:=13;y1:=-3; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); end; end; procedure affiche_pied5_180(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; x1:=13;y1:=-3; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+50)*frX),y+round(y1*frY) ); end; end; procedure affiche_pied7_180(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; x1:=38;y1:=0; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); end; end; procedure affiche_pied9_180(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; x1:=38;y1:=0; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); end; end; procedure affiche_pied20_90G(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; if contrevoie then begin x1:=0;y1:=34; moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round(x1*frX),y+round((y1+40)*frY) ) else // a gauche LineTo( x+round(x1*frX),y+round((y1-65)*frY) ); // a droite end else begin x1:=0;y1:=14; moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round(x1*frX),y+round((y1+60)*frY) ) else LineTo( x+round(x1*frX),y+round((y1-45)*frY) ); end; end; end; procedure affiche_pied20_90D(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; if contrevoie then begin x1:=65;y1:=-8; moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round(x1*frX),y+round((y1+65)*frY) ) else // a gauche LineTo( x+round(x1*frX),y+round((y1-40)*frY) ); // a droite end else begin x1:=65;y1:=10; moveTo( x+round(x1*frX),y+round(y1*frY) ); x1:=x1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round(x1*frX),y+round((y1-57)*frY) ) else LineTo( x+round(x1*frX),y+round((y1+45)*frY) ); end; end; end; procedure affiche_pied20_180(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; if contrevoie then begin x1:=20;y1:=0; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-50)*frX),y+round(y1*frY) ) else // a gauche LineTo( x+round((x1+55)*frX),y+round(y1*frY) ); // a droite end else begin x1:=38;y1:=0; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1-6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1-63)*frX),y+round(y1*frY) ) else LineTo( x+round((x1+40)*frX),y+round(y1*frY) ); end; end; end; procedure affiche_pied20_vertical(index,x,y : integer;FrX,frY : real;pied : integer;contrevoie : boolean); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; if contrevoie then begin x1:=38;y1:=102; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1+40)*frX),y+round(y1*frY) ) else LineTo( x+round((x1-65)*frX),y+round(y1*frY) ); end else begin x1:=18;y1:=102; moveTo( x+round(x1*frX),y+round(y1*frY) ); y1:=y1+6; LineTo( x+round(x1*frX),y+round(y1*frY) ); if pied=1 then LineTo( x+round((x1+62)*frX),y+round(y1*frY) ) else LineTo( x+round((x1-40)*frX),y+round(y1*frY) ); end; end; end; procedure affiche_pied2G_90G(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Color:=clPiedSignal[index]; 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(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(index,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[index] do begin Pen.Color:=clPiedSignal[index]; 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(index,x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; begin with PcanvasTCO[index] do begin Pen.Width:=2; Pen.Color:=clPiedSignal[index]; 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(indexTCO : integer;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[indextco,x,y-1].BImage=12) and (tco[indextco,x,y-1].FeuOriente=1) then exit; end; if xNbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x<1) or (y<1) then exit; x0:=(x-1)*LargeurCell[indexTCO]; y0:=(y-1)*hauteurCell[indexTCO]; r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); c:=tco[indextco,x,y].CouleurFond; with canvas do begin Pen.Mode:=mode; Pen.Width:=1; Pen.color:=c;; Brush.Color:=c; Brush.style:=bsSolid; fillRect(r); end; if avecGrille[indexTCO] then begin canvas.pen.color:=clGrille[indexTCO]; r:=Rect(x0,y0,x0+LargeurCell[indexTCO]+1,y0+hauteurCell[indexTCO]+1); canvas.rectangle(r); end; end; // Dessine un signal dans le canvasDest en x,y , dont l'adresse se trouve à la cellule x,y procedure dessin_Signal(indexTCO : integer;CanvasDest : Tcanvas;x,y : integer ); var index,x0,y0,xp,yp,orientation,adresse,aspect,PiedFeu,TailleX,TailleY,larg,haut : integer; ImageFeu : Timage; Contrevoie : boolean; frX,frY : real; begin if (x>NbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x<1) or (y<1) or (NbreSignaux=0) then exit; larg:=LargeurCell[indexTCO]; haut:=hauteurCell[indexTCO]; xp:=(x-1)*larg; // coordonnées cellule yp:=(y-1)*haut; Adresse:=tco[indextco,x,y].Adresse; Orientation:=tco[indextco,x,y].FeuOriente; if Orientation=0 then Orientation:=1; // cas d'un signal non encore renseigné index:=Index_Signal(adresse); aspect:=Signaux[index].aspect; if aspect=0 then aspect:=9; //if aspect>9 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; 20 : ImageFeu:=formprinc.ImageSignal20; else ImageFeu:=Formprinc.Image9feux; end; TailleX:=ImageFeu.picture.BitMap.Width; TailleY:=ImageFeu.picture.BitMap.Height; // taille du feu d'origine (verticale) PiedFeu:=tco[indextco,x,y].PiedFeu; // gauche ou droite de la voie // réduction variable en fonction de la taille des cellules. 50 est le Zoom Maxi calcul_reduction(frx,fry,Larg,haut); x0:=0;y0:=0; // pour les signaux directionnels // point d'origine dans la cellule du signal if orientation=3 then //90°D begin if aspect=20 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-round(tailleX*frY);end; if aspect=9 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-round(tailleX*frY);end; if aspect=7 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-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 //90°G begin if aspect=20 then begin x0:=0; y0:=0;end; if aspect=9 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-round(tailleX*frY);end; if aspect=7 then begin x0:=round(10*frX); y0:=hauteurCell[indexTCO]-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=20 then begin x0:=0; y0:=0; end; 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; if orientation=4 then begin if aspect=2 then begin x0:=round(14*frx);y0:=round(15*fry);end; if aspect=3 then begin x0:=round(14*frx);y0:=round(15*fry);end; if aspect=4 then begin x0:=round(14*frx);y0:=round(15*fry);end; if aspect=5 then begin x0:=round(14*frx);y0:=round(15*fry);end; if aspect=7 then begin x0:=round(2*frx);y0:=round(15*fry);end; if aspect=9 then begin x0:=round(2*frx);y0:=round(15*fry);end; end; x0:=x0+xp;y0:=y0+yp; // coordonnées cellule + décalage tco[indextco,x,y].x:=x0; tco[indextco,x,y].y:=y0; Contrevoie:=Signaux[index].contrevoie; // affichage du signal et du pied - orientation verticale if (Orientation=1) then begin // si inversion if Signaux[index].contrevoie then begin inverse_image(FormTCO[indexTCO].ImageTemp,ImageFeu); // copie avec mise à l'échelle de l'image du signal TransparentBlt(canvasDest.Handle,x0,y0,round(TailleX*frX),round(TailleY*frY), FormTCO[indexTCO].ImageTemp.Canvas.Handle,0,0,TailleX,TailleY,clBlue); end else // 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[indexTCO].Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas. case aspect of 20 : affiche_pied20_vertical(indexTCO,x0,y0,frX,frY,piedFeu,contrevoie); 9 : affiche_pied_Vertical9G(indexTCO,x0,y0,frX,frY,piedFeu); 7 : affiche_pied_Vertical7G(indexTCO,x0,y0,frX,frY,piedFeu); 5 : affiche_pied_Vertical5G(indexTCO,x0,y0,frX,frY,piedFeu); 4 : affiche_pied_Vertical4G(indexTCO,x0,y0,frX,frY,piedFeu); 3 : affiche_pied_Vertical3G(indexTCO,x0,y0,frX,frY,PiedFeu); 2 : affiche_pied_Vertical2G(indexTCO,x0,y0,frX,frY,PiedFeu); end; end; // affichage du feu et du pieds - orientation 90°G if Orientation=2 then begin Feu_90G(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); // ici on passe l'origine du signal // dessiner le pied case aspect of 20 : affiche_pied20_90G(indexTCO,x0+2,y0+round(fry*5),frX,frY,piedFeu,contrevoie); 9 : affiche_pied9G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 7 : affiche_pied7G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 5 : affiche_pied5G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 4 : affiche_pied4G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 3 : affiche_pied3G_90G(indexTCO,x0,y0,frX,frY,piedFeu); 2 : affiche_pied2G_90G(indexTCO,x0,y0,frX,frY,piedFeu); end; end; // affichage du signal et du pied - orientation 90°D if Orientation=3 then begin Feu_90D(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); // dessiner le pied case aspect of 20 : affiche_pied20_90D(indexTCO,x0+(LargeurCell[indexTCO] div 2)+round(frx*12),y0+(hauteurCell[indexTCO] div 2),frX,frY,piedFeu,contrevoie); 9 : affiche_pied9G_90D(indexTCO,x0,y0,frX,frY,piedFeu); 7 : affiche_pied7G_90D(indexTCO,x0,y0,frX,frY,piedFeu); 5 : affiche_pied5G_90D(indexTCO,x0,y0,frX,frY,piedFeu); 4 : affiche_pied4G_90D(indexTCO,x0,y0,frX,frY,piedFeu); 3 : affiche_pied3G_90D(indexTCO,x0,y0,frX,frY,PiedFeu); 2 : affiche_pied2G_90D(indexTCO,x0,y0,frX,frY,PiedFeu); end; end; // 180° if orientation=4 then begin Feu_180(indexTCO,ImageFeu,x0,y0,frX,frY,contrevoie); case aspect of 2 : affiche_pied2_180(indexTCO,x0,y0,frX,frY,PiedFeu); 3 : affiche_pied3_180(indexTCO,x0,y0,frX,frY,PiedFeu); 4 : affiche_pied4_180(indexTCO,x0,y0,frX,frY,PiedFeu); 5 : affiche_pied5_180(indexTCO,x0,y0,frX,frY,PiedFeu); 7 : affiche_pied7_180(indexTCO,x0,y0,frX,frY,PiedFeu); 9 : affiche_pied9_180(indexTCO,x0,y0,frX,frY,PiedFeu); 20 : affiche_pied20_180(indexTCO,x0,y0,frX,frY,PiedFeu,contrevoie); end; end; // allumage des feux du signal ----------------- dessine_signal_mx(canvasDest,x0,y0,frX,frY,adresse,orientation); end; // dessine l'icone n° Bimage dans le canvas PcanvasTCO, aux coordonnées cellules x,y en mode procedure dessine_icone(indexTCO : integer;PCanvasTCO : tcanvas;Bimage,X,Y,mode : integer); begin case Bimage of // 0 : efface_cellule(PCanvasTCO,x,y,pmcopy); 1 : dessin_1(indexTCO,PCanvasTCO,X,Y,mode); 2 : dessin_2(indexTCO,PCanvasTCO,X,Y,mode); 3 : dessin_3(indexTCO,PCanvasTCO,X,Y,mode); 4 : dessin_4(indexTCO,PCanvasTCO,X,Y,Mode); 5 : dessin_5(indexTCO,PCanvasTCO,X,Y,Mode); 6 : dessin_6(indexTCO,PCanvasTCO,X,Y,Mode); 7 : dessin_7(indexTCO,PCanvasTCO,X,Y,Mode); 8 : dessin_8(indexTCO,PCanvasTCO,X,Y,Mode); 9 : dessin_9(indexTCO,PCanvasTCO,X,Y,mode); 10 : dessin_10(indexTCO,PCanvasTCO,X,Y,mode); 11 : dessin_11(indexTCO,PCanvasTCO,X,Y,mode); 12 : dessin_12(indexTCO,PCanvasTCO,X,Y,mode); 13 : dessin_13(indexTCO,PCanvasTCO,X,Y,mode); 14 : dessin_14(indexTCO,PCanvasTCO,X,Y,mode); 15 : dessin_15(indexTCO,PCanvasTCO,X,Y,mode); 16 : dessin_16(indexTCO,PCanvasTCO,X,Y,mode); 17 : dessin_17(indexTCO,PCanvasTCO,X,Y,mode); 18 : dessin_18(indexTCO,PCanvasTCO,X,Y,mode); 19 : dessin_19(indexTCO,PCanvasTCO,X,Y,mode); 20 : dessin_20(indexTCO,PCanvasTCO,X,Y,mode); 21 : dessin_21(indexTCO,PCanvasTCO,X,Y,mode); 22 : dessin_22(indexTCO,PCanvasTCO,X,Y,mode); 23 : dessin_23(indexTCO,PCanvasTCO,X,Y,mode); 24 : dessin_24(indexTCO,PCanvasTCO,X,Y,mode); 25 : dessin_25(indexTCO,PCanvasTCO,X,Y,mode); 26 : dessin_26(indexTCO,PCanvasTCO,X,Y,mode); 27 : dessin_27(indexTCO,PCanvasTCO,X,Y,mode); 28 : dessin_28(indexTCO,PCanvasTCO,X,Y,mode); 29 : dessin_29(indexTCO,PCanvasTCO,X,Y,mode); 32 : dessin_32(indexTCO,PCanvasTCO,X,Y,mode); 33 : dessin_33(indexTCO,PCanvasTCO,X,Y,mode); 34 : dessin_34(indexTCO,PCanvasTCO,X,Y,mode); Id_signal : dessin_Signal(indexTCO,PCanvasTCO,X,Y); Id_Quai : dessin_51(indexTCO,PCanvasTCO,X,Y,mode); Id_action : dessin_52(indexTCO,PCanvasTCO,X,Y,mode); end; end; // affiche la cellule x et y en cases // index est utilisé pour accéder au tableau du tracé de la fonction zone_tco procedure affiche_cellule(indexTCO,x,y : integer); var i,index,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied,AdrTr : integer; typ : tequipement; inverse : boolean; s : string; begin if tco[indextco,x,y].BImage=0 then exit; //Affiche('Affiche_cellule',clLime); PcanvasTCO[indexTCO].pen.Mode:=PmCopy; //pcanvasTCO.Brush.Style:=BsClear; adresse:=tco[indextco,x,y].Adresse; BImage:=tco[indextco,x,y].BImage; mode:=tco[indextco,x,y].mode; // mode pour la couleur repr:=tco[indextco,x,y].repr; Epaisseur:=LargeurCell[indexTCO]*epaisseur_voies div 30; Xorg:=(x-1)*LargeurCell[indexTCO]; Yorg:=(y-1)*hauteurCell[indexTCO]; // ------------- 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 dessine_icone(indexTCO,PCanvasTCO[indexTCO],Bimage,X,Y,mode); PCanvasTCO[indexTCO].font.Size:=(LargeurCell[indexTCO] div 10)+4 ; //Affiche(intToSTR( (LargeurCell[indexTCO] div 30)+6),clyellow); // affiche le texte des aiguillages if IsAigTCO(Bimage) and (adresse<>0) then begin if adresse<>0 then s:='A'+s+' ' else s:=' '; with PCanvasTCO[indexTCO] do begin // si réservation par train i:=index_aig(adresse); AdrTr:=aiguillage[i].AdrTrain; typ:=aiguillage[i].modele; if AdrTr=0 then begin Brush.Color:=tco[indextco,x,y].CouleurFond; //SetBkMode(PCanvasTCO[indexTCO].Handle,TRANSPARENT); if avecRESA or roulage then s:=s+' '; // efface l'adresse de réservation end else begin // couleur de fond de la réservation Brush.style:=bsSolid; Brush.Color:=clBlue; s:=s+intToSTR(AdrTr); //SetBkMode(PCanvasTCO[indexTCO].Handle,OPAQUE); end; //Brush.Style:=Bsclear; Font.Color:=tco[indextco,x,y].coulFonte; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); xt:=0;yt:=0; if Bimage=2 then begin xt:=LargeurCell[indexTCO] div 2;yt:=1;end; if Bimage=3 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(20*fryGlob[indexTCO]);end; if Bimage=4 then begin xt:=3;yt:=1;end; if Bimage=5 then begin xt:=3;yt:=hauteurCell[indexTCO]-round(20*fryGlob[indexTCO]);end; if Bimage=12 then begin xt:=1;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=13 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=14 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=1;end; if Bimage=15 then begin xt:=3;yt:=1;end; if Bimage=21 then begin xt:=(LargeurCell[indexTCO] div 2)+round(2*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; if Bimage=22 then begin xt:=(LargeurCell[indexTCO] div 2);yt:=-2;end; if Bimage=23 then begin xt:=round(33*frxGlob[indexTCO]);yt:=round(35*fryGlob[indexTCO]);end; if Bimage=24 then begin xt:=LargeurCell[indexTCO]-round(20*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=25 then begin xt:=round(34*frxGlob[indexTCO]);yt:=round(8*fryGlob[indexTCO]);end; if Bimage=26 then begin xt:=1;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=27 then begin xt:=1;yt:=1;end; if Bimage=28 then begin xt:=1;yt:=1;end; if Bimage=29 then begin xt:=LargeurCell[indexTCO] div 2;yt:=1;end; if Bimage=32 then begin xt:=1;yt:=1;end; if Bimage=33 then begin xt:=1;yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if Bimage=34 then begin xt:=LargeurCell[indexTCO]-round(30*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);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 xt:=3; if repr<>0 then with PCanvasTCO[indexTCO] do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Font.Color:=tco[indextco,x,y].coulFonte; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); xt:=round(15*frxGlob[indexTCO]); case repr of 1 : yt:=(hauteurCell[indexTCO] div 2)-round(7*fryGlob[indexTCO]); // milieu 2 : yt:=1; // haut 3 : yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]); // bas end; { // affiche/efface le nom du train du détecteur s:=s+' '; case repr of 1,3 : yt:=1; // haut 2 : yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]); // bas end; } i:=detecteur[adresse].AdrTrain; if i<>0 then begin i:=index_train_adresse(i); if i<>0 then s:=s+' '+trains[i].nom_train; end; //PCanvasTCO[indexTCO].font.Size:=(LargeurCell[indexTCO] div 13)+4 ; TextOut(xOrg+xt,Yorg+yt,s+' '); end; end; // autres détecteurs if ((Bimage=7) or (Bimage=8) or (Bimage=9) or (Bimage=10) or (Bimage=17) ) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO[indexTCO] do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); Font.Color:=tco[indextco,x,y].coulFonte; TextOut(xOrg+round(2*frxGlob[indexTCO]),yOrg+round(2*fryGlob[indexTCO]),s); end; end; // écriture adresse à 90° if (Bimage=20) and (adresse<>0) then begin with PCanvasTCO[indexTCO] do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); Font.Color:=tco[indextco,x,y].coulFonte; PCanvasTCO[indexTCO].font.Size:=PCanvasTCO[indexTCO].font.Size+1; //TextOut(xOrg+round(2*frxGlob[indexTCO]),yOrg+round(2*fryGlob[indexTCO]),s); AffTexteIncliBordeTexture(PCanvasTCO[indexTCO],Xorg,yOrg+round(30*fryGlob[indexTCO]), PCanvasTCO[indexTCO].Font,clYellow,0,pmcopy,nil,s,910); end; end; // autres détecteurs if (Bimage=18) and (adresse<>0) then begin // Adresse de l'élément with PCanvasTCO[indexTCO] do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Font.Name:='Arial'; Font.Style:=style(tco[indextco,x,y].FontStyle); Font.Color:=tco[indextco,x,y].coulFonte; TextOut(xOrg+round(20*frxGlob[indexTCO]),yOrg+hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]),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[indexTCO] do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Font.Color:=tco[indextco,x,y].coulFonte;; Font.Style:=style(tco[indextco,x,y].FontStyle); Font.Name:='Arial'; TextOut(xOrg+round(28*frxGlob[indexTCO]),yOrg+round(2*fryGlob[indexTCO]),s); //exit; end; end; // adresse des signaux if (BImage=Id_signal) and (adresse<>0) then begin index:=Index_Signal(adresse); aspect:=Signaux[index].Aspect; oriente:=tco[indextco,x,y].FeuOriente; pied:=tco[indextco,x,y].PiedFeu; inverse:=Signaux[index].contrevoie; // pour signal belge xt:=0;yt:=0; // signal belge if (aspect=20) then begin if (Oriente=1) then begin if inverse then begin xt:=2;yt:=2*hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end else begin xt:=(LargeurCell[indexTCO] div 2)+round(5*frxGlob[indexTCO]);yt:=2*hauteurCell[indexTCO]-round(20*fryGlob[indexTCO]); end; end; if (Oriente=2) then begin if inverse then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(3*fryGlob[indexTCO]);end else begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(16*fryGlob[indexTCO]);end; end; if (Oriente=3) then begin if inverse then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(50*frxGlob[indexTCO]);end else begin xt:=round(60*frxGlob[indexTCO]);yt:=round(1*frxGlob[indexTCO])end; end; if (oriente=4) then begin if inverse then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end else begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*fryGlob[indexTCO]);end; end; end; if (aspect=9) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=round(60*fryGlob[indexTCO]);end; if (aspect=9) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(17*fryGlob[indexTCO]);end; // orientation G if (aspect=9) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+round(25*frxGlob[indexTCO]);yt:=1;end; if (aspect=9) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; if (aspect=9) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=7) and (Oriente=1) then begin xt:=LargeurCell[indexTCO]-round(25*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; if (aspect=7) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]-round(15*fryGlob[indexTCO]);end; if (aspect=7) and (Oriente=3) then begin xt:=LargeurCell[indexTCO]+2;yt:=1;end; if (aspect=7) and (Oriente=4) and (pied=1) then begin xt:=round(2*frxGlob[indexTCO]);yt:=round(10*frYGlob[indexTCO]);end; if (aspect=7) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=5) and (Oriente=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO]+round(25*fryGlob[indexTCO]);end; if (aspect=5) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO] ;end; if (aspect=5) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; if (aspect=5) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=5) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=4) and (Oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]+round(20*fryGlob[indexTCO]);end; if (aspect=4) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; if (aspect=4) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=-round(14*fryGlob[indexTCO]);end; if (aspect=4) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=4) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=3) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite if (aspect=3) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche if (aspect=3) and (Oriente=2) and (pied=1) then begin xt:=round(10*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // signal à G if (aspect=3) and (Oriente=2) and (pied=2) then begin xt:=round(20*frxGlob[indexTCO]);yt:=0;end; // signal à droite if (aspect=3) and (Oriente=3) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; if (aspect=3) and (Oriente=4) and (pied=1) then begin xt:=round(35*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=3) and (Oriente=4) and (pied=2) then begin xt:=round(3*frxGlob[indexTCO]);yt:=round(1*frYGlob[indexTCO]);end; if (aspect=2) and (Oriente=1) and (pied=2) then begin xt:=round(-15*frxGlob[indexTCO]);yt:=1;end; // signal à droite if (aspect=2) and (Oriente=1) and (pied=1) then begin xt:=round(45*frxGlob[indexTCO]);yt:=1;end; // signal à gauche if (aspect=2) and (Oriente=2) then begin xt:=round(10*frxGlob[indexTCO]);yt:=hauteurCell[indexTCO];end; // orientation G if (aspect=2) and (Oriente=3) then begin xt:=round(20*frxGlob[indexTCO]);yt:=round(40*fryGlob[indexTCO]);end; // orientation D if (aspect=2) and (Oriente=4) then begin xt:=round(40*frxGlob[indexTCO]);yt:=round(10*fryglob[indexTCO]);end; // orientation 180 // signaux directionnels if (aspect>10) and (aspect<20) and(oriente=1) then begin xt:=1;yt:=hauteurCell[indexTCO]-round(14*fryGlob[indexTCO]);end; if (aspect>10) and (aspect<20) and (oriente=2) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; if (aspect>10) and (aspect<20) and (oriente=3) then begin xt:=LargeurCell[indexTCO]-round(15*frxGlob[indexTCO]);yt:=0;end; with PCanvasTCO[indexTCO] do begin Brush.Color:=tco[indextco,x,y].CouleurFond; Font.Color:=tco[indextco,x,y].coulFonte; Font.Style:=style(tco[indextco,x,y].FontStyle); Font.Name:='Arial'; TextOut(xOrg+xt,yOrg+yt,s); end; end; end; procedure Entoure_cell(indexTCO,x,y : integer); var r : Trect; x0,y0 : integer; begin x0:=(x-1)*LargeurCell[indexTCO]+1; y0:=(y-1)*hauteurCell[indexTCO]+1; with PcanvasTCO[indexTCO] do begin Pen.width:=3; Pen.Color:=clyellow; Brush.Color:=clBlack; Brush.Style:=bsSolid; Pen.Mode:=PmXor; r:=Rect(x0,y0,x0+LargeurCell[indexTCO],y0+hauteurCell[indexTCO]); Rectangle(r); Pen.width:=1; Pen.Mode:=PmCopy; end; end; procedure efface_entoure(indexTCO : integer); begin if (entoure[indexTCO]) then begin Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]); entoure[indexTCO]:=false; end end; procedure _entoure_cell_clic(indexTCO: integer); begin if not(entoure[indexTCO]) then begin Entoure_cell(indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]); Xentoure[indexTCO]:=XClicCell[indexTCO]; Yentoure[indexTCO]:=YclicCell[indexTCO]; entoure[indexTCO]:=true; end else begin Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]); // efface l'ancien // si on clique sur le même on l'efface sans afficher un nouveau if (Xentoure[indexTCO]<>XclicCell[indexTCO]) or (Yentoure[indexTCO]<>YClicCell[indexTCO]) then begin Entoure_cell(indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]); end else entoure[indexTCO]:=false; Xentoure[indexTCO]:=XClicCell[indexTCO]; Yentoure[indexTCO]:=YclicCell[indexTCO]; end; end; // affiche le tco suivant le tableau TCO procedure Affiche_TCO(indexTCO : integer) ; var x,y,x1,y1,DimX,DimY : integer; s : string; r : Trect; begin if affevt then affiche('Affiche_tco',clLime); if pImageTCO[indexTCO]=nil then exit; DimX:=LargeurCell[indexTCO]*NbreCellX[indexTCO]; DimY:=hauteurCell[indexTCO]*NbreCellY[indexTCO]; Epaisseur:=LargeurCell[indexTCO]*epaisseur_voies div 30; // 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[indexTCO].Height:=DimY; PImageTCO[indexTCO].Width:=DimX; ClBarriere[indexTCO]:=not(clfond[indexTCO]) and $FFFFFF; PBitMapTCO[indexTCO].Height:=DimY; PBitMapTCO[indexTCO].Width:=DimX; with formTCO[indexTCO].ScrollBox do begin HorzScrollBar.Range:=DimX; HorzScrollBar.Tracking:=true; HorzScrollBar.Smooth:=false; // ne pas mettre true sinon figeage dans W11 si on clique sur la trackbar!! VertScrollBar.Range:=DimY; VertScrollBar.Tracking:=true; VertScrollBar.Smooth:=false; end; calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]); //Affiche(formatfloat('0.000000',frxGlob[indexTCO]),clyellow); //effacer toutes cellules par cellule car chaque cellule a une couleur de fond spécifique with PcanvasTCO[indexTCO] do begin Pen.width:=1; Brush.Style:=bsSolid; pen.color:=clyellow; pen.Mode:=PmCopy; for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin x1:=(x-1)*LargeurCell[indexTCO]; y1:=(y-1)*hauteurCell[indexTCO]; brush.Color:=tco[indextco,x,y].CouleurFond; r:=rect(x1,y1,x1+LargeurCell[indexTCO],y1+hauteurCell[indexTCO]); FillRect(r); end; end; if AvecGrille[indexTCO] then begin y1:=HauteurCell[IndexTCO]*NbreCellY[indexTCO]; with PcanvasTCO[indexTCO] do pen.color:=clGrille[IndexTCO]; //Affiche(intToSTr(clGrille[IndexTCO]),clred); with PcanvasTCO[indexTCO] do begin for x:=1 to NbreCellX[indexTCO] do begin x1:=(x-1)*largeurCell[indexTCO]; moveto(x1,0);LineTo(x1,y1); // lignes verticales end; x1:=LargeurCell[IndexTCO]*NbreCellX[indexTCO]; for y:=1 to NbreCellY[indexTCO] do begin y1:=(y-1)*HauteurCell[indexTCO]; moveto(0,y1);LineTo(x1,y1); // lignes horizontales end; end; end; //afficher les cellules sauf les signaux for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin if tco[indextco,x,y].BImage<>Id_signal then begin affiche_cellule(indexTCO,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[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin if tco[indextco,x,y].BImage=Id_signal then begin affiche_cellule(indexTCO,x,y); end; //Affiche(intToSTR(indexTCO)+' '+intToSTR(x)+' '+intToSTR(y),clred); s:=tco[indextco,x,y].Texte; if s<>'' then Affiche_texte(indexTCO,x,y); end; // afficher les sélections si elles sont présentes if entoure[indexTCO] then Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]); if rect_select.NumTCO<>0 then Affiche_Rectangle(IndexTCO,Rect_select); if selectionaffichee[indexTCO] then Affiche_selection(indexTCO); end; procedure TFormTCO.FormCreate(Sender: TObject); var s : string; begin if affevt or (debug=1) then Affiche('FormTCO'+intToSTR(indexTCOCreate)+' create',clLime); //Screen.OnActiveControlChange := ActiveControlChanged; offsetSourisY:=-10; // permet de tenir l'icone au milieu quand on fait un glisser offsetSourisX:=-10; RadioGroupSel.ItemIndex:=0; ligne_supprime:=0; colonne_supprime:=0; auto_tcurs:=true; TCO_modifie:=false; rangUndo:=1; epaisseur_voies:=5; XclicCell[indexTCOCreate]:=1; YclicCell[indexTCOCreate]:=1; xCoupe:=0;yCoupe:=0; indexTrace:=0; KeyPreview:=true; // valide les évènements clavier TrackBarZoom.Tabstop:=false; // permet d'avoir les evts curseurs ButtonSauveTCO.TabStop:=false; ButtonConfigTCO.TabStop:=false; Buttonmasquer.TabStop:=false; ButtonRaz.TabStop:=false; ButtonDessiner.TabStop:=false; //TrackBarZoom.position:=78; couleurAdresse:=clCyan; xMiniSel:=99999;yMiniSel:=99999; xMaxiSel:=0;yMaxiSel:=0; SelectionAffichee[indexTCOCreate]:=false; //ImageTCO.Canvas.font.Name:='Arial'; //<--- peut générer exception out of ressource!! clTexte:=ClLime; // é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; oldbmp:=Tbitmap.Create; oldbmp.width:=100; oldbmp.Height:=100; modeTrace[indexTCOCreate]:=false; // pour tracer les voies à la souris //controlStyle:=controlStyle+[csOpaque]; 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 ou buttoir'; ImagePalette1.Hint:=s;ImagePalette1.ShowHint:=true; ImagePalette20.Hint:=s;ImagePalette20.ShowHint:=true; s:='Voie ou buttoir'; ImagePalette10.Hint:=s;ImagePalette10.ShowHint:=true; ImagePalette11.Hint:=s;ImagePalette11.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; ImagePalette26.Hint:=s;ImagePalette26.ShowHint:=true; ImagePalette27.Hint:=s;ImagePalette27.ShowHint:=true; ImagePalette28.Hint:=s;ImagePalette28.ShowHint:=true; ImagePalette29.Hint:=s;ImagePalette29.ShowHint:=true; ImagePalette32.Hint:=s;ImagePalette32.ShowHint:=true; ImagePalette33.Hint:=s;ImagePalette33.ShowHint:=true; ImagePalette34.Hint:=s;ImagePalette34.ShowHint:=true; s:='Croisement ou TJD ou TJS ou pont'; ImagePalette21.Hint:=s;ImagePalette21.ShowHint:=true; ImagePalette22.Hint:=s;ImagePalette22.ShowHint:=true; ImagePalette23.Hint:=s;ImagePalette23.ShowHint:=true; ImagePalette25.Hint:=s;ImagePalette25.ShowHint:=true; s90:='Insère une ligne au dessus'; popupMenu1.Items[9][0].Hint:=s90; s91:='Insère une ligne en dessous'; popupMenu1.Items[9][1].Hint:=s91; s93:='Insère une colonne à gauche'; popupMenu1.Items[9][3].Hint:=s93; s94:='Insère une colonne à droite'; popupMenu1.Items[9][4].Hint:=s94; s100:='Supprime la ligne pointée'; popupMenu1.Items[10][0].Hint:=s100; s101:='Supprime la colonne pointée'; popupMenu1.Items[10][1].Hint:=s101; 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(indexTCO,det : integer;var x,y : integer); var xc,yc,b : integer; trouve : boolean; begin yc:=1; repeat xc:=0; repeat inc(xc); b:=tco[indextco,xc,yc].Bimage; trouve:=(tco[indextco,xc,yc].Adresse=det) and ( (b=1) or (b=10) or (b=11) or (b=20) ); // trouvé détecteur- obligé de regarder le type d'objet car un détecteur et un signal peuvent avoir la même adresse! until (xc=NbreCellX[indexTCO]) or trouve; inc(yc); until (yc>NbreCellY[indexTCO]) or trouve; dec(yc); if trouve then begin x:=xc; y:=yc; end else begin x:=0; y:=0; end; end; procedure Erreur_TCO(indexTCO,x,y : integer); var s : string; i,adresse : integer; begin s:='Erreur 92 TCO - Cellule '+intToSTR(x)+','+intToSTR(y)+' '; adresse:=tco[indextco,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; // efface le trajet du tco du train depuis le détecteur jusqu'au premier aiguillage procedure efface_trajet(det,train : integer); var i,j,t,n,Bimage,x,y : integer; trouve : boolean; begin for t:=1 to NbreTCO do begin n:=Trace_Train[t].train[train].nombre; if n=0 then exit; i:=n; repeat x:=Trace_Train[t].train[train].route[i].x; y:=Trace_Train[t].train[train].route[i].y; Bimage:=tco[t,x,y].BImage; trouve:=isAigTCO(Bimage); dec(i); until trouve or (i=0); if trouve then begin for j:=i+1 downto 1 do begin x:=Trace_Train[t].train[train].route[j].x; y:=Trace_Train[t].train[train].route[j].y; tco[t,x,y].mode:=0; Affiche_cellule(t,x,y); end; end; end; end; // affiche le trajet dans le tco du train,ir =nombre d'éléments du tableau trace_train mode=couleur procedure affiche_trajet(indexTCO,train,ir,mode : integer); var i,sx,sy,x,y,ax,ay,Bimage,adresse : integer; begin // et affichage de la route for i:=1 to ir do begin x:=Trace_Train[indexTCO].Train[train].route[i].x; y:=Trace_Train[indexTCO].Train[train].route[i].y; tco[Indextco,x,y].mode:=mode; //mode; // pour la couleur TCO[IndexTCO,x,y].train:=index_couleur; // = numéro du train //Affiche(intToSTR(x)+' '+intToSTR(y),clorange); bimage:=tco[indextco,x,y].BImage; adresse:=tco[indextco,x,y].Adresse; tco[indextco,x,y].trajet:=0; // pour les croisements il faut mettre à jour la variable "trajet" pour l'affichage dans la cellule if (bimage=21) and (i>1) then begin ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[indextco,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[indextco,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[indextco,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[indextco,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[indextco,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[indextco,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[indextco,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[indextco,x,y].trajet:=3; // de gauche vers haut droite if tco[indextco,x,y].trajet=0 then affiche('Erreur 70 TCO - Cellule '+intToSTR(x)+','+intToSTR(y),clred); end; // croisement if (bimage=22) and (i>1) then begin ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; if (ax-x=-1) and (ay-y=0) and (sx-x=1) and (sy-y=0) then tco[indextco,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[indextco,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[indextco,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[indextco,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[indextco,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[indextco,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[indextco,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[indextco,x,y].trajet:=4; // de gauche vers en bas a droite if tco[indextco,x,y].trajet=0 then affiche('Erreur 71 TCO - Cellule '+intToSTR(x)+','+intToSTR(y),clred); end; // croisement if (bimage=23) and (i>1) then begin ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; if (ax-x=0) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[indextco,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[indextco,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[indextco,x,y].trajet:=2; // de haut droit vers bas gauche if (ax-x=-1) and (ay-y=1) and (sx-x=1) and (sy-y=-1) then tco[indextco,x,y].trajet:=2; // de bas gauche vers haut droit if (ax-x=1) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[indextco,x,y].trajet:=3; // de haut droit vers bas if (ax-x=0) and (ay-y=1) and (sx-x=1) and (sy-y=-1) then tco[indextco,x,y].trajet:=3; // de bas vers haut droit if (ax-x=0) and (ay-y=-1) and (sx-x=-1) and (sy-y=1) then tco[indextco,x,y].trajet:=4; // de haut vers bas gauche if (ax-x=-1) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[indextco,x,y].trajet:=4; // de bas gauche vers haut if tco[indextco,x,y].trajet=0 then affiche('Erreur 72 TCO - Cellule '+intToSTR(x)+','+intToSTR(y),clred); end; // croisement if (bimage=25) and (i>1) then begin ax:=Trace_Train[indexTCO].Train[train].route[i-1].x; ay:=Trace_Train[indexTCO].Train[train].route[i-1].y; sx:=Trace_Train[indexTCO].Train[train].route[i+1].x; sy:=Trace_Train[indexTCO].Train[train].route[i+1].y; tco[indextco,x,y].trajet:=0; if (ax-x=0) and (ay-y=-1) and (sx-x=0) and (sy-y=1) then tco[indextco,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[indextco,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[indextco,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[indextco,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[indextco,x,y].trajet:=3; // de NO vers S if (ax-x=0) and (ay-y=1) and (sx-x=-1) and (sy-y=-1) then tco[indextco,x,y].trajet:=3; // de S vers haut gauche if (ax-x=0) and (ay-y=-1) and (sx-x=1) and (sy-y=1) then tco[indextco,x,y].trajet:=4; // de N vers SE if (ax-x=1) and (ay-y=1) and (sx-x=0) and (sy-y=-1) then tco[indextco,x,y].trajet:=4; // de SE vers N if tco[indextco,x,y].trajet=0 then affiche('Erreur 73 TCO - Cellule '+intToSTR(x)+','+intToSTR(y),clred); end; Affiche_cellule(indexTCO,x,y); end; end; // allume ou éteint (mode=0 ou 1) la voie du train "train", zone de det1 à det2 sur le TCO // det1 et det2 doivent être consécutifs sur le TCO, mais peuvent être séparés par des aiguillages // si mode=0 : éteint // =1 : couleur détecteur allumé // =2 : couleur de l'index train // Ne nécessite pas que les aiguillages aoient bien positionnés entre det1 et det2 // procédure récursive quand on passe par un aiguillage en pointe pour explorer les éléments opposés procedure zone_tco(indexTCO,det1,det2,train,mode: integer); var i,ir,adresse,Bimage,direction,ancienX,ancienY,x,y,xn,yn,Xdet1,yDet1,iteration,indexIr : integer; memtrouve,sortir,casok,indextrouve : boolean; s : string; // stocke la route dans le tableau, et incrémente l'index procedure maj_route(indexTCO,x,y,train : integer;var ir : integer); begin if debugTCO then AfficheDebug('Ir='+IntToSTR(ir)+'->'+intToSTR(x)+' '+intToSTR(y),clyellow); if (train<0) or (train>Max_Trains) then begin Affiche('Erreur index train',clred); exit; end; Trace_Train[indexTCO].train[train].route[ir].x:=x; Trace_Train[indexTCO].train[train].route[ir].y:=y; Trace_Train[indexTCO].train[train].Nombre:=ir; if ir<500 then inc(ir); end; // mise à jour de x,y, nouvelles coordonnées par xn,yn (var globales de la procédure zone_tco) procedure Maj_coords(var ancienX,ancienY,x,y : integer); begin ancienX:=x; ancienY:=y; x:=xn; y:=yn; end; // El_Tco : trouve l'élément en x,y et constuit la route à l'élément de destination suivant, suivant // les variables ancienX et ancienY // x, y et ir sont locales pour des récursivités différentes, donc on les passe en paramètre pour transmettre à la // récursivité suivante leur valeur, mais elles reprennent leur valeurs initiales à la remontée vers la résursivité appellante. Procedure El_tco(x,y,train : integer; ir : integer); var mdl : Tequipement; i,j :integer; sortir : boolean; begin // répète la route depuis un aiguillage inc(iteration); if DebugTCO then AfficheDebug('El_TCO',clorange); i:=0; repeat maj_route(indextco,x,y,train,ir); adresse:=tco[indextco,x,y].Adresse ; Bimage:=tco[indextco,x,y].Bimage; if debugTCO then begin s:='X='+intToSTR(x)+' y='+intToSTR(y)+' Elément='+intToSTR(Bimage); if adresse<>0 then s:=s+' Adresse='+intToSTR(adresse); AfficheDebug(s,clyellow); end; casok:=false; // 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; yn:=y; if ancienXy) then begin xn:=x+1;xn:=x+1;end; if (ancienX>x) and (ancienY=Y) then begin //pris en pointe ancienX:=x; ancienY:=y; x:=x-1; el_tco(x,y,train,ir); // essaye droit // essayer dévié if not(memtrouve) then begin AncienY:=y; AncienX:=x+1; y:=y+1; x:=x; el_tco(x,y,train,ir); // nouvelle itération end; end; end; 3 : begin //if debugTCO then AfficheDebug('El 3',clyellow); if (ancienX>x) and (ancienY<=Y) then begin xn:=x-1;end; if (ancienXx) and (ancienY=Y) then begin xn:=x-1;end; if (ancienX>x) and (ancienY>y) then begin xn:=x-1;end; if (ancienXx) and (ancienY=Y) then begin // pris en pointe pos droite ancienx:=x;ancieny:=y; x:=x-1;y:=y; el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y; AncienX:=x+1; y:=y-1;x:=x; el_tco(x,y,train,ir); end; end; end; 6 : if ancienXx) and (ancienY>=Y) then begin xn:=x-1;yn:=y-1;end; if (ancienX=Y) then begin xn:=x+1;yn:=y-1;end; if (ancienX>x) and (ancienYx) and (ancienY>y) then begin // pris en pointe droit ancienX:=x;ancienY:=y; x:=x-1;y:=y-1; el_tco(x,y,train,ir); if not(memtrouve) then begin // essai dévié AncienY:=y+1; AncienX:=x+1; y:=y+1;x:=x; el_tco(x,y,train,ir); end; end; end; 15 : begin if (ancienX>x) and (ancienY<=Y) then begin xn:=x-1;yn:=y+1;end; if (ancienXY) then begin // aiguillage pris en pointe ancienX:=x;ancienY:=y; x:=x+1;y:=y-1; // essayer droit el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x-1; y:=y+1; x:=x; el_tco(x,y,train,ir); // nouvelle itération end; end; end; 16 : if ancienX0 then s:=s+'adr='+intToStr(adresse); AfficheDebug(s,clyellow); end; xn:=x; casok:=true; if (ancienY0 then begin j:=Index_Aig(adresse); mdl:=aiguillage[j].modele; if (mdl=tjs) or (mdl=tjd) then begin // tjd ou tjs if ancienXx) and not(Memtrouve) then // on va à gauche begin // essayer vers O ancienX:=x;ancienY:=y; x:=x-1; el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers SO AncienY:=y; AncienX:=x+1; y:=y+1;x:=x; el_tco(x,y,train,ir); end; end; end; end; if (adresse=0) or (mdl=crois) then // croisement begin if DebugTCO then AfficheDebug('Croisement',clyellow); if (ancienXx) and (ancienY=Y) then begin xn:=x-1;yn:=y;end; 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; if (mdl=tjs) or (mdl=tjd) then begin // tjd ou tjs if ancienXx) and not(Memtrouve) then // on va à gauche begin // essayer vers O ancienX:=x;ancienY:=y; x:=x-1; el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NO AncienY:=y; AncienX:=x+1; y:=y-1;x:=x; el_tco(x,y,train,ir); end; end; end; end; if (adresse=0) or (mdl=crois) then // croisement begin if DebugTCO then AfficheDebug('croisement',clyellow); if (ancienXx) and (ancienY=Y) then begin casok:=true;xn:=x-1;end; if (ancienX>x) and (ancienY>Y) then begin casok:=true;xn:=x-1;yn:=y-1;end; if (ancienX0 then begin j:=Index_Aig(adresse); mdl:=aiguillage[j].modele; // tjd ou tjs if (mdl=tjd) or (mdl=tjs) then begin if ancienYy) and not(Memtrouve) then // on monte begin // essayer vers N ancienX:=x;ancienY:=y; y:=y-1; el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NE AncienY:=y+1; AncienX:=x; x:=x+1; el_tco(x,y,train,ir); end; end; end; end; if (adresse=0) or (mdl=crois) then // croisement begin if DebugTCO then AfficheDebug('Croisement',clyellow); if (ancienX>x) and (ancienYY) then begin xn:=x+1;yn:=yn-1;end; if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; end; if (mdl=aig) then begin Affiche('Erreur 50 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); Affiche('mais la cellule représente un croisement ou une TJD/S',clred); exit; end; end; 24 : begin if debugTCO then AfficheDebug('El 24',clyellow); // on vient d'en haut ou en haut à gauche if (ancienYy) and (ancienX=x) then begin ancienX:=x;ancienY:=y; y:=y-1; // essayer droit el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x; x:=x-1; el_tco(x,y,train,ir); // nouvelle itération end; end; end; // tjd ou croisement 25 : begin mdl:=rien; if adresse<>0 then begin j:=Index_Aig(adresse); mdl:=aiguillage[j].modele; // tjd ou tjs if (mdl=tjd) or (mdl=tjs) then begin if ancienYy) and not(Memtrouve) then // on monte begin // essayer vers N ancienX:=x;ancienY:=y; y:=y-1; el_tco(x,y,train,ir); if not(memtrouve) then begin // essai vers NO AncienY:=y+1; AncienX:=x; x:=x-1; el_tco(x,y,train,ir); end; end; end; end; if (adresse=0) or (mdl=crois) then // croisement begin if DebugTCO then AfficheDebug('Croisement',clyellow); 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; if (mdl=aig) then begin Affiche('Erreur 51 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); Affiche('mais la cellule représente un croisement ou une TJD/S',clred); exit; end; end; 26 : begin if debugTCO then AfficheDebug('El 26',clyellow); if (ancienY=x) then begin yn:=y+1;xn:=x;end; // on vient d'en bas if (ancienY>y) and (ancienX=x) then begin ancienX:=x;ancienY:=y; y:=y-1; // essayer droit el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x; x:=x+1; el_tco(x,y,train,ir); // nouvelle itération end; end; end; 27 : begin if debugTCO then AfficheDebug('El 27',clyellow); // on vient d'en bas if (ancienY>y) and (ancienX<=x) then begin yn:=y-1;xn:=x;end; // on vient d'en haut: pris en pointe if (ancienYy) and (ancienX>=x) then begin yn:=y-1;xn:=x; end; // on vient d'en haut if (ancienY=x) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; // on vient de NO if (ancienXY) then begin xn:=x+1;yn:=y-1;end; // on vient d'en haut à droite if (ancienX>x) and (ancienYx) and (ancienY>y) then begin // on vient de SE ancienX:=x;ancienY:=y; y:=y-1;x:=x-1; // essayer droit el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x+1; x:=x+1; el_tco(x,y,train,ir); // nouvelle itération end; end; end; 34 : begin // on vient du N ou NE if (ancienX>=x) and (ancienYy) then begin ancienX:=x;ancienY:=y; y:=y-1;x:=x+1; // essayer droit el_tco(x,y,train,ir); // essayer dévié if not(memtrouve) then begin AncienY:=y+1; AncienX:=x-1; x:=x-1; el_tco(x,y,train,ir); // nouvelle itération 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; if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and ((adresse<>det2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; if (i>200) or (iteration>200) then sortir:=true; Maj_coords(AncienX,AncienY,x,y); until sortir or memtrouve; if DebugTCO and not(memtrouve) then AfficheDebug('Fin de boucle dét '+intToSTR(det2)+' non trouvé',clOrange); //mémoriser l'index de route si on a trouvé det2, et uniquement sur la première itération quand on l'a trouvé if memTrouve and not(indextrouve) then begin indexTrouve:=true; indexIr:=ir-1; end; if i>200 then Affiche('Erreur 487 : limite d''itérations TCO',clred); if iteration>200 then Affiche('Erreur 488 : limite de récursivité TCO',clred); end; // Début de la procédure zone_tco begin if debugTCO then AfficheDebug('Zone_TCO det1='+intToSTR(det1)+' det2='+intToSTR(det2)+' Train'+intToSTR(Train)+' mode='+intToSTR(mode),clyellow); trouve_det(indexTCO,det1,Xdet1,Ydet1); if (Xdet1=0) or (Ydet1=0) then exit; memtrouve:=false; indextrouve:=false; Direction:=1; // on teste 4 directions: 1=SE 2=NO 3=SO 4=NE 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; // itérations if debugTCO then afficheDebug('Direction '+intToSTR(direction),clOrange); // initialiser les points d'où l'on vient if direction=1 then begin // vers SE ancieny:=ydet1+1; ancienx:=xdet1+1; end; if direction=2 then begin // vers NO ancieny:=ydet1-1; ancienx:=xdet1-1; end; if direction=3 then begin // SO ancieny:=ydet1+1; ancienx:=xdet1-1; end; if direction=4 then begin // vers NE ancieny:=ydet1-1; ancienx:=xdet1+1; end; if debugTCO then AfficheDebug('X='+intToSTR(x)+' Y='+IntToSTR(Y)+' AncienX='+intToSTR(ancienX)+' AncienY='+IntToSTR(ancienY),clyellow); // Affiche la cellule en fonction du mode iteration:=0; ir:=1; El_tco(x,y,train,ir); // trouve l'élément suivant, et explore les ports de l'aiguillage en récursif inc(i); if (adresse=det2) then memTrouve:=true; if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and ((adresse<>det2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; if (i>NbCellulesTCO[indexTCO]) then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); inc(direction) until (direction=5) or memtrouve ; if memTrouve then begin if debugTco then afficheDebug('TCO: Trouvé route de '+intToSTR(det1)+' à '+intToSTR(det2)+' en '+intToSTR(x)+','+intToSTR(y),clLime); Affiche_trajet(indexTCO,train,indexIr,mode); // affiche le trajet dans le TCO end; 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 // nécessite que les aiguillages aoient bien positionnés entre det1 et det2 procedure zone_TCO_ancien(indexTCO,det1,det2,mode: integer); var direction,i,j,x,y,xn,yn,ancienY,ancienX,Xdet1,Ydet1,Xdet2,Ydet2,Bimage,adresse, pos,pos2,ir: integer; memtrouve,sortir,casok : 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),clyellow); trouve_det(indexTCO,det1,Xdet1,Ydet1); if (Xdet1=0) or (Ydet1=0) then exit; trouve_det(indexTCO,det2,Xdet2,Ydet2); if (Xdet2=0) or (Ydet2=0) then exit; 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; // on teste 4 directions: 1=SE 2=NO 3=SO 4=NE 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; // itérations if debugTCO then afficheDebug('Direction '+intToSTR(direction),clOrange); // initialiser les points d'où l'on vient if direction=1 then begin // vers SE casok:=true; ancieny:=ydet1+1; ancienx:=xdet1+1; end; if direction=2 then begin // vers NO casok:=true; ancieny:=ydet1-1; ancienx:=xdet1-1; end; if direction=3 then begin // SO casok:=true; ancieny:=ydet1+1; ancienx:=xdet1-1; end; if direction=4 then begin // vers NE casok:=true; ancieny:=ydet1-1; ancienx:=xdet1+1; end; // boucle de remplissage du tableau routeTCO de det1 à det2 repeat // routetco[indexTCO,ir].x:=x; // routetco[indexTCO,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[indextco,x,y].Adresse ; Bimage:=tco[indextco,x,y].Bimage; casok:=false; // 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 begin xn:=x+1; end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 3 : begin //if debugTCO then AfficheDebug('El 3',clyellow); pos:=positionTCO(indexTCO,x,y); if (ancienXx) and (ancienY=Y) then begin xn:=x-1;end; if (ancienX>x) and (ancienYx) and (ancienY=Y) then begin xn:=x-1;end; if (ancienX>x) and (ancienY>y) then begin xn:=x-1;end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 5 : begin //if debugTCO then AfficheDebug('El 5',clyellow); pos:=positionTCO(indexTCO,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(indexTCO,x,y);sortir:=true;end; end; 13 : begin //if debugTCO then AfficheDebug('El 13',clyellow); pos:=positionTCO(indexTCO,x,y); if (ancienXx) and (ancienYy) then begin xn:=x+1;yn:=y-1;end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 14 : begin //if debugTCO then AfficheDebug('El 14',clyellow); pos:=positionTCO(indexTCO,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(indexTCO,x,y);sortir:=true;end; end; 15 : begin //if debugTCO then AfficheDebug('El 15',clyellow); pos:=positionTCO(indexTCO,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(indexTCO,x,y);sortir:=true;end; end; 16 : if ancienX0 then s:=s+'adr='+intToStr(adresse); AfficheDebug(s,clyellow); end; xn:=x; casok:=true; if (ancienY0 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(indexTCO,x,y);sortir:=true;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(indexTCO,x,y);sortir:=true;end; if (pos=const_droit) and (pos2=const_droit) then begin casok:=true; if ancienXx) and (ancienY=Y) then begin xn:=x-1;end; 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(indexTCO,x,y);sortir:=true;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(indexTCO,x,y);sortir:=true;end; if (pos=const_droit) and (pos2=const_droit) then begin if ancienXx) and (ancienY=Y) then begin casok:=true;xn:=x-1;end; if (ancienX>x) and (ancienY>Y) then begin casok:=true;xn:=x-1;yn:=y-1;end; if (ancienX0 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(indexTCO,x,y);sortir:=true;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(indexTCO,x,y);sortir:=true;end; if (pos=const_droit) and (pos2=const_droit) then begin if ancienXx) and (ancienYY) then begin xn:=x+1;yn:=yn-1;end; if (ancienX=x) and (ancienYY) then begin xn:=x;yn:=y-1;end; end; if (mdl=aig) then begin Affiche('Erreur 50 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); Affiche('mais la cellule représente un croisement ou une TJD/S',clred); exit; end; end; 24 : begin if debugTCO then AfficheDebug('El 24',clyellow); pos:=positionTCO(indexTCO,x,y); // on vient d'en bas if (ancienY>y) 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(indexTCO,x,y);sortir:=true;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(indexTCO,x,y);sortir:=true;end; if (pos=const_droit) and (pos2=const_droit) then begin if ancienXx) and (ancienY>Y) then begin casok:=true;xn:=x-1;yn:=yn-1;end; if (ancienX=x) and (ancienYY) then begin casok:=true;xn:=x;yn:=y-1;end; end; if (mdl=aig) then begin Affiche('Erreur 51 TCO : la cellule '+intToSTR(x)+','+intToSTR(y)+' d''adresse '+intToSTR(Adresse)+' est décrite comme un aiguillage ',clred); Affiche('mais la cellule représente un croisement ou une TJD/S',clred); exit; end; end; 26 : begin if debugTCO then AfficheDebug('El 26',clyellow); pos:=positionTCO(indexTCO,x,y); // on vient d'en bas if (ancienY>y) 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 (ancienYx) then begin yn:=y+1;xn:=x; end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 27 : begin if debugTCO then AfficheDebug('El 27',clyellow); pos:=positionTCO(indexTCO,x,y); // on vient d'en bas if (ancienY>y) and (ancienX=x) then begin yn:=y-1;xn:=x; end; // on vient d'en haut if (ancienYy) and (ancienXy) and (ancienX=x) then begin yn:=y-1;xn:=x; end; // on vient d'en haut if (ancienYy) and (ancienX>x) then begin yn:=y-1;xn:=x; end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 29 : begin //if debugTCO then AfficheDebug('El 12',clyellow); pos:=positionTCO(indexTCO,x,y); // on vient à de haut à gauche if (ancienXx) and (ancienY>Y) then begin xn:=x-1;yn:=y-1;end; // on vient de bas if (ancienX=x) and (ancienY>y) then begin xn:=x-1;yn:=y-1;end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 32 : begin if debugTCO then AfficheDebug('El 32',clyellow); pos:=positionTCO(indexTCO,x,y); // on vient d'en bas à gauche if (ancienXY) then begin xn:=x+1;yn:=y-1;end; // on vient d'en bas if (ancienX=x) and (ancienY>Y) then begin xn:=x+1;yn:=y-1;end; // on vient d'en haut à droite if (ancienX>x) and (ancienYx) and (ancienY>y) then begin yn:=y-1;if pos=const_droit then xn:=x-1 else xn:=x;end; if (pos=const_inconnu) then begin Erreur_TCO(indexTCO,x,y);sortir:=true;end; end; 34 : begin pos:=positionTCO(indexTCO,x,y); // on vient du SE if (ancienXy) then begin yn:=y-1;if pos=const_droit then xn:=x+1 else xn:=x;end; // on vient du N if (ancienX=x) and (ancienYx) and (ancienYdet2) and (adresse<>det1) and (adresse<>0)) then sortir:=true; ancienX:=x; ancienY:=y; x:=xn; y:=yn; until (memTrouve) or (i>NbCellulesTCO[indexTCO]) or (x>NbreCellX[indexTCO]) or (y>NbreCellY[indexTCO]) or (x=0) or (y=0) or sortir; // or not(casok) ; { if not(casok) then begin Affiche('Erreur TCO incohérence tracé cellule '+intToSTR(x)+','+intToSTR(y),clred); exit; end; } if (i>NbCellulesTCO[indexTCO]) then AfficheDebug('Erreur 1000 TCO : dépassement d''itérations - Route de '+IntToSTR(det1)+' à '+IntToSTR(det2),clred); inc(direction) until (direction=5) or memtrouve ; //Affiche(intToSTR(x),clLime); if i>NbCellulesTCO[indexTCO] 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; if DebugTCO then AfficheDebug('trouvé liaison de '+IntToSTR(det1)+' à '+IntToSTR(det2),clLime); dec(ir); Affiche_trajet(indexTCO,1,ir,mode); end; // positionne l'icone du groupe G2 (signal, quai, action) procedure positionne_icone_G2(IndexTCO : integer;ip : timage;lbl : tlabel;i : integer); const NbElLi=12; var s : string; l : integer; begin l:=formTCO[1].groupBox1.Width; dec(i,17); if ip<>nil then begin with ip do begin width:=licone; height:=hicone; left:=((i-1) mod NbElLi)*(licone+20)+l+xicones; top:= ((i-1) div NbElLi)*(hicone+10)+8; with canvas do begin Pen.Color:=clFond[IndexTCO]; Brush.color:=clFond[IndexTCO]; Rectangle(0,0,licone,hicone); end; end; end; if lbl<>nil then begin with lbl do begin s:=intToSTR(i+17); if i<10 then s:=' '+s; caption:=s; left:=((i-1) mod NbElLi)*(licone+20)+l+xicones-18; top:= ((i-1) div NbElLi)*(hicone+10)+16; end; end; end; // positionne l'icone d'image ip et la place en x y d'après son index i procedure positionne_iconeLbIm(IndexTCO : integer;ip : timage;lbl : tlabel;i : integer); const NbElLi=12; var s : string; l : integer; begin l:=formTCO[1].groupBox1.Width; if (i>=32) and (i<=34) then dec(i,2); if ip<>nil then begin with ip do begin width:=licone; height:=hicone; left:=((i-1) mod NbElLi)*(licone+20)+l+Xicones; top:= ((i-1) div NbElLi)*(hicone+10)+8; with canvas do begin Pen.Color:=clFond[IndexTCO]; Brush.color:=clFond[IndexTCO]; Rectangle(0,0,licone,hicone); end; end; end; if lbl<>nil then begin with lbl do begin if (i=35) or (i=36) or (i=37) then s:=intToSTR(i+15) else if (i>=30) and (i<=32) then s:=intToSTR(i+2) else s:=intToSTR(i); if i<10 then s:=' '+s; caption:=s; left:=((i-1) mod NbElLi)*(licone+20)+l+Xicones-18; top:= ((i-1) div NbElLi)*(hicone+10)+16; end; end; end; // dessine les icones du tco et les aligne procedure dessine_icones(indexTCO : integer); var ancH,ancW,i,lf,hf,sauv_ep: integer; ip : TImage; lbl : Tlabel; begin // d'abord on positionne les icones with formTCO[indexTCO] do begin // groupe 1 les voies, les aiguillages, les TJD for i:=1 to 29 do begin ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; positionne_iconeLbIm(indexTCO,ip,lbl,i); end; for i:=32 to 34 do begin ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; positionne_iconeLbIm(IndexTCO,ip,lbl,i); end; // groupe 2 i:=Id_signal; ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; positionne_icone_G2(IndexTCO,ip,lbl,i); i:=Id_Quai; ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; positionne_icone_G2(IndexTCO,ip,lbl,i); i:=Id_action; ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; positionne_icone_G2(IndexTCO,ip,lbl,i); // signal ip:=findComponent('ImagePalette51') as Timage; if ip<>nil then begin with ip do begin with canvas do begin Pen.Color:=clFond[IndexTCO]; Brush.color:=clFond[IndexTCO]; Rectangle(0,0,licone,hicone); end; end; end; // et puis on les dessine sauv_ep:=epaisseur; epaisseur:=3; ancw:=LargeurCell[indexTCO]; AncH:=hauteurCell[indexTCO]; hauteurCell[indexTCO]:=ImagePalette1.Height; LargeurCell[indexTCO]:=ImagePalette1.Width; dessin_5(indexTCO,ImagePalette5.Canvas,1,1,0); //posX,posY,état,position dessin_2(indexTCO,ImagePalette2.Canvas,1,1,0); dessin_3(indexTCO,ImagePalette3.Canvas,1,1,0); dessin_4(indexTCO,ImagePalette4.Canvas,1,1,0); dessin_1(indexTCO,ImagePalette1.canvas,1,1,0); dessin_6(indexTCO,ImagePalette6.canvas,1,1,0); dessin_7(indexTCO,ImagePalette7.canvas,1,1,0); dessin_8(indexTCO,ImagePalette8.canvas,1,1,0); dessin_9(indexTCO,ImagePalette9.canvas,1,1,0); dessin_10(indexTCO,ImagePalette10.Canvas,1,1,0); dessin_11(indexTCO,ImagePalette11.Canvas,1,1,0); dessin_12(indexTCO,ImagePalette12.Canvas,1,1,0); dessin_13(indexTCO,ImagePalette13.Canvas,1,1,0); dessin_14(indexTCO,ImagePalette14.Canvas,1,1,0); dessin_15(indexTCO,ImagePalette15.Canvas,1,1,0); dessin_16(indexTCO,ImagePalette16.canvas,1,1,0); dessin_17(indexTCO,ImagePalette17.canvas,1,1,0); dessin_18(indexTCO,ImagePalette18.canvas,1,1,0); dessin_19(indexTCO,ImagePalette19.canvas,1,1,0); dessin_20(indexTCO,ImagePalette20.canvas,1,1,0); dessin_21(indexTCO,ImagePalette21.canvas,1,1,0); dessin_22(indexTCO,ImagePalette22.canvas,1,1,0); dessin_23(indexTCO,ImagePalette23.canvas,1,1,0); dessin_24(indexTCO,ImagePalette24.canvas,1,1,0); dessin_25(indexTCO,ImagePalette25.canvas,1,1,0); dessin_26(indexTCO,ImagePalette26.canvas,1,1,0); dessin_27(indexTCO,ImagePalette27.canvas,1,1,0); dessin_28(indexTCO,ImagePalette28.canvas,1,1,0); dessin_29(indexTCO,ImagePalette29.canvas,1,1,0); dessin_32(indexTCO,ImagePalette32.canvas,1,1,0); dessin_33(indexTCO,ImagePalette33.canvas,1,1,0); dessin_34(indexTCO,ImagePalette34.canvas,1,1,0); dessin_51(indexTCO,ImagePalette51.canvas,1,1,0); //quai dessin_52(indexTCO,ImagePalette52.canvas,1,1,0); //action LargeurCell[indexTCO]:=20; with formprinc.Image9Feux do begin lf:=width; hf:=height; end; With ImagePalette50 do begin Picture.Bitmap.TransparentMode:=tmAuto; Picture.Bitmap.TransparentColor:=clblue; Transparent:=true; end; //Picture.Bitmap:=Formprinc.Image9feux.Picture.Bitmap; TransparentBlt(ImagePalette50.canvas.Handle,8,0,LargeurCell[indexTCO],hauteurCell[indexTCO], formprinc.Image9Feux.Canvas.Handle,0,0,50,90,clBlue); // end; end; LargeurCell[indexTCO]:=ancW; hauteurCell[indexTCO]:=ancH; epaisseur:=sauv_ep; end; procedure positionne(indexTCO : integer); var clLarge,ClHaut : integer; begin with formTCO[indexTCO] do begin clLarge:=Width; clHaut:=Height; panelBas.width:=clLarge-5; PanelBas.Top:=clHaut-PanelBas.Height-50; // 50=entete de la fenetre with ScrollBox do begin Width:=clLarge-55; // laisser 50 pixels pour la trackbarzoom + scrollBar //Width:=clLarge-300; // mode pour voir les imageTemp top:=1; left:=1; end; if MasqueBandeauTCO then begin BandeauMasque:=true; PanelBas.Hide; ScrollBox.Height:=clientHeight; end else begin BandeauMasque:=false; PanelBas.show; ScrollBox.Height:=ClHaut-PanelBas.Height-ScrollBox.Top-54; end; end; end; procedure TFormTCO.FormActivate(Sender: TObject); //procedure PFormTCO[indexTCO].FormActivate(Sender: TObject); var indextco : integer; begin indextco:=index_TCO(sender); IndexTCOCourant:=indexTCO; if affevt then Affiche('Form TCO'+intToSTR(indexTCO)+' activate',clyellow); Caption:='TCO'+intToSTR(indexTCO)+' : '+NomFichierTCO[indexTCO]; {initalisation des dimensions du tco - à ne faire qu'une fois} if not(Forminit[indexTCO]) then begin ButtonCalibrage.Visible:=not(diffusion); ButtonSimu.Visible:=not(Diffusion); ImageTemp.Visible:=not(Diffusion); ImageTemp2.Visible:=not(Diffusion); hauteurCell[indexTCO]:=ImagePalette1.Height; LargeurCell[indexTCO]:=ImagePalette1.Width; LargeurCelld2[indexTCO]:=LargeurCell[indexTCO] div 2;hauteurCelld2[indexTCO]:=hauteurCell[indexTCO] div 2; calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]); dessine_icones(indexTCO); NbCellulesTCO[indexTCO]:=NbreCellX[indexTCO]*NbreCellY[indexTCO]; ImageTCO.Width:=LargeurCell[indexTCO]*NbreCellX[indexTCO]; ImageTCO.Height:=hauteurCell[indexTCO]*NbreCellY[indexTCO]; ImageTCO.Picture.Create; ImageTCO.Picture.Bitmap.Height:=hauteurCell[indexTCO]*NbreCellY[indexTCO]; ImageTCO.Picture.BitMap.Width:=LargeurCell[indexTCO]*NbreCellX[indexTCO]; //initialiser les pointeurs images du tco PCanvasTCO[indextco]:=FormTCO[indextco].ImageTCO.Picture.Bitmap.Canvas; PBitMapTCO[indextco]:=FormTCO[indextco].ImageTCO.Picture.Bitmap; PImageTCO[indextco]:=FormTCO[indextco].ImageTCO; // initialiser le pointeur image temporaire du TCO PImageTemp[indextco]:=FormTCO[indextco].ImageTemp; // peindre l'image en bleu pour la transparence , nécessaire en cas de décalage des signaux à 180° mais correction apportée dans feu_180 with PImageTemp[indextco].Canvas do begin Pen.Color:=ClBlue; Brush.Color:=CLBlue; // FillRect(Rect(0,0,100,100)); end; //PImageTemp[indextco].Canvas.Rectangle(0,0,PImageTemp[indextco].Width,PimageTemp[indextco].Height); //PImageTemp[indextco].Picture.Bitmap.TransparentMode:=tmAuto; //PImageTemp[indextco].Picture.Bitmap.TransparentColor:=clblue; //PImageTemp[indextco].Transparent:=true; //déclenche l'Affiche_tco if ZoomInit[indexTCO]<>0 then FormTCO[indexTCO].TrackBarZoom.Position:=ZoomInit[indexTCO] else TrackBarZoom.position:=34; TrackBarZoom.Max:=ZoomMax; TrackBarZoom.Min:=ZoomMin; positionne(indexTCO); FormInit[indexTCO]:=true; end; if indexTCO=NbreTCO then TCOActive:=true; end; // vérifie que les icones adjacentes sont cohérentes - ne pas utiliser.... function verif_cellule(IndexTCO,x,y,Bim : integer) : boolean; var res,verif : boolean; Bimz,i,bl : integer; begin result:=true; verif:=false; if (bim>=Id_signal) 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[indexTCO,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[indexTCO,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[indexTCO,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[indexTCO,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[indexTCO,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[indexTCO,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[indextco,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[indextco,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; // efface le contenu de la cellule, sauf le fond procedure raz_cellule(indexTCO,x,y : integer); begin tco[indextco,x,y].Adresse:=0; tco[indextco,x,y].Mode:=0; tco[indextco,x,y].Trajet:=0; tco[indextco,x,y].inverse:=false; tco[indextco,x,y].repr:=0; tco[indextco,x,y].Bimage:=0; tco[indextco,x,y].liaisons:=0; tco[indextco,x,y].epaisseurs:=0; tco[indextco,x,y].buttoir:=0; tco[indextco,x,y].pont:=0; tco[indextco,x,y].sortie:=0; tco[indextco,x,y].Texte:=''; tco[indextco,x,y].Fonte:=''; tco[indextco,x,y].FontStyle:=''; tco[indextco,x,y].CoulFonte:=0; // tco[indextco,x,y].CouleurFond:=0; tco[indextco,x,y].PiedFeu:=0; tco[indextco,x,y].x:=0; tco[indextco,x,y].y:=0; tco[indextco,x,y].xUndo:=0; tco[indextco,x,y].yUndo:=0; tco[indextco,x,y].FeuOriente:=0; end; procedure insere_colonne(indexTCO,colonne : integer); var x,y : integer; begin if NbreCellX[indexTCO]>=MaxCellX then exit; for x:=NbreCellX[indexTCO] downto colonne do begin for y:=1 to NbreCellY[indexTCO] do tco[indextco,x+1,y]:=tco[indextco,x,y]; end; for y:=1 to NbreCellY[indexTCO] do begin raz_cellule(indextco,colonne,y); tco[indextco,colonne,y].Couleurfond:=Clfond[IndexTCO]; end; inc(NbreCellX[indexTCO]); tco_modifie:=true; end; procedure insere_ligne(indexTCO,ligne : integer); var x,y : integer; begin if NbreCellY[indexTCO]>=MaxCellY then exit; for y:=NbreCellY[indexTCO] downto ligne do for x:=1 to NbreCellX[indexTCO] do tco[indextco,x,y+1]:=tco[indextco,x,y]; for x:=1 to NbreCellX[indexTCO] do begin raz_cellule(indextco,x,ligne); tco[indextco,x,ligne].Couleurfond:=Clfond[IndexTCO]; end; inc(NbreCellY[indexTCO],1); tco_modifie:=true; end; procedure Annule(indextco : integer); var x,y,xu,yu,Xplace,yplace,adresse,i : integer; begin if (TamponTCO_org.numTCO<>indexTCO) then exit; if ligne_supprime<>0 then insere_ligne(indexTCO,ligne_Supprime); if colonne_supprime<>0 then insere_colonne(indexTCO,colonne_Supprime); if TamponAffecte then begin 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[indexTCO]) and (yPlace<=NbreCellY[indexTCO]) then begin tco[indextco,xPlace,yPlace]:=tampontco[x,y]; if tco[indextco,xPlace,yPlace].Bimage=Id_signal then begin adresse:=tco[indextco,xPlace,yPlace].Adresse; end; end; end; end; Affiche_TCO(indextco); tco_modifie:=true; tamponaffecte:=false; ligne_supprime:=0; colonne_supprime:=0; 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 xu:=undo[rangUndo].element[i].Xundo; yu:=undo[rangUndo].element[i].Yundo; if (xu<=NbreCellX[indexTCO]) and (yu<=NbreCellY[indexTCO]) then tco[indextco,xu,yu]:=undo[rangUndo].element[i]; end; Affiche_tco(indexTCO); tco_modifie:=true; exit; end; end; procedure stop_modetrace(indexTCO : integer); begin modetrace[indexTCO]:=false; screen.cursor:=crDefault; IndexTrace:=0; traceXY[1].x:=0;traceXY[1].y:=0; traceXY[2].x:=0;traceXY[2].y:=0; affiche_tco(indexTCO); if debugTCO then Affiche('------------',clYellow); FormTCO[indexTCO].Caption:='TCO'+intToSTR(indexTCO)+' : '+NomFichierTCO[indexTCO]; screen.cursor:=crDefault; end; procedure grille(indexTCO : integer); var x,y : integer; begin if not(AvecGrille[indexTCO]) then exit; With PCanvasTCO[indexTCO] do begin pen.color:=ClGrille[IndexTCO]; pen.Width:=1; Brush.Color:=ClFond[IndexTCO]; pen.mode:=PmCopy; // lignes verticales for x:=1 to NbreCellX[indexTCO] do begin moveto(x*LargeurCell[indexTCO],1); LineTo(x*LargeurCell[indexTCO],hauteurCell[indexTCO]*NbreCelly[indexTCO]); end; // lignes horizontales for y:=1 to NbreCelly[indexTCO] do begin moveto(1,y*hauteurCell[indexTCO]); LineTo(LargeurCell[indexTCO]*NbreCellX[indexTCO],y*hauteurCell[indexTCO]); end; end; end; procedure copier(indexTCO : integer); var x,y : integer; begin if SelectionAffichee[indexTCO] then begin TamponTCO_org.numTCO:=indexTCO; TamponTCO_Org.x1:=XminiSel div LargeurCell[indexTCO] +1; TamponTCO_Org.x2:=XmaxiSel div LargeurCell[indexTCO] +1; TamponTCO_Org.y1:=yminiSel div hauteurCell[indexTCO] +1; TamponTCO_Org.y2:=ymaxiSel div hauteurCell[indexTCO] +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),clred); tampontco[x,y]:=tco[indextco,x,y]; end; TamponAffecte:=true; end; end; procedure couper(indexTCO: integer); var x,y,XCell1,YCell1,xCell2,yCell2 : integer; begin if (XclicCell[indexTCO]=0) or (YclicCell[indexTCO]=0) then exit; //Affiche(intToSTR(ancienXclic)+' '+intToSTR(XclicCell[indexTCO]),clred); if (AncienXclic=XclicCell[indexTCO]) and (AncienYclic=YclicCell[indexTCO]) then exit; AncienXclic:=XclicCell[indexTCO]; AncienYclic:=YclicCell[indexTCO]; with formTCO[indexTCO] do begin EditAdrElement.Text:=''; EditTypeImage.Text:=''; EditTexte.Text:=''; end; // couper par la fenetre graphique if FormTCO[indexTCO].RadioGroupSel.ItemIndex=1 then begin xMiniSel:=Rect_select.Gd.Left; yMiniSel:=Rect_select.Gd.top; xMaxiSel:=Rect_select.Gd.right; yMaxiSel:=Rect_select.Gd.bottom; if xminiSel>xMaxiSel then echange(xminiSel,xMaxiSel); if yminiSel>yMaxiSel then echange(yminiSel,yMaxiSel); // effacer le rectangle Affiche_Rectangle(IndexTCO,Rect_select); Rect_select.NumTCO:=0; // indicateur de non affichage end; // couper sans sélection : on coupe une seule cellule if not(SelectionAffichee[indexTCO]) then begin tampontco[XclicCell[indexTCO],YclicCell[indexTCO]]:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]]; // pour pouvoir faire annuler couper TamponTCO_org.x1:=XclicCell[indexTCO];TamponTCO_org.y1:=YclicCell[indexTCO]; TamponTCO_org.x2:=XclicCell[indexTCO];TamponTCO_org.y2:=YclicCell[indexTCO]; raz_cellule(indextco,XclicCell[indexTCO],YClicCell[indexTCO]); TamponTCO_org.numTCO:=indexTCO; efface_entoure(indexTCO); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XclicCell[indexTCO],YClicCell[indexTCO],PmCopy); TamponAffecte:=true; xCoupe:=XclicCell[indexTCO];yCoupe:=YclicCell[indexTCO]; Affiche_tco(indexTCO); exit; end; TCO_modifie:=true; copier(indexTCO); SelectionAffichee[indexTCO]:=false; xCell1:=XminiSel div LargeurCell[indexTCO] +1; xCell2:=XmaxiSel div LargeurCell[indexTCO] +1; yCell1:=yminiSel div hauteurCell[indexTCO] +1; yCell2:=ymaxiSel div hauteurCell[indexTCO] +1; xCoupe:=XCell1;yCoupe:=yCell1; for y:=yCell1 to yCell2 do for x:=xCell1 to xCell2 do begin raz_cellule(indextco,x,y); //Affiche('Efface cellules '+IntToSTR(X)+' '+intToSTR(y),clyellow); efface_entoure(indexTCO); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,X,Y,PmCopy); if avecGrille[indexTCO] then grille(indexTCO); end; end; procedure selection_bleue(indexTCO,cellX,cellY : integer); var xMiniSelP,yminiSelP,xMaxiSelP,ymaxiSelP : integer; r : Trect; begin // zone de sélection bleue en coords pixels xMiniSel:=(Xentoure[indexTCO]-1)*LargeurCell[indexTCO];; yMiniSel:=(Yentoure[indexTCO]-1)*HauteurCell[indexTCO];; xMaxiSel:=(cellX-1)*LargeurCell[indexTCO]; yMaxiSel:=(cellY-1)*hauteurCell[indexTCO]; xminiSelP:=min(xminiSel,xMaxiSel); yminiSelP:=min(yminiSel,yMaxiSel); xmaxiSelP:=max(xminiSel,xMaxiSel); ymaxiSelP:=max(yminiSel,yMaxiSel); xminiSel:=xMiniSelP; yminiSel:=yMiniSelP; xMaxiSel:=xMaxiSelP; yMaxiSel:=yMaxiSelP; //Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange); // efface l'ancien rectangle de sélection if SelectionAffichee[indexTCO] then with formTCO[indexTCO].ImageTCO.canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[IndexTCO]; Brush.Color:=clblue; Rectangle(rAncien); end; if piloteAig then begin SelectionAffichee[indexTCO]:=false;piloteAig:=false;exit;end; r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]); // Affiche le nouveau rectangle de sélection Rancien:=r; with formTCO[indexTCO].ImageTCO.canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[IndexTCO]; Brush.Color:=clblue; //FillRect(r); Rectangle(r); end; SelectionAffichee[indexTCO]:=true; end; procedure selec_tout(indexTCO : integer); begin if indexTCO<0 then exit; xminiSel:=0; yminiSel:=0; xMaxiSel:=(NbreCellX[indexTCO]-1)*LargeurCell[indexTCO]; yMaxiSel:=(NbreCellY[indexTCO]-1)*hauteurCell[indexTCO]; rAncien:=rect(xminiSel,YminiSel,xmaxiSel+LargeurCell[indexTCO],YMaxiSel+hauteurCell[indexTCO]); SelectionAffichee[indexTCO]:=true; with formTCO[indexTCO].imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[IndexTCO]; Brush.Color:=clblue; Rectangle(rAncien); end; end; // pour avoir les evts keydown, il faut dévalider les propriétés tabstop des boutons de la form. procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); var s,d,indexTCO,x,y : integer; procede : boolean; begin if affevt then Affiche('TCO.FormKeyDown',clOrange); indexTCO:=index_TCO(Sender); if (RadioGroupSel.ItemIndex=1) and (Key=Vk_Escape) then begin if Rect_select.NumTCO=indexTCO then affiche_rectangle(IndexTCO,Rect_select); Rect_select.NumTCO:=0; selectionAffichee[indexTCO]:=false; exit; end; if not(auto_tcurs) or (RadioGroupSel.ItemIndex=1) then exit; procede:=false; // indicateur on a tapé une touche de curseur //Affiche(intToSTR(key),clyellow); x:=XClicCell[indexTCO]; y:=YClicCell[indexTCO]; with formTCO[indexTCO] do begin if not(ssShift in Shift) then case Key of VK_right : if xScrollBox.Width then scrollBox.HorzScrollBar.Position:=s+LargeurCell[indexTCO]; procede:=true; end else exit; VK_left : if XClicCell[indexTCO]>1 then begin dec(XClicCell[indexTCO]); d:=(xClicCell[indexTCO]-1)*LargeurCell[indexTCO]; s:=scrollBox.HorzScrollBar.Position; if d<=s then begin s:=s-LargeurCell[indexTCO]; if sScrollBox.Height then scrollBox.VertScrollBar.Position:=s+hauteurCell[indexTCO]; procede:=true; end else exit; VK_up : if YClicCell[indexTCO]>1 then begin dec(YClicCell[indexTCO]); d:=(yClicCell[indexTCO]-1)*hauteurCell[indexTCO]; s:=scrollBox.VertScrollBar.Position; if dScrollBox.Width then scrollBox.HorzScrollBar.Position:=s+LargeurCell[indexTCO]; procede:=true; end else exit; selection_bleue(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); exit; end; VK_down : begin if YClicCell[indexTCO]ScrollBox.Height then scrollBox.VertScrollBar.Position:=s+hauteurCell[indexTCO]; procede:=true; end else exit; selection_bleue(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); exit; end; VK_up : begin if YClicCell[indexTCO]>1 then begin dec(YClicCell[indexTCO]); d:=(yClicCell[indexTCO]-1)*hauteurCell[indexTCO]; s:=scrollBox.VertScrollBar.Position; if d1 then begin dec(XClicCell[indexTCO]); d:=(xClicCell[indexTCO]-1)*LargeurCell[indexTCO]; s:=scrollBox.HorzScrollBar.Position; if d<=s then begin s:=s-LargeurCell[indexTCO]; if sindexTCO then begin accept:=false; exit; // le drag source et destination sont différents end; xl:=x+offsetSourisX; yl:=y+offsetSourisY; Accept:=source is TImage; if drag then begin // canvasTCO<-oldBMP restitue l'ancien en oldx,oldy fond avant le nouveau BitBlt(PImageTCO[indexTCO].canvas.handle,oldx,oldy,LargeurCell[indexTCO],hauteurCell[indexTCO],oldbmp.canvas.handle,0,0,SRCCOPY); // remettre la sauvegarde du bitmap à l'ancienne position souris // oldbmp(0,0)<-canvasTCO(x1,y1) sauve le nouveau bitmap en x1,y1 BitBlt(oldbmp.canvas.handle,0,0,LargeurCell[indexTCO],hauteurCell[indexTCO],PImageTCO[IndexTCO].canvas.handle,xl,yl,SRCCOPY); // sauvegarder le bitmap actuel sous la souris oldx:=xl; oldy:=yl; // canvasTCO(x1,y1)<-ImageTemp(0,0) BitBlt(PImageTCO[indexTCO].canvas.handle,xl,yl,LargeurCell[indexTCO],hauteurCell[indexTCO],formTCO[indexTCO].ImageTemp.canvas.handle,0,0,SRCCOPY); // copier l'icone vers la souris PImageTCO[IndexTCO].Repaint; end; end; // met le tableau undo a jour après un remplissage procedure maj_undo(i : integer); var k : integer; begin undo[rangUndo].nombre:=i; if rangUndo=100 then exit; tco[indextco,xu,yu].Xundo:=xu; // stocke les coordonnées de la cellule concernée tco[indextco,xu,yu].Yundo:=yu; undo[rangUndo].element[i]:=tco[indextco,xu,yu]; //affiche('Rang undo='+intToSTR(rangundo),clYellow); end; procedure end_Drag(icone,x,y : integer;Sender, Target: TObject); var s : string; indexTCO,xclic,Yclic : integer; begin if not(Target is TImage) then exit; s:=(Target as TImage).Name; if copy(s,1,8)<>'ImageTCO' then exit; if (x=0) and (y=0) then exit; indexTCO:=Index_tco(sender); //Xclic:=XclicCell[indexTCO]; //Yclic:=YClicCell[indexTCO]; BitBlt(formTCO[indexTCO].imageTCO.canvas.handle,oldx,oldy,LargeurCell[indexTCO],hauteurCell[indexTCO],oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure(indexTCO); FormTCO[indexTCO].imageTCO.repaint; Xclic:=X div LargeurCell[indexTCO] +1; Yclic:=Y div hauteurCell[indexTCO] +1; XclicCell[indexTCO]:=Xclic; YClicCell[indexTCO]:=Yclic; if not(verif_cellule(indexTCO,Xclic,Yclic,icone)) then exit; efface_cellule(IndexTCO,formTCO[indexTCO].ImageTCO.Canvas,Xclic,YClic,PmCopy); TCO_modifie:=true; case icone of 1 : dessin_1(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 2 : dessin_2(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 3 : dessin_3(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 4 : dessin_4(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 5 : dessin_5(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 6 : dessin_6(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 7 : dessin_7(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 8 : dessin_8(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 9 : dessin_9(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 10 : dessin_10(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 11 : dessin_11(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 12 : dessin_12(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 13 : dessin_13(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 14 : dessin_14(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 15 : dessin_15(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 16 : dessin_16(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 17 : dessin_17(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 18 : dessin_18(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 19 : dessin_19(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 20 : dessin_20(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 21 : dessin_21(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 22 : dessin_22(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 23 : dessin_23(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 24 : dessin_24(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 25 : dessin_25(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 26 : dessin_26(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 27 : dessin_27(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 28 : dessin_28(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 29 : dessin_29(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 32 : dessin_32(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 33 : dessin_33(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); 34 : dessin_34(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); id_Quai : dessin_51(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); id_action : dessin_52(indexTCO,FormTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,0); end; stocke_undo(indexTCO,1,XClic,YClic); maj_undo(1); tco[indextco,XClic,YClic].BImage:=icone; tco[indextco,XClic,YClic].liaisons:=liaisons[icone]; tco[indextco,xClic,YClic].CoulFonte:=clYellow; formTCO[indexTCO].EditAdrElement.Text:=IntToSTR( tco[indextco,XClic,YClic].Adresse); formTCO[indexTCO].EdittypeImage.Text:=IntToSTR(tco[indextco,XClic,YClic].BImage); end; procedure TFormTCO.ImagePalette5EndDrag(Sender, Target: TObject; X,Y: Integer); begin end_drag(5,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette2EndDrag(Sender,Target: TObject; X,Y: Integer); begin end_drag(2,x,y,Sender,Target); 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 end_drag(3,x,y,Sender,Target); 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 end_drag(4,x,y,Sender,Target); 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 end_drag(1,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette6EndDrag(Sender, Target: TObject; X,Y: Integer); begin end_drag(6,x,y,Sender,Target); 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 end_drag(7,x,y,Sender,Target); 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 end_drag(8,x,y,Sender,Target); 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 end_drag(9,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette12EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(12,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette13EndDrag(Sender, Target: TObject; X,Y: Integer); begin end_drag(13,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette14EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(14,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette15EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(15,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette16EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(16,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette17EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(17,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette18EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(18,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette19EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(19,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette21EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(21,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette22EndDrag(Sender, Target: TObject; X,Y: Integer); begin end_drag(22,x,y,Sender,Target); end; procedure TFormTCO.ButtonSauveTCOClick(Sender: TObject); begin sauve_fichiers_tco; defocusControl(ButtonSauveTCO,true); end; procedure TFormTCO.MenuCollerClick(Sender: TObject); var x,y,xPlace,yPlace,indexTCO: integer; c : tComponent; begin if TamponAffecte then begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); 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[indexTCO]+x-TamponTCO_Org.x1; // destination yPlace:=YclicCell[indexTCO]+y-TamponTCO_Org.y1; if (xPlace<=NbreCellX[indexTCO]) and (yPlace<=NbreCellY[indexTCO]) then tco[indextco,xPlace,yPlace]:=tampontco[x,y]; end; selectionaffichee[indexTCO]:=false; Affiche_TCO(indexTCO); TCO_modifie:=true; ligne_supprime:=0; colonne_supprime:=0; end; end; procedure TFormTCO.MenuCopierClick(Sender: TObject); var indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); copier(indexTCO); ligne_supprime:=0; colonne_supprime:=0; end; // supprimer la sélection procedure TFormTCO.MenuCouperClick(Sender: TObject); var indexTCO : integer; c : Tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); couper(indexTCO); ligne_supprime:=0; colonne_supprime:=0; end; procedure TFormTCO.AnnulercouperClick(Sender: TObject); var indexTCO : integer; c : tComponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); Annule(indexTCO); end; // renvoie une icone en fonction des 4 tracés désirés // exemple : deux lignes qui se croisent renvoie un croisement // el = élement à remplacer // quadrant des 4 tracés (2=NE 3=Est 4=SE 5=S ) // premier : si c'est le premier élément du tracé // dernier : si c'est le dernier élément du tracé // on regarde si l'élément est connecté par testbit(tco[indextco,x,y].liaisons,numbit) numbit=0=NO 1=N 2=NE 3=E 4=SE 5=S 6=SO 7=O function replace(indexTCO,x,y,el,quadrant : integer;premier,dernier : boolean) : integer; var bim : integer; begin //if debugTCO then Affiche('Quadrant '+intToSTR(quadrant),clred); result:=0; bim:=tco[indextco,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[indextco,x+1,y].liaisons,3) then result:=3 else result:=7; end; if dernier then begin if testbit(tco[indextco,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[indextco,x-1,y].liaisons,3)) then result:=6; if testbit(tco[indextco,x-1,y].liaisons,3) then result:=5; end; if premier then begin if testbit(tco[indextco,x+1,y].liaisons,7) then result:=4 ; if not(testbit(tco[indextco,x+1,y].liaisons,7)) then result:=8; end; if not(premier) and not(dernier) then begin if testbit(tco[indextco,x-1,y].liaisons,3) and testbit(tco[indextco,x+1,y].liaisons,7) then result:=22; if not(testbit(tco[indextco,x-1,y].liaisons,3)) and testbit(tco[indextco,x+1,y].liaisons,7) then result:=12; if not(testbit(tco[indextco,x+1,y].liaisons,7)) and testbit(tco[indextco,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[indextco,x+1,y-1].liaisons,6) then result:=15 else result:=9;end else if dernier then begin if testbit(tco[indextco,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[indextco,x-1,y+1].liaisons,2)) and (testbit(tco[indextco,x+1,y-1].liaisons,6)) then result:=21; if not(testbit(tco[indextco,x-1,y+1].liaisons,2)) and (testbit(tco[indextco,x+1,y-1].liaisons,6)) then result:=3; if testbit(tco[indextco,x-1,y+1].liaisons,2) and not(testbit(tco[indextco,x+1,y-1].liaisons,6)) then result:=2; end; end; if quadrant=5 then begin if premier then begin // SO if testbit(tco[indextco,x-1,y+1].liaisons,2) then result:=32 else result:=17; end; if dernier then begin // NE if testbit(tco[indextco,x+1,y-1].liaisons,6) then result:=34 else result:=18; end; if not(premier) and not(dernier) then result:=23; end; end; 11 : begin if quadrant=1 then result:=19; if quadrant=3 then begin if dernier then begin if testbit(tco[indextco,x-1,y-1].liaisons,4) then result:=14 else result:=8;end else if premier then begin if testbit(tco[indextco,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[indextco,x-1,y-1].liaisons,4)) and (testbit(tco[indextco,x+1,y+1].liaisons,0)) then result:=22; if not(testbit(tco[indextco,x-1,y-1].liaisons,4)) and (testbit(tco[indextco,x+1,y+1].liaisons,0)) then result:=4; if testbit(tco[indextco,x-1,y-1].liaisons,4) and not(testbit(tco[indextco,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 begin // NO if testbit(tco[indextco,x-1,y-1].liaisons,4) then result:=33 else result:=19; end; if premier then begin // SE if testbit(tco[indextco,x+1,y+1].liaisons,0) then result:=29 else result:=16; end; 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 premier then result:=29; if dernier then result:=16; if not(premier) and not(dernier) then result:=29; end; if quadrant=5 then begin if testbit(tco[indextco,x,y-1].liaisons,5) then result:=24 else result:=16; end; end; 17 : begin if quadrant=2 then begin if premier then result:=17; if dernier then result:=32; if not(premier) and not(dernier) then result:=32; end; if quadrant=5 then begin if premier then result:=17; if dernier then result:=26; if not(premier) and not(dernier) then result:=26; end; end; 18 : begin if quadrant=2 then result:=34; if quadrant=5 then begin if premier then result:=27; if dernier then begin if testbit(tco[indextco,x,y+1].liaisons,1) then result:=21;result:=18; end; if not(premier) and not(dernier) then result:=27; end; end; 19 : begin if quadrant=4 then result:=19; if quadrant=5 then begin result:=28; end; end; 20 : begin if (quadrant=2) then begin if premier then begin // /N if not(testbit(tco[indextco,x,y-1].liaisons,5)) then result:=17 else result:=26; // SO if (testbit(tco[indextco,x-1,y+1].liaisons,2)) then result:=23; // /SO N if not(testbit(tco[indextco,x-1,y+1].liaisons,2)) and testbit(tco[indextco,x-1,y].liaisons,5) then result:=26; end; if dernier then begin // /S if not(testbit(tco[indextco,x,y+1].liaisons,1)) then result:=18 else result:=27; end; if not(premier) and not(dernier) then result:=23; end; if quadrant=4 then begin if dernier then begin if (testbit(tco[indextco,x,y-1].liaisons,5)) and not(testbit(tco[indextco,x+1,y+1].liaisons,0)) then result:=24; if (testbit(tco[indextco,x,y-1].liaisons,5)) and (testbit(tco[indextco,x+1,y+1].liaisons,0)) then result:=25; if not(testbit(tco[indextco,x,y-1].liaisons,5)) and not(testbit(tco[indextco,x+1,y+1].liaisons,0)) then result:=16; end; if premier then begin if (testbit(tco[indextco,x-1,y-1].liaisons,4)) then result:=25; // /NO /S if not(testbit(tco[indextco,x-1,y-1].liaisons,4)) and not(testbit(tco[indextco,x,y+1].liaisons,1)) then result:=19; // /NO S if not(testbit(tco[indextco,x-1,y-1].liaisons,4)) and (testbit(tco[indextco,x,y+1].liaisons,1)) then result:=28; end; if not(premier) and not(dernier) then result:=25; end; if quadrant=5 then result:=20; end; 21 : result:=21; 22 : result:=22; 23 : result:=23; 24 : begin if quadrant=4 then begin if dernier then begin if testbit(tco[indextco,x+1,y+1].liaisons,0) then result:=25 ; if not(testbit(tco[indextco,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; 26 : begin if quadrant=2 then begin if premier then result:=26; if dernier then result:=23; if not(premier) and not(dernier) then result:=23; end; end; 27 : begin if quadrant=2 then begin if premier then result:=23; if dernier then result:=27; if not(premier) and not(dernier) then result:=23; end; if quadrant=5 then result:=27; end; 28 : begin if quadrant=4 then begin if premier then result:=28; if dernier then begin if (testbit(tco[indextco,x,y-1].liaisons,5)) and (testbit(tco[indextco,x+1,y+1].liaisons,0)) and (testbit(tco[indextco,x,y+1].liaisons,1)) then result:=25 else result:=28; end; if not(premier) and not(dernier) then result:=25; end; if quadrant=5 then result:=28; end; 29 : begin if quadrant=4 then result:=29; if quadrant=5 then begin if dernier then result:=25; if premier then result:=29; if not(premier) and not(dernier) then result:=25; end; end; 32 : begin if quadrant=2 then result:=32; if quadrant=5 then begin if dernier then result:=23; if premier then begin // N if (testbit(tco[indextco,x,y-1].liaisons,5)) then result:=23 else result:=32; end; if not(premier) and not(dernier) then begin // N if (testbit(tco[indextco,x,y-1].liaisons,5)) then result:=23 else result:=32; end; end; end; 33 : begin if quadrant=1 then begin if premier then result:=32; if dernier then result:=25; if not(premier) and not(dernier) then result:=25; end; if quadrant=5 then begin if premier then result:=25; if dernier then result:=33; if not(premier) and not(dernier) then result:=25; end; if quadrant=4 then result:=33; end; 34 : begin if quadrant=2 then result:=34; if quadrant=5 then begin if dernier then result:=34; if premier then result:=23; if not(premier) and not(dernier) then result:=23; end; end; end; tco[indextco,x,y].coulFonte:=clyellow; if result=1 then begin tco[indextco,x,y].repr:=2; end; 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; indexTCO,i,n,adresse,Bimage,xt,yt,xf,yf,xclic,yclic : integer; s : string; begin indexTCO:=index_tco(sender); GetCursorPos(Position); Position:=ImageTCO.screenToCLient(Position); Xclic:=position.X div LargeurCell[indexTCO] + 1; Yclic:=position.Y div hauteurCell[indexTCO] + 1; if button=mbLeft then begin if affEvt then Affiche('TCO Souris clicG enfoncée',clYellow); if dbleClicTCO then begin dbleClicTCO:=false;exit;end; // coordonnées grille AncienXclic:=XclicCell[indexTCO]; AncienYclic:=YclicCell[indexTCO]; XclicCell[indexTCO]:=Xclic; YclicCell[indexTCO]:=Yclic; auto_tcurs:=true; clicsouris:=true; Bimage:=tco[indextco,xclic,yclic].BImage; // action if (Bimage=id_action) and not(ConfCellTCO) then begin i:=tco[indextco,xclic,yclic].piedfeu; n:=tco[indextco,xclic,yclic].feuoriente; if i=1 then Affiche_fenetre_TCO(n,true); // affiche le TCO n°n if i=2 then with formprinc do // afficher signaux complexes begin windowState:=wsNormal; //Maximized; show; BringToFront; end; if (i=3) and (CDMhd<>0) then begin // afficher CDM rail ShowWindow(CDMhd,SW_MAXIMIZE); SetForegroundWindow(CDMhd); // met CDM en premier plan SetActiveWindow(CdmHd); end; if i=4 then // action accessoire begin // pilotage impulsionnel pilote_acc(tco[indextco,xclic,yclic].Adresse,tco[indextco,xclic,yclic].sortie,AigP); end; end; TempoSouris:=2 ; // démarre la tempo souris // clic en mode dessin if modeTrace[indexTCO] then begin if indextrace=0 then begin inc(indexTrace); traceXY[indexTrace].x:=XClic; traceXY[indexTrace].y:=Yclic; exit; end; if indextrace=1 then begin // vérifier coordonnées valides if ( abs(XClic-traceXY[1].x)=abs(YClic-traceXY[1].y) ) or ( XClic-traceXY[1].x=0 ) or ( YClic-traceXY[1].y=0 ) then begin traceXY[2].x:=XClic; traceXY[2].y:=Yclic; xf:=XClic; yf:=Yclic; // 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(indextco,i,xt,yt); // stocke les points de la ligne entière dessinée inc(i); Bimage:=replace(indexTCO,xt,yt,1,3,xt=traceXY[1].x,xt=traceXY[2].x); tco[indextco,xt,yt].BImage:=Bimage; tco[indextco,xt,yt].liaisons:=liaisons[Bimage]; end; maj_undo(i-1); // stocke le nombre de points de la ligne affiche_tco(indextco); 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(indexTCO,i,xt,yt); inc(i); Bimage:=replace(indexTCO,xt,yt,20,5,yt=traceXY[1].y,yt=traceXY[2].y); tco[indextco,xt,yt].BImage:=Bimage; tco[indextco,xt,yt].liaisons:=liaisons[Bimage]; end; maj_undo(i-1); affiche_tco(indexTCO); 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].yindexTCO then begin affiche_rectangle(rect_select.NumTCO,Rect_select); // effacer sur l'autre tco end; if not(selectionAffichee[indexTCO]) then begin rect_select.NumTCO:=indexTCO; // indicateur d'affichage with Rect_select.Gd do begin Left:=(xclic-1)*largeurcell[indexTCO]; Top:=(yclic-1)*hauteurCell[indexTCO]; Right:=(xclic)*largeurCell[indexTCO]; Bottom:=(yclic)*hauteurCell[indexTCO]; end; Init_rectangle(IndexTCO,Rect_Select); Affiche_Rectangle(indexTCO,Rect_select); selectionAffichee[indexTCO]:=true; end; end else begin xMiniSel:=99999;yMiniSel:=99999; xMaxiSel:=0;yMaxiSel:=0; // si une zone de sélection est affichée sur un des TCO, annuler toutes for n:=1 to NbreTCO do if SelectionAffichee[n] then begin //Affiche('efface sélection',clOrange); with formTCO[n].imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[n]; Brush.Color:=clblue; Rectangle(rAncien); end; SelectionAffichee[n]:=false; end; // clic gauche, gestion des Hints clicTCO:=true; //Affiche('xcliccell='+IntToSTR(XclicCell[indexTCO])+' ycliccell='+IntToSTR(YclicCell[indexTCO]),clyellow); if Bimage=id_signal then begin adresse:=tco[IndexTCO,xClic,yClic].Adresse; if (adresse=0) or (index_signal(adresse)=0) then s:='Signal sans adresse' else s:=infosignal(adresse); ImageTCO.Hint:=s; end else if IsAigTCO(Bimage) then begin adresse:=tco[IndexTCO,xClic,yClic].Adresse; if adresse=0 then s:='Aiguillage sans adresse' else begin i:=index_aig(adresse); if aiguillage[i].modele<>crois then begin if Adresse<>0 then begin s:='Aiguillage '+intToSTR(adresse)+' Position='; n:=aiguillage[i].position; case n of const_inconnu : s:=s+'inconnue '; const_droit : s:=s+'droit '; const_devie : s:=s+'devie '; end; if ((aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs)) and (aiguillage[i].EtatTJD=4) then begin adresse:=aiguillage[i].DDevie; s:=s+#13+'Aiguillage '+intToSTR(adresse)+' Position='; i:=index_aig(adresse); n:=aiguillage[i].position; case n of const_inconnu : s:=s+'inconnue'; const_droit : s:=s+'droit'; const_devie : s:=s+'devie'; end; end; end end else s:='Croisement '+intToSTR(adresse); // réservation n:=aiguillage[i].AdrTrain; if n<>0 then s:=s+#13+'Réservé par train '+intToSTR(n); end; ImageTCO.Hint:=s; end else ImageTCO.Hint:=''; if Xclic>NbreCellX[indexTCO] then exit; if Yclic>NbreCellY[indexTCO] then exit; if not(selectionaffichee[indexTCO]) then _entoure_cell_clic(indexTCO); actualise(indexTCO); // actualise la fenetre de config cellule end; clicTCO:=false; end; if button=mbRight then begin if affEvt then Affiche('TCO Souris clicD enfoncée',clLime); auto_tcurs:=true; if modetrace[indexTCO] then begin traceXY[1].x:=0;traceXY[1].y:=0; traceXY[2].x:=0;traceXY[2].y:=0; indextrace:=0; affiche_tco(indexTCO); screen.cursor:=crUpArrow; exit; end; XclicCellInserer:=XClic; YclicCellInserer:=YClic; EditAdrElement.Text:=IntToSTR(tco[indextco,XClicCellInserer,YClicCellInserer].Adresse); EditTypeImage.Text:=IntToSTR(tco[indextco,XClicCellInserer,YClicCellInserer].Bimage); end; end; procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer); var r : Trect; indexTCO,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer; ok : boolean; begin if affevt then Affiche('ImageTCOMouseMove',clLime); if dbleClicTCO then begin dbleClicTCO:=false;exit;end; //Affiche(IntToSTR(tempoSouris),clred); indexTCO:=index_tco(sender); // exécuté uniquement si souris enfoncée et changement position souris if (radioGroupSel.ItemIndex=1) and ((ax<>x) or (ay<>y)) and selectionAffichee[indexTCO] then begin //Affiche(IntToSTR(tick),clred); Accroche_Rectangle_selection(indexTCO,x,y); exit; end; if Temposouris>0 then exit; // Affiche('*',cllime); //affiche(intToSTR(y),clorange); cellX:=x div LargeurCell[indexTCO]+1; // variables globales cellY:=y div hauteurCell[indexTCO]+1; if (AncienXClicCell=CellX) and (AncienYClicCell=CellY) then exit; PimageTCO[indexTCO].Hint:=''; AncienXClicCell:=CellX; AncienYClicCell:=CellY; //Affiche('cellX='+IntToSTR(Cellx)+' cellY='+intToSTR(cellY),clyellow); if CellX>NbreCellX[indexTCO] then exit; if CellY>NbreCellY[indexTCO] then exit; if modeTrace[indexTCO] then begin if indexTrace>0 then begin with formTCO[indexTCO].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[indexTCO]-LargeurCelld2[indexTCO],traceXY[indexTrace].y*hauteurCell[indexTCO]-hauteurCelld2[indexTCO]); LineTo(ancienTraceX*LargeurCell[indexTCO]-LargeurCelld2[indexTCO],ancienTraceY*hauteurCell[indexTCO]-hauteurCelld2[indexTCO]); 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[indexTCO]-LargeurCelld2[indexTCO],traceXY[indexTrace].y*hauteurCell[indexTCO]-hauteurCelld2[indexTCO]); LineTo(cellX*LargeurCell[indexTCO]-LargeurCelld2[indexTCO],CellY*hauteurCell[indexTCO]-hauteurCelld2[indexTCO]); if ok then begin traceXY[indextrace+1].x:=cellX; traceXY[indextrace+1].y:=cellY; end; end; end; exit; end; TpsBougeSouris:=5; if not(clicsouris) or (temposouris>0) then exit; // zone de sélection bleue en coordonnées souris xMiniSel:=(XclicCell[indexTCO]-1)*LargeurCell[indexTCO]; yMiniSel:=(YclicCell[indexTCO]-1)*hauteurCell[indexTCO]; xMaxiSel:=(cellX-1)*LargeurCell[indexTCO]; yMaxiSel:=(cellY-1)*hauteurCell[indexTCO]; xminiSelP:=min(xminiSel,xMaxiSel); yminiSelP:=min(yminiSel,yMaxiSel); xmaxiSelP:=max(xminiSel,xMaxiSel); ymaxiSelP:=max(yminiSel,yMaxiSel); xminiSel:=xMiniSelP; yminiSel:=yMiniSelP; xMaxiSel:=xMaxiSelP; yMaxiSel:=yMaxiSelP; //Affiche('xMiniSel='+IntToSTR(xMiniSel)+' yMiniSel='+IntToSTR(yMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange); //Affiche('XclicCell='+intToSTR(XclicCell[indexTCO])+' YclicCell='+intToSTR(XclicCell[indexTCO]),clorange); // efface l'ancien rectangle de sélection if SelectionAffichee[indexTCO] then with imageTCO.Canvas do begin Pen.Mode:=PmXor; Pen.color:=clGrille[IndexTCO]; Brush.Color:=clblue; Rectangle(rAncien); end; if piloteAig then begin SelectionAffichee[indexTCO]:=false;piloteAig:=false;exit;end; r:=Rect(xminiSel+1,YminiSel+1,XmaxiSel+LargeurCell[indexTCO],yMaxiSel+hauteurCell[indexTCO]); Rancien:=r; Affiche_selection(indexTCO); SelectionAffichee[indexTCO]:=true; //Affiche('Sélection affichée',clLime); if entoure[indexTCO] then begin Entoure_cell(indexTCO,Xentoure[indexTCO],Yentoure[indexTCO]);entoure[indexTCO]:=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; prise_droit:=false; prise_gauche:=false; prise_bas:=false; prise_haut:=false; prise_NE:=false; prise_SO:=false; prise_SE:=false; prise_NO:=false; prise_N:=false; end; procedure TFormTCO.ButtonRedessineClick(Sender: TObject); var indexTCO : integer; begin indexTCO:=index_TCO(sender); Affiche_TCO(indexTCO); end; // changement de l'adresse d'un élément procedure TFormTCO.EditAdrElementChange(Sender: TObject); var Adr,erreur,index,indexTCO : integer; s: string; begin //Affiche('Chgt adresse',clyellow); if clicTCO or ConfCellTCO then exit; clicTCO:=true; auto_tcurs:=false; // interdit le déplacement du curseur encadré du TCO (pour que les touches curseur s'applique au Tedit) indexTCO:=index_TCO(sender); s:=formTCO[indexTCO].EditAdrElement.Text; if length(s)>1 then begin if (s[1]='A') or (s[1]='a') then delete(s,1,1); EditAdrElement.Text:=s; end; Val(s,Adr,erreur); if erreur<>0 then exit; if (Adr<0) or (Adr>2048) then Adr:=0; clicTCO:=false; if Adr=0 then tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].repr:=2; efface_entoure(indexTCO); tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Adresse:=Adr; //formConfCellTCO.editAdrElement.Text:=intToSTR(Adr); tco_Modifie:=true; // si signal if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].BImage=Id_signal then begin index:=Index_Signal(adr); if index=0 then exit else begin //Affiche('Signal '+intToSTR(Adr),clyellow); affiche_tco(indexTCO); end; end; Affiche_cellule(indexTCO,XclicCell[indexTCO],YclicCell[indexTCO]); end; // mise à jour des cellules de l'adresse "adresse" procedure Maj_TCO(indexTCO,Adresse : integer); var x,y: integer; begin for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin if tco[indextco,x,y].Adresse=Adresse then begin affiche_cellule(indexTCO,x,y); entoure_cell_grille(indexTCO,x,y); end; end; end; // mise à jour des aiguillages procedure Maj_Aig_TCO(indexTCO :integer); var x,y: integer; begin for y:=1 to NbreCellY[indexTCO] do for x:=1 to NbreCellX[indexTCO] do begin if IsAigTCO(tco[indextco,x,y].Bimage) then begin affiche_cellule(indexTCO,x,y); end; end; end; // affiche les cellules des tco dont l'adresse d'aiguillage est adresse Procedure Texte_aig_fond(adresse : integer); var ntco,x,y,Bim : integer; begin for ntco:=1 to NbreTCO do begin // trouver les cellules comportant l'aiguillage adresse for y:=1 to NbreCellY[ntco] do for x:=1 to NbreCellX[ntco] do begin Bim:=TCO[ntco,x,y].BImage; if IsAigTCO(Bim) then begin if TCO[ntco,x,y].Adresse=adresse then begin affiche_cellule(ntco,x,y); end; end; end; end; end; procedure TFormTCO.Button1Click(Sender: TObject); begin Detecteur[569].etat:=true; Maj_tco(index_TCO(sender),569); end; procedure TFormTCO.Button2Click(Sender: TObject); begin Detecteur[569].etat:=false; Maj_tco(index_TCO(sender),569); end; procedure TFormTCO.ImagePalette10EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(10,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette11EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(11,x,y,Sender,Target); 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; // dépose un signal procedure TFormTCO.ImagePalette50EndDrag(Sender, Target: TObject; X, Y: Integer); var indexTCO,Xclic,Yclic : integer; begin if not(Target is TImage) then exit; if (x=0) and (y=0) then exit; indexTCO:=index_TCO(sender); xclicCell[indexTCO]:=(x div LargeurCell[indexTCO]) +1; yclicCell[indexTCO]:=(y div LargeurCell[indexTCO]) +1; xclic:=xclicCell[indexTCO]; yclic:=yclicCell[indexTCO]; BitBlt(formTCO[indexTCO].imageTCO.canvas.handle,oldx,oldy,LargeurCell[indexTCO],hauteurCell[indexTCO],oldbmp.canvas.handle,0,0,SRCCOPY); efface_entoure(indexTCO); TCO_modifie:=true; stocke_undo(indexTCO,1,XClic,YClic); maj_undo(1); efface_cellule(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XClic,YClic,PmCopy); raz_cellule(indextco,xClic,yClic); tco[indextco,XClic,YClic].BImage:=Id_signal; tco[indextco,XClic,YClic].FeuOriente:=1; tco[indextco,XClic,YClic].PiedFeu:=1; tco[indextco,XClic,YClic].coulFonte:=clWhite; clicTCO:=true; editAdrElement.Text:=''; clicTCO:=false; EdittypeImage.Text:=IntToSTR(tco[indextco,XClic,YClic].BImage); Dessin_Signal(indexTCO,formTCO[indexTCO].ImageTCO.Canvas,XClic,YClic); end; procedure TFormTCO.ImagePalette50MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); var l,h,indexTCO : integer; begin l:=Formprinc.Image9feux.width; //57 h:=Formprinc.Image9feux.height; //105 indexTCO:=Index_tco(sender); TCODrag:=IndexTCO; ImagePalette50.BeginDrag(true); BitBlt(OldBmp.Canvas.Handle,0,0,LargeurCell[indexTCO],hauteurCell[indexTCO],ImageTCO.Canvas.Handle,offsetSourisX,offsetSourisY,SRCCOPY); drag:=true; oldx:=offsetSourisX;oldy:=offsetSourisY; with formTCO[indexTCO].ImageTemp2.Canvas do begin pen.Color:=clfond[IndexTCO]; brush.Color:=clblack; Rectangle(0,0,91,91); end; TransparentBlt(formTCO[indexTCO].ImageTemp2.canvas.Handle,0,0,LargeurCell[indexTCO],hauteurCell[indexTCO], // destination avec mise à l'échelle //50,50 ok 51,51 nok formprinc.Image9feux.Canvas.Handle,0,0,50,90,clblue); formtco[indexTCO].ImageTCO.repaint; formTCO[indexTCO].ImageTemp:=formTCO[indexTCO].ImageTemp2; BitBlt(formTCO[indexTCO].ImageTemp.canvas.Handle,0,0,20,20,formTCO[indexTCO].ImageTemp2.canvas.Handle,0,0,SRCCOPY); formtco[indexTCO].ImageTCO.repaint; end; procedure Tourne90G(indexTCO : integer); var BImage : integer; begin if actualize then exit; BImage:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage; if Bimage<>Id_signal then exit; TCO_modifie:=true; // effacement de l'ancien signal if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=3 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=2 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]-1,yClicCell[indexTCO],PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=1 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO]+1,PmCopy); end; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente:=2; // signal orienté à 90° gauche Affiche_TCO(indexTCO); actualise(indexTCO); // met à jour la fenetre de config de la cellule end; procedure TFormTCO.Tourner90GClick(Sender: TObject); var indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); tourne90G(indextco); end; procedure tourne90D(indexTCO : integer); var BImage,aspect,adresse : integer; begin if actualize then exit; BImage:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage; if Bimage<>Id_signal then exit; TCO_modifie:=true; adresse:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Adresse; aspect:=Signaux[Index_Signal(adresse)].Aspect; if aspect=0 then aspect:=9; // ancien signal orienté orienté 90D if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=3 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; // ancien signal orienté orienté 90G if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=2 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=1 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO]+1,PmCopy); end; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente:=3; // feu orienté à 90° droit Affiche_TCO(indexTCO); actualise(indexTCO); // met à jour la fenetre de config de la cellule end; procedure TFormTCO.Tourner90DClick(Sender: TObject); var c : tcomponent; indexTCO : integer; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); tourne90D(indextco); end; procedure vertical_180(indexTCO : integer); var BImage ,aspect,Adresse : integer; begin if actualize then exit; BImage:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage; // si c'est autre chose qu'un signal, sortir if Bimage<>Id_signal then exit; TCO_modifie:=true; adresse:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Adresse; aspect:=Signaux[Index_Signal(adresse)].Aspect; if aspect=0 then aspect:=9; // effacement de l'ancien signal // ancien signal orienté orienté 90D if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=3 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; // ancien signal orienté orienté 90G if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=2 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=1 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO]+1,PmCopy); end; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente:=4; // signal orienté à 180° affiche_tco(indexTCO); actualise(indexTCO); // met à jour la fenetre de config de la cellule end; procedure vertical(indexTCO : integer); var BImage ,aspect,Adresse : integer; begin if actualize then exit; BImage:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage; // si c'est autre chose qu'un signal, sortir if Bimage<>Id_signal then exit; TCO_modifie:=true; adresse:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Adresse; aspect:=Signaux[Index_Signal(adresse)].Aspect; if aspect=0 then aspect:=9; // effacement de l'ancien signal // ancien signal orienté orienté 90D if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=3 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; // ancien signal orienté orienté 90G if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=2 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); // si le signal occupe 2 cellules if aspect>=4 then Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO]+1,yClicCell[indexTCO],PmCopy); end; // si l'image était verticale, il faut effacer la cellule en bas if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente=1 then begin Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO],PmCopy); Efface_Cellule(indexTCO,PCanvasTCO[indexTCO],xClicCell[indexTCO],yClicCell[indexTCO]+1,PmCopy); end; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].FeuOriente:=1; // signal orienté à 180° affiche_tco(indexTCO); actualise(indexTCO); // met à jour la fenetre de config de la cellule end; procedure TFormTCO.Pos_vertClick(Sender: TObject); var c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO vertical(index_tco(c)); end; procedure TFormTCO.Signalvertical180Click(Sender: TObject); var c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO vertical_180(index_tco(c)); end; procedure TFormTCO.TrackBarZoomChange(Sender: TObject); var indextco : integer; begin if affevt then Affiche('TrackBarZoomChange',clyellow); indexTCO:=index_tco(sender); ZoomInit[indexTCO]:=TrackBarZoom.Position; //Affiche(intToSTR(TrackBarZoom.position),clred); calcul_cellules(indexTCO); Affiche_TCO(indexTCO); SelectionAffichee[indexTCO]:=false; Rect_select.NumTCO:=0; 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); var indexTCO : integer; begin if clicTCO then exit; if affevt then Affiche('TCO.EditTextChange',clOrange); auto_tcurs:=false; // interdit le déplacement du curseur encadré du TCO (pour que les touches curseur s'applique au Tedit) indexTCO:=index_TCO(sender); PCanvasTCO[indexTCO].Brush.Color:=Clfond[IndexTCO]; efface_entoure(indexTCO); if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].texte='' then begin tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].CoulFonte:=clTexte; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].TailleFonte:=8; end; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Texte:=EditTexte.Text; formConfCellTCO.EditTexteCCTCO.Text:=EditTexte.Text; TCO_modifie:=true; affiche_texte(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); end; procedure TFormTCO.ButtonSimuClick(Sender: TObject); begin aiguillage[Index_Aig(1)].position:=const_devie; 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_droit; aiguillage[Index_Aig(9)].position:=const_devie; 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_droit; 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; //debugTco:=true; zone_tco(1,527,519,1,1); // zone_tco(518,515,1); //zone_tco(522,514,1); //zone_tco(514,522,1); end; procedure TFormTCO.CheckPinvClick(Sender: TObject); var Bimage,indexTCO : integer; begin if clicTCO then exit; if actualize then exit; indexTCO:=index_TCO(sender); if (xClicCell[indexTCO]=0) or (xClicCell[indexTCO]>NbreCellX[indexTCO]) or (yClicCell[indexTCO]=0) or (yClicCell[indexTCO]>NbreCelly[indexTCO]) then exit; Bimage:=tco[indextco,xClicCell[indexTCO],yClicCell[indexTCO]].Bimage; if IsAIgTCO(Bimage) then begin tco[indextco,xClicCell[indexTCO],yClicCell[indexTCO]].inverse:=CheckPinv.checked; TCO_modifie:=true; end; end; procedure TFormTCO.ButtonMasquerClick(Sender: TObject); begin PanelBas.Hide; ScrollBox.Height:=ClientHeight-32; BandeauMasque:=true; defocusControl(ButtonMasquer,true); end; procedure TFormTCO.ImageTCODblClick(Sender: TObject); var Bimage,Adresse,i,indextco : integer; tjdC : boolean; begin if affEvt then Affiche('Double clic',clYellow); clicsouris:=false; auto_tcurs:=true; // autorise le déplacement du des touches curseur encadré du TCO indexTCO:=index_TCO(sender); Bimage:=tco[indextco,xClicCell[indexTCO],yClicCell[indexTCO]].BImage; Adresse:=tco[indextco,xClicCell[indexTCO],yClicCell[indexTCO]].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 if EvtClicDet then event_detecteur(adresse,not(detecteur[adresse].etat),'') else detecteur[adresse].etat:=not(detecteur[adresse].etat); Maj_TCO(indexTCO,Adresse) end; tjdC:=false; // commande tjd/c if (Bimage=21) or (Bimage=22) or (Bimage=23) or (Bimage=25) then begin i:=Index_aig(Adresse); if aiguillage[i].modele=crois then exit; tjdC:=(aiguillage[i].modele=tjd) or (aiguillage[i].modele=tjs); end; // commande aiguillage if isAigTCO(Bimage) 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=Id_signal then begin AdrPilote:=adresse; i:=Index_Signal(adresse); if i=0 then exit; TFormPilote.Create(Self); with formPilote do begin show; ImagePilote.Parent:=FormPilote; ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto; ImagePilote.Picture.Bitmap.TransparentColor:=clblue; ImagePilote.Transparent:=true; ImagePilote.Picture.BitMap:=Signaux[i].Img.Picture.Bitmap; LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(Adresse); Signaux[0].EtatSignal:=Signaux[i].EtatSignal; LabelNbFeux.Visible:=False; EditNbreFeux.Visible:=false; GroupBox1.Visible:=true; GroupBox2.Visible:=true; efface_entoure(indexTCO); SelectionAffichee[indexTCO]:=false; if (Signaux[i].aspect>10) and (Signaux[i].aspect<20) 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; if (Signaux[i].aspect<20) then GroupBox2.Visible:=true else GroupBox2.Visible:=false; end; end; end; clicsouris:=false; dbleClicTCO:=true; end; procedure TFormTCO.ComboReprChange(Sender: TObject); var indexTCO : integer; begin if clicTCO then exit; indexTCO:=index_TCO(sender); tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Repr:=comborepr.ItemIndex; efface_entoure(indexTCO); SelectionAffichee[indexTCO]:=false; formConfCellTCO.ComboRepr.ItemIndex:=ComboRepr.ItemIndex; defocusControl(ComboRepr,true); affiche_tco(indexTCO); 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.ImagePalette51DragOver(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.ImagePalette51EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(id_Quai,x,y,sender,target); end; procedure TFormTCO.ImagePalette24EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(24,x,y,sender,target); end; procedure TFormTCO.ImagePalette25EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(25,x,y,sender,target); end; procedure TFormTCO.ImagePalette20EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(20,x,y,sender,target); end; procedure TFormTCO.ImagePalette51MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette51); 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.ImagePalette50DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.PanelBasDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure change_fonte(indexTCO : integer); var s,ss : string; fs : TFontStyles; begin s:='Fonte et couleur pour la cellule ('+intToSTR(xClicCell[indexTCO])+','+intToSTR(YClicCell[indexTCO])+') Texte: '; ss:=tco[indextco,xClicCell[indexTCO],YClicCell[indexTCO]].Texte; if ss='' then s:=s+inttoSTR(tco[indextco,xClicCell[indexTCO],YClicCell[indexTCO]].Adresse) else s:=s+ss; titre_fonte:=s; With FormTCO[indexTCO] do begin FontDialog1.Font.Name:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].Fonte; FontDialog1.Font.Color:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].CoulFonte; FontDialog1.Font.Size:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].taillefonte; fs:=[]; s:=tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].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[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].Fonte:=FontDialog1.Font.Name; tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].CoulFonte:=FontDialog1.Font.Color; tco[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].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[indextco,XclicCell[indexTCO],YclicCell[indexTCO]].FontStyle:=s; affiche_tco(indexTCO); end; end; end; procedure TFormTCO.ButtonFonteClick(Sender: TObject); begin change_fonte(index_tco(sender)); 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(indexTCO : integer); begin if actualize then exit; if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then begin tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu:=2; Affiche_TCO(indexTCO); TCO_modifie:=true; actualise(indexTCO); // met à jour la fenetre de config de la cellule end; end; procedure TFormTCO.Signaldroitedelavoie1Click(Sender: TObject); var c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO signalD(index_TCO(c)); end; procedure signalG(indexTCO : integer); begin if actualize then exit; if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then begin tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu:=1; Affiche_TCO(indexTCO); TCO_modifie:=true; actualise(indexTCO); // met à jour la fenetre de config de la cellule end; end; procedure TFormTCO.Signalgauchedelavoie1Click(Sender: TObject); var c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO signalG(index_tco(c)); end; procedure TFormTCO.PopupMenu1Popup(Sender: TObject); var oriente,piedFeu,indexTCO : integer; c : Tcomponent; begin if affevt then Affiche('on popup',clyellow); c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); indexTCOcourant:=indexTCO; PopUpMenu1.Items[9][0].Caption:='Ligne au dessus de la '+intToSTR(YclicCell[indexTCO]); PopUpMenu1.Items[9][1].Caption:='Ligne en dessous de la '+intToSTR(YclicCell[indexTCO]); PopUpMenu1.Items[9][3].Caption:='Colonne à gauche de la '+intToSTR(XclicCell[indexTCO]); PopUpMenu1.Items[9][4].Caption:='Colonne à droite de la '+intToSTR(XclicCell[indexTCO]); PopUpMenu1.Items[10][0].Caption:='Ligne '+intToSTR(YclicCell[indexTCO]); PopUpMenu1.Items[10][1].Caption:='Colonne '+intToSTR(XclicCell[indexTCO]); // grise ou non l'entrée signal du menu if tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage=Id_signal then begin PopUpMenu1.Items[6].Enabled:=true; // coche sur l'orientation du signal oriente:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Feuoriente; if oriente=1 then begin PopUpMenu1.Items[6][0].checked:=false; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=true; PopUpMenu1.Items[6][3].checked:=false; end; if oriente=2 then begin PopUpMenu1.Items[6][0].checked:=true; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=false; PopUpMenu1.Items[6][3].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; PopUpMenu1.Items[6][3].checked:=false; end; if oriente=4 then begin PopUpMenu1.Items[6][0].checked:=false; PopUpMenu1.Items[6][1].checked:=false; PopUpMenu1.Items[6][2].checked:=false; PopUpMenu1.Items[6][3].checked:=true; end; // coche sur l'orientation du pied PiedFeu:=tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].PiedFeu; if PiedFeu=1 then begin PopUpMenu1.Items[6][5].checked:=true; PopUpMenu1.Items[6][6].checked:=false; end; if PiedFeu=2 then begin PopUpMenu1.Items[6][5].checked:=false; PopUpMenu1.Items[6][6].checked:=true; end; end else PopUpMenu1.Items[6].Enabled:=false; end; // encadre la ligne cliquée du tco courant procedure encadre_ligne; var ligneY : integer; begin ligneY:=YClicCell[indexTCOcourant]; xCadre1:=1;yCadre1:=(ligneY-1)*HauteurCell[IndexTcoCourant]; xCadre2:=NbreCellX[IndexTCOCourant]*LargeurCell[IndexTCOCourant] ; yCadre2:=(ligneY)*HauteurCell[IndexTcoCourant]; with PcanvasTCO[indexTCOCourant] do begin pen.Mode:=pmXor; pen.width:=5; pen.Color:=clred; Brush.Color:=clblack; Rectangle(xCadre1,yCadre1,xCadre2,yCadre2); ligneAffiche:=not(ligneAffiche); end; end; // encadre la colonne cliquée du tco courant procedure encadre_colonne; var ligneY : integer; begin ligneY:=XClicCell[indexTCOcourant]; xCadre1:=(ligneY-1)*HauteurCell[IndexTcoCourant];yCadre1:=1; xCadre2:=(ligneY)*HauteurCell[IndexTcoCourant]; yCadre2:=NbreCellY[IndexTCOCourant]*HauteurCell[IndexTcoCourant]; with PcanvasTCO[indexTCOCourant] do begin pen.Mode:=pmXor; pen.width:=5; pen.Color:=clred; Brush.color:=clBlack; Rectangle(xCadre1,yCadre1,xCadre2,yCadre2); colonneAffiche:=not(colonneAffiche); end; end; procedure TFormTCO.N3Click(Sender: TObject); var c : Tcomponent; indexTCO : integer; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); FormConfCellTCO.show; FormConfCellTCO.BringToFront; actualise(IndexTCO); // actualiser après avoir affiché formConfCellTCO end; procedure TFormTCO.LigneDessousClick(Sender: TObject); var indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); if NbreCellY[indexTCO]>=MaxCellY then exit; TamponAffecte:=false; init_tampon_copiercoller; ligne_Supprime:=YClicCell[indexTCO]+1; // variable globale insere_ligne(indexTCO,ligne_Supprime); affiche_TCO(indexTCO); end; procedure TFormTCO.LigneDessusClick(Sender: TObject); var c : tcomponent; indexTCO : integer; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); if NbreCellY[indexTCO]>=MaxCellY then exit; TamponAffecte:=false; init_tampon_copiercoller; ligne_Supprime:=YClicCell[indexTCO]; // variable globale insere_ligne(indexTCO,ligne_Supprime); affiche_TCO(indexTCO); end; // insersion colonne procedure TFormTCO.Colonnegauche1Click(Sender: TObject); var indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); if NbreCellX[indexTCO]>=MaxCellX then exit; TamponAffecte:=false; init_tampon_copiercoller; colonne_supprime:=XClicCell[indexTCO]; insere_colonne(indexTCO,colonne_supprime); affiche_TCO(indexTCO); end; procedure TFormTCO.Colonnedroite1Click(Sender: TObject); var indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); if NbreCellX[indexTCO]>=MaxCellX then exit; TamponAffecte:=false; init_tampon_copiercoller; colonne_supprime:=XClicCell[indexTCO]+1; insere_colonne(indexTCO,colonne_supprime); affiche_TCO(indexTCO); end; procedure TFormTCO.SupprimeLigneClick(Sender: TObject); var x,y,indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); if NbreCellY[indexTCO]<=1 then exit; TamponAffecte:=true; ligne_supprime:=YClicCell[indexTCO]; // tampon de sauvegarde TamponTCO_org.numTCO:=indexTCO; TamponTCO_Org.NbreCellX:=NbreCellX[indexTCO]; TamponTCO_Org.NbreCellY:=NbreCellY[indexTCO]; TamponTCO_Org.x1:=1; TamponTCO_Org.y1:=ligne_supprime; TamponTCO_Org.x2:=NbreCellX[indexTCO]; TamponTCO_Org.y2:=ligne_supprime; // case de destination xcoupe:=1; ycoupe:=ligne_supprime; // remplir tempon de sauvegarde for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do begin //Affiche(intToSTR(x)+' '+intToSTR(y),clyellow); tampontco[x,y]:=tco[indextco,x,y]; end; // supression ligne for y:=YClicCell[indexTCO] to NbreCellY[indexTCO]-1 do begin for x:=1 to NbreCellX[indexTCO] do tco[indextco,x,y]:=tco[indextco,x,y+1]; end; for x:=1 to NbreCellX[indexTCO] do begin raz_cellule(indextco,x,NbreCellY[indexTCO]); tco[indextco,x,NbreCellY[indexTCO]].Couleurfond:=Clfond[IndexTCO]; end; dec(NbreCellY[indexTCO]); TCO_modifie:=true; affiche_TCO(indexTCO); end; // suppression colonne procedure TFormTCO.ColonneClick(Sender: TObject); var x,y,indexTCO : integer; c : tcomponent; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); if NbreCellX[indexTCO]<=1 then exit; TamponAffecte:=true; colonne_supprime:=XClicCell[indexTCO]; // tampon de sauvegarde TamponTCO_org.numTCO:=indexTCO; TamponTCO_Org.NbreCellX:=NbreCellX[indexTCO]; TamponTCO_Org.NbreCellY:=NbreCellY[indexTCO]; TamponTCO_Org.x1:=colonne_supprime; TamponTCO_Org.x2:=colonne_supprime; TamponTCO_Org.y1:=1; TamponTCO_Org.y2:=NbreCellY[indexTCO]; // cellule de destination xcoupe:=colonne_supprime; ycoupe:=1; for y:=TamponTCO_Org.y1 to TamponTCO_Org.y2 do for x:=TamponTCO_Org.x1 to TamponTCO_Org.x2 do tampontco[x,y]:=tco[indextco,x,y]; // supression colonne for x:=xClicCell[indexTCO] to NbreCellx[indexTCO]-1 do begin for y:=1 to NbreCelly[indexTCO] do begin tco[indextco,x,y]:=tco[indextco,x+1,y]; end; end; for y:=1 to NbreCellY[indexTCO] do begin raz_cellule(indextco,NbreCellx[indexTCO],y); tco[indextco,NbreCellx[indexTCO],y].CouleurFond:=Clfond[IndexTCO]; end; dec(NbreCellX[indexTCO]); TCO_modifie:=true; affiche_TCO(indexTCO); end; procedure TFormTCO.buttonRazClick(Sender: TObject); var x,y,indexTCO : integer; begin indexTCO:=index_tco(sender); for x:=1 to NbreCellx[indexTCO] do for y:=1 to NbreCelly[indexTCO] do tco[indextco,x,y].mode:=0; Affiche_TCO(indexTCO); defocusControl(buttonRaz,true); end; procedure TFormTCO.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var i,maxi,indexTCO : integer; begin if affevt then Affiche('FormMouseWheel',clOrange); indexTCO:=index_tco(sender); i:=FormTCO[indexTCO].TrackBarZoom.Position; if WheelDelta>0 then begin if (i<=ZoomMin) then begin FormTCO[indexTCO].TrackBarZoom.Position:=ZoomMin; exit; end; dec(i); end else begin if (i>=ZoomMax) then begin FormTCO[indexTCO].TrackBarZoom.Position:=ZoomMax; exit; end; inc(i); end; // positionner la trackbar zoom FormTCO[indexTCO].TrackBarZoom.Position:=i; calcul_cellules(indexTCO); Affiche_TCO(indexTCO); SelectionAffichee[indexTCO]:=false; //positionner les trackbar du scrollbox sur la position cliquée de la souris {GetCursorPos(Position); x:=position.x div LargeurCell[indexTCO] +1 ; y:=position.Y div hauteurCell[indexTCO] +1 ; ScrollBox.HorzScrollBar.position:=x; ScrollBox.VertScrollBar.position:=y; exit;} maxi:=ScrollBox.HorzScrollBar.Range-ScrollBox.ClientWidth; i:=round(xClicCell[indexTCO]*maxi/NbreCellx[indexTCO]); ScrollBox.HorzScrollBar.position:=i; maxi:=ScrollBox.VertScrollBar.Range-ScrollBox.ClientHeight; i:=round(yClicCell[indexTCO]*maxi/NbreCelly[indexTCO]); ScrollBox.VertScrollBar.position:=i; end; procedure TFormTCO.ButtonCalibrageClick(Sender: TObject); var indexTCO,x,y : integer; begin x:=0; y:=0; indexTCO:=index_tco(sender); Affiche('Calibrage='+intToSTR(largeurCell[indexTCO]),clyellow); calcul_reduction(frxGlob[indexTCO],fryGlob[indexTCO],LargeurCell[indexTCO],hauteurCell[indexTCO]); with imageTCO.Canvas do begin pen.color:=clyellow; moveTo( round(x),round(y*fryGlob[indexTCO]) ); LineTo( round((x+LargeurCell[indexTCO])),round(y+hauteurCell[indexTCO]*ratioC/10) ); end; Affiche(formatfloat('0.000000',frxGlob[indexTCO]),clyellow); end; procedure change_couleur_fond(indexTCO : integer); var cs : string; x,y,xmini,ymini,xmaxi,ymaxi : integer; modeselection : boolean; begin xmini:=(XminiSel div LargeurCell[indexTCO]) +1; ymini:=(YminiSel div hauteurCell[indexTCO]) +1; xmaxi:=(XmaxiSel div LargeurCell[indexTCO]) +1; ymaxi:=(YmaxiSel div hauteurCell[indexTCO]) +1; modeSelection:=xmini0) or not(Bimage in[0..29,32..34,id_signal,id_quai,id_action]) then begin exit; end; TCO_modifie:=true; tco[indextco,XClicCell[indexTCO],YClicCell[indexTCO]].Bimage:=Bimage; //formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage); //actualise(indexTCO); // pour mise à jour de l'image de la fenetre FormConfCellTCO efface_entoure(indexTCO); affiche_cellule(indexTCO,XClicCell[indexTCO],YClicCell[indexTCO]); end; procedure TFormTCO.Toutslectionner1Click(Sender: TObject); var c: tComponent; indexTCO : integer; begin c:=popupmenu1.PopupComponent ; // imageTCO c:=c.GetParentComponent; // scrollBox c:=c.GetParentComponent; // formTCO indexTCO:=index_tco(c); selec_tout(indexTCO); end; procedure dessinerTCO(indexTCO : integer); begin if not(modetrace[indexTCO]) then begin tamponAffecte:=false; ligne_supprime:=0; colonne_supprime:=0; modetrace[indexTCO]:=true; indexTrace:=0; traceXY[1].x:=0; traceXY[1].y:=0; traceXY[2].x:=0; traceXY[2].x:=0; FormTCO[indexTCO].Caption:='TCO'+intToSTR(indexTCO)+' ** Mode dessin ** Clic droit pour lever le pointeur. Touche Echap pour quitter le mode tracé. CTRL-Z ou annuler pour annuler les derniers tracés.'; screen.cursor:=crUpArrow; end else stop_modetrace(indexTCO); end; procedure TFormTCO.ButtonDessinerClick(Sender: TObject); var indexTCO : integer; begin indexTCO:=index_tco(sender); dessinerTCO(indexTCO); defocusControl(buttonDessiner,true); end; procedure TFormTCO.ImagePalette26DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette26EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(26,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette26MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette26); end; procedure TFormTCO.ImagePalette23EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(23,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette23DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette23MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette23); end; procedure TFormTCO.ImagePalette27DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette27MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette27); end; procedure TFormTCO.ImagePalette27EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(27,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette28DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette28EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(28,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette28MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette28); end; procedure TFormTCO.ImagePalette29DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette29EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(29,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette29MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette29); end; procedure TFormTCO.ImagePalette32DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette32EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(32,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette32); end; procedure TFormTCO.ImagePalette33DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette33EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(33,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette33MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette33); end; procedure TFormTCO.ImagePalette34DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette34EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(34,x,y,Sender,Target); end; procedure TFormTCO.ImagePalette34MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette34); end; procedure TFormTCO.EditAdrElementClick(Sender: TObject); begin auto_tcurs:=false; end; procedure TFormTCO.ImagePalette52DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end; procedure TFormTCO.ImagePalette52EndDrag(Sender, Target: TObject; X, Y: Integer); begin end_drag(id_action,x,y,sender,target); end; procedure TFormTCO.ImagePalette52MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin debut_drag(ImagePalette52); end; procedure TFormTCO.ButtonAffSCClick(Sender: TObject); begin with formprinc do begin windowState:=wsNormal; //Maximized; show; BringToFront; end; end; procedure TFormTCO.RadioGroupSelClick(Sender: TObject); var indexTCO : integer; begin indextco:=index_TCO(sender); if indexTCO=0 then exit; // sélection par cellules if RadioGroupSel.ItemIndex=0 then begin // si le rectangle est affiché dans ce tco, l'effacer if Rect_select.NumTCO=indexTCO then affiche_rectangle(IndexTCO,Rect_select); Rect_select.NumTCO:=0; selectionAffichee[indexTCO]:=false; end; // sélection par outil graphique if RadioGroupSel.ItemIndex=1 then begin efface_entoure(indexTCO); efface_selection(IndexTCO); selectionAffichee[indexTCO]:=false; end; defocusControl(RadioGroupSel,true); end; function TformTCO.index_TCOMainMenu : integer; var t : Tcontrol; s : string; begin t:=FindControl(mainmenuTCO.WindowHandle); // on ne peut pas remonter au parent d'un mainmenu avec getparentcomponent s:=t.name; result:=extract_int(s); end; procedure TFormTCO.SauvegarderleTCO1Click(Sender: TObject); begin sauve_fichiers_tco; end; procedure TFormTCO.DessinerleTCO1Click(Sender: TObject); var indexTCO : integer; begin indexTCO:=index_TCOMainMenu; dessinerTCO(indexTCO); end; procedure TFormTCO.ConfigurationduTCO1Click(Sender: TObject); begin TformconfigTCO.create(self); formconfigTCO.showmodal; formconfigTCO.close; defocusControl(ButtonConfigTCO,true); end; procedure TFormTCO.Redessine1Click(Sender: TObject); var indexTCO : integer; begin indexTCO:=index_TCOMainMenu; Affiche_TCO(indexTCO); end; procedure TFormTCO.BandeauClick(Sender: TObject); var indexTCO : integer; begin indexTCO:=index_TCOMainMenu; if bandeauMasque then begin PanelBas.Show; BandeauMasque:=false; positionne(indexTCO); Bandeau.Caption:='Masquer le bandeau'; exit; end else begin PanelBas.Hide; ScrollBox.Height:=ClientHeight; BandeauMasque:=true; defocusControl(ButtonMasquer,true); Bandeau.Caption:='Afficher le bandeau'; end; end; procedure TFormTCO.Mosaquehorizontale1Click(Sender: TObject); begin mosaiqueH; end; procedure TFormTCO.Mosaqueverticale1Click(Sender: TObject); begin mosaiqueV; end; procedure TFormTCO.AfficherSignauxComplexes1Click(Sender: TObject); begin with formprinc do begin windowState:=wsNormal; //Maximized; show; BringToFront; end; end; end.