diff --git a/Notice d'utilisation des signaux_complexes_GL_V4.8.pdf b/Notice d'utilisation des signaux_complexes_GL_V4.8.pdf index 9d2e340..0431e4f 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V4.8.pdf and b/Notice d'utilisation des signaux_complexes_GL_V4.8.pdf differ diff --git a/UnitConfig.dcu b/UnitConfig.dcu index 7ac1274..3cd185b 100644 Binary files a/UnitConfig.dcu and b/UnitConfig.dcu differ diff --git a/UnitConfig.dfm b/UnitConfig.dfm index 6e3a558..c9ad23d 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -1,11 +1,11 @@ object FormConfig: TFormConfig - Left = 281 - Top = 138 + Left = 218 + Top = 143 Hint = 'Modifie la configuration selon les s'#233'lections choisies' BorderStyle = bsDialog Caption = 'Configuration g'#233'n'#233'rale' - ClientHeight = 543 - ClientWidth = 902 + ClientHeight = 552 + ClientWidth = 901 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -1521,22 +1521,22 @@ object FormConfig: TFormConfig Visible = False end object Label19: TLabel - Left = 104 - Top = 104 + Left = 808 + Top = 96 Width = 75 Height = 13 Caption = 'Element suivant' end object Label10: TLabel - Left = 80 - Top = 120 + Left = 792 + Top = 104 Width = 105 Height = 13 Caption = 'Verrouillable au carr'#233' :' end object Label29: TLabel - Left = 144 - Top = 68 + Left = 856 + Top = 76 Width = 6 Height = 13 Caption = #224 @@ -1551,9 +1551,20 @@ object FormConfig: TFormConfig 'ouche ENTREE apr'#232's leur introduction/modification' WordWrap = True end + object Label40: TLabel + Left = 656 + Top = 496 + Width = 222 + Height = 39 + Caption = + 'Les actionneurs ne sont utilisables qu'#39'en mode RUN avec CDM Rail' + + '. Les d'#233'tecteurs sont utilisables en mode autonome.' + Visible = False + WordWrap = True + end object ButtonAppliquerEtFermer: TButton Left = 240 - Top = 512 + Top = 520 Width = 201 Height = 25 Hint = 'Enregistre la configuration et ferme la fen'#234'tre' @@ -1565,7 +1576,7 @@ object FormConfig: TFormConfig end object Button2: TButton Left = 8 - Top = 512 + Top = 520 Width = 201 Height = 25 Hint = 'Ferme la fen'#234'tre sans enregistrer la configuration' @@ -1579,7 +1590,7 @@ object FormConfig: TFormConfig Left = 8 Top = 8 Width = 633 - Height = 497 + Height = 505 ActivePage = TabSheetSig Font.Charset = DEFAULT_CHARSET Font.Color = clBlack @@ -3082,7 +3093,7 @@ object FormConfig: TFormConfig end object CheckVerrouCarre: TCheckBox Left = 120 - Top = 232 + Top = 216 Width = 145 Height = 17 Hint = @@ -3147,7 +3158,7 @@ object FormConfig: TFormConfig end object CheckBoxFB: TCheckBox Left = 120 - Top = 256 + Top = 264 Width = 153 Height = 17 Caption = 'Avec demande feu blanc' @@ -3164,6 +3175,30 @@ object FormConfig: TFormConfig Visible = False OnClick = ButtonConfigSRClick end + object CheckFVC: TCheckBox + Left = 120 + Top = 232 + Width = 145 + Height = 17 + Hint = 'Remplace le feu vert par un feu vert clignotant' + Caption = 'Feu vert clignotant' + ParentShowHint = False + ShowHint = True + TabOrder = 17 + OnClick = CheckFVCClick + end + object CheckFRC: TCheckBox + Left = 120 + Top = 248 + Width = 145 + Height = 17 + Hint = 'Remplace le s'#233'maphore par un feu rouge clignotant' + Caption = 'Feu rouge clignotant' + ParentShowHint = False + ShowHint = True + TabOrder = 18 + OnClick = CheckFRCClick + end end object RichSig: TRichEdit Left = 0 @@ -3233,17 +3268,6 @@ object FormConfig: TFormConfig TabOrder = 6 OnChange = EditTempoFeuChange end - object CheckBoxFVR: TCheckBox - Left = 0 - Top = 416 - Width = 281 - Height = 17 - Hint = 'Le changement de cette option n'#233'cessite un red'#233'marrage' - Caption = 'Gestion feux verts et s'#233'maphore clignotants' - ParentShowHint = False - ShowHint = True - TabOrder = 7 - end end object TabSheetAct: TTabSheet Caption = 'Actionneurs/D'#233'tecteurs' @@ -3264,21 +3288,11 @@ object FormConfig: TFormConfig Height = 441 Caption = 'Description de l'#39'action' TabOrder = 0 - object Label40: TLabel - Left = 16 - Top = 384 - Width = 222 - Height = 39 - Caption = - 'Les actionneurs ne sont utilisables qu'#39'en mode RUN avec CDM Rail' + - '. Les d'#233'tecteurs sont utilisables en mode autonome.' - WordWrap = True - end object GroupBoxPN: TGroupBox - Left = 8 - Top = 16 + Left = 0 + Top = 24 Width = 233 - Height = 353 + Height = 401 Caption = 'Action gestion passage '#224' niveau' ParentShowHint = False ShowHint = False @@ -3683,8 +3697,8 @@ object FormConfig: TFormConfig end end object GroupBoxRadio: TGroupBox - Left = 16 - Top = 128 + Left = 8 + Top = 16 Width = 225 Height = 73 Caption = 'Type d'#39'action' @@ -3719,21 +3733,21 @@ object FormConfig: TFormConfig end object GroupBoxAct: TGroupBox Left = 8 - Top = 148 - Width = 225 - Height = 293 + Top = 84 + Width = 233 + Height = 341 Caption = 'Action fonction de locomotive ' TabOrder = 1 object GroupBox18: TGroupBox Left = 8 Top = 16 - Width = 209 - Height = 137 + Width = 217 + Height = 153 Caption = 'D'#233'clencheur ' TabOrder = 0 object LabelActionneur: TLabel Left = 8 - Top = 80 + Top = 96 Width = 54 Height = 26 Caption = 'Actionneur D'#233'tecteurZ' @@ -3741,21 +3755,21 @@ object FormConfig: TFormConfig end object Label30: TLabel Left = 168 - Top = 88 + Top = 104 Width = 6 Height = 13 Caption = #224 end object LabelTrain: TLabel Left = 16 - Top = 110 + Top = 126 Width = 49 Height = 13 Caption = 'Train D'#233'cl' end object EditAct: TEdit Left = 72 - Top = 84 + Top = 100 Width = 41 Height = 21 ParentShowHint = False @@ -3765,7 +3779,7 @@ object FormConfig: TFormConfig end object EditEtatActionneur: TEdit Left = 184 - Top = 84 + Top = 100 Width = 17 Height = 21 TabOrder = 1 @@ -3773,7 +3787,7 @@ object FormConfig: TFormConfig end object EditTrainDecl: TEdit Left = 72 - Top = 108 + Top = 124 Width = 129 Height = 21 Hint = @@ -3788,7 +3802,7 @@ object FormConfig: TFormConfig Left = 8 Top = 16 Width = 193 - Height = 57 + Height = 73 Caption = 'Type de d'#233'clenchement' TabOrder = 3 end @@ -3812,18 +3826,27 @@ object FormConfig: TFormConfig end object EditAct2: TEdit Left = 120 - Top = 84 + Top = 100 Width = 41 Height = 21 TabOrder = 6 OnChange = EditAct2Change end + object RadioButtonAig: TRadioButton + Left = 32 + Top = 64 + Width = 145 + Height = 17 + Caption = 'Ev'#232'nement aiguillage' + TabOrder = 7 + OnClick = RadioButtonAigClick + end end object GroupBox19: TGroupBox Left = 8 - Top = 160 - Width = 209 - Height = 113 + Top = 176 + Width = 217 + Height = 129 Caption = 'Destinataire de l'#39'action ' TabOrder = 1 object LabelTempo: TLabel @@ -3859,7 +3882,7 @@ object FormConfig: TFormConfig end object SpeedButtonJoue: TSpeedButton Left = 56 - Top = 80 + Top = 88 Width = 41 Height = 33 Hint = 'Joue le son' @@ -3882,7 +3905,7 @@ object FormConfig: TFormConfig end object SpeedButtonCharger: TSpeedButton Left = 120 - Top = 80 + Top = 88 Width = 25 Height = 34 Hint = 'Ouvre un fichier son WAV' @@ -3963,7 +3986,7 @@ object FormConfig: TFormConfig end object CheckRAZ: TCheckBox Left = 32 - Top = 40 + Top = 48 Width = 145 Height = 17 Caption = 'Remise '#224' 0 apr'#232's pilotage' @@ -4011,7 +4034,7 @@ object FormConfig: TFormConfig end object ButtonTestAct: TButton Left = 64 - Top = 266 + Top = 306 Width = 89 Height = 20 Hint = 'Test de l'#39'actionneur/d'#233'tecteur en mode RUN' @@ -4072,7 +4095,7 @@ object FormConfig: TFormConfig end object GroupBox17: TGroupBox Left = 0 - Top = 232 + Top = 224 Width = 345 Height = 193 Caption = 'Actionneurs passage '#224' niveau' @@ -4121,7 +4144,7 @@ object FormConfig: TFormConfig end object ButtonEnregistre: TButton Left = 472 - Top = 512 + Top = 520 Width = 169 Height = 25 Hint = 'Enregistre la configuration sans fermer la fen'#234'tre' diff --git a/UnitConfig.pas b/UnitConfig.pas index 6b27298..9b98980 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -219,7 +219,6 @@ type Label39: TLabel; EditV4F: TEdit; EditV4O: TEdit; - Label40: TLabel; Label41: TLabel; EditFonte: TEdit; ComboBoxDD: TComboBox; @@ -286,7 +285,10 @@ type Button1: TButton; Button3: TButton; CheckPnPulse: TCheckBox; - CheckBoxFVR: TCheckBox; + CheckFVC: TCheckBox; + CheckFRC: TCheckBox; + Label40: TLabel; + RadioButtonAig: TRadioButton; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -412,6 +414,9 @@ type procedure Button1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure CheckPnPulseClick(Sender: TObject); + procedure CheckFVCClick(Sender: TObject); + procedure CheckFRCClick(Sender: TObject); + procedure RadioButtonAigClick(Sender: TObject); private { Déclarations privées } public @@ -447,7 +452,6 @@ NOTIF_VERSION_ch='NOTIF_VERSION'; verif_version_ch='verif_version'; Fonte_ch='Fonte'; Raz_signaux_ch='RazSignaux'; -AvecFVR_ch='FeuxVertRougeCli'; // sections de config section_aig_ch='[section_aig]'; @@ -841,6 +845,11 @@ begin //verrouillage au carré if feux[i].verrouCarre then s:=s+'1' else s:=s+'0'; + // feu vert cli + if feux[i].checkFV then s:=s+',FVC1' else s:=s+',FVC0'; + // feu rouge cli + if feux[i].checkFR then s:=s+',FRC1' else s:=s+',FRC0'; + // si unsemaf, paramètre supplémentaire if feux[i].decodeur=6 then s:=s+',U'+intToSTR(feux[i].unisemaf); @@ -1049,6 +1058,19 @@ begin if length(s)=0 then begin Affiche('Erreur 679: fichier de configuration ligne erronnée : '+chaine_signal,clred); closefile(fichier);exit;end; feux[i].VerrouCarre:=s[1]='1'; delete(s,1,1); + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if copy(s,1,3)='FVC' then + begin + delete(s,1,3); + if length(s)>0 then begin feux[i].checkFV:=s[1]='1';delete(s,1,1);end; + end; + if length(s)>0 then if s[1]=',' then delete(s,1,1); + if copy(s,1,3)='FRC' then + begin + delete(s,1,3); + if length(s)>0 then begin feux[i].checkFR:=s[1]='1';delete(s,1,1);end; + end; + if length(s)>0 then if s[1]=',' then delete(s,1,1); if length(s)>0 then if s[1]='U' then delete(s,1,1); @@ -1141,18 +1163,24 @@ var s : string; begin // adresse adresse:=Tablo_Actionneur[i].adresse; - - if Tablo_Actionneur[i].typActMemZone=0 then + // type actionneur + case Tablo_Actionneur[i].typdeclenche of + 0 : begin s:=IntToSTR(adresse); if tablo_actionneur[i].det then s:=s+'Z'; - end - else + end; + // type mémoire de zone + 1 : begin s:='Mem['+IntToSTR(adresse)+','+IntToSTR(Tablo_Actionneur[i].adresse2)+']'; end; - - + // type aiguillage + 2 : + begin + s:='A'+IntToSTR(adresse); + end; + end; if Tablo_Actionneur[i].loco then s:=s+','+IntToSTR(Tablo_Actionneur[i].Etat)+','+Tablo_Actionneur[i].trainDecl+',F'+ @@ -1309,9 +1337,6 @@ begin if Raz_Acc_signaux then s:='1' else s:='0'; writeln(fichierN,Raz_signaux_ch+'='+s); - if AvecFVR then s:='1' else s:='0'; - writeln(fichierN,AvecFVR_ch+'='+s); - // temporisation entre 2 commandes décodeurs feu writeln(fichierN,Tempo_feu_ch+'=',IntToSTR(Tempo_feu)); @@ -1466,7 +1491,7 @@ begin Tablo_actionneur[i].etat:=0; Tablo_actionneur[i].adresse:=0; Tablo_actionneur[i].adresse2:=0; - Tablo_Actionneur[i].typActMemZone:=0; + Tablo_Actionneur[i].typdeclenche:=0; Tablo_actionneur[i].accessoire:=0; Tablo_actionneur[i].sortie:=0; Tablo_actionneur[i].fichierSon:=''; @@ -1485,10 +1510,20 @@ begin s:=lit_ligne; sa:=s; sOrigine:=s; + if s[1]='A' then + begin + Tablo_actionneur[maxtablo_act].typdeclenche:=2; // type aiguillage + Delete(sa,1,1); + val(sa,j,erreur); + Tablo_actionneur[maxtablo_act].adresse:=j; + delete(sa,1,erreur); + s:=sa; + end; + i:=pos('MEM[',sOrigine); if i>0 then begin - Tablo_actionneur[maxtablo_act].typActMemZone:=1; // type mémoire de zone + Tablo_actionneur[maxtablo_act].typdeclenche:=1; // type mémoire de zone Delete(sa,1,4); val(sa,j,erreur); Tablo_actionneur[maxtablo_act].adresse:=j; @@ -1503,12 +1538,12 @@ begin if length(sOrigine)>1 then begin - if (sOrigine[1]<>'(') and (pos('MEM[',sOrigine)=0) then // si pas détecteur de PN + if (sOrigine[1]<>'(') and (sorigine[1]<>'A') and (pos('MEM[',sOrigine)=0) then // si pas détecteur de PN begin - Tablo_actionneur[maxtablo_act].typActMemZone:=0; // type actionneur + Tablo_actionneur[maxtablo_act].typdeclenche:=0; // type actionneur val(sa,j,erreur); Tablo_actionneur[maxtablo_act].adresse:=j; - if erreur<>0 then Tablo_actionneur[maxTablo_act].det:=sa[erreur]='Z' + if erreur<>0 then Tablo_actionneur[maxTablo_act].det:=sa[erreur]='Z' else Affiche('Erreur actionneur '+sOrigine,clred); delete(sa,1,erreur); s:=sa; @@ -2316,20 +2351,6 @@ begin Raz_Acc_signaux:=i=1; end; - sa:=uppercase(AvecFVR_ch)+'='; - i:=pos(sa,s); - if i=1 then - begin - inc(nv); - trouve_FVR:=true; - delete(s,i,length(sa)); - val(s,i,erreur); - if i>1 then i:=1; - AvecFVR:=i=1; - if avecFVR then espY:=48 else espY:=15; // espacement Y entre deux lignes de feux - end; - - // section aiguillages sa:=uppercase(section_aig_ch); if pos(sa,s)<>0 then @@ -2397,8 +2418,8 @@ begin trouve_demcnxEth:=false; trouve_Algo_Uni:=false; trouve_Nb_cantons_Sig:=false; - trouve_FVR:=false; - + //trouve_FVR:=false; + if not(trouve_tempo_feu) then begin s:=tempo_feu_ch; @@ -2408,7 +2429,6 @@ begin if not(trouve_NOTIF_VERSION) then s:=NOTIF_VERSION_ch; if not(trouve_verif_version) then s:=verif_version_ch; if not(trouve_fonte) then s:=fonte_ch; - if not(trouve_FVR) then s:=AvecFVR_ch; Nb_Det_Dist:=3; // initialisation des aiguillages avec des valeurs par défaut @@ -2447,7 +2467,6 @@ begin AvecDemandeInterfaceUSB:=true; AvecDemandeInterfaceEth:=true; lay:=''; - avecFVR:=false; Tempo_Aig:=100; Tempo_feu:=100; ServeurInterfaceCDM:=1; @@ -2486,8 +2505,7 @@ begin if not(trouve_dem_aig) then s:=Init_dem_aig_ch; if not(trouve_demcnxCOMUSB) then s:=Init_dem_interfaceUSBCOM_ch; if not(trouve_demcnxEth) then s:=Init_dem_interfaceEth_ch; - if not(trouve_FVR) then s:=AvecFVR_ch; - + if not(trouve_tempo_feu) then begin s:=tempo_feu_ch; @@ -2497,7 +2515,6 @@ begin if not(trouve_NOTIF_VERSION) then s:=NOTIF_VERSION_ch; if not(trouve_verif_version) then s:=verif_version_ch; if not(trouve_fonte) then s:=fonte_ch; - if not(trouve_FVR) then s:=AvecFVR_ch; if s<>'' then begin @@ -2666,7 +2683,6 @@ begin Srvc_PosTrain:=CheckServPosTrains.checked; Srvc_Sig:=CheckBoxSrvSig.checked; Raz_Acc_signaux:=CheckBoxRazSignaux.checked; - AvecFVR:=CheckBoxFVR.checked; AvecInitAiguillages:=CheckBoxInitAig.Checked; AvecDemandeAiguillages:=checkPosAig.checked; AvecDemandeInterfaceUSB:=CheckBoxDemarUSB.checked; @@ -2815,7 +2831,6 @@ begin CheckBoxServAct.checked:=Srvc_Act; CheckServPosTrains.checked:=Srvc_PosTrain; CheckBoxRazSignaux.checked:=Raz_Acc_signaux; - CheckBoxFVR.Checked:=AvecFVR; CheckBoxInitAig.checked:=AvecInitAiguillages; CheckPosAig.checked:=AvecDemandeAiguillages; CheckBoxDemarUSB.checked:=AvecDemandeInterfaceUSB; @@ -3218,7 +3233,7 @@ begin EditSon.Visible:=false; SpeedButtonJoue.Visible:=false; SpeedButtonCharger.Visible:=false; - + LabelNomSon.Visible:=false; end; end; @@ -3232,10 +3247,10 @@ begin GroupBoxRadio.Left:=16; GroupBoxAct.Top:=92; GroupBoxAct.Left:=16; - GroupBoxAct.Height:=292; + GroupBoxAct.Height:=340; GroupBox18.Top:=16; - GroupBox18.Height:=136; - GroupBox19.Top:=160; + GroupBox18.Height:=150; + GroupBox19.Top:=190; GroupBox19.Height:=96; end; end; @@ -3311,7 +3326,7 @@ begin SpeedButtonJoue.Visible:=true; SpeedButtonCharger.Visible:=true; LabelNomSon.Visible:=true; - + RadioButtonLoc.Checked:=false; RadioButtonAccess.Checked:=false; RadioButtonSon.checked:=true; @@ -3323,6 +3338,49 @@ begin end; end; +procedure champs_decl_actdet; +begin + with formconfig do + begin + EditTrainDecl.Visible:=true ; + LabelTrain.Visible:=true ; + radioButtonActDet.Checked:=true; + radioButtonZones.Checked:=false; + radioButtonAig.Checked:=false; + editact2.Visible:=false; + LabelActionneur.Caption:='Actionneur DétecteurZ'; + end; +end; + +procedure champs_decl_zones; +begin + with formconfig do + begin + radioButtonActDet.Checked:=false; + radioButtonZones.Checked:=true; + radioButtonAig.Checked:=false; + EditTrainDecl.Visible:=false; + LabelTrain.Visible:=false; + editact2.Visible:=true; + LabelActionneur.Caption:='Mémoire de Zone'; + end; +end; + +procedure champs_decl_aig; +begin + with formconfig do + begin + radioButtonActDet.Checked:=false; + radioButtonZones.Checked:=false; + radioButtonAig.Checked:=true; + EditAct2.Visible:=false; + EditTrainDecl.Visible:=false; + LabelTrain.Visible:=false; + editact2.Visible:=false; + LabelActionneur.Caption:='Aiguillage'; + end; +end; + // transforme une chaine "élément" en une chaine affichable pour le hint // ex chaine_element("A32")=aiguillage 32 function chaine_element(Equip : Tequipement;adr : integer) : string; @@ -3389,9 +3447,19 @@ begin end; if ((d=2) or (d>=5)) and (d<10) then checkBoxFB.Visible:=true else checkBoxFB.Visible:=false; + if d>2 then + begin + checkFVC.Visible:=true; + checkFRC.Visible:=true; + end + else + begin + checkFVC.Visible:=false; + checkFRC.Visible:=false; + end; if (d>3) and (d<10) then CheckVerrouCarre.Visible:=true else CheckVerrouCarre.Visible:=false; - + // signal normal if d<10 then begin @@ -3415,7 +3483,7 @@ begin EditSuiv2.Hint:=chaine_element(feux[i].Btype_suiv2,feux[i].Adr_el_suiv2); end else begin EditDet2.Text:='';EditSuiv2.Text:='';EditSuiv2.Hint:='';end; j:=feux[i].Adr_det3; - if j<>0 then + if j<>0 then begin EditDet3.Text:=IntToSTR(j);EditSuiv3.Text:=TypeEl_To_char(feux[i].Btype_suiv3)+IntToSTR(feux[i].Adr_el_suiv3); EditSuiv3.Hint:=chaine_element(feux[i].Btype_suiv3,feux[i].Adr_el_suiv3); @@ -3431,7 +3499,9 @@ begin checkVerrouCarre.Checked:=feux[i].VerrouCarre; checkBoxFB.Checked:=feux[i].FeuBlanc; - + checkFVC.Checked:=feux[i].checkFV; + checkFRC.Checked:=feux[i].checkFR; + // conditions supplémentaires du carré par aiguillages l:=1; repeat @@ -3458,6 +3528,9 @@ begin EditDet1.Visible:=false;EditDet2.Visible:=false;EditDet3.Visible:=false;EditDet4.Visible:=false; EditSuiv1.Visible:=false;EditSuiv2.Visible:=false;EditSuiv3.Visible:=false;EditSuiv4.Visible:=false; CheckVerrouCarre.Visible:=false; + checkFVC.visible:=false; + checkFRC.visible:=false; + Label24.Visible:=false; Label25.Visible:=false;Label26.Visible:=false;Label27.Visible:=false; // conditions d'affichage du signal directionnel @@ -3496,52 +3569,45 @@ begin fonction:=Tablo_actionneur[i].fonction; Access:=Tablo_actionneur[i].accessoire; det:=Tablo_actionneur[i].det; - typ:=Tablo_actionneur[i].typActMemZone; + typ:=Tablo_actionneur[i].typdeclenche; + // déclencheurs with formconfig do begin - if typ=0 then + // + case typ of + 0 : begin - EditTrainDecl.Visible:=true ; - LabelTrain.Visible:=true ; - end - else - begin - EditTrainDecl.Visible:=false; - LabelTrain.Visible:=false; + champs_decl_actdet; end; - end; - + 1 : + begin + champs_decl_zones; + end; + 2 : + begin + champs_decl_aig; + end; + end; + end; + if det then s2:='Détecteur ' else s2:='Actionneur '; s2:=s2+intToSTR(Tablo_actionneur[i].adresse); FormConfig.EditAct.Hint:=s2; + // Actionneur fonction F loco if Tablo_actionneur[i].loco then begin champs_type_loco; - - if typ=0 then with formconfig do - begin - radioButtonActDet.Checked:=true; - radioButtonZones.Checked:=false; - editAct2.Visible:=false; - LabelActionneur.Caption:='Actionneur DétecteurZ'; - end; - if typ=1 then with formconfig do - begin - radioButtonActDet.Checked:=false; - radioButtonZones.Checked:=true; - editAct2.Visible:=true; - LabelActionneur.Caption:='Mémoire de Zone'; - editAct2.Text:=IntToSTR(Tablo_actionneur[i].adresse2); - end; - + formconfig.editAct2.Text:=IntToSTR(Tablo_actionneur[i].adresse2); + etatAct:=Tablo_actionneur[i].etat; Adresse:=Tablo_actionneur[i].adresse; s2:=Tablo_actionneur[i].trainDecl; trainsauve:=s2; tempo:=tablo_actionneur[i].Tempo; + with formconfig do begin champs_type_loco; @@ -3560,21 +3626,22 @@ begin if Tablo_actionneur[i].act then begin champs_type_act; - if typ=0 then with formconfig do + case typ of + 0 : with formconfig do begin - radioButtonActDet.Checked:=true; - radioButtonZones.Checked:=false; - editAct2.Visible:=false; - LabelActionneur.Caption:='Actionneur DétecteurZ'; + //radioButtonActDet.Checked:=true; + //radioButtonZones.Checked:=false; + //editAct2.Visible:=false; end; - if typ=1 then with formconfig do + 1 : with formconfig do begin - radioButtonActDet.Checked:=false; - radioButtonZones.Checked:=true; - editAct2.Visible:=true; - LabelActionneur.Caption:='Mémoire de Zone'; end; - + 2 : with formconfig do + begin + end; + + end; + etatAct:=Tablo_actionneur[i].etat ; Adresse:=Tablo_actionneur[i].adresse; sortie:=Tablo_actionneur[i].sortie; @@ -3750,7 +3817,7 @@ begin editDroit_BD.Text:=''; editPointe_BG.Text:=''; EditTempo10.text:=''; - end; + end; end; procedure raz_champs_sig; @@ -3769,6 +3836,8 @@ begin ImageSignal.Picture:=Nil; checkVerrouCarre.Checked:=false; checkBoxFB.Checked:=false; + checkFVC.Checked:=false; + checkFRC.Checked:=false; end; end; @@ -4413,7 +4482,7 @@ var s : string; begin if clicliste or (ligneClicSig<0) then exit; if affevt then Affiche('Evt Verrou carré',clOrange); - + if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then begin feux[ligneClicSig+1].VerrouCarre:=checkVerrouCarre.Checked; @@ -4421,7 +4490,7 @@ begin RichSig.Lines[ligneClicSig]:=s; feux[ligneClicSig+1].modifie:=true; end; -end; +end; procedure TFormConfig.CheckBoxFBClick(Sender: TObject); var s : string; @@ -4707,14 +4776,14 @@ begin // désactiver la ligne PN RE_ColorLine(Formconfig.RichPN,LigneCliqueePN,ClAqua); lignecliqueePN:=-1; - + with RichAct do begin i:=Selstart; ligne:=Perform(EM_LINEFROMCHAR,i,0); // numéro de la lignée cliquée - if ligne-1 then RE_ColorLine(RichAct,AncligneClicAct,ClAqua); + if AncligneClicAct<>-1 then RE_ColorLine(RichAct,AncligneClicAct,ClAqua); AncligneClicAct:=Ligne; ligneClicAct:=ligne; RE_ColorLine(Formconfig.RichAct,ligneClicAct,ClYellow); @@ -4732,22 +4801,24 @@ end; procedure TFormConfig.EditEtatActionneurChange(Sender: TObject); var s : string; - etat,erreur : integer; + etat,erreur,typ : integer; begin if clicliste then exit; if affevt then affiche('Evt EditActionneur Change',clyellow); if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then with Formconfig do - begin + begin s:=EditEtatActionneur.Text; - if radioButtonLoc.Checked or RadioButtonAccess.Checked then + if radioButtonLoc.Checked or RadioButtonAccess.Checked or RadioButtonSon.Checked then begin Val(s,etat,erreur); - if (erreur<>0) or (etat<0) or (etat>1) then + typ:=tablo_actionneur[ligneClicAct+1].typdeclenche; + if (erreur<>0) or (etat<0) or ((typ<2) and (etat>1)) or ((typ=2) and (etat>2)) then begin - LabelInfo.caption:='Erreur état actionneur';exit + if typ<2 then begin LabelInfo.caption:='Erreur état actionneur';exit;end; + if typ=2 then begin LabelInfo.caption:='Erreur position aiguillage';exit;end; end else LabelInfo.caption:=' '; - + tablo_actionneur[ligneClicAct+1].etat:=etat; s:=encode_act_loc_son(ligneClicAct+1); RichAct.Lines[ligneClicAct]:=s; @@ -5047,7 +5118,24 @@ begin checkBoxFB.Visible:=false; checkBoxFB.Checked:=false; end; - if (aspect>3) and (aspect<10) then CheckVerrouCarre.Visible:=true else CheckVerrouCarre.Visible:=false; + if (aspect>3) and (aspect<10) then + begin + CheckVerrouCarre.Visible:=true + end + else + begin + CheckVerrouCarre.Visible:=false; + end; + if (aspect>2) and (aspect<10) then + begin + checkFVC.visible:=true; + checkFRC.visible:=true; + end + else + begin + checkFVC.visible:=false; + checkFRC.visible:=false; + end; feux[index].aspect:=aspect; s:=encode_sig_feux(index); @@ -5791,8 +5879,6 @@ begin feux[i].Img.free; // supprime l'image, ce qui efface le feu du tableau graphique Feux[i].Lbl.free; // supprime le label, ... if Feux[i].checkFB<>nil then begin Feux[i].checkFB.Free;Feux[i].CheckFB:=nil;end; // supprime le check du feu blanc s'il existait - feux[i].checkFR.Free;feux[i].checkFR:=nil; - feux[i].checkFV.Free;feux[i].checkFV:=nil; end; for i:=1 to NbreFeux-ligneFin do @@ -5831,22 +5917,6 @@ begin Top:=HtImg+15+((HtImg+EspY+20)*((IndexFeu-1) div NbreImagePLigne)); Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne)); end; - if Feux[IndexFeu].checkFV<>nil then - with Feux[IndexFeu].CheckFV do - begin - Name:='CheckBoxFV'+intToSTR(adresse); - Hint:='Feu vert clignotant'; - Top:=HtImg+30+((HtImg+EspY+20)*((IndexFeu-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne)); - end; - if Feux[IndexFeu].checkFR<>nil then - with Feux[IndexFeu].CheckFR do - begin - Name:='CheckBoxFR'+intToSTR(adresse); - Hint:='Sémaphore clignotant'; - Top:=HtImg+45+((HtImg+EspY+20)*((IndexFeu-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((IndexFeu-1) mod (NbreImagePLigne)); - end; //Affiche('décale feu '+IntToSTR(i)+'<'+intToSTR(i+1),clorange); @@ -7754,6 +7824,8 @@ end; procedure TFormConfig.PageControlChange(Sender: TObject); begin Label20.Visible:=false; + if FormConfig.PageControl.ActivePage=FormConfig.TabSheetAct then label40.Visible:=true + else label40.Visible:=false; end; @@ -7785,7 +7857,7 @@ begin if clicListe then exit; i:=ligneClicAct+1; if AffEvt then Affiche('RadioBoutonActDet '+IntToSTR(i),clyellow); - Tablo_Actionneur[i].typActMemZone:=0; + Tablo_Actionneur[i].typdeclenche:=0; LabelActionneur.Caption:='Actionneur DétecteurZ'; editAct2.Visible:=false; EditTrainDecl.Visible:=true; @@ -7819,13 +7891,43 @@ begin if clicListe then exit; i:=ligneClicAct+1; if AffEvt then Affiche('RadioBoutonZones '+IntToSTR(i),clyellow); - Tablo_Actionneur[i].typActMemZone:=1; - LabelActionneur.Caption:='Mémoire de Zone'; + Tablo_Actionneur[i].typdeclenche:=1; + LabelActionneur.Caption:='Mémoire de Zone'; EditTrainDecl.Visible:=false; LabelTrain.Visible:=false; editAct2.Visible:=true; //editact.Text:=intToSTR(Tablo_actionneur[i].adresse2); - + + Tablo_actionneur[i].trainDecl:='X'; + val(editact.Text,champ,erreur); + Tablo_actionneur[i].adresse:=champ ; + val(editEtatActionneur.Text,champ,erreur); + Tablo_actionneur[i].etat:=champ; + val(editFonctionAccess.Text,champ,erreur); + Tablo_actionneur[i].fonction:=champ; + val(editEtatFoncSortie.Text,champ,erreur); + Tablo_actionneur[i].sortie:=champ; + val(editTempo.Text,champ,erreur); + Tablo_actionneur[i].tempo:=champ; + tablo_actionneur[i].Raz:=checkRaz.checked; + s:=encode_act_loc_son(i); + RichAct.Lines[ligneClicAct]:=s; +end; + +procedure TFormConfig.RadioButtonAigClick(Sender: TObject); +var i,champ,erreur : integer; + s : string; +begin + if clicListe then exit; + i:=ligneClicAct+1; + if AffEvt then Affiche('RadioBoutonAig '+IntToSTR(i),clyellow); + Tablo_Actionneur[i].typdeclenche:=2; + LabelActionneur.Caption:='Aiguillage'; + EditTrainDecl.Visible:=false; + LabelTrain.Visible:=false; + editAct2.Visible:=false; + //editact.Text:=intToSTR(Tablo_actionneur[i].adresse2); + Tablo_actionneur[i].trainDecl:='X'; val(editact.Text,champ,erreur); Tablo_actionneur[i].adresse:=champ ; @@ -8398,7 +8500,39 @@ begin end; end; +procedure TFormConfig.CheckFVCClick(Sender: TObject); +var s : string; begin + if clicliste or (ligneClicSig<0) then exit; + if affevt then Affiche('Evt FVC',clOrange); + + if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then + begin + feux[ligneClicSig+1].checkFV:=checkFVC.Checked; + s:=encode_sig_feux(ligneClicSig+1); + RichSig.Lines[ligneClicSig]:=s; + feux[ligneClicSig+1].modifie:=true; + end; +end; + +procedure TFormConfig.CheckFRCClick(Sender: TObject); +var s : string; +begin + if clicliste or (ligneClicSig<0) then exit; + if affevt then Affiche('Evt FRC',clOrange); + + if FormConfig.PageControl.ActivePage=FormConfig.TabSheetSig then + begin + feux[ligneClicSig+1].checkFR:=checkFRC.Checked; + s:=encode_sig_feux(ligneClicSig+1); + RichSig.Lines[ligneClicSig]:=s; + feux[ligneClicSig+1].modifie:=true; + end; +end; + +begin + + end. diff --git a/UnitConfigCellTCO.dcu b/UnitConfigCellTCO.dcu index 29ed918..e0923df 100644 Binary files a/UnitConfigCellTCO.dcu and b/UnitConfigCellTCO.dcu differ diff --git a/UnitConfigTCO.dcu b/UnitConfigTCO.dcu index 9c15510..ca07a2a 100644 Binary files a/UnitConfigTCO.dcu and b/UnitConfigTCO.dcu differ diff --git a/UnitDebug.dcu b/UnitDebug.dcu index 016bae6..4eddefc 100644 Binary files a/UnitDebug.dcu and b/UnitDebug.dcu differ diff --git a/UnitPilote.dcu b/UnitPilote.dcu index 0f06eab..9f96337 100644 Binary files a/UnitPilote.dcu and b/UnitPilote.dcu differ diff --git a/UnitPrinc.dcu b/UnitPrinc.dcu index 6f17335..ac89ec5 100644 Binary files a/UnitPrinc.dcu and b/UnitPrinc.dcu differ diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 6a6cffd..073f4f0 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -1,6 +1,6 @@ object FormPrinc: TFormPrinc Left = 70 - Top = 187 + Top = 246 Width = 1213 Height = 670 Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ' diff --git a/UnitPrinc.pas b/UnitPrinc.pas index a5e17b3..1f5bc2b 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -244,7 +244,7 @@ Max_Event_det_tick=30000; EtatSign : array[0..13] of string[20] =('carré','sémaphore','sémaphore cli','vert','vert cli','violet', 'blanc','blanc cli','jaune','jaune cli','ral 30','ral 60','rappel 30','rappel 60'); NbDecodeur = 8; -decodeur : array[0..NbDecodeur-1] of string[20] =('rien','Digital Bahn','CDF','LDT','LEB','NMRA','Unisemaf','SR'); +decodeur : array[0..NbDecodeur-1] of string[20] =('rien','Digital Bahn','CDF','LDT','LEB','NMRA','Unisemaf Paco','SR'); Etats : array[0..19] of string[30]=('Non commandé','carré','sémaphore','sémaphore cli','vert','vert cli','violet', 'blanc','blanc cli','jaune','jaune cli','ralen 30','ralen 60','ralen 60 + jaune cli','rappel 30','rappel 60', 'rappel 30 + jaune','rappel 30 + jaune cli','rappel 60 + jaune','rappel 60 + jaune cli'); @@ -301,8 +301,8 @@ TFeu = record Img : TImage; // Pointeur sur structure TImage du feu Lbl : TLabel; // pointeur sur structure Tlabel du feu checkFB : TCheckBox; // pointeur sur structure Checkbox "demande feu blanc" - checkFR : TCheckBox; // pointeur demande feu rouge cli - checkFV : TcheckBox; // pointeur demande feu vert cli + checkFR : boolean; // demande feu rouge cli + checkFV : boolean; // demande feu vert cli FeuVertCli : boolean ; // avec checkbox ou pas FeuRougeCli : boolean ; // avec checkbox ou pas FeuBlanc : boolean ; // avec checkbox ou pas @@ -414,13 +414,13 @@ var Tablo_actionneur : array[1..100] of record - loco,act,son: boolean; // type loco actionneur ou son + loco,act,son: boolean; // destinataire loco acessoire ou son adresse,adresse2, // adresse: adresse de base ; adresse2=cas d'une Zone etat,fonction,tempo,TempoCourante, accessoire,sortie, - typActMemZone : integer; // 0=actioneur 1=MemZone + typdeclenche : integer; // déclencheur: 0=actioneur 1=MemZone 2=evt aig Raz : boolean; - det : boolean; // désigne un détecteur + det : boolean; // le déclencheur est un détecteur FichierSon,trainDecl,TrainDest,TrainCourant : string; end; @@ -645,7 +645,7 @@ procedure dessine_feu2(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal var Temp,rayon,xViolet,YViolet,xBlanc,yBlanc, LgImage,HtImage,code,combine : integer; ech : real; - + begin code_to_aspect(Etatsignal,code,combine); rayon:=round(6*frX); @@ -653,7 +653,7 @@ begin // récupérer les dimensions de l'image d'origine du feu LgImage:=Formprinc.Image2feux.Picture.Bitmap.Width; HtImage:=Formprinc.Image2feux.Picture.Bitmap.Height; - + XBlanc:=13; YBlanc:=11; xViolet:=13; yViolet:=23; @@ -691,7 +691,7 @@ procedure dessine_feu3(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal var Temp,rayon,xSem,Ysem,xJaune,Yjaune,Xvert,Yvert, LgImage,HtImage,code,combine : integer; ech : real; - + begin code_to_aspect(Etatsignal,code,combine); rayon:=round(6*frX); @@ -1266,7 +1266,7 @@ begin // indicateurs de direction 12..16 : dessine_dirN(CanvasDest,x,y,frx,fry,feux[i].EtatSignal,orientation,aspect-10); end; - end; + end; end; // procédure activée quand on clique gauche sur l'image d'un feu @@ -1421,44 +1421,6 @@ begin end else Feux[rang].checkFB:=nil; - // créée la checkbox feu vert cli - if AvecFVR or feux[rang].FeuVertCli then - begin - Feux[rang].CheckFV:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu - with Feux[rang].CheckFV do - begin - onClick:=formprinc.proc_checkBoxFV; // affecter l'adresse de la procédure de traitement quand on clique dessus - Hint:='Vert cli'; - Name:='CheckBoxFV'+intToSTR(adresse); // affecter l'adresse du feu pour pouvoir le retrouver dans la procédure - caption:='dem FVC'; - Parent:=Formprinc.ScrollBox1; - width:=100;height:=15; - Top:=HtImg+30+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); - BringToFront; - end; - end - else Feux[rang].checkFV:=nil; - - // créée la checkbox feu rouge cli - if AvecFVR or feux[rang].FeuRougeCli then - begin - Feux[rang].checkFR:=TCheckBox.create(Formprinc.ScrollBox1); // ranger l'adresse de la Checkbox dans la structure du feu - with Feux[rang].CheckFR do - begin - Feux[rang].checkFR.onClick:=formprinc.proc_checkBoxFR; // affecter l'adresse de la procédure de traitement quand on clique dessus - Feux[rang].checkFR.Hint:='Sémaphore cli'; // affecter l'adresse du feu dans le HINT pour pouvoir le retrouver plus tard - Name:='CheckBoxFR'+intToSTR(adresse); - caption:='dem FRC'; - Parent:=Formprinc.ScrollBox1; - width:=100;height:=15; - Top:=HtImg+45+((HtImg+EspY+20)*((rang-1) div NbreImagePLigne)); - Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); - BringToFront; - end; - end - else Feux[rang].checkFR:=nil; - end; // ajoute en bout de chaine le checksum d'une trame @@ -5762,13 +5724,9 @@ begin if AffSignal then AfficheDebug('Présence train après signal'+intToSTR(AdrFeu)+' -> sémaphore ou carré',clYellow); if testBit(feux[index].EtatSignal,carre)=FALSE then begin - if feux[index].checkFR<>nil then - begin - if feux[index].checkFR.Checked then Maj_Etat_Signal(AdrFeu,semaphore_cli) - else Maj_Etat_Signal(AdrFeu,semaphore); - end - else Maj_Etat_Signal(AdrFeu,semaphore); - end; + if feux[index].checkFR then Maj_Etat_Signal(AdrFeu,semaphore_cli) + else Maj_Etat_Signal(AdrFeu,semaphore); + end; end else begin @@ -5851,11 +5809,7 @@ begin end else begin - if feux[index].checkFV<>nil then - begin - if feux[index].checkFV.Checked then Maj_Etat_Signal(AdrFeu,vert_cli) - else Maj_Etat_Signal(AdrFeu,vert); - end + if feux[index].checkFV then Maj_Etat_Signal(AdrFeu,vert_cli) else Maj_Etat_Signal(AdrFeu,vert); //if affsignal then AfficheDebug('Mise du feu au vert',clyellow); end; @@ -6252,7 +6206,7 @@ end; // traitement des évènements actionneurs (detecteurs aussi) // adr adr2 : pour mémoire de zone procedure Event_act(adr,adr2,etat : integer;trainDecl : string); -var i,v,va,etatAct,Af,Ao,Access,sortie,dZ1F,dZ2F,dZ1O,dZ2O : integer; +var typ,i,v,va,etatAct,Af,Ao,Access,sortie,dZ1F,dZ2F,dZ1O,dZ2O : integer; s,st,trainDest : string; presTrain_PN,adresseOk : boolean; Ts : TAccessoire; @@ -6269,18 +6223,19 @@ begin adresseok:=(Tablo_actionneur[i].adresse=adr) ; - if Tablo_actionneur[i].det then + typ:=Tablo_actionneur[i].typdeclenche; + if typ=1 then begin - st:='Détecteur '+intToSTR(adr); - if Tablo_actionneur[i].typActMemZone=1 then - begin - adresseok:=adresseOk and (Tablo_actionneur[i].adresse2=adr2); - st:='Mémoire de zone '+intToSTR(adr)+' '+intToStr(adr2); - end; - end - else + adresseok:=adresseOk and (Tablo_actionneur[i].adresse2=adr2); + st:='Mémoire de zone '+intToSTR(adr)+' '+intToStr(adr2); + end; + if typ=0 then begin - st:='Actionneur '+intToSTR(adr); + st:='Détecteur/actionneur '+intToSTR(adr); + end; + if typ=2 then + begin + st:='Aiguillage '+intToSTR(adr); end; // actionneur pour fonction train @@ -6312,7 +6267,8 @@ begin if adresseOk and (Tablo_actionneur[i].Son) and ((s=trainDecl) or (s='X') or (trainDecl='X') or (trainDecl='')) and (etatAct=etat) then begin - Affiche(st+' Train='+trainDecl+' son '+Tablo_actionneur[i].FichierSon,clyellow); + if typ<>2 then st:=st+' Train='+trainDecl; + Affiche(st+' son '+Tablo_actionneur[i].FichierSon,clyellow); PlaySound(pchar(Tablo_actionneur[i].FichierSon),0,SND_ASYNC); end; end; @@ -6325,7 +6281,7 @@ begin // PN par actionneur for v:=1 to Tablo_PN[i].nbvoies do begin - + aF:=Tablo_PN[i].voie[v].actFerme; if (aO=adr) and (etat=0) then // actionneur d'ouverture @@ -6451,7 +6407,7 @@ begin N_Event_tick:=0; Affiche('Raz Evts détecteurs',clLime); end; - + inc(N_Event_tick); event_det_tick[N_event_tick].tick:=tick; event_det_tick[N_event_tick].adresse:=Adresse; @@ -6479,7 +6435,7 @@ begin if AdrPrec=0 then begin If traceListe then AfficheDebug('Le feu '+IntToSTR(AdrFeu)+' est précédé d''un buttoir',clyellow); - MemZone[0,AdrDetFeu]:=true; + MemZone[0,AdrDetFeu]:=true; event_act(0,AdrDetFeu,1,''); // activation zone maj_feu(AdrFeu); end; @@ -6520,7 +6476,7 @@ begin // gérer l'évènement detecteur pour action if etat then i:=1 else i:=0; - event_act(Adresse,0,i,train); + event_act(Adresse,0,i,train); if not(confignulle) then calcul_zones; end; end; @@ -6531,7 +6487,7 @@ begin N_event_det:=0; FormDebug.MemoEvtDet.lines.add('Raz sur débordement'); end; - + // attention à partir de cette section le code est susceptible de ne pas être exécuté?? // Mettre à jour le TCO @@ -6549,7 +6505,7 @@ end; procedure Event_Aig(adresse,pos : integer); var s: string; faire_event,inv : boolean; - prov,index : integer; + prov,index,i,etatact,typ,adr : integer; begin index:=index_aig(adresse); if index=0 then exit; @@ -6601,6 +6557,15 @@ begin // l'évaluation des routes est à faire selon conditions if faire_event and not(confignulle) then evalue; + + // actionneur d'aiguillage + for i:=1 to maxTablo_act do + begin + etatAct:=Tablo_actionneur[i].etat ; + adr:=Tablo_actionneur[i].adresse; + typ:=Tablo_actionneur[i].typdeclenche; + if (typ=2) and (Adr=adresse) then event_act(Adresse,0,pos,''); + end; end; // pilote une sortie à 0 à l'interface en Xpressnet dont l'adresse est à octet @@ -7667,7 +7632,7 @@ begin Affiche('Fin des initialisations',clyellow); LabelEtat.Caption:=' '; Affiche_memoire; - DoubleBuffered:=true; +// DoubleBuffered:=true; { aiguillage[index_aig(1)].position:=const_droit; @@ -8028,6 +7993,7 @@ begin pilote_acc(adr,const_devie,aigP); s:='accessoire '+IntToSTR(adr)+' dévié'; Affiche(s,clyellow); + Self.ActiveControl:=nil; end; procedure TFormPrinc.EditvalEnter(Sender: TObject); @@ -9339,8 +9305,8 @@ begin end; procedure TFormPrinc.Codificationdesactionneurs1Click(Sender: TObject); -var i,adract,etatAct,fonction,v,acc,sortie : integer; - son,Mem : boolean; +var i,typ,adract,etatAct,fonction,v,acc,sortie : integer; + loc,act,son : boolean; s,s2 : string; begin if (maxTablo_act=0) and (NbrePN=0) then @@ -9359,26 +9325,26 @@ begin acc:=Tablo_actionneur[i].accessoire; sortie:=Tablo_actionneur[i].sortie; fonction:=Tablo_actionneur[i].fonction; + loc:=Tablo_actionneur[i].loco; + act:=Tablo_actionneur[i].act; son:=Tablo_actionneur[i].son; - Mem:=Tablo_actionneur[i].typActMemZone=1; + typ:=Tablo_actionneur[i].typdeclenche; - if Mem then s:='Mem '+intToSTR(adrAct)+' '+inttostr(Tablo_actionneur[i].Adresse2) - else s:=intToSTR(adrAct); + if typ=1 then s:='Mem '+intToSTR(adrAct)+' '+inttostr(Tablo_actionneur[i].Adresse2); + if typ=0 then s:=intToSTR(adrAct); + if typ=2 then s:='Aig '+intToSTR(AdrAct); - if (s2<>'') then - begin - if fonction<>0 then + if loc then s:='FonctionF Déclencheur='+s+' :'+intToSTR(etatAct)+' TrainDécl='+s2+' TrainDest='+Tablo_actionneur[i].TrainDest+' F'+IntToSTR(fonction)+ ' Temporisation='+intToSTR(tablo_actionneur[i].Tempo); - if acc<>0 then + if act then s:='Accessoire Déclencheur='+s+' :'+intToSTR(etatAct)+' TrainDécl='+s2+' A'+IntToSTR(acc)+ ' sortie='+intToSTR(sortie); - if son then + if son then s:='Son Déclencheur='+s+' :'+intToSTR(etatAct)+' TrainDécl='+s2+ ' Fichier:'+Tablo_actionneur[i].FichierSon; - Affiche(s,clYellow); - end; + Affiche(s,clYellow); end; // dans le tableau des PN @@ -9440,6 +9406,7 @@ begin begin readln(fte,s); Affiche(s,clLime); + sleep(100); Interprete_trameCDM(s); application.processmessages; end; @@ -9730,5 +9697,7 @@ end; + + end. diff --git a/UnitSR.dcu b/UnitSR.dcu index 06a9695..8981617 100644 Binary files a/UnitSR.dcu and b/UnitSR.dcu differ diff --git a/UnitSimule.dcu b/UnitSimule.dcu index 55326fb..02a4e60 100644 Binary files a/UnitSimule.dcu and b/UnitSimule.dcu differ diff --git a/UnitTCO.dcu b/UnitTCO.dcu index ecc3a48..868edaf 100644 Binary files a/UnitTCO.dcu and b/UnitTCO.dcu differ diff --git a/UnitTCO.dfm b/UnitTCO.dfm index 179cdfb..4f803c0 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1,6 +1,6 @@ object FormTCO: TFormTCO - Left = 155 - Top = 94 + Left = 178 + Top = 70 Width = 1139 Height = 694 VertScrollBar.Visible = False @@ -24,12 +24,12 @@ object FormTCO: TFormTCO 656) PixelsPerInch = 96 TextHeight = 13 - object LabelX: TLabel + object LabelCoord: TLabel Left = 64 Top = 0 - Width = 7 + Width = 18 Height = 16 - Caption = '0' + Caption = '0,0' Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -13 @@ -50,19 +50,6 @@ object FormTCO: TFormTCO Font.Style = [fsBold] ParentFont = False end - object LabelY: TLabel - Left = 88 - Top = 0 - Width = 7 - Height = 16 - Caption = '0' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -13 - Font.Name = 'Arial' - Font.Style = [fsBold] - ParentFont = False - end object SourisX: TLabel Left = 128 Top = 2 @@ -133,8 +120,8 @@ object FormTCO: TFormTCO end end object TrackBarZoom: TTrackBar - Left = 1051 - Top = 34 + Left = 1059 + Top = 18 Width = 41 Height = 366 Anchors = [akTop, akRight, akBottom] diff --git a/UnitTCO.pas b/UnitTCO.pas index 275a5dd..bdda94d 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -9,9 +9,8 @@ uses type TFormTCO = class(TForm) - LabelX: TLabel; + LabelCoord: TLabel; Label2: TLabel; - LabelY: TLabel; PopupMenu1: TPopupMenu; MenuCouper: TMenuItem; N1: TMenuItem; @@ -284,6 +283,7 @@ type procedure Signalgauchedelavoie1Click(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure N3Click(Sender: TObject); + procedure Button3Click(Sender: TObject); private { Déclarations privées } @@ -335,7 +335,8 @@ var HtImageTCO,LargImageTCO,XclicCell,YclicCell,XminiSel,YminiSel,XCoupe,Ycoupe,Temposouris, XmaxiSel,YmaxiSel,AncienXMiniSel,AncienXMaxiSel ,AncienYMiniSel,AncienYMaxiSel, Xclic,Yclic,XClicCellInserer,YClicCellInserer,Xentoure,Yentoure,RatioC,ModeCouleurCanton, - AncienXClicCell,AncienYClicCell,LargeurCell,HauteurCell,NbreCellX,NbreCellY,NbCellulesTCO : integer; + AncienXClicCell,AncienYClicCell,LargeurCell,HauteurCell,NbreCellX,NbreCellY,NbCellulesTCO, + Epaisseur : integer; titre_Fonte : string; TamponTCO,tco : TTco ; // pour copier coller @@ -754,8 +755,9 @@ procedure calcul_cellules; begin LargeurCell:=ZoomMax-FormTCO.TrackBarZoom.Position+ZoomMin; hauteurCell:=(LargeurCell * RatioC) div 10; + Epaisseur:=LargeurCell div 7; // épaisseur du trait pour PEN end; - + procedure entoure_cell_grille(x,y : integer); // redessine le carré de grille de la cellule qui a été altéré par la mise à // jour de la cellule @@ -767,6 +769,7 @@ begin; begin Pen.Color:=clGrille; Pen.mode:=PmCopy; + Pen.width:=1; MoveTo(Xorg,YOrg); LineTo(Xorg+LargeurCell,YOrg); LineTo(Xorg+LargeurCell,YOrg+HauteurCell); @@ -800,9 +803,10 @@ begin end; function positionTCO(x,y : integer) : integer; -var position : integer; +var position,i : integer; begin - position:=aiguillage[index_Aig(TCO[x,y].Adresse)].position ; + i:=index_Aig(TCO[x,y].Adresse); + position:=aiguillage[i].position ; if position=0 then begin result:=const_inconnu;exit;end; if TCO[x,y].inverse then begin @@ -854,385 +858,516 @@ begin end; Brush.Color:=couleur; pen.color:=couleur; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - FillRect(r); + + jy1:=y0+(HauteurCell div 2); + Pen.Width:=epaisseur; + + moveTo(x0,jy1);LineTo(x0+LargeurCell,jy1); end; end; - - { diagonale - x1:=x0;y1:=y0+hauteurCell-round(3*FryGlob); - x2:=x0+largeurCell-round(3*FrXGlob);y2:=y0; - x3:=x0+largeurCell;y3:=y0+round(4*FrYGlob); - x4:=x0+round(4*FrXGlob); y4:=y0+hauteurCell; - } -// element 2 -procedure dessin_2(canvas : Tcanvas;x,y : integer; Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; +procedure dessin_2(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,jy1,jy2,xf,yf,x1,x2,y1,y2,x3,position : integer; r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // partie droite + moveto(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 - procedure horz; - begin - // bande horizontale - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - canvas.FillRect(r); - end; + if mode=1 then couleur:=clAllume; + 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); - procedure deviation; - begin - //Canvas.Brush.Color:=clRed; - x1:=x0+(largeurCell div 2)-round(1*FrXGlob); y1:=jy1+round(1*frYGlob); - x2:=x0-round(1*FrXGlob);y2:=y0+HauteurCell-round(2*FrYGlob); //1 - x3:=x0+round(4*FrXGlob);y3:=y0+HauteurCell; //2 - x4:=x1+round(2*FrXGlob);y4:=jy2; //1 - canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; + // 1ere partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(x0,yc); + end; + end; + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // horizontale complete + moveto(x0,yf);lineto(xc,yc); // partie déviée + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie horz g en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);LineTo(xc,yc); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,yf);LineTo(xc,yc);LineTo(xf,yc); // trajet déviée + end; + end; + + begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); with canvas do begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); + 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=9) then + if (position=const_Devie) or (position=const_inconnu) then begin - horz; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - deviation; - - r:=Rect(x0+(LargeurCell div 2),jy1,x0+LargeurCell,jy2); - canvas.FillRect(r); - - if (position=const_Devie) then - begin - x1:=x1;y1:=jy1; - x2:=x1-6;y2:=jy2; - x3:=x2-6;y3:=y2; - x4:=x1-6;y4:=jy1; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; + trajet_devie; // affiche la position de la branche déviée end; - if (position=const_Droit) then + if (position=const_droit) or (position=const_inconnu) then begin - deviation; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - // effacement du morceau - x1:=x1+3;y1:=jy2; - x2:=x1-10;y2:=y1; - x3:=x2-5;y3:=y2+3; - x4:=x1-5;y4:=y3; + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + Brush.Color:=fond; + pen.width:=1; + x1:=xc-epaisseur;y1:=yc-(epaisseur div 2)-1; + x2:=xc+epaisseur+10;y2:=yc-epaisseur-3; + 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; + x1:=xc+(epaisseur div 2);y1:=yc+(epaisseur div 2); + x2:=x1+epaisseur-1;y2:=yc-(epaisseur div 2); + x3:=x1+10; + 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; -// aiguillage pointe à gauche, aiguillage gauche Element 3 procedure dessin_3(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; +var x0,y0,xc,yc,jy1,xf,yf,x1,x2,y1,y2,x3,position : integer; r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // partie droite + moveto(xc,yc);lineto(xf,y0); // partie déviée + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie droite couleur voies + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);lineto(xf,y0); // partie déviée - procedure horz; - begin - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - canvas.FillRect(r); - end; + if mode=1 then couleur:=clAllume; + 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); - procedure devie; - begin - //brush.color:=clblue; - x1:=x0+(largeurCell div 2)-round(1*frXGlob); y1:=jy1; - x2:=x0+largeurCell-round(4*frXGlob); y2:=y0; - x3:=x0+largeurCell; y3:=y0+round(3*frYGlob); - x4:=x0+(largeurCell div 2)+round(1*frXGlob);y4:=jy2-round(1*frYGlob); - canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - + // 2eme partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(xf,yc); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // horizontale complete + moveto(xc,yc);lineto(xf,y0); // partie déviée + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie horz droite en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);LineTo(xf,yc); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,yc);LineTo(xc,yc);LineTo(xf,y0); // partie déviée + end; + end; + + begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); - + with canvas do begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); + 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.Color:=clVoies; Pen.Mode:=pmCopy; - - // aiguillage dévié (sans inversion) - if (position=const_Devie) or (position=9) then - begin - horz; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - devie; - - r:=Rect(x0,jy1,x0+1+(LargeurCell div 2),jy2); - canvas.FillRect(r); - - // effacement du morceau - if (position=const_Devie) then - begin - x1:=x4+round(2*frXGlob);y1:=jy2-round(1*frYGlob); - x2:=x1+round(5*frXGlob);y2:=jy1; - x3:=x2+round(5*frXGlob);y3:=y2; - x4:=x1+round(5*frXGlob);y4:=y1; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; - - // aiguillage droit (sans inversion) dévié (avec inversion) - if (position=const_Droit) then - begin - devie; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - // aiguillage droit - x1:=x1-1;y1:=jy1-1; - x2:=x1+10;y2:=y1; - x3:=x2;y3:=y2-3; - x4:=x1;y4:=y3; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; -end; - -// Element 4 -procedure dessin_4(Canvas : Tcanvas;x,y,Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; - r : Trect; - - procedure bande_horz; - begin - // bande horizontale - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - Canvas.FillRect(r); - end; - - procedure deviation; - begin - // déviation - x1:=x0+(largeurCell div 2)+round(1*frXGlob); y1:=jy1+round(1*frYGlob); - x2:=x0+largeurCell;y2:=y0+HauteurCell-round(3*frYGlob); - x3:=x0+largeurCell-round(3*frXGlob);y3:=y0+HauteurCell; - x4:=x0+(largeurCell div 2)-round(1*frXGlob);y4:=jy2-round(1*frYGlob); - Canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; - position:=positionTCO(x,y); - - with canvas do - begin - // efface la cellule - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - Pen.Mode:=pmCopy; - pen.color:=clVoies; - Brush.color:=clVoies; - - if (position=const_Devie) or (position=9) then - begin - bande_horz; - begin - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - end; - - // demi bande droite - r:=Rect(x0,jy1,x0+(LargeurCell div 2),jy2); - Canvas.FillRect(r); - deviation; - // effacement du morceau - if (position=const_Devie) then - begin - x1:=x1;y1:=jy1; - x2:=x1+5;y2:=jy2-1; - x3:=x2+6;y3:=y2; - x4:=x1+6;y4:=y1; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; - - // aiguillage droit (sans inversion) dévié (avec inversion) - if (position=const_Droit) then - begin - deviation; - begin - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - end; - bande_horz; - - // efface le morceau - x1:=x4;y1:=jy2; - x2:=x1+10;y2:=y1; - x3:=x2;y3:=y2+3; - x4:=x1;y4:=y3; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; -end; - - -// Element 5 -procedure dessin_5(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; - r : Trect; - - procedure horz; - begin - // bande horizontale - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - Canvas.FillRect(r); - end; - - procedure deviation; - begin - x1:=x0+(largeurCell div 2); y1:=jy1; - x2:=x0+round(3*FrXGlob); y2:=y0; - x3:=x0; y3:=y0+round(3*FrYGlob); - x4:=x0+(largeurCell div 2)-round(1*FrXGlob); y4:=jy2-round(1*FrYGlob); - canvas.Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*FrXGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*FrYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; - position:=positionTCO(x,y); - - with canvas do - begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - Brush.COlor:=clVoies; - Pen.Mode:=pmCopy; - pen.color:=clVoies; if (position=const_Devie) or (position=const_inconnu) then begin - horz; - begin - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - end; - // demi bande droite - r:=Rect(x0+(largeurCell div 2),jy1,x0+LargeurCell,jy2); - Canvas.FillRect(r); - deviation; - - // efface le morceau - if (position=const_Devie) then - begin - x1:=x1-12;y1:=jy1; - x2:=x1+5;y2:=jy2-1; - x3:=x2+6;y3:=y2; - x4:=x1+6;y4:=y1; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; + trajet_devie; // affiche la position de la branche déviée end; - if (position=const_Droit) then + if (position=const_droit) or (position=const_inconnu) then begin - deviation; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - // efface le morceau - x1:=x4-10;y1:=jy1-1; - x2:=x1+10;y2:=y1; - x3:=x2;y3:=y2-3; - x4:=x1;y4:=y3; + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau pen.color:=fond; - Brush.COlor:=fond; + Brush.Color:=fond; + pen.width:=1; + x1:=xc-epaisseur;y1:=yc-(epaisseur div 2)-1; + x2:=xc+epaisseur+10;y2:=yc-epaisseur-3; + jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup + pen.width:=1; + Polygon([point(xc+epaisseur-4,yc+epaisseur-1),point(xc+2*epaisseur-1,yc-epaisseur),point(xc+3*epaisseur,yc-epaisseur),point(xc+2*epaisseur,yc+epaisseur-1)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.Width:=1; + x1:=xc+(epaisseur div 2);y1:=yc+(epaisseur div 2); + x2:=x1+epaisseur-1;y2:=yc-(epaisseur div 2); + x3:=x1+10; + jy1:=yc-(Epaisseur div 2); // pos Y de la bande sup + r:=rect(x0+1,jy1,x0+largeurCell-1,jy1-epaisseur); + FillRect(r); + end; + end; +end; + +procedure dessin_4(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,jy1,jy2,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; + r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // partie droite + moveto(xc,yc);lineto(xf,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:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // première partie gauche toujours allumée + moveto(x0,yc);LineTo(xc,yc); + + // 2eme partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(xf,yc); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // horizontale complete + moveto(xc,yc);lineto(xf,yf); // partie déviée + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie horz droite en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);LineTo(xf,yc); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,yc);LineTo(xc,yc);LineTo(xf,yf); // trajet dévié + end; + end; + + +begin + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + position:=positionTCO(x,y); + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=fond; + r:=Rect(x0,y0,xf,yf); + FillRect(r); // efface la cellule + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if (position=const_Devie) or (position=const_inconnu) then + begin + trajet_devie; // affiche la position de la branche déviée + end; + + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.width:=1; + x1:=xc+(epaisseur div 2);y1:=yc-(epaisseur div 2)-1; + x2:=x1+8;y2:=y1; + x3:=x2+6;y3:=y2+7; + x4:=x1+6;y4:=y3; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.Width:=1; + // efface le morceau + x1:=xc-epaisseur-1;y1:=yc+(epaisseur div 2)+1; + x2:=x1+21;y2:=y1+5; + r:=rect(x1,y1,x2,y2); + rectangle(r); + end; + end; +end; + +procedure dessin_5(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; + r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // partie droite + moveto(x0,y0);lineto(xc,yc); // partie déviée + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie droite couleur voies + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);lineto(xc,yc); // partie déviée + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // 2eme partie droite toujours allumée + moveto(xc,yc);LineTo(xf,yc); + + // 1ere partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(x0,yc); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xf,yc); // horizontale complete + moveto(x0,y0);lineto(xc,yc); // partie déviée + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie horz g en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);LineTo(xc,yc); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,y0);LineTo(xc,yc);LineTo(xf,yc); // trajet dévié + end; + end; + + +begin + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + position:=positionTCO(x,y); + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=fond; + r:=Rect(x0,y0,xf,yf); + FillRect(r); // efface la cellule + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if (position=const_Devie) or (position=const_inconnu) then + begin + trajet_devie; // affiche la position de la branche déviée + end; + + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau + pen.width:=1; + x1:=xc-(epaisseur div 2);y1:=yc+(epaisseur div 2); + x2:=x1-epaisseur;y2:=y1; + x3:=x2-epaisseur;y3:=y2-epaisseur-1; + x4:=x3+epaisseur;y4:=y3; + pen.color:=fond; + Brush.Color:=fond; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.Width:=1; + // efface le morceau + x1:=xc-(epaisseur div 2)-10;y1:=yc-(epaisseur div 2); + x2:=x1+20;y2:=y1-epaisseur; + pen.color:=fond; + Brush.Color:=fond; + r:=rect(x1,y1,x2,y2); + rectangle(r); end; end; end; @@ -1240,14 +1375,17 @@ end; // coin supérieur gauche (Element 6) procedure dessin_6(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; +var x0,y0,xc,yc,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); @@ -1256,70 +1394,58 @@ begin 1: couleur:=clAllume; 2: couleur:=couleurtrain[index_couleur]; end; - Brush.COlor:=Couleur; + Pen.Width:=epaisseur; + Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0+(LargeurCell div 2),jy1,x0+LargeurCell,jy2); - FillRect(r); - - // brush.color:=clblue; - x1:=x0+(LargeurCell div 2)-round(1*frXGlob); y1:=jy2-round(2*frYGlob); - x2:=x0;y2:=y0+round(2*frYGlob); - x3:=x0+round(3*frXGlob);y3:=y0; - x4:=x0+(LargeurCell div 2);y4:=jy1; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + MoveTo(x0,y0);LineTo(xc,yc);Lineto(x0+largeurCell,yc); end; end; // Element 7 procedure dessin_7(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); + with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; + 0: couleur:=clVoies; + 1: couleur:=clAllume; + 2: couleur:=couleurtrain[index_couleur]; end; - Brush.COlor:=Couleur; + Brush.Color:=Couleur; pen.color:=couleur; Pen.Mode:=pmCopy; - - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0,jy1,x0+(LargeurCell div 2)+4,jy2); - FillRect(r); - - x1:=x0+(LargeurCell div 2)+round(2*frXGlob);y1:=jy1; - x2:=x0+LargeurCell-round(2*frXGlob);y2:=y0; - x3:=x0+LargeurCell;y3:=y0+round(4*frYGlob); - x4:=x0+(LargeurCell div 2)+round(4*frXGlob);y4:=jy2-round(2*frYGlob); - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + Pen.Width:=epaisseur; + MoveTo(x0,yc);LineTo(xc,yc);lineto(x0+largeurCell,y0); end; end; // courbe: droit vers bas -\ Element 8 procedure dessin_8(Canvas : Tcanvas;x,y : integer;Mode : integer); -var jy1,jy2,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); @@ -1328,36 +1454,28 @@ begin 1: couleur:=clAllume; 2: couleur:=couleurtrain[index_couleur]; end; - Brush.COlor:=Couleur; + Brush.Color:=Couleur; Pen.Mode:=pmCopy; pen.color:=Couleur; - - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0,jy1,x0+(LargeurCell div 2),jy2); - FillRect(r); - - // brush.color:=clblue; - x1:=x0+(LargeurCell div 2) ; - y1:=jy1; - x2:=x0+LargeurCell; y2:=y0+HauteurCell-round(3*frYGlob); - x3:=x0+LargeurCell -round(2*frXGlob); y3:=y0+HauteurCell; - x4:=x0+(LargeurCell div 2); y4:=jy2; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + pen.Width:=epaisseur; + moveto(x0,yc);lineto(xc,yc);lineto(x0+largeurCell,y0+hauteurCell); end; end; // courbe bas gauche vers droit Elément 9 procedure dessin_9(Canvas : Tcanvas;x,y : integer;Mode : integer); -var jy1,jy2,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); @@ -1366,21 +1484,11 @@ begin 1: couleur:=clAllume; 2: couleur:=couleurtrain[index_couleur]; end; - Brush.COlor:=Couleur; + Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0+(largeurCell div 2),jy1,x0+LargeurCell,jy2); - FillRect(r); - - // brush.color:=clblue; - x1:=x0; y1:=y0+HauteurCell-round(4*frYGlob); - x2:=x0+(LargeurCell div 2) ; y2:=jy1; - x3:=x0+(LargeurCell div 2) +round(2*frXGlob); y3:=jy2; - x4:=x0+round(4*frXGlob); y4:=y0+HauteurCell; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + pen.width:=epaisseur; + MoveTo(x0,y0+hauteurCell);LineTo(xc,yc);LineTo(x0+largeurCell,yc); end; end; @@ -1395,78 +1503,13 @@ begin with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); Adr:=TCO[x,y].adresse; - if Adr<>0 then - begin - if detecteur[Adr].etat then - begin - Brush.Color:=clAllume; - pen.color:=clAllume; - Pen.Mode:=pmCopy; - x1:=x0;y1:=y0+hauteurCell-round(7*FryGlob); - x2:=x0+largeurCell-round(8*FrXGlob);y2:=y0+1; - x3:=x0+largeurCell-1;y3:=y0+round(9*FrYGlob); - x4:=x0+round(9*FrXGlob); y4:=y0+hauteurCell-1; - PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - end; - end; - - x1:=x0;y1:=y0+hauteurCell-round(3*FryGlob); - x2:=x0+largeurCell-round(3*FrXGlob);y2:=y0; - x3:=x0+largeurCell;y3:=y0+round(4*FrYGlob); - x4:=x0+round(4*FrXGlob); y4:=y0+hauteurCell; - - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - - PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - - end; -end; - -// élément 11 -procedure dessin_11(Canvas : Tcanvas;x,y : integer;Mode : integer); -var Adr, x0,y0,x1,y1,x2,y2,x3,y3,x4,y4 : integer; - r : Trect; -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - - with canvas do - begin - Brush.Color:=Fond; - - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - Adr:=TCO[x,y].adresse; - if Adr<>0 then - begin - if detecteur[Adr].etat then - begin - Brush.Color:=clAllume; - pen.color:=clAllume; - Pen.Mode:=pmCopy; - x1:=x0+round(7*FrXGlob);y1:=y0; - x2:=x0+largeurCell-1;y2:=y0+HauteurCell-round(7*FrYGlob)-1; - x3:=x0+largeurCell-round(8*FrXGlob)-1;y3:=y0+HauteurCell-1; - x4:=x0;y4:=y0+round(8*frYGlob); - PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - end; - end; - - x1:=x0+round(3*FrXGlob);y1:=y0; - x2:=x0+largeurCell;y2:=y0+HauteurCell-round(3*FrYGlob); - x3:=x0+largeurCell-round(4*FrXGlob);y3:=y0+HauteurCell; - x4:=x0;y4:=y0+round(4*frYGlob); - + if (Adr<>0) and detecteur[Adr].etat then couleur:=clAllume + else case mode of 0: couleur:=clVoies; 1: couleur:=clAllume; @@ -1474,100 +1517,163 @@ begin end; Brush.Color:=couleur; pen.color:=couleur; - - PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + Pen.Mode:=pmCopy; + pen.Width:=epaisseur; + MoveTo(x0+largeurCell,y0);LineTo(x0,y0+hauteurCell); end; -end; +end; -// Element 12 aiguillage pointe 45°G vers droit -procedure dessin_12(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; +// élément 11 +procedure dessin_11(Canvas : Tcanvas;x,y : integer;Mode : integer); +var Adr, x0,y0 : integer; r : Trect; - procedure horz; - begin - // bande horizontale - //r:=Rect(x0,jy1,x0+LargeurCell,jy2); - //Canvas.FillRect(r); - - r:=Rect(x0+(LargeurCell div 2),jy1,x0+LargeurCell,jy2); - canvas.FillRect(r); - end; - - procedure diagonale; - begin - x1:=x0+round(3*frXGlob);y1:=y0; - x2:=x0+largeurCell;y2:=y0+HauteurCell-round(3*frYGlob); - x3:=x0+largeurCell-round(4*frXGlob); y3:=y0+HauteurCell; - x4:=x0; y4:=y0+round(4*frYGlob); - - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - end; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; - position:=positionTCO(x,y); - + with canvas do begin - // efface cellule Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); - Brush.Color:=clVoies; - pen.color:=clVoies; - - if (position=const_Devie) or (position=9) then - begin - diagonale; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - - x1:=x0+round(3*frXGlob);y1:=y0; - x2:=x0+(largeurCell div 2)+round(7*frXGlob);y2:=jy2;//y2:=y0+(HauteurCell div 2); - x3:=x2-round(9*frXGlob); y3:=y2; - x4:=x0; y4:=y0+round(4*frYGlob); - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - - // efface le morceau - if (position=const_Devie) then - begin - x1:=x0+round(22*frxGlob);y1:=jy2; //+round(FrYGlob*1); - x2:=x1+round(12*frxGlob);y2:=y1; - x3:=x2;y3:=y2+3; - x4:=x1;y4:=y3; - pen.color:=fond; - Brush.COlor:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; + Adr:=TCO[x,y].adresse; + if (Adr<>0) and detecteur[Adr].etat then couleur:=clAllume + else + case mode of + 0: couleur:=clVoies; + 1: couleur:=clAllume; + 2: couleur:=couleurtrain[index_couleur]; end; - - // aiguillage droit (sans inversion) ou dévie (avec inversion) - if (position=const_Droit) then - begin - horz; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - diagonale; + Brush.Color:=couleur; + pen.color:=couleur; + Pen.Mode:=pmCopy; + Pen.Width:=epaisseur; + moveTo(x0,y0);LineTo(x0+largeurCell,y0+hauteurCell); + end; +end; - // efface le morceau - x1:=x0+round(26*frXGlob);y1:=jy1; - x2:=x1+round(10*frxGlob);y2:=y1; - x3:=x2+round(12*FrxGlob);y3:=y2+round(12*fryGlob); - x4:=x3-round(10*frxGlob);y4:=y3; + +// Element 12 +procedure dessin_12(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; + r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);lineto(xf,yf); // diag complete + moveto(xc,yc);lineto(xf,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie droite couleur voies + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);lineto(xf,yc); // partie droite + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // première partie haute toujours allumée + moveto(x0,y0);LineTo(xc,yc); + + // 2eme partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(xf,yf); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);lineto(xf,yf); // diag complete + moveto(xc,yc);lineto(xf,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie sup en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);LineTo(xf,yf); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,y0);LineTo(xc,yc);LineTo(xf,yc); + end; + end; + +begin + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + position:=positionTCO(x,y); + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=fond; + r:=Rect(x0,y0,xf,yf); + FillRect(r); // efface la cellule + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if (position=const_Devie) or (position=const_inconnu) then + begin + trajet_devie; // affiche la position de la branche déviée + end; + + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau + pen.width:=1; + x1:=xc-epaisseur;y1:=yc+(epaisseur div 2)+1; + x2:=x1+3*epaisseur;y2:=y1; + x3:=x2;y3:=y2+epaisseur; + x4:=x1;y4:=y3; + pen.color:=fond; + Brush.COlor:=fond; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.Width:=1; + x1:=xc+(epaisseur div 2)-2;y1:=yc-(epaisseur div 2)-1; + x2:=x1+epaisseur;y2:=y1; + x3:=x2+epaisseur+2;y3:=y2+epaisseur+2; + x4:=x3-epaisseur;y4:=y3; pen.color:=fond; Brush.COlor:=fond; Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); @@ -1577,303 +1683,392 @@ end; // Elément 13 procedure dessin_13(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; r : Trect; - procedure horz; - begin - // bande horizontale - r:=Rect(x0,jy1,x0+(LargeurCell div 2),jy2); - canvas.FillRect(r); - end; - procedure diagonale; - begin - x1:=x0;y1:=y0+hauteurCell-round(3*frYGlob); - x2:=x0+largeurCell-round(3*frXGlob);y2:=y0; - x3:=x0+largeurCell;y3:=y0+round(4*FryGlob); - x4:=x0+round(4*frXGlob);y4:=y0+hauteurCell; - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - end; - + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yf);lineto(xf,y0); // diag complete + moveto(x0,yc);lineto(xc,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie horz couleur voies + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xc,yc); // partie horz + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // première partie basse toujours allumée + moveto(x0,yf);LineTo(xc,yc); + + // 2eme partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(xf,y0); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yf);lineto(xf,y0); // diag complete + moveto(x0,yc);lineto(xc,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie inf en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);LineTo(x0,yf); + + if mode=1 then couleur:=clAllume; + 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; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin position:=positionTCO(x,y); - + with canvas do begin - //efface - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - + 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; - - // aiguillage dévié (sans inversion) ou position inconnue (9) + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + if (position=const_Devie) or (position=const_inconnu) then begin - diagonale; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - - // morceau de diagonale à tracer en clAllume - x1:=x0+largeurCell-round(3*frXGlob);y1:=y0; - x2:=x0+largeurCell;y2:=y0+round(4*FryGlob); - x3:=x0+(largeurCell div 2)+round(4*frXGlob);y3:=jy2; - x4:=x0+(largeurCell div 2)-round(7*frXGlob);y4:=jy2; - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - - // efface le morceau - if (position=const_Devie) then - begin - // efface le morceau - x1:=x0+round(12*frXGlob);y1:=jy2; - x2:=x1+round(20*frxGlob);y2:=y1; - x3:=x2;y3:=y2+round(3*frYGlob); - x4:=x1;y4:=y3; - pen.color:=fond; - Brush.Color:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; + trajet_devie; // affiche la position de la branche déviée end; - - // aiguillage droit (sans inversion) ou dévie (avec inversion) - if (position=const_droit) then - begin - horz; - begin - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - end; - diagonale; - // efface le morceau - x1:=x0+round(19*frXGlob);y1:=jy1; - x2:=x1+round(6*frxGlob);y2:=y1; - x3:=x2-round(12*FrxGlob);y3:=y2+round(12*fryGlob); - x4:=x3-round(8*frxGlob);y4:=y3; + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau pen.color:=fond; Brush.Color:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; -end; - -// Element 14 -procedure dessin_14(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; - r : Trect; - - procedure horz; - begin - r:=Rect(x0,jy1,x0+(LargeurCell div 2),jy2); - canvas.FillRect(r); + pen.width:=1; + x1:=xc-2*epaisseur-5;y1:=yc+(epaisseur div 2)+1; + x2:=xc+epaisseur+10;y2:=y1+epaisseur; + r:=rect(x1,y1,x2,y2); + rectangle(r); end; - procedure diagonale; + if position=const_droit then begin - x1:=x0+round(3*frXGlob); y1:=y0; - x2:=x0+largeurCell; y2:=y0+HauteurCell-round(3*fryGlob); - x3:=x0+largeurCell-round(4*frXGlob);y3:=y0+HauteurCell; - x4:=x0; y4:=y0+round(4*frYGlob); - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - end; -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; - position:=positionTCO(x,y); - - with canvas do - begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - Brush.Color:=clVoies; - pen.color:=clVoies; - - // aiguillage dévié (sans inversion) - if (position=const_Devie) or (position=9) then - begin - diagonale; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - - // morceau de diagonale à tracer en clAllume - x1:=x0+(largeurCell div 2)-round(8*frXGlob); y1:=jy1; - x2:=x1+round(8*frXGlob); y2:=y1; - x3:=x0+largeurCell; y3:=y0+HauteurCell-round(3*fryGlob); - x4:=x0+largeurCell-round(4*frXGlob);y4:=y0+HauteurCell; - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - - // efface le morceau - if (position=const_Devie) then - begin - // efface le morceau - x1:=x0+round(2*frXGlob);y1:=jy1-round(1*fryGlob); - x2:=x1+round(23*frxGlob);y2:=y1; - x3:=x2;y3:=y2-round(3*fryGlob); - x4:=x1;y4:=y3; - pen.color:=fond; - Brush.Color:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; - - // aiguillage droit (sans inversion) ou dévie (avec inversion) - if (position=const_Droit) then - begin - horz; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - diagonale; - // efface le morceau - x1:=x0+round(10*frXGlob);y1:=jy1; - x2:=x1+round(6*frxGlob);y2:=y1; - x3:=x2+round(12*FrxGlob);y3:=y2+round(12*fryGlob); - x4:=x3-round(5*frxGlob);y4:=y3; + // effacement du morceau pen.color:=fond; Brush.Color:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; -end; - - -// Element 15 -procedure dessin_15(Canvas : Tcanvas;x,y : integer;Mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2,position : integer; - inverse : boolean; - r : Trect; - - procedure horz; - begin - r:=Rect(x0+(LargeurCell div 2)+1,jy1,x0+LargeurCell,jy2); - canvas.FillRect(r); - end; - - procedure diagonale; - begin - x1:=x0;y1:=y0+hauteurCell-round(3*frYGlob); - x2:=x0+largeurCell-round(3*frXGlob);y2:=y0; - x3:=x0+largeurCell;y3:=y0+round(4*frYGlob); - x4:=x0+round(3*frYGlob);y4:=y0+hauteurCell; - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - end; - -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - inverse:=tco[x,y].inverse; - position:=positionTCO(x,y); - - with canvas do - begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - Brush.Color:=clVoies; - pen.color:=clVoies; - - // aiguillage dévié (sans inversion) - if (position=const_Devie) or (position=const_inconnu) then - begin - diagonale; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - horz; - // morceau de diag à tracer - x1:=x0-round(0*frxglob);y1:=y0+hauteurCell-round(3*frYGlob); - x2:=x0+(largeurCell div 2)-round(0*frXGlob);y2:=jy1; - x3:=x2+round(8*frXglob);y3:=y2; - x4:=x0+round(3*frYGlob);y4:=y0+hauteurCell; - canvas.PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); - - // efface le morceau - if (position=const_Devie) then - begin - x1:=x0+round(20*frXGlob);y1:=jy1-round(1*frYGlob); - x2:=x1+round(23*frxGlob);y2:=y1; - x3:=x2;y3:=y2-round(3*frYGlob); - x4:=x1;y4:=y3; - - pen.color:=fond; - Brush.Color:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - end; - end; - - // aiguillage droit (sans inversion) ou dévie (avec inversion) - if (position=const_Droit) then - begin - horz; - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Pen.color:=couleur;Brush.Color:=couleur; - diagonale; - - // efface morceau - x1:=x0+round(34*frXGlob);y1:=jy1; - x2:=x1+round(6*frxGlob);y2:=y1; - x3:=x2-round(12*FrxGlob);y3:=y2+round(12*fryGlob); - x4:=x3-round(8*frxGlob);y4:=y3; - pen.color:=fond; - Brush.Color:=fond; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + pen.width:=1; + x1:=xc-(epaisseur div 2)+1;y1:=yc-(epaisseur div 2)-1; + x2:=x1-epaisseur-1; + x3:=x2-epaisseur;y3:=yc+(epaisseur div 2)+1; + x4:=x1-epaisseur-1; + polygon([point(x1,y1),point(x2,y1),point(x3,y3),point(x4,y3)]); end; end; end; +// Element 14 +procedure dessin_14(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,y3,x4,y4,position : integer; + r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);lineto(xf,yf); // diag complete + moveto(x0,yc);lineto(xc,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie droite couleur voies + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yc);lineto(xc,yc); // partie droite + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // première partie basse toujours allumée + moveto(xf,yf);LineTo(xc,yc); + + // 2eme partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(x0,y0); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);lineto(xf,yf); // diag complete + moveto(x0,yc);lineto(xc,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie sup en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,y0);LineTo(xc,yc); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(xf,yf);LineTo(xc,yc);LineTo(x0,yc); + end; + end; + + +begin + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + position:=positionTCO(x,y); + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=fond; + r:=Rect(x0,y0,xf,yf); + FillRect(r); // efface la cellule + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if (position=const_Devie) or (position=const_inconnu) then + begin + trajet_devie; // affiche la position de la branche déviée + end; + + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau + pen.width:=1; + x1:=xc-2*epaisseur-5;y1:=yc-(epaisseur div 2); + x2:=x1+3*epaisseur;y2:=y1-epaisseur; + pen.color:=fond; + Brush.Color:=fond; + r:=rect(x1,y1,x2,y2); + rectangle(r); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.Width:=1; + x1:=xc-epaisseur-3;y1:=yc-(epaisseur div 2)-1; + x2:=x1-epaisseur;y2:=y1; + x3:=x2+epaisseur+2;y3:=y2+epaisseur+2; + x4:=x3+epaisseur;y4:=y3; + pen.color:=fond; + Brush.Color:=fond; + Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); + end; + end; +end; + +// Element 15 +procedure dessin_15(Canvas : Tcanvas;x,y : integer;Mode : integer); +var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position : integer; + r : Trect; + + procedure trajet_droit; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yf);lineto(xf,y0); // diag complete + moveto(xc,yc);lineto(xf,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie droite couleur voies + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);lineto(xf,yc); // partie droite + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + // première partie basse toujours allumée + moveto(x0,yf);LineTo(xc,yc); + + // 2eme partie en fonction de la position + if position=const_devie then + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + end; + LineTo(xf,y0); + end; + end; + + procedure trajet_devie; + begin + if mode=0 then + with canvas do + begin + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(x0,yf);lineto(xf,y0); // diag complete + moveto(xc,yc);lineto(xf,yc); // partie droite + end; + if (mode=1) or (mode=2) then + with canvas do + begin + // partie sup en couleur de voie + pen.color:=clvoies; + Brush.Color:=clvoies; + moveto(xc,yc);LineTo(xf,y0); + + if mode=1 then couleur:=clAllume; + if mode=2 then couleur:=couleurtrain[index_couleur]; + pen.color:=couleur; + Brush.Color:=couleur; + moveto(x0,yf);LineTo(xc,yc);LineTo(xf,yc); + end; + end; + +begin + x0:=(x-1)*LargeurCell; // x origine + y0:=(y-1)*HauteurCell; // y origine + yc:=y0+(HauteurCell div 2); // y centre + xc:=x0+(LargeurCell div 2); // x centre + xf:=x0+largeurCell; // x fin + yf:=y0+HauteurCell; // y fin + position:=positionTCO(x,y); + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=fond; + Pen.Color:=fond; + r:=Rect(x0,y0,xf,yf); + FillRect(r); // efface la cellule + + Pen.Width:=epaisseur; + Brush.Color:=clVoies; + Pen.Color:=clVoies; + Pen.Mode:=pmCopy; + + if (position=const_Devie) or (position=const_inconnu) then + begin + trajet_devie; // affiche la position de la branche déviée + end; + + if (position=const_droit) or (position=const_inconnu) then + begin + trajet_droit; + end; + + if (position=const_Devie) then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.width:=1; + x1:=xc-epaisseur;y1:=yc-(epaisseur div 2)-1; + x2:=xc+epaisseur+10;y2:=yc-epaisseur-3; + polygon([point(x1,y1),point(x2,y1),point(x2,y2),point(x1,y2)]); + end; + + if position=const_droit then + begin + // effacement du morceau + pen.color:=fond; + Brush.Color:=fond; + pen.Width:=1; + x1:=xc+(epaisseur div 2);y1:=yc+(epaisseur div 2); + x2:=x1+epaisseur-1;y2:=yc-(epaisseur div 2); + x3:=x1+10; + polygon([point(x1,y1),point(x2,y2),point(x3,y2),point(x3,y1)]); + end; + end; +end; + // Element 16 procedure dessin_16(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,xbv1,xbv2 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; - xbv1:=x0+(LargeurCell div 2)-round(3*frXGlob); // pos x de la bande verticale - xbv2:=x0+(LargeurCell div 2)+round(3*frXGlob); // pos x de la bande verticale + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); @@ -1885,35 +2080,120 @@ begin Brush.Color:=Couleur; pen.color:=Couleur; Pen.Mode:=pmCopy; - - // brush.color:=clblue; - x1:=x0; y1:=y0+round(3*frYGlob); - x2:=x0+round(2*frXGlob);y2:=y0; - x3:=x0+(LargeurCell div 2)+round(2*frXGlob);y3:=y0+(HauteurCell div 2); - x4:=x0+(LargeurCell div 2)-round(3*frXGlob);y4:=y3; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - - r:=Rect(xbv1,y0+HauteurCell div 2,xbv2,y0+HauteurCell); - FillRect(r); + Pen.width:=epaisseur; + MoveTo(x0,y0);lineTo(xc,yc);LineTo(xc,y0+hauteurCell); end; end; // Element 17 procedure dessin_17(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,xbv1,xbv2 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; - xbv1:=x0+(LargeurCell div 2)-round(3*frXGlob); // pos x de la bande verticale - xbv2:=x0+(LargeurCell div 2)+round(3*frXGlob); // pos x de la bande verticale + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin Brush.Color:=Fond; + Pen.Width:=1; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); + case mode of + 0: couleur:=clVoies; + 1: couleur:=clAllume; + 2: couleur:=couleurtrain[index_couleur]; + end; + Pen.Width:=epaisseur; + Brush.Color:=couleur; + pen.color:=couleur; + Pen.Mode:=pmCopy; + MoveTo(x0+LargeurCell,y0);LineTo(xc,yc);LineTo(xc,y0+hauteurCell); + end; +end; + +// Elément 18 +procedure dessin_18(Canvas : Tcanvas;x,y,mode: integer); +var x0,y0,xc,yc : integer; + r : Trect; +begin + x0:=(x-1)*LargeurCell; + y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); + + with canvas do + begin + Brush.Color:=Fond; + Pen.Width:=1; + r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); + FillRect(r); + + case mode of + 0: couleur:=clVoies; + 1: couleur:=clAllume; + 2: couleur:=couleurtrain[index_couleur]; + end; + Brush.Color:=Couleur; + pen.color:=Couleur; + Pen.Mode:=pmCopy; + Pen.Width:=epaisseur; + MoveTo(x0,y0+hauteurCell);LineTo(xc,yc);LineTo(xc,y0); + end; +end; + +// Element 19 +procedure dessin_19(Canvas : Tcanvas;x,y,mode: integer); +var x0,y0,xc,yc,adr : integer; + r : Trect; +begin + x0:=(x-1)*LargeurCell; + y0:=(y-1)*HauteurCell; + xc:=x0+(largeurcell div 2); + yc:=y0+(Hauteurcell div 2); + + with canvas do + begin + Brush.Color:=Fond; + Pen.Width:=1; + r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); + FillRect(r); + + case mode of + 0: couleur:=clVoies; + 1: couleur:=clAllume; + 2: couleur:=couleurtrain[index_couleur]; + end; + Brush.Color:=Couleur; + pen.color:=Couleur; + Pen.Mode:=pmCopy; + Pen.width:=epaisseur; + moveto(xc,y0);LineTo(xc,yc);LineTo(x0+largeurCell,y0+HauteurCell); + end; +end; + +// Element 20 +procedure dessin_20(Canvas : Tcanvas;x,y,mode: integer); +var x0,y0,xc,adr : integer; + r : Trect; +begin + x0:=(x-1)*LargeurCell; + y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + + with canvas do + begin + Pen.Width:=1; + Brush.Color:=Fond; + r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); + FillRect(r); + + Adr:=TCO[x,y].adresse; + if (Adr<>0) and detecteur[Adr].etat then couleur:=clAllume + else case mode of 0: couleur:=clVoies; 1: couleur:=clAllume; @@ -1922,211 +2202,73 @@ begin Brush.Color:=couleur; pen.color:=couleur; Pen.Mode:=pmCopy; - - // brush.color:=clblue; - x1:=x0+largeurCell-round(3*frxGlob); y1:=y0; - x2:=x0+LargeurCell;y2:=y0+round(2*frYGlob); - x3:=x0+(LargeurCell div 2)+round(2*frXGlob);y3:=y0+(HauteurCell div 2); - x4:=x0+(LargeurCell div 2)-round(3*frXGlob);y4:=y3; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - - r:=Rect(xbv1,y0+HauteurCell div 2,xbv2,y0+HauteurCell); - FillRect(r); - end; -end; - -// Elément 18 -procedure dessin_18(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,xbv1,xbv2 : integer; - r : Trect; -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - xbv1:=x0+(LargeurCell div 2)-round(3*frXGlob); // pos x de la bande verticale - xbv2:=x0+(LargeurCell div 2)+round(3*frXGlob); // pos x de la bande verticale - - with canvas do - begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Brush.Color:=Couleur; - pen.color:=Couleur; - Pen.Mode:=pmCopy; - - // brush.color:=clblue; - x1:=x0+(largeurCell div 2)-round(3*frxGlob); y1:=y0+(HauteurCell div 2); - x2:=x0+(largeurCell div 2)+round(2*frxGlob); y2:=y1; - x3:=x0+round(2*frXGlob);y3:=y0+HauteurCell; - x4:=x0;y4:=y0+HauteurCell-round(3*frYGlob); - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - - r:=Rect(xbv1,y0+HauteurCell div 2,xbv2,y0); - FillRect(r); - end; -end; - -// Element 19 -procedure dessin_19(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,xbv1,xbv2 : integer; - r : Trect; -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - xbv1:=x0+(LargeurCell div 2)-round(3*frXGlob); // pos x de la bande verticale - xbv2:=x0+(LargeurCell div 2)+round(3*frXGlob); // pos x de la bande verticale - - with canvas do - begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Brush.Color:=Couleur; - pen.color:=Couleur; - Pen.Mode:=pmCopy; - - // brush.color:=clblue; - x1:=x0+(largeurCell div 2)-round(3*frxGlob); y1:=y0+(HauteurCell div 2); - x2:=x0+(largeurCell div 2)+round(2*frxGlob); y2:=y1; - x3:=x0+largeurCell;y3:=y0+HauteurCell-round(2*frYGlob); - x4:=x0+largeurCell-round(3*frXGlob);y4:=y0+HauteurCell; - Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]); - - r:=Rect(xbv1,y0+HauteurCell div 2,xbv2,y0); - FillRect(r); - end; -end; - -// Element 20 -procedure dessin_20(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,xbv1,xbv2,adr : integer; - r : Trect; -begin - x0:=(x-1)*LargeurCell; - y0:=(y-1)*HauteurCell; - - - with canvas do - begin - Brush.Color:=Fond; - r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); - FillRect(r); - - Adr:=TCO[x,y].adresse; - if Adr<>0 then - begin - if detecteur[Adr].etat then - begin - Brush.Color:=clAllume; - pen.color:=clAllume; - Pen.Mode:=pmCopy; - xbv1:=x0+(LargeurCell div 2)-round(6*frXGlob); // pos x de la bande verticale - xbv2:=x0+(LargeurCell div 2)+round(6*frXGlob); // pos x de la bande verticale - r:=Rect(xbv1,y0,xbv2,y0+HauteurCell); - FillRect(r); - end; - end; - - case mode of - 0: couleur:=clVoies; - 1: couleur:=clAllume; - 2: couleur:=couleurtrain[index_couleur]; - end; - Brush.Color:=Couleur; - pen.color:=Couleur; - Pen.Mode:=pmCopy; - xbv1:=x0+(LargeurCell div 2)-round(3*frXGlob); // pos x de la bande verticale - xbv2:=x0+(LargeurCell div 2)+round(3*frXGlob); // pos x de la bande verticale - r:=Rect(xbv1,y0,xbv2,y0+HauteurCell); - FillRect(r); + Pen.width:=epaisseur; + MoveTo(xc,y0);LineTo(xc,y0+HauteurCell); end; end; // Element 21 - croisement - TJD procedure dessin_21(Canvas : Tcanvas;x,y,mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin - + Pen.Width:=1; Brush.Color:=Fond; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); Brush.Color:=clvoies; pen.color:=clvoies; + pen.width:=epaisseur; // diagonale - x1:=x0;y1:=y0+hauteurCell-round(3*FryGlob); - x2:=x0+largeurCell-round(3*FrXGlob);y2:=y0; - x3:=x0+largeurCell;y3:=y0+round(4*FrYGlob); - x4:=x0+round(4*FrXGlob); y4:=y0+hauteurCell; - PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + moveTo(x0,y0+hauteurCell);LineTo(x0+LargeurCell,y0); // horizontale - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - FillRect(r); - + moveTo(x0,yc);LineTo(x0+largeurCell,yc); end; end; // Element 22 procedure dessin_22(Canvas : Tcanvas;x,y,mode : integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; +var x0,y0,xc,yc : integer; r : Trect; begin x0:=(x-1)*LargeurCell; y0:=(y-1)*HauteurCell; + xc:=x0+(largeurCell div 2); + yc:=y0+(hauteurCell div 2); with canvas do begin - + Pen.Width:=1; Brush.Color:=Fond; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); Brush.Color:=clvoies; pen.color:=clvoies; + pen.width:=epaisseur; // diagonale - x1:=x0+round(3*FrXGlob);y1:=y0; - x2:=x0+largeurCell;y2:=y0+HauteurCell-round(3*FrYGlob); - x3:=x0+largeurCell-round(4*FrXGlob);y3:=y0+HauteurCell; - x4:=x0;y4:=y0+round(4*frYGlob); - PolyGon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]); + moveto(x0,y0);lineTo(x0+largeurCell,y0+hauteurCell); // horizontale - Brush.Color:=clvoies; - pen.color:=clvoies; - jy1:=y0+(HauteurCell div 2)-round(3*frYGlob); // pos Y de la bande sup - jy2:=y0+(HauteurCell div 2)+round(3*frYGlob); // pos Y de la bande inf - r:=Rect(x0,jy1,x0+LargeurCell,jy2); - FillRect(r); + moveto(x0,yc);LineTo(x0+hauteurCell,yc); end; end; // Element 23 procedure dessin_23(Canvas : Tcanvas;x,y,mode: integer); -var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; +var x0,y0,x1,y1,x2,y2,jy1,jy2 : integer; r : Trect; begin x0:=(x-1)*LargeurCell; @@ -2134,7 +2276,7 @@ begin with canvas do begin - + Pen.Width:=1; Brush.Color:=Fond; r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell); FillRect(r); @@ -2143,13 +2285,11 @@ begin pen.color:=clQuai; x1:=x0;y1:=y0; x2:=x0+largeurCell;y2:=y0+HauteurCell-round(3*FrYGlob); - x3:=x0+largeurCell-round(4*FrXGlob);y3:=y0+HauteurCell; - x4:=x0;y4:=y0+round(4*frYGlob); jy1:=y0+(HauteurCell div 2)-round(14*frYGlob); // pos Y de la bande sup jy2:=y0+(HauteurCell div 2)+round(14*frYGlob); // pos Y de la bande inf - - PolyGon([point(x1,jy1),point(x2,jy1),point(x2,jy2),point(x1,jy2)]); + r:=rect(x1,jy1,x2,jy2); + rectangle(r); end; end; @@ -2218,6 +2358,7 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=0;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); @@ -2239,6 +2380,7 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=35;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); @@ -2258,13 +2400,14 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=12;y1:=35; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ); - + moveTo( x+round((x1+1)*frX),y+round((y1+0)*frY) ); LineTo( x+round((x1+1)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else @@ -2279,12 +2422,13 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=45;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-50)*fry) ) else - LineTo( x+round((x1+7)*frX),y+round((y1+50)*fry) ); + LineTo( x+round((x1+7)*frX),y+round((y1+50)*fry) ); moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); @@ -2293,13 +2437,14 @@ begin end; end; -procedure affiche_pied3G_90G(x,y : integer;FrX,frY : real;pied : integer); +procedure affiche_pied3G_90G(x,y : integer;FrX,frY : real;pied : integer); var x1,y1 : integer; ech : real; begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=0;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); @@ -2319,13 +2464,14 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=12;y1:=42; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+6)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+6)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+6)*frY) ) ; - + moveTo( x+round((x1+1)*frX),y+round((y1+0)*frY) ); LineTo( x+round((x1+1)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else @@ -2338,6 +2484,7 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=0;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); @@ -2355,10 +2502,11 @@ end; procedure affiche_pied4G_90D(x,y : integer;FrX,frY : real;piedfeu: integer); var x1,y1 : integer; ech : real; -begin +begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=55;y1:=12; moveTo( x+round(x1*frX),y+round(y1*frY) ); @@ -2378,13 +2526,14 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; - x1:=12;y1:=55; + x1:=12;y1:=55; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); - + moveTo( x+round((x1+1)*frX),y+round((y1+0)*frY) ); LineTo( x+round((x1+1)*frX),y+round((y1+8)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+8)*frY) ) else @@ -2399,16 +2548,17 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=90;y1:=38; moveTo( x+round((x1)*frX),y+round(y1*frY) ); LineTo( x+round((x1+7)*frX),y+round((y1+0)*frY) ); - if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fry)) else + if pied=1 then LineTo( x+round((x1+7)*frX),y+round((y1-62)*fry)) else LineTo( x+round((x1+7)*frX),y+round((y1+40)*fry)); moveTo( x+round((x1)*frX),y+round((y1+1)*frY) ); LineTo( x+round((x1+6)*frX),y+round((y1+1)*frY) ); - if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-62)*fry) ) else + if pied=1 then LineTo( x+round((x1+6)*frX),y+round((y1-62)*fry) ) else LineTo( x+round((x1+6)*frX),y+round((y1+40)*fry)) ; end; end; @@ -2421,6 +2571,7 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=66;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); @@ -2442,7 +2593,8 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin - Pen.Color:=clOrange; + Pen.Width:=1; + Pen.Color:=clOrange; x1:=0;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); LineTo( x+round((x1-7)*frX),y+round((y1+0)*frY) ); @@ -2461,13 +2613,14 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=12;y1:=65; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); if pied=1 then LineTo( x+round((x1+50)*frX),y+round((y1+7)*frY) ) else - LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); + LineTo( x+round((x1-50)*frX),y+round((y1+7)*frY) ); moveTo( x+round((x1+1)*frX),y+round((y1+0)*frY) ); LineTo( x+round((x1+1)*frX),y+round((y1+8)*frY) ); @@ -2483,6 +2636,7 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clorange; x1:=75;y1:=38; moveTo( x+round((x1)*frX),y+round(y1*frY) ); @@ -2505,6 +2659,7 @@ begin with PcanvasTCO do begin Pen.Color:=clOrange; + Pen.Width:=1; x1:=0;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); LineTo( x+round((x1-7)*frX),y+round((y1+0)*frY) ); @@ -2523,16 +2678,17 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=12;y1:=75; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); - if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+7)*frY) ) else + if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-40)*frX),y+round((y1+7)*frY) ) ; moveTo( x+round((x1+1)*frX),y+round((y1+0)*frY) ); LineTo( x+round((x1+1)*frX),y+round((y1+8)*frY) ); - if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+8)*frY) ) else + if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+8)*frY) ) else LineTo( x+round((x1-40)*frX),y+round((y1+8)*frY) ) ; end; end; @@ -2544,6 +2700,7 @@ begin ech:=frY;frY:=frX;FrX:=ech; with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=0;y1:=12; moveTo( x+round((x1)*frX),y+round(y1*frY) ); @@ -2563,11 +2720,12 @@ var x1,y1 : integer; begin with PcanvasTCO do begin + Pen.Width:=1; Pen.Color:=clOrange; x1:=12;y1:=90; moveTo( x+round((x1+0)*frX),y+round(y1*frY) ); LineTo( x+round((x1+0)*frX),y+round((y1+7)*frY) ); - if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+7)*frY) ) else + if pied=1 then LineTo( x+round((x1+60)*frX),y+round((y1+7)*frY) ) else LineTo( x+round((x1-40)*frX),y+round((y1+7)*frY) ) ; moveTo( x+round((x1+1)*frX),y+round((y1+0)*frY) ); @@ -2844,15 +3002,13 @@ begin Font.Name:='Arial'; Font.Style:=style(tco[x,y].FontStyle); xt:=round(15*frXGlob); + repr:=0; case repr of 1 : yt:=(HauteurCell div 2)-round(7*fryGlob); // milieu 2 : yt:=1; // haut 3 : yt:=HauteurCell-round(17*frYGlob); // bas end; - if repr<>0 then - begin - TextOut(xOrg+xt,Yorg+yt,s); - end; + if repr<>0 then TextOut(xOrg+xt,Yorg+yt,s); end; end; @@ -2947,7 +3103,7 @@ begin Brush.Color:=clBlack; Brush.Style:=bsSolid; Pen.Mode:=PmXor; - r:=Rect(x0,y0,x0+largeurCell,y0+LargeurCell); + r:=Rect(x0,y0,x0+largeurCell,y0+HauteurCell); Rectangle(r); Pen.width:=1; Pen.Mode:=PmCopy; @@ -3099,7 +3255,7 @@ begin clTexte:=ClLime; clGrille:=$404040; // évite le clignotement pendant les affichages mais ne marche pas - //DoubleBuffered:=true; + DoubleBuffered:=true; comborepr.Enabled:=false; ImageTCO.Top:=0; ImageTCO.Left:=0; @@ -3165,8 +3321,7 @@ begin comboRepr.Enabled:=false; end; - LabelX.caption:=IntToSTR(XclicCell); - LabelY.caption:=IntToSTR(YclicCell); + LabelCoord.caption:=IntToSTR(XclicCell)+','+IntToSTR(YclicCell); XclicCellInserer:=XClicCell; YclicCellInserer:=YClicCell; @@ -3552,6 +3707,7 @@ begin calcul_reduction(frxGlob,fryGlob,LargeurCell,HauteurCell,ZoomMax,ZoomMax); // dessiner les icônes + epaisseur:=5; dessin_5(ImagePalette5.Canvas,1,1,0); //posX,posY,état,position dessin_2(ImagePalette2.Canvas,1,1,0); dessin_3(ImagePalette3.Canvas,1,1,0); @@ -3636,8 +3792,7 @@ begin _entoure_cell_clic; - LabelX.caption:=IntToSTR(XclicCell); - LabelY.caption:=IntToSTR(YclicCell); + LabelCoord.caption:=IntToSTR(XclicCell)+','+IntToSTR(YclicCell); XclicCellInserer:=XClicCell; YclicCellInserer:=YClicCell; //Entoure_cell(XclicCellInserer,YclicCellInserer); @@ -3656,8 +3811,7 @@ begin VK_up : if YClicCell>1 then dec(YClicCell); VK_delete : affiche('delete',clorange); end; - LabelX.caption:=IntToSTR(XClicCell); - LabelY.caption:=IntToSTR(YClicCell); + LabelCoord.caption:=IntToSTR(XClicCell)+','+IntToSTR(YClicCell); Entoure_cell(XclicCell,YclicCell); EditAdrElement.Text:=IntToSTR(tco[XClicCell,YClicCell].Adresse); end; @@ -4386,7 +4540,7 @@ begin begin adresse:=tco[xPlace,yPlace].Adresse; end; - end; + end; end; end; end; @@ -4396,49 +4550,45 @@ end; // évènement qui se produit quand on clique gauche ou droit procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); -var position : Tpoint; +var position : Tpoint; begin // ImageTCO.BeginDrag(true); - if button=mbLeft then + if button=mbLeft then + begin + //Affiche('Souris clic enfoncée',clLime); + Temposouris:=0; + xMiniSel:=99999;yMiniSel:=99999; + xMaxiSel:=0;yMaxiSel:=0; + sourisclic:=true; + if SelectionAffichee then begin - //Affiche('Souris clic enfoncée',clLime); - Temposouris:=0; - xMiniSel:=99999;yMiniSel:=99999; - xMaxiSel:=0;yMaxiSel:=0; - sourisclic:=true; - if SelectionAffichee then + //Affiche('efface sélection',clOrange); + with imageTCO.Canvas do begin - //Affiche('efface sélection',clOrange); - with imageTCO.Canvas do - begin - Pen.Mode:=PmXor; - Pen.color:=clGrille; - Brush.Color:=clblue; - //FillRect(r); - Rectangle(rAncien); - end; - SelectionAffichee:=false; + Pen.Mode:=PmXor; + Pen.color:=clGrille; + Brush.Color:=clblue; + //FillRect(r); + Rectangle(rAncien); end; + SelectionAffichee:=false; end; + end; - if button=mbRight then - begin - GetCursorPos(Position); - Position:=ImageTCO.screenToCLient(Position); - Xclic:=position.X; - YClic:=position.Y; - - // coordonnées grille - XclicCell:=Xclic div largeurCell + 1; - YclicCell:=Yclic div hauteurCell + 1; - - LabelX.caption:=IntToSTR(XclicCell); - LabelY.caption:=IntToSTR(YclicCell); - XclicCellInserer:=XClicCell; - YclicCellInserer:=YClicCell; - //Entoure_cell(XclicCellInserer,YclicCellInserer); - - EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); + if button=mbRight then + begin + GetCursorPos(Position); + Position:=ImageTCO.screenToCLient(Position); + Xclic:=position.X; + YClic:=position.Y; + // coordonnées grille + XclicCell:=Xclic div largeurCell + 1; + YclicCell:=Yclic div hauteurCell + 1; + LabelCoord.caption:=IntToSTR(XClicCell)+','+IntToSTR(YClicCell); + XclicCellInserer:=XClicCell; + YclicCellInserer:=YClicCell; + //Entoure_cell(XclicCellInserer,YclicCellInserer); + EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse); end; end; @@ -5346,5 +5496,10 @@ begin FormConfCellTCO.BringToFront; end; +procedure TFormTCO.Button3Click(Sender: TObject); +begin + dessin_14(ImageTCO.canvas,6,1,1); +end; + begin end. diff --git a/verif_version.dcu b/verif_version.dcu index ae2586f..c825609 100644 Binary files a/verif_version.dcu and b/verif_version.dcu differ diff --git a/verif_version.pas b/verif_version.pas index f79ef56..bfdeb60 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -23,7 +23,7 @@ var Lance_verif : integer; verifVersion,notificationVersion : boolean; -Const Version='4.8'; // sert à la comparaison de la version publiée +Const Version='5.0'; // sert à la comparaison de la version publiée SousVersion=' '; // en cas d'absence de sous version mettre un espace implementation diff --git a/versions.txt b/versions.txt index ae59506..bbcdaab 100644 --- a/versions.txt +++ b/versions.txt @@ -113,39 +113,15 @@ version 4.3 : D Information sur la compatibilité windows 11 ajoutée à la documentation. version 4.4 : Possibilité d'avoir un champ vide dans le LAY, ce qui ouvre CDM avec le dernier LAY pour les problèmes d'ouverture avec W10 et W11. - Les passages à niveaux peut être commandés par des zones de détection. + Les passages à niveaux peuvent être commandés par des zones de détection. Code source modifié pour être compilable avec Rad Studio 11. version 4.5 : Correction champ "déclencheur" pour son. version 4.6 : Correction TJD 2/4 états dans le changement de sélection. Gestion des panneaux directionnels dans le TCO. version 4.7 : Réorganisation du menu et du panneau de configuration des cellules du TCO. Amélioration du séquenceur de connexion à l'interface. -version 4.71 : Correction bug décodage trame actionneur de CDM +version 4.71 : Correction bug décodage trame actionneur de CDM. version 4.72 : Renforcement de la vérification de la configuration. -version 4.73 : Pilotage des PN en impulsionnel ou non -version 4.8 : gestion des sémaphores clignotants et voie libre clignotants - - - - - - - - - - - - - - - - - - - - - - - - - +version 4.73 : Pilotage des PN en impulsionnel ou non. +version 5.0 : Gestion des sémaphores clignotants et voies libres clignotants. + Gestion des actionneurs déclenchés par évènements aiguillages.