diff --git a/Notice d'utilisation des signaux_complexes_GL_V7.1.pdf b/Notice d'utilisation des signaux_complexes_GL_V7.2.pdf similarity index 76% rename from Notice d'utilisation des signaux_complexes_GL_V7.1.pdf rename to Notice d'utilisation des signaux_complexes_GL_V7.2.pdf index 9323f67..d737f80 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V7.1.pdf and b/Notice d'utilisation des signaux_complexes_GL_V7.2.pdf differ diff --git a/Signaux_complexes_GL.cfg b/Signaux_complexes_GL.cfg index e9e902f..1e45cf1 100644 --- a/Signaux_complexes_GL.cfg +++ b/Signaux_complexes_GL.cfg @@ -14,8 +14,8 @@ -$N+ -$O- -$P+ --$Q+ --$R+ +-$Q- +-$R- -$S- -$T- -$U- diff --git a/Signaux_complexes_GL.dof b/Signaux_complexes_GL.dof index f78f51d..2a4eebc 100644 --- a/Signaux_complexes_GL.dof +++ b/Signaux_complexes_GL.dof @@ -17,8 +17,8 @@ M=0 N=1 O=0 P=1 -Q=1 -R=1 +Q=0 +R=0 S=0 T=0 U=0 diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 769403a..7182106 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -180,6 +180,7 @@ procedure affichage(imprime : boolean); procedure Aff_train(adr: integer;train:string;x1,y1,x2,y2 :integer); procedure D_Arc(Canvas: TCanvas; CenterX,CenterY: integer; rayon: Integer; StartDegres, StopDegres: Double); +function point_Sur_Segment(x,y,x1,y1,x2,y2 : integer): Boolean; implementation diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 21e171e..fd2793c 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,6 +1,6 @@ object FormConfig: TFormConfig - Left = 319 - Top = 128 + Left = 243 + Top = 134 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' @@ -1571,7 +1571,7 @@ object FormConfig: TFormConfig Top = 8 Width = 633 Height = 497 - ActivePage = TabSheetAct + ActivePage = TabSheetAig Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 @@ -2402,13 +2402,14 @@ object FormConfig: TFormConfig ParentFont = False end object LabelCrois: TLabel - Left = 32 - Top = 320 + Left = 56 + Top = 280 Width = 187 Height = 26 Caption = 'Les croisements re'#231'oivent une adresse m'#234'me s'#39'ils ne sont pas pil' + 'ot'#233's' + Visible = False WordWrap = True end object GroupBox10: TGroupBox @@ -2746,7 +2747,7 @@ object FormConfig: TFormConfig end object GroupBox21: TGroupBox Left = 8 - Top = 352 + Top = 312 Width = 273 Height = 97 Caption = 'Initialisation de l'#39'aiguillage en mode autonome' @@ -3641,7 +3642,7 @@ object FormConfig: TFormConfig Left = 352 Top = 32 Width = 257 - Height = 441 + Height = 433 Caption = 'Description de l'#39'action' TabOrder = 0 object GroupBoxRadio: TGroupBox diff --git a/UnitConfig.pas b/UnitConfig.pas index 42df17d..0f0faab 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -322,7 +322,6 @@ type Label58: TLabel; EditFiltrDet: TEdit; CheckBoxVerifXpressNet: TCheckBox; - LabelCrois: TLabel; ImageTrain: TImage; ButtonPFCDM: TButton; Label59: TLabel; @@ -358,6 +357,7 @@ type LabelNbDecPers: TLabel; MemoBlanc: TMemo; Label69: TLabel; + LabelCrois: TLabel; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -814,11 +814,11 @@ begin val(s,vitesse,i); if (vitesse<>300) and (vitesse<>1200) and (vitesse<>2400) and (vitesse<>4800) and (vitesse<>9600) and (vitesse<>19200) and (vitesse<>38400) and (vitesse<>57600) and (vitesse<>115200) then - begin - Affiche('Vitesse COM ('+intToSTR(vitesse)+') incorrecte',clred); - result:=false; - exit; - end; + begin + Affiche('Vitesse COM ('+intToSTR(vitesse)+') incorrecte',clred); + result:=false; + exit; + end; end else begin @@ -3384,7 +3384,6 @@ begin if not(trouve_section_aig) then Affiche('Manque section '+section_aig_ch,clred); if not(trouve_section_sig) then Affiche('Manque section '+section_sig_ch,clred); if not(trouve_section_branche) then Affiche('Manque section '+section_branches_ch,clred); - end; @@ -3643,10 +3642,6 @@ begin EditDevieS2.Visible:=false; Label18.Visible:=false; Label20.Visible:=false; - GroupBoxPN.Visible:=false; - GroupBoxAct.Visible:=false; - GroupBoxRadio.Visible:=false; - GroupBoxEtatTJD.Visible:=false; EditP1.ReadOnly:=false; EditP2.ReadOnly:=false; @@ -3723,151 +3718,9 @@ begin RadioButtonXpress.Checked:=protocole=1; RadioButtonDcc.Checked:=protocole=2; - clicListe:=true; // empeche le traitement de l'evt text - EditDroit_BD.Text:=''; - EditPointe_BG.Text:=''; - EditDevie_HD.Text:=''; editLAY.Text:=lay; - ligneclicSig:=-1; - AncLigneClicSig:=-1; - ligneclicAct:=-1; - AncLigneClicAct:=-1; - ligneclicAig:=-1; - AncLigneClicAig:=-1; - lignecliqueePN:=-1; - AncLigneCliqueePN:=-1; - - // remplit les 4 fenêtres de config des aiguillages branches signaux, actionneurs - - // aiguillages - RichAig.Clear; - for i:=1 to MaxAiguillage do - begin - s:=encode_aig(i); - RichAig.Lines.Add(s); - RE_ColorLine(RichAig,RichAig.lines.count-1,ClAqua); - Aiguillage[i].modifie:=false; - end; - // pour positionner sur la 1ere ligne - With RichAig do - begin - SelStart:=0; - Perform(EM_SCROLLCARET,0,0); - end; - - // branches - clicListe:=true; - RichBranche.clear; - for i:=1 to NbreBranches do - begin - s:=Branche[i]; - RichBranche.Lines.Add(s); - RE_ColorLine(RichBranche,RichBranche.lines.count-1,ClAqua); - end; - With RichBranche do - begin - SelStart:=0; - Perform(EM_SCROLLCARET,0,0); - end; - - // signaux - RichSig.clear; - ComboBoxDec.items.Clear; - - for i:=0 to 11 do - begin - ComboBoxAsp.items.add(Aspects[i]); - end; - // décodeurs de base - for i:=1 to NbDecodeur do - begin - ComboBoxDec.items.add(decodeur[i-1]); - end; - // décodeurs personalisés - for i:=1 to NbreDecPers do - begin - s:=decodeur_pers[i].nom; - formconfig.ComboBoxDec.Items.add(s); - end; - - - for i:=1 to NbreFeux do - begin - s:=encode_sig_feux(i); // encode la ligne depuis le tableau feux - //Affiche(s,clwhite); - if s<>'' then - begin - RichSig.Lines.Add(s); - RE_ColorLine(RichSig,RichSig.lines.count-1,ClAqua); - Feux[i].modifie:=false; - end; - end; - With RichSig do - begin - SelStart:=0; - Perform(EM_SCROLLCARET,0,0); - end; - - // actionneurs Train ou accessoire - RichAct.Clear; - for i:=1 to maxTablo_act do - begin - s:=encode_act_loc_son(i); - if s<>'' then - begin - RichAct.Lines.Add(s); - RE_ColorLine(RichAct,RichAct.lines.count-1,ClAqua); - end; - end; - With RichAct do - begin - SelStart:=0; - Perform(EM_SCROLLCARET,0,0); - end; - - // actionneurs PN - RichPN.Clear; - for i:=1 to NbrePN do - begin - s:=encode_act_pn(i); - if s<>'' then - begin - RichPN.Lines.Add(s); - RE_ColorLine(RichPN,RichPN.lines.count-1,ClAqua); - end; - end; - With RichPN do - begin - SelStart:=0; - Perform(EM_SCROLLCARET,0,0); - end; - - if clicproprietes then clicListeSignal(Adressefeuclic); - clicproprietes:=false; - - i:=1; - RichCdeDCCpp.clear; - repeat - if CdeDccpp[i]<>'' then - begin - RichCdeDccpp.Lines.add(CdeDccpp[i]); - RE_ColorLine(RichCdeDccpp,RichCdeDccpp.lines.count-1,ClAqua); - end; - inc(i); - until (CdeDccpp[i]='') or (i>MaxCdeDccpp); - - CheckEnvAigDccpp.Checked:=EnvAigDccpp=1; - EditBase.Text:=intToSTR(AdrBaseDetDccpp); - - with RicheditTrains do - begin - clear; - for i:=1 to ntrains do - begin - Lines.Add(Train_tablo(i)); - end; - end; + LabelNbDecPers.caption:=intToSTR(NbreDecPers); //l'onglet affiché est sélectionné à l'appel de la fiche dans l'unité UnitPrinc clicListe:=false; @@ -4058,6 +3911,7 @@ begin end; end; + // remplit les 4 fenêtres de config des aiguillages branches signaux, actionneurs for i:=1 to NbreDecPers do begin s:=decodeur_pers[i].nom; @@ -4071,6 +3925,149 @@ begin end else formconfig.ComboBoxDecodeurPerso.ItemIndex:=-1; maj_decodeurs; + + // aiguillages + RichAig.Clear; + for i:=1 to MaxAiguillage do + begin + s:=encode_aig(i); + RichAig.Lines.Add(s); + RE_ColorLine(RichAig,RichAig.lines.count-1,ClAqua); + Aiguillage[i].modifie:=false; + end; + // pour positionner sur la 1ere ligne + With RichAig do + begin + SelStart:=0; + Perform(EM_SCROLLCARET,0,0); + end; + + + // branches + clicListe:=true; + RichBranche.clear; + for i:=1 to NbreBranches do + begin + s:=Branche[i]; + RichBranche.Lines.Add(s); + RE_ColorLine(RichBranche,RichBranche.lines.count-1,ClAqua); + end; + With RichBranche do + begin + SelStart:=0; + Perform(EM_SCROLLCARET,0,0); + end; + + // signaux + RichSig.clear; + ComboBoxDec.items.Clear; + + for i:=0 to 11 do + begin + ComboBoxAsp.items.add(Aspects[i]); + end; + // décodeurs de base + for i:=1 to NbDecodeur do + begin + ComboBoxDec.items.add(decodeur[i-1]); + end; + // décodeurs personalisés + for i:=1 to NbreDecPers do + begin + s:=decodeur_pers[i].nom; + formconfig.ComboBoxDec.Items.add(s); + end; + + + for i:=1 to NbreFeux do + begin + s:=encode_sig_feux(i); // encode la ligne depuis le tableau feux + //Affiche(s,clwhite); + if s<>'' then + begin + RichSig.Lines.Add(s); + RE_ColorLine(RichSig,RichSig.lines.count-1,ClAqua); + Feux[i].modifie:=false; + end; + end; + With RichSig do + begin + SelStart:=0; + Perform(EM_SCROLLCARET,0,0); + end; + + // actionneurs Train ou accessoire + RichAct.Clear; + for i:=1 to maxTablo_act do + begin + s:=encode_act_loc_son(i); + if s<>'' then + begin + RichAct.Lines.Add(s); + RE_ColorLine(RichAct,RichAct.lines.count-1,ClAqua); + end; + end; + With RichAct do + begin + SelStart:=0; + Perform(EM_SCROLLCARET,0,0); + end; + + // actionneurs PN + RichPN.Clear; + for i:=1 to NbrePN do + begin + s:=encode_act_pn(i); + if s<>'' then + begin + RichPN.Lines.Add(s); + RE_ColorLine(RichPN,RichPN.lines.count-1,ClAqua); + end; + end; + With RichPN do + begin + SelStart:=0; + Perform(EM_SCROLLCARET,0,0); + end; + GroupBoxRadio.Visible:=false; + GroupBoxAct.Visible:=false; + GroupBoxPN.Visible:=false; + + if clicproprietes then clicListeSignal(Adressefeuclic); + clicproprietes:=false; + + i:=1; + RichCdeDCCpp.clear; + repeat + if CdeDccpp[i]<>'' then + begin + RichCdeDccpp.Lines.add(CdeDccpp[i]); + RE_ColorLine(RichCdeDccpp,RichCdeDccpp.lines.count-1,ClAqua); + end; + inc(i); + until (CdeDccpp[i]='') or (i>MaxCdeDccpp); + + CheckEnvAigDccpp.Checked:=EnvAigDccpp=1; + EditBase.Text:=intToSTR(AdrBaseDetDccpp); + + with RicheditTrains do + begin + clear; + for i:=1 to ntrains do + begin + Lines.Add(Train_tablo(i)); + end; + end; + + ligneclicAig:=-1; + AncLigneClicAig:=-1; + ligneClicSig:=-1; + AncligneClicSig:=-1; + ligneClicBr:=-1; + AncligneClicBr:=-1; + ligneClicAct:=-1; + AncLigneClicAct:=-1; + end; @@ -4268,6 +4265,7 @@ begin // aiguillage normal ou tri if (not(tjd) and not(tjs) and not(croi)) or tri then begin + labelcrois.Visible:=false; EditL.Visible:=false; Label20.Visible:=false; LabelL.Visible:=false; diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index 8136e93..cc59482 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -11,6 +11,7 @@ object FormConfCellTCO: TFormConfCellTCO Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] + KeyPreview = True OldCreateOrder = False OnActivate = FormActivate OnCreate = FormCreate @@ -102,17 +103,6 @@ object FormConfCellTCO: TFormConfCellTCO Font.Style = [] ParentFont = False end - object ImagePalette: TImage - Left = 112 - Top = 24 - Width = 41 - Height = 41 - Hint = 'Voie pouvant porter un d'#233'tecteur' - DragMode = dmAutomatic - ParentShowHint = False - ShowHint = True - Stretch = True - end object Label2: TLabel Left = 168 Top = 14 @@ -126,6 +116,13 @@ object FormConfCellTCO: TFormConfCellTCO Font.Style = [] ParentFont = False end + object ImagePaletteCC: TImage + Left = 112 + Top = 24 + Width = 49 + Height = 49 + OnMouseDown = ImagePaletteCCMouseDown + end object EditTypeImage: TEdit Left = 32 Top = 40 diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index 00a05dc..626fe5e 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -17,7 +17,6 @@ type GroupBox2: TGroupBox; Label15: TLabel; EditTypeImage: TEdit; - ImagePalette: TImage; CheckPinv: TCheckBox; Label2: TLabel; GroupBox3: TGroupBox; @@ -30,6 +29,7 @@ type EditAdrElement: TEdit; ButtonFond: TButton; BitBtnOk: TBitBtn; + ImagePaletteCC: TImage; procedure EditAdrElementChange(Sender: TObject); procedure EditTexteCCTCOChange(Sender: TObject); procedure ButtonFonteClick(Sender: TObject); @@ -46,6 +46,8 @@ type procedure FormKeyPress(Sender: TObject; var Key: Char); procedure BitBtnOkClick(Sender: TObject); procedure EditTypeImageChange(Sender: TObject); + procedure ImagePaletteCCMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Déclarations privées } public @@ -55,13 +57,15 @@ type var FormConfCellTCO: TFormConfCellTCO; actualize : boolean; - + IconeX,IconeY : integer; + procedure actualise; implementation -uses UnitPrinc; +uses UnitPrinc,UnitAnalyseSegCDM, + UnitConfigTCO; {$R *.dfm} @@ -70,10 +74,12 @@ procedure actualise; var Bimage,oriente,piedFeu : integer; s : string; ip : Timage; + Bm : Tbitmap; r : trect; begin + Bm:=formConfCellTCO.imagepalettecc.Picture.Bitmap; Bimage:=tco[XClicCell,YClicCell].Bimage; - + if formConfCellTCOAff then begin // si aiguillage, mettre à jour l'option de pilotage inverse @@ -98,7 +104,7 @@ begin end; // si voie ou rien ou signal ou quai - if (Bimage=1) or (Bimage=0) or (Bimage=50) or (Bimage=51) then + if (Bimage=1) or (Bimage=0) or (Bimage=Id_signal) or (Bimage=51) then begin s:=Tco[XClicCell,YClicCell].Texte; with formTCO do @@ -136,16 +142,16 @@ begin formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage); // si signal - if Bimage=50 then - With formConfCellTCO.ImagePalette do + if Bimage=Id_signal then + With formConfCellTCO.ImagePaletteCC do begin - Height:=FormTCO.ImagePalette1.Picture.Height; - Width:=FormTCO.ImagePalette1.Picture.Width; + //Height:=FormTCO.ImagePalette1.Picture.Height; + //ziziWidth:=FormTCO.ImagePalette1.Picture.Width; Transparent:=false; end; // si pas signal - if Bimage<>50 then + if Bimage<>Id_signal then with formConfCellTCO do begin RadioButtonV.Enabled:=false; @@ -153,16 +159,18 @@ begin RadioButtonHD.Enabled:=false; RadioButtonG.Enabled:=false; RadioButtonD.Enabled:=false; + ImagePaletteCC.transparent:=false; end; - //mettre l'image de la cellule cliquée dans l'icone de la fenetre de config cellule + // mettre l'image de la cellule cliquée dans l'icone de la fenetre de config cellule if Bimage=0 then begin - with FormConfCellTCO.ImagePalette do + with FormConfCellTCO.ImagePaletteCC do begin r:=Rect(0,0,width,height); with canvas do begin + // effacer l'icone Pen.Mode:=pmCopy; Pen.Width:=1; Pen.color:=tco[XClicCell,YClicCell].CouleurFond; @@ -184,17 +192,33 @@ begin else + // Bimage non nulle begin ip:=formTCO.findComponent('ImagePalette'+intToSTR(Bimage)) as Timage; if ip=nil then exit; - formConfCellTCO.ImagePalette.picture.Assign(ip.picture); - if Bimage=50 then + // affiche l'icone cliquée dans la fenetre ----------------------------------------------- + // pour que le stretchBlt soit visible, il faut mettre à jour la taille du bitmap + with FormConfCellTCO.ImagePaletteCC.Picture.Bitmap do + begin + width:=iconeX; + Height:=iconeY; + end; + + ip:=formTCO.findComponent('ImagePalette'+intToSTR(Bimage)) as Timage; // image source + + // destination masque avec mise à l'échelle + StretchBlt(FormConfCellTCO.ImagePaletteCC.canvas.Handle,0,0,iconeX,iconeY, + ip.Canvas.Handle,0,0,ip.Width,ip.Height,srccopy); + FormConfCellTCO.ImagePaletteCC.repaint; // obligatoire sinon il ne s'affiche pas + //----------------------------------------------------------------------------------------- + + if Bimage=Id_signal then begin // signal - With formConfCellTCO.ImagePalette do + With formConfCellTCO.ImagePaletteCC do begin - Height:=FormTCO.ImagePalette50.Height; - Width:=FormTCO.ImagePalette50.Width; + // Height:=FormTCO.ImagePalette50.Height; + // Width:=FormTCO.ImagePalette50.Width; //Picture.Assign(FormTCO.ImagePalette50.Picture); Picture.Bitmap.TransparentMode:=tmAuto; Picture.Bitmap.TransparentColor:=clblue; @@ -273,7 +297,7 @@ begin formTCO.EditAdrElement.Text:=intToSTR(adr); - if tco[XClicCell,YClicCell].BImage=50 then + if tco[XClicCell,YClicCell].BImage=Id_signal then begin index:=Index_Signal(adr); if index=0 then exit @@ -321,9 +345,11 @@ begin actualize:=false; formConfCellTCOAff:=true; SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); - exit; - + iconeX:=50; // taille de l'icone + iconeY:=50; + // dessine les composants - non utilisé + { i:=1; //Affiche('formconfcellTCO create',clYellow); begin @@ -352,7 +378,8 @@ begin inc(i); end; end; - end; + end; } +// FormConfCellTCO.ImagePaletteCC.OnMouseDown:=ImagePaletteCCMouseDown; end; procedure TFormConfCellTCO.ComboReprChange(Sender: TObject); @@ -427,6 +454,27 @@ begin close end; +// extraire les points de connexion de l'icone (de 0 à 7) +procedure extrait_connect(numero : integer;var connect1,connect2,connect3,connect4 : integer); +var i,j : integer; +begin + connect1:=-1;connect2:=-1;connect3:=-1;connect4:=-1; + j:=0; + for i:=0 to 7 do + begin + if testBit(liaisons[numero],i) then + begin + case j of + 0 : connect1:=i; + 1 : connect2:=i; + 2 : connect3:=i; + 3 : connect4:=i; + end; + inc(j); + end; + end; +end; + procedure TFormConfCellTCO.EditTypeImageChange(Sender: TObject); var Bimage,erreur : integer; begin @@ -447,5 +495,93 @@ begin end; +procedure copie_cellule; +begin +// affiche l'icone cliquée dans la fenetre ----------------------------------------------- + // pour que le stretchBlt soit visible, il faut mettre à jour la taille du bitmap + with FormConfCellTCO.ImagePaletteCC.Picture.Bitmap do + begin + width:=iconeX; + Height:=iconeY; + end; + + // destination masque avec mise à l'échelle + StretchBlt(FormConfCellTCO.ImagePaletteCC.canvas.Handle,0,0,iconeX,iconeY, + PcanvasTCO.Handle,(xClicCell-1)*largeurCell,(yClicCell-1)*hauteurCell,largeurCell,hauteurCell,srccopy); + FormConfCellTCO.ImagePaletteCC.repaint; // obligatoire sinon il ne s'affiche pas +end; + +procedure TFormConfCellTCO.ImagePaletteCCMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var c,x0,y0,xc,yc,xf,yf,element,i,erreur,x1,y1,x2,y2,c1,c2,c3,c4 : integer; +begin + x0:=0; // x origine + y0:=0; // y origine + yc:=y0+(iconeY div 2); // y centre + xc:=x0+(iconeX div 2); // x centre + xf:=x0+iconeX; // x fin + yf:=y0+iconeY; // y fin + + //Affiche(IntToSTR(x)+' '+IntToSTR(y),clyellow); + val(editTypeImage.text,element,erreur); + + if erreur<>0 then exit; + + extrait_connect(element,c1,c2,c3,c4); + + // scanner les 4 ports de connexion c1 c2 c3 c4 + for i:=1 to 4 do + begin + case i of + 1 : c:=c1; + 2 : c:=c2; + 3 : c:=c3; + 4 : c:=c4; + end; + if c<>-1 then + begin + case c of + 0 : begin x1:=x0;y1:=y0;end; + 1 : begin x1:=xc;y1:=y0;end; + 2 : begin x1:=xf;y1:=y0;end; + 3 : begin x1:=xf;y1:=yc;end; + 4 : begin x1:=xf;y1:=yf;end; + 5 : begin x1:=xc;y1:=yf;end; + 6 : begin x1:=x0;y1:=yf;end; + 7 : begin x1:=x0;y1:=yc;end; + end; + // x1,y1 désigne le permier point du segment + if point_Sur_Segment(x,y,x1,y1,xc,yc) then + begin + if not(testbit(tco[xClicCell,yClicCell].epaisseurs,c)) then + with ImagePaletteCC.Picture.Bitmap.Canvas do + begin + efface_entoure; + tco[xClicCell,yClicCell].epaisseurs:=setbit(tco[xClicCell,yClicCell].epaisseurs,c); + efface_cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); + dessine_icone(PCanvasTCO,element,xClicCell,yClicCell,0); + copie_cellule; + end + else + with ImagePaletteCC.Picture.Bitmap.Canvas do + begin + efface_entoure; + tco[xClicCell,yClicCell].epaisseurs:=Razbit(tco[xClicCell,yClicCell].epaisseurs,c); + efface_cellule(PCanvasTCO,xClicCell,yClicCell,PmCopy); + dessine_icone(PCanvasTCO,element,xClicCell,yClicCell,0); + copie_cellule; + end + end; + + end; + end; + +end; + + + + + begin end. + diff --git a/UnitConfigTCO.dfm b/UnitConfigTCO.dfm index 9c3e00a..6caa960 100644 --- a/UnitConfigTCO.dfm +++ b/UnitConfigTCO.dfm @@ -3,7 +3,7 @@ object FormConfigTCO: TFormConfigTCO Top = 218 BorderStyle = bsDialog Caption = 'Configuration du TCO' - ClientHeight = 277 + ClientHeight = 293 ClientWidth = 665 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -65,7 +65,7 @@ object FormConfigTCO: TFormConfigTCO end object ButtonDessine: TButton Left = 16 - Top = 240 + Top = 256 Width = 75 Height = 25 Caption = 'Redessine' @@ -79,6 +79,7 @@ object FormConfigTCO: TFormConfigTCO Height = 17 Caption = 'dessine grille' TabOrder = 1 + OnClick = CheckDessineGrilleClick end object EditNbCellX: TEdit Left = 184 @@ -87,6 +88,7 @@ object FormConfigTCO: TFormConfigTCO Height = 21 TabOrder = 2 Text = 'EditNbCellX' + OnChange = EditNbCellXChange end object EditNbCellY: TEdit Left = 184 @@ -95,12 +97,13 @@ object FormConfigTCO: TFormConfigTCO Height = 21 TabOrder = 3 Text = 'EditNbCellY' + OnChange = EditNbCellYChange end object GroupBox1: TGroupBox Left = 304 Top = 8 Width = 353 - Height = 265 + Height = 273 Caption = 'Couleurs ' TabOrder = 4 object Label5: TLabel @@ -177,7 +180,7 @@ object FormConfigTCO: TFormConfigTCO end object Label10: TLabel Left = 48 - Top = 240 + Top = 248 Width = 258 Height = 13 Caption = 'Cliquez sur l'#39'ic'#244'ne pour changer la couleur de l'#39#233'l'#233'ment' @@ -240,11 +243,12 @@ object FormConfigTCO: TFormConfigTCO Height = 17 Caption = 'Couleur du canton activ'#233' par la couleur du train' TabOrder = 0 + OnClick = CheckCouleurClick end end object Memo1: TMemo Left = 16 - Top = 168 + Top = 184 Width = 273 Height = 65 BevelInner = bvLowered @@ -270,8 +274,8 @@ object FormConfigTCO: TFormConfigTCO Text = 'EditRatio' end object BitBtnOk: TBitBtn - Left = 208 - Top = 240 + Left = 216 + Top = 256 Width = 75 Height = 25 TabOrder = 7 @@ -280,7 +284,7 @@ object FormConfigTCO: TFormConfigTCO end object RadioGroup1: TRadioGroup Left = 16 - Top = 96 + Top = 120 Width = 273 Height = 57 Caption = 'Graphisme' @@ -288,19 +292,33 @@ object FormConfigTCO: TFormConfigTCO end object RadioButtonLignes: TRadioButton Left = 40 - Top = 112 + Top = 136 Width = 113 Height = 17 Caption = 'Lignes bris'#233'es' TabOrder = 9 + OnClick = RadioButtonLignesClick end object RadioButtonCourbes: TRadioButton Left = 40 - Top = 128 + Top = 152 Width = 113 Height = 17 Caption = 'Lignes courbes' TabOrder = 10 + OnClick = RadioButtonCourbesClick + end + object CheckBoxCreerEvt: TCheckBox + Left = 16 + Top = 96 + Width = 281 + Height = 17 + Hint = 'Pour simuler l'#39'action d'#39'une locomotive sur un d'#233'tecteur' + Caption = 'Cr'#233'er '#233'v'#232'nement d'#233'tecteur sur double clic d'#233'tecteur' + ParentShowHint = False + ShowHint = True + TabOrder = 11 + OnClick = CheckBoxCreerEvtClick end object ColorDialog1: TColorDialog OnShow = ColorDialog1Show diff --git a/UnitConfigTCO.pas b/UnitConfigTCO.pas index 65e540d..41c98db 100644 --- a/UnitConfigTCO.pas +++ b/UnitConfigTCO.pas @@ -47,6 +47,7 @@ type RadioGroup1: TRadioGroup; RadioButtonLignes: TRadioButton; RadioButtonCourbes: TRadioButton; + CheckBoxCreerEvt: TCheckBox; procedure ButtonDessineClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ImageAigClick(Sender: TObject); @@ -59,6 +60,13 @@ type procedure ImageQuaiClick(Sender: TObject); procedure ImagePiedFeuClick(Sender: TObject); procedure BitBtnOkClick(Sender: TObject); + procedure CheckBoxCreerEvtClick(Sender: TObject); + procedure EditNbCellXChange(Sender: TObject); + procedure EditNbCellYChange(Sender: TObject); + procedure CheckDessineGrilleClick(Sender: TObject); + procedure CheckCouleurClick(Sender: TObject); + procedure RadioButtonLignesClick(Sender: TObject); + procedure RadioButtonCourbesClick(Sender: TObject); private { Déclarations privées } public @@ -241,19 +249,6 @@ begin ok:=false; end; - { - Val(LabelTailleX.caption,LargeurCell,erreur); - nokLg:=erreur<>0; - if nokLg then LabelErreur.caption:='Erreur largeur de cellules'; - nokLg:=nokLg or (LargeurCell<20) or (LargeurCell>50) ; - if nokLg then LabelErreur.caption:='Erreur: Tailles des cellules - largeur cellules mini=20 maxi=50'; - - Val(LabelTailleY.caption,HauteurCell,erreur); - nokHt:=erreur<>0; - if nokHt then LabelErreur.caption:='Erreur hauteur de cellules'; - nokHt:=nokHt or (HauteurCell<20) or (HauteurCell>50) ; - if nokHt then LabelErreur.caption:='Erreur: Tailles des cellules - hauteur cellules mini=20 maxi=50'; - } val(EditRatio.text,RatioC,erreur); AvecGrille:=checkDessineGrille.Checked; @@ -292,6 +287,7 @@ begin checkCouleur.Checked:=ModeCouleurCanton=1; labelMaxX.caption:='Max='+intToSTR(MaxCellX); labelMaxY.caption:='Max='+intToSTR(MaxCellY); + CheckBoxCreerEvt.checked:=EvtClicDet; dessine_icones_config; s:='ColorA='+IntToHex(clfond,6); // ajouter aux couleurs personnalisées colorDialog1.CustomColors.Add(s); @@ -481,5 +477,41 @@ begin end; end; +procedure TFormConfigTCO.CheckBoxCreerEvtClick(Sender: TObject); +begin + EvtClicDet:=CheckBoxCreerEvt.checked; + TCO_modifie:=true; +end; + +procedure TFormConfigTCO.EditNbCellXChange(Sender: TObject); +begin + TCO_modifie:=true; +end; + +procedure TFormConfigTCO.EditNbCellYChange(Sender: TObject); +begin + TCO_modifie:=true; +end; + +procedure TFormConfigTCO.CheckDessineGrilleClick(Sender: TObject); +begin + TCO_modifie:=true; +end; + +procedure TFormConfigTCO.CheckCouleurClick(Sender: TObject); +begin + TCO_modifie:=true; +end; + +procedure TFormConfigTCO.RadioButtonLignesClick(Sender: TObject); +begin + TCO_modifie:=true; +end; + +procedure TFormConfigTCO.RadioButtonCourbesClick(Sender: TObject); +begin + TCO_modifie:=true; +end; + begin end. diff --git a/UnitDebug.pas b/UnitDebug.pas index d3f9217..dfdcfdf 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -137,7 +137,7 @@ begin end; end; - +// affiche un texte coloré dans la fenêtre evt procedure affiche_evt(s: string;lacouleur : TColor); begin if DebugAffiche then @@ -405,14 +405,14 @@ begin end; procedure TFormDebug.Button2Click(Sender: TObject); -var Adr,erreur,ancdebug : integer ; +var Adr,erreur,ancdebug,train : integer ; reservetraintiers : boolean; begin Val(EditSigSuiv.Text,Adr,erreur); if erreur<>0 then exit; ancdebug:=NivDebug; NivDebug:=3; Cond_Carre(Adr); - carre_signal(adr,0,reservetraintiers); + carre_signal(adr,0,reservetraintiers,train); NivDebug:=AncDebug; end; diff --git a/UnitPareFeu.dcu b/UnitPareFeu.dcu deleted file mode 100644 index f4fb31c..0000000 Binary files a/UnitPareFeu.dcu and /dev/null differ diff --git a/UnitPareFeu.pas b/UnitPareFeu.pas index 2348985..f7dc5d0 100644 --- a/UnitPareFeu.pas +++ b/UnitPareFeu.pas @@ -1,5 +1,7 @@ unit UnitPareFeu; +// créée une règle dans le parefeu windows pour autoriser tous les ports entre CDM et Signaux_complexes + interface function verifie_regle : integer; function cree_regle : boolean; diff --git a/UnitPilote.pas b/UnitPilote.pas index 640c23e..0d010ac 100644 --- a/UnitPilote.pas +++ b/UnitPilote.pas @@ -345,7 +345,7 @@ begin if (n<4) or (n>10) then checkVerrouCarre.Visible:=false else begin checkVerrouCarre.Visible:=true; - checkVerrouCarre.Checked:=feux[i].VerrouilleCarre; + checkVerrouCarre.Checked:=feux[i].VerrouCarre; end; ImagePilote.Parent:=FormPilote; @@ -379,9 +379,9 @@ procedure TFormPilote.CheckVerrouCarreClick(Sender: TObject); var i : integer; begin i:=Index_Signal(AdrPilote); - feux[i].VerrouilleCarre:=checkVerrouCarre.Checked=true; - if feux[i].VerrouilleCarre then + if feux[i].VerrouCarre then begin + feux[i].EtatVerrouCarre:=checkVerrouCarre.Checked=true; Maj_Etat_Signal(AdrPilote,carre); envoi_signal(Adrpilote); Maj_Etat_Signal(0,carre); diff --git a/UnitPrinc.pas b/UnitPrinc.pas index 72ba479..f1b14e7 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -1,7 +1,7 @@ Unit UnitPrinc; -// 8/8 22h +// 17/8 10h (******************************************** - programme signaux complexes Graphique Lenz + Programme signaux complexes Graphique Lenz Delphi 7 + activeX Tmscomm + clientSocket ou RadStudio options de compilation: options du debugger/exception du langage : décocher "arreter sur exceptions delphi" @@ -409,7 +409,7 @@ TSignal = record Btype_suiv3 : TEquipement ; // Btype_suiv4 : TEquipement ; // VerrouCarre : boolean ; // si vrai, le feu se verrouille au carré si pas de train avant le signal - VerrouilleCarre : boolean ; // si vrai, le feu est verrouillé au carré + EtatVerrouCarre : boolean ; // si vrai, le feu est verrouillé au carré modifie : boolean; // feu modifié EtatSignal : word ; // état du signal AncienEtat : word ; // ancien état du signal @@ -590,6 +590,8 @@ var trains : array[1..Max_Trains] of record nom_train : string; adresse,vitmax,VitNominale,VitRalenti : integer; + vitesse : integer; // vitesse actuelle + compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s TempoArret : integer; // tempo d'arret pour le timer TempoDemarre : integer; index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train @@ -665,7 +667,7 @@ function detecteur_suivant_El(el1: integer;TypeDet1 : TEquipement;el2 : integer; function test_memoire_zones(adresse : integer) : boolean; function PresTrainPrec(Adresse,NbCtSig : integer;detect : boolean;var AdrTr,voie : integer) : boolean; function cond_carre(adresse : integer) : boolean; -function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean) : boolean; +function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean;Var AdrTrain : integer) : boolean; procedure Event_Detecteur(Adresse : integer;etat : boolean;train : string); procedure Event_act(adr,adr2,etat : integer;trainDecl : string); function verif_UniSemaf(adresse,UniSem : integer) : integer; @@ -682,7 +684,7 @@ procedure init_dccpp; procedure init_aiguillages; function index_adresse_detecteur(de : integer) : integer; function index_train_adresse(adr : integer) : integer; -procedure vitesse_loco(nom_train :string;loco : integer;vitesse : integer;sens : boolean); +procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;sens : boolean;repetition : boolean); procedure Maj_Feux(detect : boolean); procedure Det_Adj(adresse : integer); procedure reserve_canton(detecteur1,detecteur2,adrtrain : integer); @@ -692,6 +694,7 @@ function BTypeToChaine(BT : TEquipement) : string; function testBit(n : word;position : integer) : boolean; procedure det_contigu(det1,det2 : integer;var suivant : integer;var ElSuiv : TEquipement); Function SetBit(n : word;position : integer) : word; +Function RazBit(n : word;position : integer) : word; procedure inverse_image(imageDest,ImageSrc : Timage) ; function extract_int(s : string) : integer; @@ -2401,7 +2404,8 @@ begin end; // envoie une vitesse à une loco par XpressNet/Dcc++ ou par CDM -procedure vitesse_loco(nom_train :string;loco : integer;vitesse : integer;sens : boolean); +// répétition=avec répétition de la commande dans 1s +procedure vitesse_loco(nom_train :string;index : integer;adr_loco : integer;vitesse : integer;sens,repetition : boolean); var s : string; begin if not(hors_tension) and ((portCommOuvert or parSocketLenz)) then @@ -2413,13 +2417,13 @@ begin if vitesse>127 then vitesse:=127; if sens then vitesse:=vitesse or 128; - s:=#$e4+#$13+#$0+char(loco)+char(vitesse); + s:=#$e4+#$13+#$0+char(adr_loco)+char(vitesse); s:=checksum(s); envoi(s); end; if protocole=2 then begin - s:='' else s:=s+'0>'; envoi(s); end; @@ -2428,10 +2432,18 @@ begin if cdm_connecte then begin s:=chaine_CDM_vitesseST(vitesse,nom_train); // par nom du train - //s:=chaine_CDM_vitesseINT(vitesse,loco); // par adresse du train + //s:=chaine_CDM_vitesseINT(vitesse,adr_loco); // par adresse du train envoi_CDM(s); //affiche(s,clLime); end; + + // répétition de la consigne dans 1 s + if (index<>0) and repetition then + begin + trains[index].vitesse:=vitesse; + trains[index].compteur_consigne:=10; + end; + end; // renvoie la chaîne de l'état du signal @@ -6342,9 +6354,9 @@ end; // et teste si les éléments jusqu'au signal suivant s'ils sont verrouillés // TrainReserve : adresse du train qui demande la fonction ou 0 // Si reserveTrainTiers=vrai, le parcours est réservé par un autre train -function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean) : boolean; +function carre_signal(adresse,TrainReserve : integer;var reserveTrainTiers : boolean;Var AdrTrain : integer) : boolean; var - i,j,k,prec,indexFeu,AdrSuiv,index2,voie,AdrFeu,adrtrain : integer; + i,j,k,prec,indexFeu,AdrSuiv,index2,voie,AdrFeu : integer; TypeELPrec,TypeElActuel : TEquipement; sort,prestrain : boolean; s : string; @@ -7499,7 +7511,7 @@ end; // met à jour l'état du signel belge selon l'environnement des aiguillages et des trains procedure signal_belge(Adrfeu : integer;detect : boolean); -var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant : integer; +var adrAig,adr_det,adr_el_suiv,AdrTrainLoc,voie,indexAig,etat,AdrSignalsuivant,AdrTrainRes : integer; Btype_el_suivant : TEquipement; car,presTrain,reserveTrainTiers,Aff_Semaphore : boolean; s: string; @@ -7532,15 +7544,15 @@ begin // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal // verrouillable au carré, afficher un carré - car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers); // si reserveTrainTiers, réservé par un autre train - if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train',clYellow); + car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes); // si reserveTrainTiers, réservé par un autre train + if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train (@'+intToSTR(AdrTrainRes)+')',clYellow); if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); // En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré if roulage then car:=reserveTrainTiers or car; // conditions supplémentaires de carré en fonction des aiguillages décrits car:=cond_carre(AdrFeu) or car; - if AffSignal and feux[index].VerrouilleCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); + if AffSignal and feux[index].VerrouCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); if (Feux[index].VerrouCarre and not(presTrain)) or car @@ -7626,7 +7638,7 @@ end; procedure Maj_Feu(Adrfeu : integer;detect : boolean); var Adr_det,etat,Aig,Adr_El_Suiv,modele,index,IndexAig,AdrTrainLoc,voie : integer ; PresTrain,Aff_semaphore,car,reserveTrainTiers : boolean; - code,combine,AdrSignalsuivant : integer; + code,combine,AdrSignalsuivant,AdrTrainRes : integer; Btype_el_suivant : TEquipement; s : string; begin @@ -7687,7 +7699,7 @@ begin begin // si aiguillage après signal mal positionnées ou réservé ou pas de train avant le signal PresTrain:=PresTrainPrec(AdrFeu,Nb_cantons_Sig,detect,AdrTrainLoc,voie); - if carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers) or not(PresTrain) or (feux[index].VerrouilleCarre) then + if carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes) or not(PresTrain) or (feux[index].VerrouCarre) then begin Maj_Etat_Signal(AdrFeu,violet); envoi_signal(AdrFeu); @@ -7718,18 +7730,18 @@ begin // si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou aig réservé ou que pas présence train avant signal et signal // verrouillable au carré, afficher un carré - car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers); // si reserveTrainTiers, réservé par un autre train + car:=carre_signal(AdrFeu,AdrTrainLoc,reserveTrainTiers,AdrTrainRes); // si reserveTrainTiers, réservé par un autre train if AffSignal and reserveTrainTiers then AfficheDebug('trouvé aiguillage réservé par autre train',clYellow); if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); // En mode roulage, si la réservation est faite par le train détecté en étape A, ne pas verrouiller au carré if roulage then car:=reserveTrainTiers or car; // conditions supplémentaires de carré en fonction des aiguillages décrits - car:=cond_carre(AdrFeu) or car; + car:=cond_carre(AdrFeu) or car; //if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); - if AffSignal and feux[index].VerrouilleCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); + if AffSignal and feux[index].VerrouCarre then AfficheDebug('le signal est verrouillé au carré',clYellow); - if (modele>=4) and ((not(PresTrain) and feux[index].Verrouillecarre) or car ) then Maj_Etat_Signal(AdrFeu,carre) + if (modele>=4) and ((not(PresTrain) and feux[index].Verroucarre) or car ) then Maj_Etat_Signal(AdrFeu,carre) else begin // si on quitte le détecteur on affiche un sémaphore : tester le sens de circulation @@ -8054,7 +8066,7 @@ end; // pilote le train sur le détecteur det2, d'adresse adrtrain // le det1 indique d'ou vient le train pour le bon sens du signal -// le train est piloté si ontrouve un signal dans le bon sens sur det2 +// le train est piloté si on trouve un signal dans le bon sens sur det2 // it : numéro du train du réseau (pour la couleur) procedure pilote_train(det1,det2,AdrTrain,it : integer); var entree_signal,jauneC,rappel30C,rappel60C,rouge : boolean; @@ -8104,32 +8116,32 @@ begin if jauneC then AfficheDebug('Signal '+intToSTR(adresse)+' à l''avertissement - Ralentissement train @'+intToSTR(AdrTrain),clLime); if Rappel30C and not(jauneC) then AfficheDebug('Signal '+intToSTR(adresse)+' au rappel30 - Ralentissement train @'+intToSTR(AdrTrain),clLime); end; - if (index_train<>0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train0) and (index_train0 then dec(temps); - // gestion du clignotant des feux de la page principale - + // gestion du clignotant des feux de la page principale---------------------- if tempsCli>0 then dec(tempsCli); if tempsCli=0 then begin @@ -12432,7 +12449,7 @@ begin end; end; - // signaux du TCO + // signaux du TCO----------------------------------------------- if TCOActive then // évite d'accéder à la variable FormTCO si elle est pas encore ouverte begin // parcourir les feux du TCO @@ -12480,7 +12497,7 @@ begin end; end; - // fenêtre de pilotage manuel du feu + // fenêtre de pilotage manuel du feu ------------------- if AdrPilote<>0 then begin a:=feux[0].EtatSignal; @@ -12529,8 +12546,10 @@ begin end; end; + // pilotage des trains : // arret loco sur n secondes // démarrage loco temporisé + // renvoi de la consigne for i:=1 to ntrains do begin a:=trains[i].TempoArret; @@ -12538,9 +12557,10 @@ begin begin dec(a); trains[i].TempoArret:=a; - if a=0 then vitesse_loco('',trains[i].adresse,0,true) else - if (a mod 10)=0 then vitesse_loco('',trains[i].adresse,trains[i].VitRalenti div 2,true); + if a=0 then vitesse_loco('',i,trains[i].adresse,0,true,false) else + if (a mod 10)=0 then vitesse_loco('',i,trains[i].adresse,trains[i].VitRalenti div 2,true,false); end; + a:=trains[i].TempoDemarre; if a<>0 then begin @@ -12549,9 +12569,21 @@ begin if a=0 then begin //Affiche('Démarrage train @'+intToSTR(trains[i].Adresse),clLime); - vitesse_loco('',trains[i].Adresse,trains[i].VitNominale,not(placement[i].inverse)); + vitesse_loco('',i,trains[i].Adresse,trains[i].VitNominale,not(placement[i].inverse),false); end; end; + + a:=trains[i].compteur_consigne; + if a<>0 then + begin + dec(a); + trains[i].compteur_consigne:=a; + if a=0 then + begin + vitesse_loco('',i,trains[i].vitesse,0,true,false); + //Affiche('vitesse ' +intToSTR(i)+' '+intToSTR(trains[i].vitesse),clred); + end; + end; end; //simulation @@ -14223,20 +14255,25 @@ begin end; procedure TFormPrinc.locoClick(Sender: TObject); -var adr,vit,erreur : integer; +var i,adr,vit,erreur : integer; s : string; begin // vitesse et direction 18 pas s:=editAdrTrain.Text; val(s,adr,erreur); if (erreur<>0) or (adr<0) then exit; - if not(portCommOuvert) and not(parSocketLenz) and not(CDM_Connecte) then exit; + //if not(portCommOuvert) and not(parSocketLenz) and not(CDM_Connecte) then exit; s:=editVitesse.Text; val(s,vit,erreur); if (erreur<>0) or (vit<0) then exit; - s:=trains[combotrains.itemindex+1].nom_train; + i:=0;s:=''; + if combotrains.itemindex<>-1 then + begin + s:=trains[combotrains.itemindex+1].nom_train; + i:=index_train_nom(s); + end; Affiche('Commande vitesse train '+s+' ('+intToSTR(adr)+') à '+IntToSTR(vit)+'%',cllime); - vitesse_loco(s,adr,vit,true); + vitesse_loco(s,i,adr,vit,true,true); if s='' then s:=intToSTR(adr); end; @@ -14398,7 +14435,7 @@ end; procedure TFormPrinc.Informationsdusignal1Click(Sender: TObject); var s: string; - nation,etat,index,i,aspect,n,combine,adresse,aig,trainReserve,AdrSignalsuivant,voie : integer; + nation,etat,index,i,aspect,n,combine,adresse,aig,trainReserve,AdrSignalsuivant,voie,AdrTrainRes : integer; reserveTrainTiers : boolean; code : word; begin @@ -14422,13 +14459,13 @@ begin // carré if (aspect=carre) and (nation=1) then begin - Affiche(s,clyellow); - if carre_signal(Adresse,trainreserve,reserveTrainTiers) then affiche('les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues',clyellow) ; - if reserveTrainTiers then affiche('un aiguillage ou un croisement en aval du signal sont réservés par un autre train ',clyellow); + Affiche(s,clyellow); + if carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes) then affiche('les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues',clyellow) ; + if reserveTrainTiers then affiche('un aiguillage ou un croisement en aval du signal sont réservés par un autre train (@'+intToSTR(AdrTrainRes)+')',clyellow); if Cond_Carre(Adresse) then affiche_suivi('les aiguillages déclarés dans la définition du signal sont mal positionnés',clyellow); if feux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,false,TrainReserve,voie)) then affiche('le signal est verrouillable au carré et aucun train n''est présent avant le signal',clyellow); if test_memoire_zones(Adresse) then affiche('présence train dans canton suivant le signal',clyellow); - if feux[i].VerrouilleCarre then affiche('le signal est verrouillé au carré dans la fenêtre de pilotage',clYellow); + if feux[i].EtatVerrouCarre then affiche('le signal est verrouillé au carré dans la fenêtre de pilotage',clYellow); end; if (aspect=vert_jaune_H) and (nation=2) then @@ -14448,12 +14485,12 @@ begin if n=20 then begin // signal belge - if carre_signal(Adresse,trainreserve,reserveTrainTiers) then affiche('les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues',clyellow) ; - if reserveTrainTiers then affiche('un aiguillage ou un croisement en aval du signal sont réservés par un autre train ',clyellow); + if carre_signal(Adresse,trainreserve,reserveTrainTiers,AdrTrainRes) then affiche('les aiguillages en aval du signal sont mal positionnés ou leur positions inconnues',clyellow) ; + if reserveTrainTiers then affiche('un aiguillage ou un croisement en aval du signal sont réservés par un autre train (@'+intToSTR(AdrTrainRes)+')',clyellow); if Cond_Carre(Adresse) then affiche_suivi('les aiguillages déclarés dans la définition du signal sont mal positionnés',clyellow); if feux[i].VerrouCarre and not(PresTrainPrec(Adresse,Nb_cantons_Sig,false,TrainReserve,voie)) then affiche('le signal est verrouillable au carré et aucun train n''est présent avant le signal',clyellow); if test_memoire_zones(Adresse) then affiche('présence train dans canton suivant le signal',clyellow); - if feux[i].VerrouilleCarre then affiche('le signal est verrouillé au carré dans la fenêtre de pilotage',clYellow); + if feux[i].EtatVerrouCarre then affiche('le signal est verrouillé au rouge dans la fenêtre de pilotage',clYellow); end; end; // avertissement ou deux-jaunes (belge) @@ -14481,7 +14518,7 @@ begin begin i:=etat_signal_suivant(Adresse,1,AdrSignalsuivant); index:=Index_Signal(AdrSignalSuivant); - Affiche(s+'car son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i,adresse),clyellow); + Affiche(s+'son signal suivant '+intToSTR(AdrSignalsuivant)+' est au '+chaine_signal(i,adresse),clyellow); end; if ((combine=rappel_30) or (combine=rappel_60)) and (nation=1) then begin @@ -14507,7 +14544,6 @@ begin Affiche(s+'l''aiguillage mène à une voie en contresens',clyellow); end; end; - end; procedure TFormPrinc.VrifierlacohrenceClick(Sender: TObject); @@ -14739,7 +14775,7 @@ begin if traceListe then AfficheDebug(s,clyellow); AdrTrain:=detecteur[Adr].AdrTrain; j:=index_train_adresse(AdrTrain); - vitesse_loco('',adrTrain,trains[j].VitNominale,not(placement[j].inverse)); + vitesse_loco('',j,adrTrain,trains[j].VitNominale,not(placement[j].inverse),true); trouve:=true; roulage:=true; end; @@ -14815,7 +14851,7 @@ begin if adr<>0 then begin Affiche('Arrêt train @'+intToSTR(adr)+' '+Trains[i].nom_train,clyellow); - vitesse_loco('',adr,0,not(placement[i].inverse)); + vitesse_loco('',i,adr,0,not(placement[i].inverse),true); end; end; end; @@ -14956,7 +14992,5 @@ begin end; - - -end. + end. diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 1edae3c..3a646f0 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,6 +1,6 @@ object FormTCO: TFormTCO - Left = 197 - Top = 29 + Left = 82 + Top = 114 Width = 1142 Height = 678 VertScrollBar.Visible = False @@ -22,8 +22,8 @@ object FormTCO: TFormTCO OnKeyPress = FormKeyPress OnMouseWheel = FormMouseWheel DesignSize = ( - 1134 - 647) + 1126 + 640) PixelsPerInch = 96 TextHeight = 13 object LabelCoord: TLabel @@ -917,7 +917,7 @@ object FormTCO: TFormTCO OnMouseDown = ImagePalette34MouseDown end object ButtonSauveTCO: TButton - Left = 1025 + Left = 1017 Top = 48 Width = 96 Height = 33 @@ -929,7 +929,7 @@ object FormTCO: TFormTCO OnClick = ButtonSauveTCOClick end object ButtonRedessine: TButton - Left = 1025 + Left = 1017 Top = 8 Width = 96 Height = 33 @@ -940,7 +940,7 @@ object FormTCO: TFormTCO OnClick = ButtonRedessineClick end object Button1: TButton - Left = 928 + Left = 920 Top = 56 Width = 89 Height = 25 @@ -949,7 +949,7 @@ object FormTCO: TFormTCO OnClick = Button1Click end object Button2: TButton - Left = 928 + Left = 912 Top = 32 Width = 89 Height = 25 @@ -958,7 +958,7 @@ object FormTCO: TFormTCO OnClick = Button2Click end object ButtonConfigTCO: TButton - Left = 1025 + Left = 1017 Top = 88 Width = 96 Height = 33 @@ -978,7 +978,7 @@ object FormTCO: TFormTCO OnClick = ButtonSimuClick end object ButtonMasquer: TButton - Left = 1025 + Left = 1017 Top = 128 Width = 96 Height = 33 @@ -1152,7 +1152,7 @@ object FormTCO: TFormTCO end end object buttonRaz: TButton - Left = 920 + Left = 912 Top = 128 Width = 96 Height = 33 @@ -1164,7 +1164,7 @@ object FormTCO: TFormTCO OnClick = buttonRazClick end object ButtonCalibrage: TButton - Left = 848 + Left = 840 Top = 136 Width = 75 Height = 25 @@ -1173,7 +1173,7 @@ object FormTCO: TFormTCO OnClick = ButtonCalibrageClick end object ButtonDessiner: TButton - Left = 920 + Left = 912 Top = 88 Width = 96 Height = 33 @@ -1188,15 +1188,6 @@ object FormTCO: TFormTCO TabStop = False OnClick = ButtonDessinerClick end - object ButtonTrajet: TButton - Left = 936 - Top = 8 - Width = 75 - Height = 25 - Caption = 'Trajets' - TabOrder = 11 - OnClick = ButtonTrajetClick - end end object ButtonAfficheBandeau: TButton Left = 1070 diff --git a/UnitTCO.pas b/UnitTCO.pas index b1986b7..cfcb9b3 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -125,7 +125,6 @@ type ImageTemp2: TImage; outslectionner1: TMenuItem; ButtonDessiner: TButton; - ButtonTrajet: TButton; ImagePalette26: TImage; Label26: TLabel; ImagePalette23: TImage; @@ -346,9 +345,8 @@ type procedure EditTypeImageChange(Sender: TObject); procedure outslectionner1Click(Sender: TObject); procedure ButtonDessinerClick(Sender: TObject); - procedure ButtonTrajetClick(Sender: TObject); - procedure ImagePalette26DragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); + 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; @@ -420,9 +418,12 @@ const Cellule_ch='Cellule'; ClCanton_ch='CoulCanton'; Ratio_ch='Ratio'; + EvtClicDet_ch='EvtClicDet'; AvecGrille_ch='AvecGrille'; ModeCouleurCanton_ch='ModeCouleurCanton'; Graphisme_ch='Graphisme'; + Id_signal=50; + // 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..51] of integer= // 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 @@ -450,6 +451,7 @@ type 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 liaisons : integer; // quadrants des liaisons + epaisseurs : integer; // épaisseur des liaisons : si le bit n est à 1 : liaison fine end; var @@ -459,7 +461,7 @@ var Forminit,SelectionAffichee,TamponAffecte,entoure,TCO_modifie,clicsouris, clicTCO,piloteAig,BandeauMasque,eval_format,sauve_tco,formConfCellTCOAff, - drag,TCOActive,TCOCree,modeTrace,ancienok,dbleClicTCO,auto_tcurs : boolean; + drag,TCOActive,TCOCree,modeTrace,ancienok,dbleClicTCO,auto_tcurs,EvtClicDet : boolean; HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel ,AncienYMiniSel,AncienYMaxiSel, @@ -518,10 +520,11 @@ function verif_cellule(x,y,Bim : integer) : boolean; procedure dessine_icones; procedure echange(var a,b : integer); procedure Efface_Cellule(Canvas : Tcanvas;x,y : integer;Mode : TPenMode); +procedure dessine_icone(PCanvasTCO : tcanvas;Bimage,X,Y,mode : integer); implementation -uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO; +uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO ; {$R *.dfm} @@ -566,8 +569,8 @@ begin ClCanton:=$00FFFF; AvecGrille:=true; Graphisme:=1; - SetLength(TCO,NbreCellX+1,NbreCellY+1); - SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); + SetLength(TCO,NbreCellX+2,NbreCellY+2); // +2 pour éviter les erreurs d'index sur +1 et -1 + SetLength(TamponTCO,NbreCellX+2,NbreCellY+2); for x:=1 to NbreCellX do for y:=1 to NbreCellY do with tco[x,y] do @@ -732,7 +735,6 @@ begin val(s,i,erreur); AvecGrille:=i=1; end; - //---------------------------------------------------------------- // taille de la matrice sa:=uppercase(Matrice_ch)+'='; @@ -747,7 +749,6 @@ begin Val(s,NbreCellY,erreur) end; - // ratio sa:=uppercase(Ratio_ch)+'='; i:=pos(sa,s); @@ -760,6 +761,18 @@ begin 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:=NbreCellX*NbreCellY; @@ -776,11 +789,11 @@ begin end; try - SetLength(TCO,NbreCellX+1,NbreCellY+1); + SetLength(TCO,NbreCellX+2,NbreCellY+2); except Affiche('TCO:Mémoire insuffisante pour'+intToSTR(NbreCellX)+' '+intToSTR(NbreCellY),clred); NbreCellX:=20;NbreCellY:=12; - SetLength(TCO,NbreCellX+1,NbreCellY+1); + SetLength(TCO,NbreCellX+2,NbreCellY+2); end; try @@ -788,7 +801,7 @@ begin except Affiche('TamponTCO:Mémoire insuffisante',clred); NbreCellX:=20;NbreCellY:=12; - SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); + SetLength(TamponTCO,NbreCellX+2,NbreCellY+2); end; @@ -837,7 +850,7 @@ begin 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:=50;sauve_tco:=true;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[x,y].Bimage:=valeur; tco[x,y].liaisons:=liaisons[valeur]; @@ -863,7 +876,7 @@ begin delete(s,1,i); // si c'est un signal, remplir les paramètres du signal - if tco[x,y].Bimage=50 then + if tco[x,y].Bimage=Id_signal then begin i:=Index_Signal(adresse); if i<>0 then @@ -926,10 +939,12 @@ begin delete(s,1,i-1); //ne pas supprimer la virgule end; + // 13 réserve if npar=13 then begin - delete(s,1,1); // supprimer la virgule + delete(s,1,1); // supprimer la virgule du paramètre optionnel val(s,i,erreur); + tco[x,y].epaisseurs:=i; end; i:=pos(')',s); if i<>0 then delete(s,1,i); @@ -976,14 +991,14 @@ begin if avecGrille then s:='1' else s:='0'; Writeln(fichier,Avecgrille_ch+'='+s); writeln(fichier,Graphisme_ch+'=',graphisme); - - writeln(fichier,'/ Taille de la matrice x,y'); + if EvtClicDet then s:='1' else s:='0'; + Writeln(fichier,EvtClicDet_ch+'='+s); + writeln(fichier,matrice_ch+'='+IntToSTR(NbreCellX)+','+intToSTR(NbreCellY)); - writeln(fichier,'/ Ratio d''affichage celluleX/CelluleY'); writeln(fichier,Ratio_ch+'='+intToSTR(ratioC)); writeln(fichier,'/Matrice TCO'); writeln(fichier,'[Matrice]'); - writeln(fichier,'/ couleur fond,adresse,image,inversion aiguillage,Orientation du signal, pied du signal , [texte], representation, fonte, taille fonte, couleur fonte, style, réserve '); + writeln(fichier,'/ couleur fond,adresse,image,inversion aiguillage,Orientation du signal, pied du signal , [texte], representation, fonte, taille fonte, couleur fonte, style, épaisseurs '); for y:=1 to NbreCellY do begin s:=''; @@ -993,7 +1008,7 @@ begin if TCO[x,y].inverse then s:=s+'1,' else s:=s+'0,'; - if TCO[x,y].BImage=50 then + if TCO[x,y].BImage=Id_signal then begin s:=s+IntToSTR(TCO[x,y].FeuOriente)+','+IntToSTR(TCO[x,y].PiedFeu)+','; end @@ -1011,7 +1026,7 @@ begin couleurfonte:=TCO[x,y].coulFonte; s:=s+','+intTohex(couleurFonte,6); s:=s+','+TCO[x,y].FontStyle; - s:=s+',0'; + s:=s+','+intToSTR(TCO[x,y].epaisseurs); s:=s+')'; end; writeln(fichier,s); @@ -1166,73 +1181,104 @@ begin end; -procedure dessin_2L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,jy1,jy2,xf,yf,position : integer; +// essai pour dessiner les icones de façon paramétrées en fonction du numéro de dessin +// et des points de connexion +// numéro = numéro d'icone +procedure dessin(Canvas : Tcanvas;x,y,Mode,numero : integer); +var i,j,x0,y0,xc,yc,jy2,xf,yf,position,jy1,connect1,connect2,connect3,connect4 : integer; r : Trect; fond : tcolor; + procedure trace_point(canvas : Tcanvas;i : integer); + begin + with canvas do + begin + case i of + 0 : moveto(x0,y0); + 1 : moveto(xc,y0); + 2 : moveto(xf,y0); + 3 : moveto(xf,yc); + 4 : moveto(xf,yf); + 5 : moveto(xc,yf); + 6 : moveto(x0,yf); + 7 : moveto(x0,yc); + end; + end; + end; + + procedure trace_ligne(canvas : Tcanvas;i : integer); + begin + with canvas do + begin + case i of + 0 : lineto(x0,y0); + 1 : lineto(xc,y0); + 2 : lineto(xf,y0); + 3 : lineto(xf,yc); + 4 : lineto(xf,yf); + 5 : lineto(xc,yf); + 6 : lineto(x0,yf); + 7 : lineto(x0,yc); + end; + end; + end; + + procedure trajet_droit; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // partie droite - moveto(x0,yf);lineto(xc,yc); // partie déviée - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xc,yc); // partie déviée - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // 2eme partie droite toujours allumée - moveto(xc,yc);LineTo(xf,yc); - - // 1ere partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(x0,yc); + end; + + with canvas do + begin + pen.color:=couleur; + pen.Width:=epaisseur; + {case numero of + 2 : begin moveto(x0,yc);lineto(xf,yc);end; // partie droite + end;} + //ou + + // trace le premier point + trace_point(canvas,connect1); + lineto(xc,yc); + // trace le 2eme point + trace_ligne(canvas,connect1); end; end; procedure trajet_devie; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // horizontale complete - moveto(x0,yf);lineto(xc,yc); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie horz g en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yf);LineTo(xc,yc);LineTo(xf,yc); // trajet déviée + pen.Width:=epaisseur; + {case numero of + 2 : begin moveto(x0,yf);lineto(xc,yc);lineto(xf,yc);end; + end; } + trace_point(canvas,connect1); + lineto(xc,yc); + // trace le 2eme point + trace_ligne(canvas,connect1); end; end; - begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -1243,26 +1289,52 @@ begin fond:=TCO[x,y].CouleurFond; position:=positionTCO(x,y); + // extraire les points de connexion de l'icone (de 0 à 7) + connect1:=0;connect2:=0;connect3:=0;connect4:=0; + j:=0; + for i:=0 to 7 do + begin + if testBit(liaisons[numero],i) then + begin + case j of + 0 : connect1:=i; + 1 : connect2:=i; + 2 : connect3:=i; + 3 : connect4:=i; + end; + inc(j); + end; + end; + + with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=fond; - //r:=Rect(x0,y0,xf,yf); - //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; - if (position=const_Devie) or (position=const_inconnu) then + if mode>0 then begin - trajet_devie; // affiche la position de la branche déviée - end; + 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 - if (position=const_droit) or (position=const_inconnu) then + else begin + trajet_devie; trajet_droit; end; @@ -1290,9 +1362,11 @@ begin end; end; -// essai courbe -procedure dessin_2C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; + + +// sert de référence11 +procedure dessin_2L(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,jy2,xf,yf,position,jy1,ep : integer; r : Trect; fond : tcolor; @@ -1310,8 +1384,129 @@ var x0,y0,xc,yc,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; 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(xf,yc); // partie droite + 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; + if mode>0 then + begin + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; + end; + + with canvas do + begin + pen.color:=couleur; + 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; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + fond:=TCO[x,y].CouleurFond; + position:=positionTCO(x,y); + ep:=tco[x,y].epaisseurs; + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=fond; + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if mode>0 then + begin + if (position=const_devie) or (position=const_inconnu) then + begin + trajet_droit; + trajet_devie; + end; + if (position=const_droit) then + begin + trajet_devie; + trajet_droit; + end; + end + + else + begin + trajet_devie; + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.width:=1; + jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup + pen.width:=1; + Polygon([point(x0+1,y0+hauteurCell-epaisseur),Point(xc-(epaisseur div 2),jy1),Point(xc-epaisseur-epaisseur,jy1),Point(x0+1,y0+hauteurcell-epaisseur-epaisseur)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.Width:=1; + jy2:=yc+(Epaisseur div 2); // pos Y de la bande inf + r:=rect(x0+1,jy2+1,x0+largeurCell-1,jy2+epaisseur); + FillRect(r); + end; + + end; +end; + + +// courbe +procedure dessin_2C(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; + if mode>0 then + begin + if position=const_droit then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; + end; + + with canvas do + begin + 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; @@ -1330,6 +1525,7 @@ var x0,y0,xc,yc,jy2,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; 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; @@ -1343,6 +1539,7 @@ begin yf:=y0+HauteurCell; // y fin fond:=TCO[x,y].CouleurFond; position:=positionTCO(x,y); + ep:=tco[x,y].epaisseurs; // mode rond x1:=xf-x0; @@ -1416,71 +1613,53 @@ begin end; procedure dessin_3L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,jy1,xf,yf,position : integer; +var x0,y0,xc,yc,jy1,xf,yf,position,ep : integer; fond : Tcolor; r : Trect; procedure trajet_droit; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // partie droite - moveto(xc,yc);lineto(xf,y0); // partie déviée - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);lineto(xf,y0); // partie déviée - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie gauche toujours allumée - moveto(x0,yc);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,yc); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // horizontale complete - moveto(xc,yc);lineto(xf,y0); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie horz droite en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(xf,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yc);LineTo(xc,yc);LineTo(xf,y0); // partie déviée + 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; // x origine @@ -1489,32 +1668,40 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin - position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + position:=positionTCO(x,y); + ep:=tco[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; Pen.Color:=clVoies; Pen.Mode:=pmCopy; - if (position=const_Devie) or (position=const_inconnu) then + if mode>0 then begin - trajet_devie; // affiche la position de la branche déviée - end; + 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 - if (position=const_droit) or (position=const_inconnu) then + else begin - trajet_droit; + trajet_devie; + trajet_droit; end; - if (position=const_Devie) then begin // effacement du morceau @@ -1539,7 +1726,7 @@ begin end; procedure dessin_3C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,jy1,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; +var x0,y0,xc,yc,jy1,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4,ep : integer; fond : Tcolor; r : Trect; @@ -1557,8 +1744,11 @@ var x0,y0,xc,yc,jy1,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; 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(xf,yc); // partie droite + 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; @@ -1577,6 +1767,7 @@ var x0,y0,xc,yc,jy1,xf,yf,position,x1,y1,x2,y2,x3,y3,x4,y4 : integer; 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; @@ -1588,6 +1779,7 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin + ep:=tco[x,y].epaisseurs; // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); @@ -1673,70 +1865,52 @@ begin if graphisme=1 then dessin_3L(Canvas,x,y,Mode); if graphisme=2 then dessin_3C(Canvas,x,y,Mode); end; - + procedure dessin_4L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // partie droite - moveto(xc,yc);lineto(xf,yf); // partie déviée - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);lineto(xf,yf); // partie déviée - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie gauche toujours allumée - moveto(x0,yc);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,yc); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // horizontale complete - moveto(xc,yc);lineto(xf,yf); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie horz droite en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(xf,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yc);LineTo(xc,yc);LineTo(xf,yf); // trajet dévié + 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; @@ -1747,32 +1921,41 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin - position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + position:=positionTCO(x,y); + ep:=tco[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; Pen.Color:=clVoies; Pen.Mode:=pmCopy; - if (position=const_Devie) or (position=const_inconnu) then + if mode>0 then begin - trajet_devie; // affiche la position de la branche déviée - end; + 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 - if (position=const_droit) or (position=const_inconnu) then + else begin + trajet_devie; trajet_droit; end; - + if (position=const_Devie) then begin // effacement du morceau @@ -1802,7 +1985,7 @@ begin end; procedure dessin_4C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; @@ -1821,7 +2004,10 @@ var x0,y0,xc,yc,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position : integer; with canvas do begin pen.color:=couleur; - moveto(x0,yc);lineto(xf,yc); // partie droite + 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; @@ -1840,6 +2026,7 @@ var x0,y0,xc,yc,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position : integer; 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; @@ -1852,6 +2039,7 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin + ep:=tco[x,y].epaisseurs; // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=yc; @@ -1927,74 +2115,56 @@ begin if graphisme=1 then dessin_4L(Canvas,x,y,Mode); if graphisme=2 then dessin_4C(Canvas,x,y,Mode); end; - + procedure dessin_5L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // partie droite - moveto(x0,y0);lineto(xc,yc); // partie déviée - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xc,yc); // partie déviée - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // 2eme partie droite toujours allumée - moveto(xc,yc);LineTo(xf,yc); - - // 1ere partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(x0,yc); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xf,yc); // horizontale complete - moveto(x0,y0);lineto(xc,yc); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie horz g en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);LineTo(xc,yc); - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; + with canvas do + begin pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,y0);LineTo(xc,yc);LineTo(xf,yc); // trajet dévié + 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; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -2002,29 +2172,38 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin - position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + position:=positionTCO(x,y); + ep:=tco[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; Pen.Color:=clVoies; Pen.Mode:=pmCopy; - if (position=const_Devie) or (position=const_inconnu) then + if mode>0 then begin - trajet_devie; // affiche la position de la branche déviée - end; + 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 - if (position=const_droit) or (position=const_inconnu) then + else begin + trajet_devie; trajet_droit; end; @@ -2057,7 +2236,7 @@ begin end; procedure dessin_5C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; @@ -2075,8 +2254,11 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; 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(xf,yc); // partie droite + 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; @@ -2095,6 +2277,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; 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; @@ -2108,6 +2291,7 @@ begin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=tco[x,y].epaisseurs; // mode rond x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2)+4; @@ -2183,12 +2367,14 @@ end; // coin supérieur gauche (Element 6) procedure dessin_6L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=tco[x,y].epaisseurs; + with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; @@ -2205,13 +2391,17 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - MoveTo(x0,y0);LineTo(xc,yc);Lineto(x0+largeurCell,yc); + + 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,yc); end; end; // coin supérieur gauche (Element 6) procedure dessin_6C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -2219,6 +2409,8 @@ begin yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin + ep:=tco[x,y].epaisseurs; + // mode rond x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+largeurCell+(largeurcell div 3);y2:=yc; @@ -2250,12 +2442,13 @@ end; // Element 7 procedure dessin_7L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -2272,13 +2465,17 @@ begin Brush.Color:=Couleur; pen.color:=couleur; Pen.Mode:=pmCopy; - Pen.Width:=epaisseur; - MoveTo(x0,yc);LineTo(xc,yc);lineto(x0+largeurCell,y0); + + 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,y0); + end; end; procedure dessin_7C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -2286,6 +2483,7 @@ begin yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin + ep:=tco[x,y].epaisseurs; // mode rond x1:=x0-largeurCell-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+(largeurcell div 3)+3;y2:=yc; @@ -2320,12 +2518,13 @@ end; // courbe: droit vers bas -\ Element 8 procedure dessin_8L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -2342,13 +2541,16 @@ begin Brush.Color:=Couleur; Pen.Mode:=pmCopy; pen.color:=Couleur; - pen.Width:=epaisseur; - moveto(x0,yc);lineto(xc,yc);lineto(x0+largeurCell,y0+hauteurCell); + + 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,y0+hauteurCell); end; end; procedure dessin_8C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -2361,6 +2563,7 @@ begin x2:=xf+(largeurcell div 3);y2:=yf+2*hauteurcell+(hauteurcell div 2); x3:=xf;y3:=yf; x4:=x0;y4:=yc; + ep:=tco[x,y].epaisseurs; with canvas do @@ -2391,12 +2594,13 @@ end; // courbe bas gauche vers droit Elément 9 procedure dessin_9l(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -2413,15 +2617,19 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - pen.width:=epaisseur; - MoveTo(x0,y0+hauteurCell);LineTo(xc,yc);LineTo(x0+largeurCell,yc); + + if testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + MoveTo(x0,y0+hauteurCell);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + LineTo(x0+largeurCell,yc); + end; end; // courbe bas gauche vers droit Elément 9 procedure dessin_9c(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -2429,6 +2637,7 @@ begin yc:=y0+(hauteurCell div 2); xf:=x0+largeurCell; yf:=y0+HauteurCell; + ep:=tco[x,y].epaisseurs; // mode rond x1:=xf-x0; x1:=x0-(x1 div 3);y1:=yc; @@ -2451,7 +2660,8 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - pen.width:=epaisseur; + 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; @@ -2464,10 +2674,11 @@ end; // élément 10 procedure dessin_10(Canvas : Tcanvas;x,y : integer;Mode : integer); -var Adr, x0,y0: integer; +var Adr, x0,y0,ep: integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -2496,25 +2707,26 @@ begin end; // voie - Pen.Width:=epaisseur; - case mode of 0 : couleur:=clVoies; 1 : couleur:=clAllume; 2 : couleur:=couleurtrain[index_couleur]; 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,y0);LineTo(x0,y0+hauteurCell); end; end; // élément 11 procedure dessin_11(Canvas : Tcanvas;x,y : integer;Mode : integer); -var Adr, x0,y0 : integer; +var Adr, x0,y0,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; - + ep:=tco[x,y].epaisseurs; + with canvas do begin Brush.Color:=TCO[x,y].CouleurFond; @@ -2542,84 +2754,70 @@ begin end; // voie - Pen.Width:=epaisseur; - case mode of 0 : couleur:=clVoies; 1 : couleur:=clAllume; 2 : couleur:=couleurtrain[index_couleur]; 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,y0+hauteurCell); end; end; -// Element 12 +// Element 12 procedure dessin_12L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(xc,yc);lineto(xf,yc); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);lineto(xf,yc); // partie droite - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie haute toujours allumée - moveto(x0,y0);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,yf); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(xc,yc);lineto(xf,yc); // partie droite + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie sup en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(xf,yf); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,y0);LineTo(xc,yc);LineTo(xf,yc); + 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; // x origine @@ -2630,6 +2828,7 @@ begin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -2683,7 +2882,7 @@ begin end; procedure dessin_12C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; begin @@ -2700,7 +2899,11 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; with canvas do begin pen.color:=couleur; - moveto(x0,y0);lineto(xf,yf); // partie droite + 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; @@ -2719,6 +2922,7 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; 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; @@ -2732,6 +2936,7 @@ begin xc:=x0+(LargeurCell div 2); // x centre xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin + ep:=tco[x,y].epaisseurs; // mode rond x1:=x0-(largeurCell div 3);y1:=y0-2*hauteurCell-(hauteurCell div 2); x2:=xf+largeurCell+(largeurcell div 3);y2:=yc; @@ -2810,71 +3015,52 @@ end; // Elément 13 procedure dessin_13L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position : integer; +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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(x0,yc);lineto(xc,yc); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie horz couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xc,yc); // partie horz - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie basse toujours allumée - moveto(x0,yf);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,y0); + end; + + with canvas do + begin + if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + pen.color:=couleur; + moveto(x0,yf);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xf,y0); end; end; procedure trajet_devie; begin - if mode=0 then + couleur:=clvoies; + if mode>0 then + begin + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; + end; + with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; + pen.color:=couleur; moveto(x0,yf);lineto(xf,y0); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie inf en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(x0,yf); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yc);LineTo(xc,yc);LineTo(xf,y0); - end; end; - + begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -2936,7 +3122,7 @@ begin end; procedure dessin_13C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : tcolor; procedure trajet_droit; @@ -2954,7 +3140,11 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; with canvas do begin pen.color:=couleur; - moveto(x0,yf);lineto(xf,y0); // partie droite + if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + pen.color:=couleur; + moveto(xf,yf);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(x0,y0); end; end; @@ -3063,72 +3253,53 @@ end; // Element 14 procedure dessin_14l(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(x0,yc);lineto(xc,yc); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yc);lineto(xc,yc); // partie droite - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie basse toujours allumée - moveto(xf,yf);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(x0,y0); + 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 - if mode=0 then + couleur:=clvoies; + if mode>0 then + begin + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; + end; + with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; + pen.color:=couleur; moveto(x0,y0);lineto(xf,yf); // diag complete moveto(x0,yc);lineto(xc,yc); // partie droite end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie sup en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - moveto(xf,yf);LineTo(xc,yc);LineTo(x0,yc); - end; end; - - + + begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -3330,69 +3501,52 @@ begin end; -// Element 15 +// Element 15 fait procedure dessin_15L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position,ep : integer; fond : Tcolor; procedure trajet_droit; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(xc,yc);lineto(xf,yc); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);lineto(xf,yc); // partie droite - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie basse toujours allumée - moveto(x0,yf);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,y0); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(xc,yc);lineto(xf,yc); // partie droite + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie sup en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(xf,y0); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yf);LineTo(xc,yc);LineTo(xf,yc); + 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; @@ -3405,6 +3559,7 @@ begin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -3419,13 +3574,23 @@ begin Pen.Color:=clVoies; Pen.Mode:=pmCopy; - if (position=const_Devie) or (position=const_inconnu) then + if mode>0 then begin - trajet_devie; // affiche la position de la branche déviée - end; + 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 - if (position=const_droit) or (position=const_inconnu) then + else begin + trajet_devie; trajet_droit; end; @@ -3454,8 +3619,9 @@ begin end; end; +// fait procedure dessin_15C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : Tcolor; procedure trajet_droit; @@ -3473,7 +3639,11 @@ procedure trajet_droit; with canvas do begin pen.color:=couleur; - moveto(x0,yf);lineto(xf,y0); // partie droite + 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; @@ -3492,6 +3662,7 @@ procedure trajet_droit; 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; @@ -3513,16 +3684,12 @@ begin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; - + ep:=TCO[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; Pen.Color:=clVoies; Pen.Mode:=pmCopy; @@ -3582,14 +3749,15 @@ begin end; -// Element 16 +// Element 16 fait procedure dessin_16L(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -3606,14 +3774,14 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - Pen.width:=epaisseur; + 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); end; end; - +// fait procedure dessin_16C(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -3626,6 +3794,7 @@ begin x2:=x0+(largeurcell div 2);y2:=yf+hauteurcell+(hauteurCell div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3639,7 +3808,7 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - Pen.width:=epaisseur; + 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; @@ -3652,14 +3821,15 @@ begin end; -// Element 17 +// Element 17 fait procedure dessin_17l(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3670,17 +3840,17 @@ begin 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; - Pen.Width:=epaisseur; 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,y0);LineTo(xc,yc);LineTo(xc,y0+hauteurCell); end; end; -// Element 17 +// Element 17 fait procedure dessin_17c(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -3692,6 +3862,7 @@ begin x2:=xf+(2*largeurCell)+(largeurcell div 2);y2:=yf+hauteurcell+(hauteurCell div 3); x3:=xf;y3:=y0; x4:=xc;y4:=yf; + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3702,10 +3873,10 @@ begin 1: couleur:=ClCanton; 2: couleur:=couleurtrain[index_couleur]; end; - Pen.Width:=epaisseur; 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; @@ -3716,14 +3887,15 @@ begin if graphisme=2 then dessin_17C(Canvas,x,y,Mode); end; -// Elément 18 +// Elément 18 fait procedure dessin_18l(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3737,13 +3909,14 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - Pen.Width:=epaisseur; + if testbit(ep,1) or testbit(ep,6) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; MoveTo(x0,y0+hauteurCell);LineTo(xc,yc);LineTo(xc,y0); end; end; +// fait procedure dessin_18c(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -3755,6 +3928,7 @@ begin x2:=x0+(largeurcell div 2);y2:=yf+(hauteurCell div 3); x3:=x0;y3:=yf; x4:=xc;y4:=y0; + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3768,7 +3942,7 @@ begin Brush.Color:=clfond; pen.color:=Couleur; Pen.Mode:=pmCopy; - Pen.Width:=epaisseur; + 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; @@ -3780,13 +3954,15 @@ begin end; // Element 19 +// fait procedure dessin_19l(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc : integer; +var x0,y0,xc,yc,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurcell div 2); yc:=y0+(Hauteurcell div 2); + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3800,13 +3976,14 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - Pen.width:=epaisseur; + 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,y0+HauteurCell); end; end; +// fait procedure dessin_19c(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,xf,yf,ep : integer; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; @@ -3818,6 +3995,7 @@ begin x2:=xf+(2*largeurCell)+(largeurcell div 2);y2:=yf+(hauteurCell div 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; + ep:=tco[x,y].epaisseurs; with canvas do begin @@ -3832,7 +4010,7 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - Pen.width:=epaisseur; + 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; @@ -3844,15 +4022,16 @@ begin end; -// Element 20 +// Element 20 fait procedure dessin_20(Canvas : Tcanvas;x,y,mode: integer); -var jx1,jx2,x0,y0,xc,adr : integer; +var jx1,jx2,x0,y0,xc,adr,ep : integer; r : Trect; couleur : tcolor; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -3879,7 +4058,7 @@ begin jx1:=x0+(LargeurCell div 2)-round(6*frxGlob); // pos Y de la bande sup jx2:=x0+(LargeurCell div 2)+round(6*frxGlob); // pos Y de la bande inf if avecGrille then r:=Rect(jx1,y0+1,jx2,y0+HauteurCell-1) else - r:=Rect(jx1,y0,jx2,y0+HauteurCell) ; + r:=Rect(jx1,y0,jx2,y0+HauteurCell) ; FillRect(r); end; @@ -3892,21 +4071,45 @@ begin Brush.Color:=couleur; pen.color:=couleur; - //jx1:=y0+(HauteurCell div 2); - Pen.Width:=epaisseur; - + 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); end; end; -// Element 21 - croisement - TJD +// Element 21 - croisement - TJD fait procedure dessin_21(Canvas : Tcanvas;x,y,mode : integer); -var x0,y0,xc,yc,trajet : integer; +var x0,y0,xc,yc,xf,yf,trajet,ep : integer; + 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; + + begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(largeurCell div 2); yc:=y0+(hauteurCell div 2); + xf:=x0+largeurCell; + yf:=y0+HauteurCell; + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -3917,9 +4120,9 @@ begin Brush.Color:=clvoies; pen.color:=clvoies; - pen.width:=epaisseur; - moveTo(x0,y0+hauteurCell);LineTo(x0+LargeurCell,y0); // diagonale - moveTo(x0,yc);LineTo(x0+largeurCell,yc); // horizontale + + horizontale; + diagonale; // regarder d'ou on vient de la route du tco if mode>0 then @@ -3932,28 +4135,60 @@ begin end; Brush.Color:=couleur; pen.color:=couleur; - if trajet=1 then begin moveTo(x0,yc);LineTo(x0+largeurCell,yc);end; // horizontale - if trajet=2 then begin moveTo(x0,y0+hauteurCell);LineTo(x0+LargeurCell,y0);end; // diagonale + if trajet=1 then horizontale; // horizontale + if trajet=2 then diagonale; // diagonale if trajet=3 then begin - moveto(x0,y0+HauteurCell);LineTo(xc,yc);lineTo(x0+largeurCell,yc); + 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; if trajet=4 then begin - moveto(x0,yc);LineTo(xc,yc);lineTo(x0+largeurCell,y0); + 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); end; end; end; end; -// Element 22 +// Element 22 fait procedure dessin_22(Canvas : Tcanvas;x,y,mode : integer); -var x0,y0,xc,yc,trajet : integer; +var x0,y0,xc,yc,xf,yf,trajet,ep : integer; + + 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; + begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; xc:=x0+(LargeurCell div 2); yc:=y0+(hauteurCell div 2); + xf:=x0+largeurCell; + yf:=y0+HauteurCell; + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -3966,8 +4201,8 @@ begin pen.color:=clvoies; pen.width:=epaisseur; - moveto(x0,y0);lineTo(x0+largeurCell,y0+hauteurCell); // diagonale - moveTo(x0,yc);LineTo(x0+largeurCell,yc); // horizontale + diagonale; + horizontale; // regarder d'ou on vient de la route du tco if mode>0 then @@ -3980,17 +4215,22 @@ begin end; Brush.Color:=couleur; pen.color:=couleur; - if trajet=1 then begin moveTo(x0,yc);LineTo(x0+largeurCell,yc);end; // horizontale - if trajet=2 then begin moveto(x0,y0);lineTo(x0+largeurCell,y0+hauteurCell);end; // diagonale + if trajet=1 then horizontale; + if trajet=2 then diagonale; if trajet=3 then begin - moveto(x0,y0);LineTo(xc,yc);lineTo(x0+largeurCell,yc); + 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; if trajet=4 then begin - moveto(x0,yc);LineTo(xc,yc);lineTo(x0+largeurCell,y0+hauteurcell); + 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); end; - end; end; end; @@ -4022,75 +4262,56 @@ begin end; end; -// Element 24 +// Element 24 fait procedure dessin_24L(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,jx1,jy1,xf,yf,position : integer; +var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; r : Trect; fond: tcolor; - procedure trajet_droit; + procedure trajet_droit; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // partie droite - moveto(x0,y0);lineto(xc,yc); // partie déviée + if position=const_droit then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xc,yc); // partie déviée éteinte - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; + if testbit(ep,1) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; - Brush.Color:=couleur; - // 2eme partie droite toujours allumée - moveto(xc,yf);LineTo(xc,yc); - - // 1ere partie en fonction de la position - if position=const_devie then - begin - pen.color:=clvoies; - Brush.Color:=clvoies; - end; - LineTo(xc,y0); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // verticale complete - moveTo(x0,y0);lineto(xc,yc); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - // partie horz g en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,y0);LineTo(xc,yc);LineTo(xc,yf); // trajet déviée + 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; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -4099,6 +4320,7 @@ begin xf:=x0+largeurCell; // x fin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); + ep:=TCO[x,y].epaisseurs; fond:=TCO[x,y].CouleurFond; with canvas do @@ -4106,25 +4328,32 @@ begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; - //r:=Rect(x0,y0,xf,yf); - //FillRect(r); // efface la cellule Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; Pen.Mode:=pmCopy; - if (position=const_Devie) or (position=const_inconnu) then + if mode>0 then begin - trajet_devie; // affiche la position de la branche déviée - end; + 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 - if (position=const_droit) or (position=const_inconnu) then + else begin + trajet_devie; trajet_droit; end; - if (position=const_Devie) then begin // effacement du morceau @@ -4152,7 +4381,7 @@ end; // Element 24 procedure dessin_24C(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,jx1,jy1,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,jx1,jy1,xf,yf,x1,y1,x2,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond: tcolor; @@ -4171,7 +4400,10 @@ procedure trajet_droit; with canvas do begin pen.color:=couleur; - moveto(xc,y0);lineto(xc,yf); // partie droite + 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; @@ -4190,12 +4422,11 @@ procedure trajet_droit; 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; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -4205,24 +4436,20 @@ begin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=TCO[x,y].epaisseurs; // mode rond x1:=x0-(2*largeurCell)-(largeurcell div 2);y1:=y0-(hauteurCell div 3); x2:=x0+(largeurcell div 2);y2:=yf+hauteurcell+(hauteurCell div 3); x3:=xc;y3:=yf; x4:=x0;y4:=y0; - + with canvas do begin Pen.Width:=1; Brush.Color:=fond; Pen.Color:=Fond;; - { - pen.Width:=1; - pen.color:=clyellow; - moveto(x1,y1);lineTo(x2,y2); - ellipse(x1,y1,x2,y2); - } + Pen.Width:=epaisseur; Brush.Color:=clVoies; Pen.Color:=clVoies; @@ -4319,13 +4546,10 @@ begin begin moveto(xc,y0);LineTo(xc,yc);lineTo(x0,yf); // -\ end; - end; end; end; - - procedure dessin_24(Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_24L(Canvas,x,y,Mode); @@ -4378,76 +4602,55 @@ begin begin moveto(xc,y0);LineTo(xc,yc);lineTo(xf,yf); // -\ end; - end; end; end; // Element 26 procedure dessin_26L(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xc,yc,jx1,jy1,xf,yf,position : integer; +var x0,y0,xc,yc,jx1,jy1,xf,yf,position,ep : integer; r : Trect; fond: tcolor; procedure trajet_droit; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // partie droite - moveto(xf,y0);lineto(xc,yc); // partie déviée + if position=const_droit then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xf,y0);lineto(xc,yc); // partie déviée éteinte - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; + if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; - Brush.Color:=couleur; - // 2eme partie droite toujours allumée - moveto(xc,yf);LineTo(xc,yc); - - // 1ere partie en fonction de la position - if position=const_devie then - begin - pen.color:=clvoies; - Brush.Color:=clvoies; - end; - LineTo(xc,y0); + moveto(xc,y0);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xc,yf); end; end; procedure trajet_devie; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // verticale complete - moveTo(xf,y0);lineto(xc,yc); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - // partie horz d en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(xf,y0);LineTo(xc,yc);LineTo(xc,yf); // trajet déviée + moveto(xc,y0);lineto(xc,yf); // verticale complete + moveTo(xf,y0);lineto(xc,yc); // partie déviée end; end; @@ -4635,68 +4838,49 @@ end; // Element 27 procedure dessin_27L(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,jx2,jy2,jx3,jy3,xc,yc,jx1,jy1,xf,yf,position : 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // partie droite - moveto(x0,yf);lineto(xc,yc); // partie déviée + if position=const_droit then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xc,yc); // partie déviée éteinte - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; + if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; - Brush.Color:=couleur; - // 2eme partie droite toujours allumée - moveto(xc,y0);LineTo(xc,yc); - - // 1ere partie en fonction de la position - if position=const_devie then - begin - pen.color:=clvoies; - Brush.Color:=clvoies; - end; - LineTo(xc,yf); + moveto(xc,y0);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xc,yf); end; end; procedure trajet_devie; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // verticale complete - moveTo(x0,yf);lineto(xc,yc); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yf);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yf);LineTo(xc,yc);LineTo(xc,y0); // trajet déviée + moveto(xc,y0);lineto(xc,yf); // verticale complete + moveTo(x0,yf);lineto(xc,yc); // partie déviée end; end; @@ -4887,69 +5071,49 @@ end; // Element 28 procedure dessin_28L(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,jx2,jy2,jx3,jy3,xc,yc,jx1,jy1,xf,yf,position : 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // partie droite - moveto(xf,yf);lineto(xc,yc); // partie déviée + if position=const_droit then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xf,yf);lineto(xc,yc); // partie déviée éteinte - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; + if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; pen.color:=couleur; - Brush.Color:=couleur; - // 2eme partie droite toujours allumée - moveto(xc,y0);LineTo(xc,yc); - - // 1ere partie en fonction de la position - if position=const_devie then - begin - pen.color:=clvoies; - Brush.Color:=clvoies; - end; - LineTo(xc,yf); - + moveto(xc,y0);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xc,yf); end; end; procedure trajet_devie; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yf); // verticale complete - moveTo(xf,yf);lineto(xc,yc); // partie déviée + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then with canvas do begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yf);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(xf,yf);LineTo(xc,yc);LineTo(xc,y0); // trajet déviée + moveto(xc,y0);lineto(xc,yf); // verticale complete + moveTo(xf,yf);lineto(xc,yc); // partie déviée end; end; @@ -5139,70 +5303,52 @@ end; // Element 29 procedure dessin_29L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(xc,yc);lineto(xc,yf); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);lineto(xc,yf); // partie droite - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie haute toujours allumée - moveto(x0,y0);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,yf); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(xc,yc);lineto(xc,yf); // partie droite + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie sup en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(xf,yf); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,y0);LineTo(xc,yc);LineTo(xc,yf); + moveto(x0,y0);lineto(xf,yf); + moveto(xc,yc);lineto(xc,yf); end; end; + begin x0:=(x-1)*LargeurCell; // x origine y0:=(y-1)*HauteurCell; // y origine @@ -5390,70 +5536,52 @@ end; // Elément 32 procedure dessin_32L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,position : 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(xc,yf);lineto(xc,yc); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie horz couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yf);lineto(xc,yc); // partie déviée - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie basse toujours allumée - moveto(x0,yf);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,y0); + end; + + with canvas do + begin + if testbit(ep,7) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + pen.color:=couleur; + moveto(x0,yf);lineto(xc,yc); + if testbit(ep,3) then pen.Width:=epaisseur div 2 else pen.Width:=epaisseur; + lineto(xf,y0); end; end; procedure trajet_devie; begin - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(xc,yf);lineto(xc,yc); // partie droite + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(x0,yf); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(xc,yf);LineTo(xc,yc);LineTo(xf,y0); + moveto(x0,yf);lineto(xf,y0); + moveto(xc,yf);lineto(xc,yc); end; end; + begin x0:=(x-1)*LargeurCell; // x origine @@ -5516,9 +5644,9 @@ begin end; procedure dessin_32C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : 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; @@ -5534,7 +5662,10 @@ var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; with canvas do begin pen.color:=couleur; - moveto(x0,yf);lineto(xf,y0); // partie droite + if testbit(ep,7) 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,yf); end; end; @@ -5641,70 +5772,54 @@ begin if graphisme=2 then dessin_32C(Canvas,x,y,Mode); end; -// Element 34 +// Element 33 fait procedure dessin_33L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(xc,y0);lineto(xc,yc); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,y0);lineto(xc,yc); // partie droite - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie basse toujours allumée - moveto(xf,yf);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(x0,y0); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);lineto(xf,yf); // diag complete - moveto(xc,y0);lineto(xc,yc); // partie verticale + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie sup en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,y0);LineTo(xc,yc); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(xf,yf);LineTo(xc,yc);LineTo(xc,y0); + 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; @@ -5718,6 +5833,7 @@ begin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -5779,8 +5895,9 @@ begin end; end; +// fait procedure dessin_33c(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; r : Trect; fond : tcolor; @@ -5799,7 +5916,10 @@ procedure trajet_droit; with canvas do begin pen.color:=couleur; - moveto(x0,y0);lineto(xf,yf); // partie droite + 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; @@ -5818,6 +5938,7 @@ procedure trajet_droit; 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; @@ -5835,6 +5956,7 @@ begin x2:=xf+(2*largeurCell)+(largeurcell div 2);y2:=yf+(hauteurCell div 3); x3:=xc;y3:=y0; x4:=xf;y4:=yf; + ep:=TCO[x,y].epaisseurs; position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; @@ -5908,69 +6030,52 @@ begin if graphisme=2 then dessin_33C(Canvas,x,y,Mode); end; -// Element 34 +// Element 34 fait procedure dessin_34L(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(xc,yc);lineto(xc,y0); // partie droite - end; - if (mode=1) or (mode=2) then - with canvas do - begin - // partie droite couleur voies - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);lineto(xc,y0); // partie droite - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; - pen.color:=couleur; - Brush.Color:=couleur; - // première partie basse toujours allumée - moveto(x0,yf);LineTo(xc,yc); - - // 2eme partie en fonction de la position - if position=const_devie then + if position=const_droit then begin - pen.color:=clvoies; - Brush.Color:=clvoies; + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; end; - LineTo(xf,y0); + 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 - if mode=0 then - with canvas do + couleur:=clvoies; + if mode>0 then begin - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(x0,yf);lineto(xf,y0); // diag complete - moveto(xc,yc);lineto(xc,y0); // partie droite + if position=const_devie then + begin + if mode=1 then couleur:=clcanton; + if mode=2 then couleur:=couleurtrain[index_couleur]; + end; end; - if (mode=1) or (mode=2) then + with canvas do begin - // partie sup en couleur de voie - pen.color:=clvoies; - Brush.Color:=clvoies; - moveto(xc,yc);LineTo(xf,y0); - - if mode=1 then couleur:=ClCanton; - if mode=2 then couleur:=couleurtrain[index_couleur]; pen.color:=couleur; - Brush.Color:=couleur; - moveto(x0,yf);LineTo(xc,yc);LineTo(xc,y0); + 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; @@ -5983,6 +6088,7 @@ begin yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -6033,8 +6139,9 @@ begin end; end; +//fait procedure dessin_34C(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position,ep : integer; fond : Tcolor; procedure trajet_droit; @@ -6052,7 +6159,10 @@ procedure trajet_droit; with canvas do begin pen.color:=couleur; - moveto(x0,yf);lineto(xf,y0); // partie droite + 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; @@ -6071,6 +6181,7 @@ procedure trajet_droit; 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; @@ -6091,6 +6202,7 @@ begin position:=positionTCO(x,y); fond:=TCO[x,y].CouleurFond; + ep:=TCO[x,y].epaisseurs; with canvas do begin @@ -6737,29 +6849,9 @@ begin style:=fs; end; -// affiche la cellule x et y en cases -// index est utilisé pour accéder au tableau du tracé de la fonction zone_tco -procedure affiche_cellule(x,y : integer); -var i,index,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied : integer; - inverse : boolean; - s : string; +// dessine l'icone n° Bimage dans le canvas PcanvasTCO, aux coordonnées cellules x,y en mode +procedure dessine_icone(PCanvasTCO : tcanvas;Bimage,X,Y,mode : integer); begin - //if tco[x,y].BImage=0 then exit; - //Affiche('Affiche_cellule',clLime); - PcanvasTCO.pen.Mode:=PmCopy; - //pcanvasTCO.Brush.Style:=BsClear; - adresse:=tco[x,y].Adresse; - BImage:=tco[x,y].BImage; - mode:=tco[x,y].mode; - repr:=tco[x,y].repr; - - Xorg:=(x-1)*LargeurCell; - Yorg:=(y-1)*HauteurCell; - - // ------------- affichage de l'adresse ------------------ - s:=IntToSTR(adresse); - - // affiche d'abord l'icone de la cellule et colore la voie si zone ou détecteur actionnée selon valeur mode case Bimage of // 0 : efface_cellule(PCanvasTCO,x,y,pmcopy); 1 : dessin_voie(PCanvasTCO,X,Y,mode); @@ -6797,7 +6889,33 @@ begin 50 : dessin_Signal(PCanvasTCO,X,Y); 51 : dessin_51(PCanvasTCO,X,Y,mode); - end; + 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(x,y : integer); +var i,index,repr,Xorg,Yorg,xt,yt,mode,adresse,Bimage,aspect,oriente,pied : integer; + inverse : boolean; + s : string; +begin + //if tco[x,y].BImage=0 then exit; + //Affiche('Affiche_cellule',clLime); + PcanvasTCO.pen.Mode:=PmCopy; + //pcanvasTCO.Brush.Style:=BsClear; + adresse:=tco[x,y].Adresse; + BImage:=tco[x,y].BImage; + mode:=tco[x,y].mode; + repr:=tco[x,y].repr; + + Xorg:=(x-1)*LargeurCell; + Yorg:=(y-1)*HauteurCell; + + // ------------- affichage de l'adresse ------------------ + s:=IntToSTR(adresse); + + // affiche d'abord l'icone de la cellule et colore la voie si zone ou détecteur actionnée selon valeur mode + dessine_icone(PCanvasTCO,Bimage,X,Y,mode); PCanvasTCO.font.Size:=(LargeurCell div 10)+4 ; //Affiche(intToSTR( (LargeurCell div 30)+6),clyellow); @@ -6917,7 +7035,7 @@ begin end; // adresse des signaux - if (BImage=50) and (adresse<>0) then + if (BImage=Id_signal) and (adresse<>0) then begin index:=Index_Signal(adresse); aspect:=feux[index].Aspect; @@ -7032,7 +7150,7 @@ begin end; procedure affiche_texte(x,y : integer); -var x0,y0,yt,repr : integer; +var x0,y0,yt,repr,taillefont : integer; ss,s : string; begin x0:=(x-1)*Largeurcell; @@ -7050,15 +7168,15 @@ begin PcanvasTCO.Font.Style:=style(ss); repr:=tco[x,y].repr; - taillefonte:=tco[x,y].TailleFonte; + taillefont:=tco[x,y].TailleFonte; case repr of - 0,1 : yt:=(HauteurCell div 2)-round(tailleFonte*fryGlob); // milieu + 0,1 : yt:=(HauteurCell div 2)-round(tailleFont*fryGlob); // milieu 2 : yt:=1; // haut - 3 : yt:=HauteurCell-round(2*TailleFonte*frYGlob); // bas + 3 : yt:=HauteurCell-round(2*TailleFont*frYGlob); // bas end; - if taillefonte=0 then taillefonte:=8; - PCanvasTCO.font.Size:=(taillefonte*LargeurCell) div 40; + if taillefont=0 then taillefont:=8; + PCanvasTCO.font.Size:=(taillefont*LargeurCell) div 40; s:=tco[x,y].Texte+' '; PcanvasTCO.Textout(x0+2,y0+yt,s); @@ -7084,9 +7202,6 @@ begin PBitMapTCO.Height:=DimY; PBitMapTCO.Width:=DimX; - - //PScrollBoxTCO.HorzScrollBar.Range:=DimX; - //PScrollBoxTCO. with formTCO.ScrollBox do begin HorzScrollBar.Range:=DimX; @@ -7104,6 +7219,7 @@ begin //Affiche(formatfloat('0.000000',frxGlob),clyellow); //effacer tout + with PcanvasTCO do begin Pen.width:=1; @@ -7136,7 +7252,7 @@ begin for y:=1 to NbreCellY do for x:=1 to NbreCellX do begin - if TCO[x,y].BImage=50 then + if TCO[x,y].BImage=Id_signal then begin affiche_cellule(x,y); end; @@ -7149,6 +7265,7 @@ begin begin Entoure_cell(Xentoure,Yentoure); end; + end; procedure grise_ligne_tco; @@ -7994,11 +8111,12 @@ begin end; end; -procedure dessine_icone(ip : timage;lbl : tlabel;i : integer); +// dessine l'icone d'image ip et la place en x y d'après son index +procedure positionne_icone(ip : timage;lbl : tlabel;i : integer); const NbElLi=12; var s : string; begin - if i=50 then i:=35; // pour affichage en XY + if i=Id_signal then i:=35; // pour affichage en XY if i=51 then i:=36; if ip<>nil then begin @@ -8044,25 +8162,25 @@ begin begin ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; - dessine_icone(ip,lbl,i); + positionne_icone(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; - dessine_icone(ip,lbl,i); + positionne_icone(ip,lbl,i); end; - i:=50; + i:=Id_signal; ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; - dessine_icone(ip,lbl,i); + positionne_icone(ip,lbl,i); i:=51; ip:=findComponent('ImagePalette'+intToSTR(i)) as Timage; lbl:=findComponent('Label'+intToSTR(i)) as Tlabel; - dessine_icone(ip,lbl,i); + positionne_icone(ip,lbl,i); // signal ip:=findComponent('ImagePalette51') as Timage; @@ -8154,7 +8272,6 @@ begin ButtonSimu.Visible:=not(Diffusion); ImageTemp.Visible:=not(Diffusion); ImageTemp2.Visible:=not(Diffusion); - ButtonTrajet.visible:=not(diffusion); SourisX.Visible:=not(Diffusion); SourisY.Visible:=not(Diffusion); ButtonAfficheBandeau.visible:=false; @@ -8243,6 +8360,9 @@ begin ScrollBox.Height:=ClientHeight-Panel1.Height-30; end; end; + + //scrollBox.Width:=800; + TCOActive:=true; end; @@ -8254,7 +8374,7 @@ var res,verif : boolean; begin result:=true; verif:=false; - if (bim>=50) or (AvecVerifIconesTCO=0) then exit; + if (bim>=Id_signal) or (AvecVerifIconesTCO=0) then exit; //exit; res:=true; bl:=liaisons[Bim]; @@ -8414,7 +8534,7 @@ begin if (xPlace<=NbreCellX) and (yPlace<=NbreCellY) then begin tco[xPlace,yPlace]:=tamponTCO[x,y]; - if tco[xPlace,yPlace].Bimage=50 then + if tco[xPlace,yPlace].Bimage=Id_signal then begin adresse:=tco[xPlace,yPlace].Adresse; end; @@ -10038,7 +10158,7 @@ var r : Trect; begin if affevt then Affiche('ImageTCOMouseMove',clLime); if dbleClicTCO then begin dbleClicTCO:=false;exit;end; - if Temposouris>0 then begin exit;end; + if Temposouris>0 then exit; // Affiche('*',cllime); SourisX.Caption:=IntToSTR(x); SourisY.Caption:=IntToSTR(y); @@ -10197,7 +10317,7 @@ begin tco_Modifie:=true; // si signal - if tco[XClicCell,YClicCell].BImage=50 then + if tco[XClicCell,YClicCell].BImage=Id_signal then begin index:=Index_Signal(adr); if index=0 then exit @@ -10326,7 +10446,7 @@ begin stocke_undo(1,XClicCell,YClicCell); maj_undo(1); efface_cellule(ImageTCO.Canvas,XclicCell,YClicCell,PmCopy); - tco[XClicCell,YClicCell].BImage:=50; + tco[XClicCell,YClicCell].BImage:=Id_signal; tco[XClicCell,YClicCell].liaisons:=0; tco[XClicCell,YClicCell].Adresse:=0; tco[XClicCell,YClicCell].FeuOriente:=1; @@ -10618,7 +10738,8 @@ begin // double clic sur détecteur : inversion if ((Bimage=1) or (Bimage=20) or (Bimage=10) or (Bimage=11)) and (adresse<>0) then begin - detecteur[adresse].etat:=not(detecteur[adresse].etat); + if EvtClicDet then event_detecteur(adresse,not(detecteur[adresse].etat),'') + else detecteur[adresse].etat:=not(detecteur[adresse].etat); Affiche_tco; end; @@ -10651,7 +10772,7 @@ begin end; // commande de signal - if Bimage=50 then + if Bimage=Id_signal then begin AdrPilote:=adresse; i:=Index_Signal(adresse); @@ -11055,7 +11176,7 @@ end; procedure signalD; begin if actualize then exit; - if TCO[XClicCell,YClicCell].Bimage=50 then + if TCO[XClicCell,YClicCell].Bimage=Id_signal then begin TCO[XClicCell,YClicCell].PiedFeu:=2; Affiche_TCO; @@ -11072,7 +11193,7 @@ end; procedure signalG; begin if actualize then exit; - if TCO[XClicCell,YClicCell].Bimage=50 then + if TCO[XClicCell,YClicCell].Bimage=Id_signal then begin TCO[XClicCell,YClicCell].PiedFeu:=1; Affiche_TCO; @@ -11090,7 +11211,6 @@ procedure TFormTCO.PopupMenu1Popup(Sender: TObject); var oriente,piedFeu : integer; begin if affevt then Affiche('on popup',clyellow); - // if modetrace then Abort; PopUpMenu1.Items[9][0].Caption:='Ligne au dessus de la '+intToSTR(YclicCell); PopUpMenu1.Items[9][1].Caption:='Ligne en dessous de la '+intToSTR(YclicCell); PopUpMenu1.Items[9][3].Caption:='Colonne à gauche de la '+intToSTR(XclicCell); @@ -11100,7 +11220,7 @@ begin PopUpMenu1.Items[10][1].Caption:='Colonne '+intToSTR(XclicCell); // grise ou non l'entrée signal du menu - if tco[XClicCell,YClicCell].Bimage=50 then + if tco[XClicCell,YClicCell].Bimage=Id_signal then begin PopUpMenu1.Items[6].Enabled:=true; oriente:=tco[XClicCell,YClicCell].Feuoriente; @@ -11152,9 +11272,9 @@ end; begin if NbreCellY>=MaxCellY then exit; TamponAffecte:=false; - SetLength(TCO,NbreCellX+1,NbreCellY+2); // ajoute une ligne en Y - SetLength(TamponTCO,NbreCellX+1,NbreCellY+2); - + SetLength(TCO,NbreCellX+2,NbreCellY+3); // ajoute une ligne en Y + SetLength(TamponTCO,NbreCellX+2,NbreCellY+3); + for y:=NbreCellY-1 downto YClicCell do begin for x:=1 to NbreCellX do @@ -11183,8 +11303,8 @@ var x,y : integer; begin if NbreCellY>=MaxCellY then exit; TamponAffecte:=false; - SetLength(TCO,NbreCellX+1,NbreCellY+2); // ajoute une ligne en Y - SetLength(TamponTCO,NbreCellX+1,NbreCellY+2); // ajoute une ligne en Y + SetLength(TCO,NbreCellX+2,NbreCellY+3); // ajoute une ligne en Y + SetLength(TamponTCO,NbreCellX+2,NbreCellY+3); // ajoute une ligne en Y for y:=NbreCellY downto YClicCell+1 do begin @@ -11245,9 +11365,9 @@ begin tco[x,NbreCellY].FeuOriente:=0; end; dec(NbreCellY); - SetLength(TCO,NbreCellX+1,NbreCellY+1); // ajuste la taille du tableau - SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); // ajoute une ligne en Y - + SetLength(TCO,NbreCellX+2,NbreCellY+2); // ajuste la taille du tableau + SetLength(TamponTCO,NbreCellX+2,NbreCellY+2); // ajoute une ligne en Y + affiche_TCO; end; @@ -11256,9 +11376,9 @@ procedure TFormTCO.Colonnegauche1Click(Sender: TObject); begin if NbreCellX>=MaxCellX then exit; TamponAffecte:=false; - SetLength(TCO,NbreCellX+2,NbreCellY+1); // ajoute taille X - SetLength(TamponTCO,NbreCellX+2,NbreCellY+1); - + SetLength(TCO,NbreCellX+3,NbreCellY+2); // ajoute taille X + SetLength(TamponTCO,NbreCellX+3,NbreCellY+2); + for x:=NbreCellX downto XClicCell do begin for y:=1 to NbreCellY do tco[x+1,y]:=tco[x,y]; @@ -11284,9 +11404,9 @@ procedure TFormTCO.Colonnedroite1Click(Sender: TObject); begin if NbreCellX>=MaxCellX then exit; TamponAffecte:=false; - SetLength(TCO,NbreCellX+2,NbreCellY+1); // ajoute taille X - SetLength(TamponTCO,NbreCellX+2,NbreCellY+1); // ajoute taille X - + SetLength(TCO,NbreCellX+3,NbreCellY+2); // ajoute taille X + SetLength(TamponTCO,NbreCellX+3,NbreCellY+2); // ajoute taille X + for x:=NbreCellX downto XClicCell+1 do begin for y:=1 to NbreCellY do tco[x+1,y]:=tco[x,y]; @@ -11347,8 +11467,8 @@ begin tco[NbreCellx,y].FeuOriente:=0; end; dec(NbreCellX); - SetLength(TCO,NbreCellX+1,NbreCellY+1); // ajuste taille - SetLength(TamponTCO,NbreCellX+1,NbreCellY+1); // ajuste taille + SetLength(TCO,NbreCellX+2,NbreCellY+2); // ajuste taille + SetLength(TamponTCO,NbreCellX+2,NbreCellY+2); // ajuste taille affiche_TCO; end; @@ -11548,25 +11668,6 @@ begin defocusControl(buttonDessiner,true); end; -procedure TFormTCO.ButtonTrajetClick(Sender: TObject); -var c : Tcanvas; -begin - c:=FormTCO.ImageTCO.canvas; - //efface_cellule(c,5,1,pmcopy); - TCO[5,1].Adresse:=1;dessin_2(c,5,1,1); - TCO[7,1].Adresse:=1;dessin_3(c,7,1,1); - TCO[9,1].Adresse:=1;dessin_4(c,9,1,1); - TCO[11,1].Adresse:=1;dessin_5(c,11,1,1); - TCO[5,3].Adresse:=1;dessin_12(c,5,3,1); - TCO[7,3].Adresse:=1;dessin_13(c,7,3,1); - TCO[9,3].Adresse:=1;dessin_14(c,9,3,1); - TCO[11,3].Adresse:=1;dessin_15(c,11,3,1); - TCO[5,5].Adresse:=1;dessin_24(c,5,5,1); - - -end; - - procedure TFormTCO.ImagePalette26DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); @@ -11881,4 +11982,6 @@ begin auto_tcurs:=false; end; + + end. diff --git a/Unitplace.pas b/Unitplace.pas index 94779c1..bfb707c 100644 --- a/Unitplace.pas +++ b/Unitplace.pas @@ -174,12 +174,14 @@ begin if (prec<9990) then begin inc(it); - + { detecteur[detect].etat:=true; detecteur[detect].AdrTrain:=trains[i].adresse; detecteur[detect].train:=placement[i].train; detecteur[detect].IndexTrain:=i; + + MemZone[prec,detect].etat:=true; MemZone[prec,detect].train:=placement[i].train; MemZone[prec,detect].Adrtrain:=trains[i].adresse; @@ -192,9 +194,16 @@ begin event_det_train[it].det[1].etat:=false; event_det_train[it].nom_train:=placement[i].train; + inc(N_trains); + } + // essai------------------------- + Event_Detecteur(detect,true,nomtrain); + detecteur[detect].AdrTrain:=trains[i].adresse; + // ----------------------------- + Affiche('Positionnement train '+detecteur[detect].train+' sur détecteur '+intToSTR(detect)+' vers '+Ssuiv,clLime); - inc(N_trains); + end else begin @@ -342,7 +351,7 @@ begin end; trouve:=false; - // explorer les détecteurs pour lancer les trains + // explorer les détecteurs pour lancer les trains si le détecteur est affecté à un train for i:=1 to NDetecteurs do begin adrDet:=Adresse_detecteur[i]; @@ -365,7 +374,7 @@ begin if not(rouge) then begin j:=index_train_adresse(AdrTrain); - vitesse_loco('',adrTrain,trains[j].VitNominale,not(placement[j].inverse)); + vitesse_loco('',adrTrain,j,trains[j].VitNominale,not(placement[j].inverse),true); maj_feux(true); // avec détecteurs s:='Lancement du train '+detecteur[adrDet].train+' depuis détecteur '+intToSTR(adrDet); @@ -398,7 +407,7 @@ begin Affiche('Arrêt du roulage de tous les trains',clorange); Formprinc.LabelTitre.caption:=titre+' '; for i:=1 to ntrains do - vitesse_loco('',trains[i].adresse,0,true); + vitesse_loco('',i,trains[i].adresse,0,true,true); end; procedure TFormPlace.CheckInverse1Click(Sender: TObject); @@ -534,7 +543,7 @@ begin Affiche('Arrêt du roulage de tous les trains et libération des aiguillages',clorange); Formprinc.LabelTitre.caption:=titre+' '; for i:=1 to ntrains do - vitesse_loco('',trains[i].adresse,0,true); + vitesse_loco('',i,trains[i].adresse,0,true,true); raz_tout; end; diff --git a/tco.cfg b/tco.cfg index ac2255b..158b0e4 100644 --- a/tco.cfg +++ b/tco.cfg @@ -1,4 +1,4 @@ -/ Définitions TCO version 7.1 +/ Définitions TCO version 7.11 CoulFond=202050 CoulVoies=0077FF CoulAllume=00FFFF @@ -10,9 +10,8 @@ CoulCanton=00FFFF ModeCouleurCanton=1 AvecGrille=0 Graphisme=2 -/ Taille de la matrice x,y +EvtClicDet=1 Matrice=39,13 -/ Ratio d'affichage celluleX/CelluleY Ratio=10 /Matrice TCO [Matrice] diff --git a/verif_version.dcu b/verif_version.dcu deleted file mode 100644 index fc0034f..0000000 Binary files a/verif_version.dcu and /dev/null differ diff --git a/verif_version.pas b/verif_version.pas index 3420470..8cbee78 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -24,7 +24,7 @@ var Lance_verif : integer; verifVersion,notificationVersion : boolean; -Const Version='7.1'; // sert à la comparaison de la version publiée +Const Version='7.2'; // sert à la comparaison de la version publiée SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace function GetCurrentProcessEnvVar(const VariableName: string): string; diff --git a/versions.txt b/versions.txt index 35d56cd..b0839e4 100644 --- a/versions.txt +++ b/versions.txt @@ -174,7 +174,13 @@ version 6.4 : Gestion des signaux belges (avec chevron et r version 7.0 : Possibilité de créer des décodeurs spécifiques de signaux. Affichage du feu blanc sur les signaux sur position spécifique d'aiguillages. version 7.1 : Nouveaux éléments graphiques pour le TCO. - +version 7.11 : Renvoi de la consigne de vitesse au trains après 1s en mode roulage. + Correction d'un bug sur le verrouillage au carré des signaux. + Possibilité de générer des évènements détecteurs depuis le TCO. +version 7.2 : Possibilité de dessiner des voies fines et épaisses dans le TCO + par exemple pour distinguer les voies principales et les bretelles. + +