diff --git a/Notice d'utilisation des signaux_complexes_GL_V9.76.pdf b/Notice d'utilisation des signaux_complexes_GL_V9.77.pdf similarity index 81% rename from Notice d'utilisation des signaux_complexes_GL_V9.76.pdf rename to Notice d'utilisation des signaux_complexes_GL_V9.77.pdf index fe94243..b76ade0 100644 Binary files a/Notice d'utilisation des signaux_complexes_GL_V9.76.pdf and b/Notice d'utilisation des signaux_complexes_GL_V9.77.pdf differ diff --git a/UnitAnalyseSegCDM.dfm b/UnitAnalyseSegCDM.dfm index 98790ce..196da0f 100644 --- a/UnitAnalyseSegCDM.dfm +++ b/UnitAnalyseSegCDM.dfm @@ -137,10 +137,10 @@ object FormAnalyseCDM: TFormAnalyseCDM object CheckPorts: TCheckBox Left = 240 Top = 32 - Width = 65 + Width = 129 Height = 17 Hint = 'Affiche le num'#233'ro de segment et le port de CDM' - Caption = 'Ports' + Caption = 'Ports et segments' ParentShowHint = False ShowHint = True TabOrder = 3 @@ -198,7 +198,7 @@ object FormAnalyseCDM: TFormAnalyseCDM end object ButtonImprime: TButton Left = 232 - Top = 48 + Top = 56 Width = 75 Height = 25 Caption = 'Imprimer' diff --git a/UnitAnalyseSegCDM.pas b/UnitAnalyseSegCDM.pas index 22b7a1d..01946c3 100644 --- a/UnitAnalyseSegCDM.pas +++ b/UnitAnalyseSegCDM.pas @@ -1314,11 +1314,11 @@ var TmpBmp: TBitmap; ARect: TRect; begin - TmpBmp := TBitmap.Create; - TmpBmp.Width := wid; - TmpBmp.Height := hei; - ARect := Rect(0,0, wid, hei); - TmpBmp.Canvas.StretchDraw(ARect, Bitmp); + TmpBmp:=TBitmap.Create; + TmpBmp.Width:=wid; + TmpBmp.Height:=hei; + ARect:=Rect(0,0, wid, hei); + TmpBmp.Canvas.StretchDraw(ARect,Bitmp); bitmp.Assign(TmpBmp); TmpBmp.Free; end; @@ -1330,7 +1330,7 @@ begin SinCos(Angle,SinA,CosA); Result.eM11:=CosA; Result.eM12:=SinA; - Result.eM21:=-SinA; + Result.eM21:=-SinA; Result.eM22:=CosA; Result.eDx:=(Centre.X - (CosA*Centre.X)) + (SinA*Centre.Y); Result.eDy:=(Centre.Y - (SinA*Centre.X)) - (CosA*Centre.Y); @@ -1370,7 +1370,7 @@ var recta : trect; begin ACanvas:=FormAnalyseCDM.ImageCDm.Canvas; - + l2:=largeurTrain div 2; h2:=hauteurTrain div 2; y:=y-1; // décalage observé @@ -1897,7 +1897,7 @@ begin end; // renvoie si le segment est de type aiguillage croisement compris -function segment_aig(s : string) : boolean; +function segment_aig_crois(s : string) : boolean; begin result:=(s='turnout') or (s='dbl_slip_switch') or (s='turnout_sym') or (s='turnout_curved') or (s='turnout_curved_2r') or (s='turnout_3way') or @@ -1935,7 +1935,7 @@ begin p:=segment[i].adresse; p2:=segment[i].adresse2; //Affiche(intToSTR(p),clwhite); - trouve:=((p=adresse) or (p2=adresse)) and segment_aig(segment[i].typ); + trouve:=((p=adresse) or (p2=adresse)) and segment_aig_crois(segment[i].typ); inc(i); until (i>nSeg-1) or trouve; dec(i); @@ -2399,7 +2399,7 @@ begin exit; end; - if segment_aig(typeP) then // est-ce un aig + if segment_aig_crois(typeP) then // est-ce un aig //------------- aiguillage begin portlocal:=segment[idSeg].port[idport].local; @@ -2874,7 +2874,7 @@ begin end; // autre aiguillage - if segment_aig(ctype) then + if segment_aig_crois(ctype) then begin // déterminer le numéro du port d'origine pOrg:=0; @@ -3104,7 +3104,7 @@ begin ctype:=segment[indexSegSuivant].typ; // est-ce un aiguillage ou tjd (croisement compris) - if segment_aig(ctype) then + if segment_aig_crois(ctype) then begin AdrAigRencontre:=segment[indexSegSuivant].adresse; if debugBranche then Affichedebug('Aiguillage '+intTostr(adrAigRencontre),clyellow); @@ -3489,7 +3489,7 @@ begin end; // si on rencontre une table, çà revient dans l'autre sens - trouve:=segment_aig(ctype); // est-ce un aiguillage ??? + trouve:=segment_aig_crois(ctype); // est-ce un aiguillage ??? // prépare suivant if not(trouve) then @@ -4732,9 +4732,8 @@ end; procedure clic_image; var pt : Tpoint; xSouris,ySouris,x1,y1,x2,y2,i,j,centreX,centrey,rayon,numero: integer; - StartAngle,StopAngle : single; - trouve : boolean; - debug : boolean; + StartAngle,StopAngle,Zoom : single; + trouve,debug : boolean; ctype,s : string; canvasI : Tcanvas; begin @@ -4744,6 +4743,8 @@ begin ySouris:=pt.y; canvasI:=FormAnalyseCDM.ImageCDM.Canvas; + Zoom:=(2*(90-formAnalyseCDM.TrackBar1.Position)/100)+0.4; + canvasI.font.size:=round(zoom*10); i:=0; repeat @@ -4756,7 +4757,7 @@ begin ctype:=Segment[i].typ; // aiguillage à 3 ports (turnout) - if segment_aig(ctype) and (ctype<>'dbl_slip_switch') then + if segment_aig_crois(ctype) and (ctype<>'dbl_slip_switch') then begin x1:=segment[i].port[0].x; y1:=segment[i].port[0].y; @@ -4818,10 +4819,10 @@ begin trouve:=point_Sur_Segment(Xsouris,Ysouris,x1,y1,x2,y2); if trouve then begin - s:=intToSTR(Segment[i].adresse); + s:=intToSTR(Segment[i].adresse); if Segment[i].adresse2<>0 then s:=s+'/'+intToSTR(Segment[i].adresse2); formAnalyseCDM.EditAdresse.Text:=s; - s:='Ports 0/1/2/3 = '+IntToSTR(Segment[i].port[0].numero)+'/'+IntToSTR(Segment[i].port[1].numero)+'/'+ + s:='Ports 0/1/2/3 = (NO/SO/NE/SE)'+#13+IntToSTR(Segment[i].port[0].numero)+'/'+IntToSTR(Segment[i].port[1].numero)+'/'+ IntToSTR(Segment[i].port[2].numero)+'/'+IntToSTR(Segment[i].port[3].numero); formAnalyseCDM.LabelPorts.Caption:=s; @@ -4984,7 +4985,7 @@ begin if adresse2<>0 then segment[IndexClic].adresse2:=adresse2; if (ctyp='crossing') then ofs:=YcrOffset; ctyp:=segment[IndexClic].typ; - if not(segment_aig(ctyp)) and not(ctyp='crossing') then exit; // si c'est pas un aiguillage ni un croisement + if not(segment_aig_crois(ctyp)) and not(ctyp='crossing') then exit; // si c'est pas un aiguillage ni un croisement if (ctyp='crossing') or (ctyp='dbl_slip_switch') then ofs:=YcrOffset; if (ctyp='turnout') or (ctyp='turnout_sym') then ofs:=yTurnoutOffset; if (ctyp='turnout_curved') or (ctyp='turnout_curved_2r') then ofs:=YcrOffset; diff --git a/UnitClock.pas b/UnitClock.pas index f1fa070..0a69388 100644 --- a/UnitClock.pas +++ b/UnitClock.pas @@ -62,7 +62,7 @@ type procedure SetFaceColor( Value : TColor); procedure SetArrowColor( Value : TColor); procedure SetShowSecond( Value : boolean); - function HourAngle( Hou, Min : word) : real; // Hour arrow angle + function HourAngle( Hou, Min : word) : single; // Hour arrow angle procedure CalcClockSettings; procedure DrawClockBkg; // Draw clock background on FBitMap @@ -150,7 +150,7 @@ begin inherited Destroy; end; -function TClock.HourAngle( Hou, Min : word) : real; +function TClock.HourAngle( Hou, Min : word) : single; begin HourAngle:=(Hou mod 12) * pisur6 + (Min*pisur360); end; @@ -172,9 +172,9 @@ var ABitMap : TBitMap; sin,cos :extended; - // Dessine les flèches dans le bitmap hors écran - procedure DrawArrow(Angle, Scale : real;AWidth : integer); - var SR : real; + // Dessine les flèches dans le bitmap hors écran (Abitmap) + procedure DessineAiguille(Angle,Scale : single;AWidth : integer); + var SR : single; begin with ABitMap.Canvas do begin @@ -202,17 +202,17 @@ begin if ShowSecond then begin ABitMap.Canvas.pen.Color:=$600000; // bleu foncé - DrawArrow(seconde*pisur30, SecScale, SecThick); // seconde + DessineAiguille(seconde*pisur30,SecScale,SecThick); // seconde end; ABitMap.Canvas.Pen.color:=ClkArrowColor; - DrawArrow(minute*pisur30,MinScale, MinThick); // minute - DrawArrow(HourAngle(heure,minute),HouScale,HouThick); // heure + DessineAiguille(minute*pisur30,MinScale, MinThick); // minute + DessineAiguille(HourAngle(heure,minute),HouScale,HouThick); // heure - // copie le bitmap hors écran dans l'horloge + // copie le bitmap hors écran (Abitmap) dans l'horloge Canvas.CopyMode:=cmSrcCopy; - Canvas.Draw(0,0,ABitMap); - formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] ); + Canvas.Draw(0,0,ABitMap); // copie formclock.canvas<-Abitmap ABitMap.Free; + formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] ); end; procedure TClock.CalcClockSettings; @@ -239,19 +239,19 @@ end; procedure TClock.DrawClockBkg; // Dessine les tirets minute sur FBitMap - procedure DrawMinSteps; - const EpGd=2; // epaisseurs des aiguilles - LgGd=25; - EpPt=1; - LgPt=7; + procedure DessineTiretsMn; + const EpGd=2; // epaisseurs grands marqueurs 12 3 6 9 + LgGd=25; // longueur grands marqueurs + EpPt=1; // epaisseurs petits marqueurs + LgPt=7; // longueur petits marqueurs var ep,lg,OfsX : integer; Angle : word; - SR : real; - sin, cos : extended; + SR : single; + sin,cos : extended; x1,y1,x2,y2,x3,y3,x4,y4 : integer; begin - OfsX := LapStepW DIV 2; + OfsX := LapStepW div 2; Angle:=0; FBitMap.Canvas.Pen.color:=ClkArrowColor; Fbitmap.canvas.Brush.Color:=clkArrowColor; @@ -325,9 +325,9 @@ begin begin Brush.Style:=bsSolid; Brush.Color:=ClkFaceColor; - FillRect( ClipRect); + FillRect(ClipRect); end; - DrawMinSteps; + DessineTiretsMn; end; // sur la fermeture de SC, l'horloge provoque une exception @@ -380,7 +380,7 @@ begin off:=40; {$IFEND} - ImageList24x24.GetBitmap(0,BitBtnMarHor.Glyph); + ImageList24x24.GetBitmap(0,BitBtnMarHor.Glyph); // marche horloge with BitBtnMarHor do begin Height:=26; @@ -388,7 +388,7 @@ begin Top:=formClock.Height-BitBtnMarHor.Height-off; end; - ImageList24x24.GetBitmap(1,BitBtnArrHorl.Glyph); + ImageList24x24.GetBitmap(1,BitBtnArrHorl.Glyph); // arrêt horloge with BitBtnArrHorl do begin Height:=26; @@ -396,7 +396,7 @@ begin Top:=formClock.Height-BitBtnMarHor.Height-off; end; - ImageList24x24.GetBitmap(2,BitBtnInitHor.Glyph); + ImageList24x24.GetBitmap(2,BitBtnInitHor.Glyph); // init horloge with BitBtnInitHor do begin Height:=26; @@ -426,7 +426,7 @@ begin end; end; -// fixer les valeurs maxi et mini de la taille de la fenetre +// fixer les valeurs maxi et mini de la taille de la fenetre de l'horloge procedure TFormClock.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); var MinMaxInfo : PMinMaxInfo; begin @@ -470,7 +470,7 @@ end; procedure TFormClock.TjsVerClick(Sender: TObject); begin - SetWindowPos(Handle,HWND_TOPMOST, 0, 0, 0, 0,SWP_NoMove or SWP_NoSize); + SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); // le checked ne fonctionne pas sous D7, fonctionne sous D12. TjsDev.Checked:=true; Dverrouiller1.Checked:=false; @@ -479,13 +479,12 @@ end; procedure TFormClock.Dverrouiller1Click(Sender: TObject); begin - SetWindowPos(Handle,HWND_NOTOPMOST, 0, 0, 0, 0,SWP_NoMove or SWP_NoSize); + SetWindowPos(Handle,HWND_NOTOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); TjsDev.Checked:=false; Dverrouiller1.Checked:=true; Verrouille:=false; end; - procedure affiche_horloge; begin if (formClock<>nil) then @@ -495,7 +494,6 @@ begin end; end; - procedure TFormClock.ButtonGHClick(Sender: TObject); begin formFicheHoraire.showModal; diff --git a/UnitConfig.dfm b/UnitConfig.dfm index f979869..e9e4b98 100644 --- a/UnitConfig.dfm +++ b/UnitConfig.dfm @@ -665,32 +665,19 @@ object FormConfig: TFormConfig TabOrder = 0 OnClick = ButtonAppliquerEtFermerClick end - object ButtonFSE: TButton - Left = 696 - Top = 440 - Width = 33 - Height = 25 - Hint = 'Ferme la fen'#234'tre sans enregistrer la configuration' - Caption = 'Fermer sans enregistrer la configuration' - ParentShowHint = False - ShowHint = True - TabOrder = 1 - Visible = False - OnClick = ButtonFSEClick - end object PageControl: TPageControl Left = 8 Top = 8 Width = 633 Height = 505 - ActivePage = TabSheetAig + ActivePage = TabSheetPeriph Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False - TabOrder = 2 + TabOrder = 1 OnChange = PageControlChange object TabSheetCDM: TTabSheet Caption = 'CDM Rail' @@ -1208,7 +1195,7 @@ object FormConfig: TFormConfig 'S'#233'lection du style d'#39#39'affichage - Le style sera chang'#233' '#224' la ferm' + 'eture de la fen'#234'tre'#39 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 0 @@ -2415,7 +2402,7 @@ object FormConfig: TFormConfig Width = 137 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 1 OnChange = ComboBoxDecChange end @@ -2546,7 +2533,7 @@ object FormConfig: TFormConfig Width = 137 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxAspChange end @@ -2854,7 +2841,7 @@ object FormConfig: TFormConfig Top = 56 Width = 193 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 0 OnChange = ComboBoxDecodeurPersoChange end @@ -2873,7 +2860,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxNationChange end @@ -2919,7 +2906,7 @@ object FormConfig: TFormConfig Width = 193 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 6 OnChange = ComboBoxDecCdeChange end @@ -3134,7 +3121,7 @@ object FormConfig: TFormConfig Top = 96 Width = 137 Height = 21 - ItemHeight = 13 + ItemHeight = 0 TabOrder = 2 OnChange = ComboBoxOperateurChange OnDrawItem = ComboBoxOperateurDrawItem @@ -3154,7 +3141,7 @@ object FormConfig: TFormConfig Top = 96 Width = 161 Height = 21 - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 4 @@ -3255,7 +3242,7 @@ object FormConfig: TFormConfig Width = 145 Height = 21 Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 TabOrder = 7 OnChange = ComboBoxFLChange end @@ -3337,9 +3324,7 @@ object FormConfig: TFormConfig 'Elles permettent de r'#233'aliser des combinaisons logiques d'#39#39#233'lemen' + 'ts divers comme ' - - 'l'#39#39#233'tat des aiguillages, d'#233'tecteurs, boutons TCO, m'#233'moires etc..' + - '.') + 'l'#39#233'tat des aiguillages, d'#233'tecteurs, boutons TCO, m'#233'moires etc...') ReadOnly = True TabOrder = 2 end @@ -3807,7 +3792,7 @@ object FormConfig: TFormConfig Height = 21 Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' Style = csDropDownList - ItemHeight = 13 + ItemHeight = 0 ParentShowHint = False ShowHint = True TabOrder = 10 @@ -4002,12 +3987,12 @@ object FormConfig: TFormConfig object Label19: TLabel Left = 8 Top = 8 - Width = 404 - Height = 16 + Width = 333 + Height = 13 Caption = 'Configuration de l'#39'interface DCC++ pour le mode autonome' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack - Font.Height = -13 + Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False @@ -4094,14 +4079,14 @@ object FormConfig: TFormConfig Caption = 'Trains' ImageIndex = 7 object Label54: TLabel - Left = 16 + Left = 8 Top = 8 - Width = 244 - Height = 16 + Width = 199 + Height = 13 Caption = 'Liste des trains d'#233'clar'#233's du r'#233'seau' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack - Font.Height = -13 + Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False @@ -4493,7 +4478,7 @@ object FormConfig: TFormConfig object LabeledEditCV3: TLabeledEdit Left = 224 Top = 136 - Width = 41 + Width = 33 Height = 21 EditLabel.Width = 135 EditLabel.Height = 13 @@ -4506,7 +4491,7 @@ object FormConfig: TFormConfig object LabeledEditCV4: TLabeledEdit Left = 224 Top = 160 - Width = 41 + Width = 33 Height = 21 EditLabel.Width = 135 EditLabel.Height = 13 @@ -4536,7 +4521,7 @@ object FormConfig: TFormConfig Height = 73 Font.Charset = ANSI_CHARSET Font.Color = clBlack - Font.Height = -12 + Font.Height = -13 Font.Name = 'Arial Narrow' Font.Style = [] ParentFont = False @@ -4544,9 +4529,9 @@ object FormConfig: TFormConfig TabOrder = 7 end object ButtonlCV3: TButton - Left = 272 + Left = 264 Top = 136 - Width = 27 + Width = 20 Height = 25 Hint = 'Lire le CV3 de la locomotive plac'#233'e sur la voie de programmation' Caption = 'CV' @@ -4556,9 +4541,9 @@ object FormConfig: TFormConfig OnClick = ButtonlCV3Click end object ButtonlCV4: TButton - Left = 272 + Left = 264 Top = 160 - Width = 27 + Width = 20 Height = 25 Hint = 'Lire le CV4 de la locomotive plac'#233'e sur la voie de programmation' Caption = 'CV' @@ -4567,6 +4552,18 @@ object FormConfig: TFormConfig TabOrder = 9 OnClick = ButtonlCV4Click end + object ButtonRepriseDCC: TButton + Left = 288 + Top = 144 + Width = 25 + Height = 25 + Hint = 'Repasse la centrale en mode DCC' + Caption = 'Dcc' + ParentShowHint = False + ShowHint = True + TabOrder = 10 + OnClick = ButtonRepriseDCCClick + end end end end @@ -4577,12 +4574,12 @@ object FormConfig: TFormConfig object Label73: TLabel Left = 8 Top = 8 - Width = 252 - Height = 16 + Width = 208 + Height = 13 Caption = 'P'#233'riph'#233'riques COM/USB ou Sockets' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack - Font.Height = -13 + Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False @@ -4879,12 +4876,12 @@ object FormConfig: TFormConfig object Label50: TLabel Left = 8 Top = 8 - Width = 216 - Height = 16 + Width = 176 + Height = 13 Caption = 'Param'#232'tres avanc'#233's et experts' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack - Font.Height = -13 + Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False @@ -4916,7 +4913,7 @@ object FormConfig: TFormConfig Caption = 'Enregistre la configuration' ParentShowHint = False ShowHint = True - TabOrder = 3 + TabOrder = 2 OnClick = ButtonEnregistreClick end object Panel1: TPanel @@ -4927,7 +4924,7 @@ object FormConfig: TFormConfig BevelWidth = 2 Caption = 'Fermer sans enregistrer la configuration' Color = clGradientActiveCaption - TabOrder = 4 + TabOrder = 3 OnClick = Panel1Click OnMouseDown = Panel1MouseDown OnMouseUp = Panel1MouseUp diff --git a/UnitConfig.pas b/UnitConfig.pas index 5ea6aa0..9d84ffa 100644 --- a/UnitConfig.pas +++ b/UnitConfig.pas @@ -418,7 +418,6 @@ type ImageListLogic: TImageList; Label63: TLabel; ComboBoxFL: TComboBox; - ButtonFSE: TButton; ButtonNouvFL: TButton; ButtonEvalue: TButton; LabeledEditNomLog: TLabeledEdit; @@ -444,6 +443,7 @@ type ButtonNouvPN: TButton; ButtonSupPN: TButton; Label58: TLabel; + ButtonRepriseDCC: TButton; procedure ButtonAppliquerEtFermerClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListBoxAigMouseDown(Sender: TObject; Button: TMouseButton; @@ -699,6 +699,7 @@ type procedure ComboStyleChange(Sender: TObject); procedure RadioGroupClClick(Sender: TObject); procedure ButtonlCV3Click(Sender: TObject); + procedure ButtonRepriseDCCClick(Sender: TObject); private { Déclarations privées } @@ -2030,7 +2031,7 @@ begin end; // encode une entrée de train -function Train_tablo(index : integer) : string; +function encode_train(index : integer) : string; var s: string; nc,i : integer; begin @@ -2038,7 +2039,7 @@ begin begin s:=nom_train+','+inttostr(adresse)+','+ intToSTR(vitmax)+','+intToSTR(vitnominale)+','+ - intToSTR(vitRalenti)+','+NomIcone+','+intToSTR(TempsDemarreSig)+','; + intToSTR(vitRalenti)+','+NomIcone+','+intToSTR(TempsDemarreSig)+','; if inverse then s:=s+'1,' else s:=s+'0,'; s:=s+intToSTR(longueur)+','+IntToSTR(ConsV1)+','+IntToSTR(ConsV2)+','+IntToSTR(ConsV3)+','; s:=s+FloatToSTRF(coeffV1,ffFixed,5,2,FormatSettings)+','+FloatToSTRF(coeffV2,ffFixed,5,2,FormatSettings)+','+FloatToSTRF(coeffV3,ffFixed,5,2,FormatSettings)+','; @@ -2381,7 +2382,7 @@ begin writeln(fichierN,section_trains_ch); for i:=1 to ntrains do begin - writeln(fichierN,Train_tablo(i)); + writeln(fichierN,encode_train(i)); // route du train for j:=1 to trains[i].routePref[0][0].adresse do begin @@ -2556,6 +2557,8 @@ begin end; + + // trier les aiguillages par adresses croissantes // et complète les aiguillages triples (créée aiguillahe homologue) procedure trier_aig; @@ -2690,11 +2693,35 @@ begin end; end; + +// trie les trains par adresses croissantes +// on utilise l'index 0 car si on déclare une variabe temporaire +// t : Ttrain +// on a une erreur de stack overflow à l'exécution car la structure de Ttrain est trop grosse +procedure trier_trains; +var i,j : integer; +begin + for i:=1 to ntrains-1 do + begin + for j:=i+1 to ntrains do + begin + if trains[i].Adresse>trains[j].adresse then + begin + trains[0]:=trains[i]; + trains[i]:=trains[j]; + trains[j]:=trains[0]; + end; + end; + end; + +end; + + // trouve les id des routesPref des trains et le stocke dedans procedure compile_id_routes; var t1,t2,r1,r2,Id,nr : integer; route1 : tUneroute; -begin +begin // raz tous les ID de routes for t1:=1 to nTrains do begin @@ -5634,6 +5661,7 @@ const LessThanValue=-1; begin trouve_section_trains:=true; compile_trains; + trier_trains; end; // section dédodeurs @@ -7884,10 +7912,9 @@ begin with ListBoxTrains do begin clear; - for i:=1 to ntrains do begin - s:=Train_tablo(i); + s:=encode_train(i); items.Add(s); l:=Length(s); if l>LongestLength then @@ -7897,6 +7924,10 @@ begin end; end; end; + ButtonlCV3.hint:='Passe la centrale en mode programmation et'+#13+ + 'lit le CV3 de la locomotive placée sur la voie de programmation'; + ButtonlCV4.hint:='Passe la centrale en mode programmation et'+#13+ + 'lit le CV4 de la locomotive placée sur la voie de programmation'; PixelLength:=ListboxTrains.Canvas.TextWidth(LongestString)+8; // positionne une scrollbar dans la listbox - pour l'enlever, envoyer 0 dans pixelLength @@ -13624,7 +13655,7 @@ begin if affevt then affiche('Evt change nom train',clyellow); if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; trains[ligneclicTrain+1].Nom_train:=EditNomTrain.text; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; i:=formprinc.ComboTrains.ItemIndex; @@ -13642,7 +13673,7 @@ begin val(EditAdresseTrain.text,i,erreur); if i<1 then exit; trains[ligneclicTrain+1].adresse:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -13655,7 +13686,7 @@ begin val(EditVitesseMaxi.text,i,erreur); if i<1 then exit; trains[ligneclicTrain+1].vitmax:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -13668,7 +13699,7 @@ begin val(EditLongLoco.text,i,erreur); if i<1 then exit; trains[ligneclicTrain+1].longueur:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -13684,7 +13715,7 @@ begin val(EditVitNom.text,i,erreur); if i<1 then exit; trains[ligneclicTrain+1].vitNominale:=i; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; end; @@ -13701,7 +13732,7 @@ begin val(EditVitRalenti.text,i,erreur); if i<1 then exit; trains[ligneclicTrain+1].vitRalenti:=i; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; end; @@ -13721,13 +13752,13 @@ begin ligneclicTrain:=ntrains-1; clicListe:=false; - formprinc.ComboTrains.Items.Add(Train_tablo(ntrains)); + formprinc.ComboTrains.Items.Add(encode_train(ntrains)); for i:=0 to ntrains-2 do formConfig.ListBoxTrains.selected[i]:=false; with formConfig.ListBoxTrains do begin - items.add(Train_tablo(ntrains)); + items.add(encode_train(ntrains)); selected[ntrains-1]:=true; SetFocus; perform(WM_VSCROLL,SB_BOTTOM,0); @@ -13772,6 +13803,15 @@ begin editVitNom.Text:=''; editVitesseMaxi.text:=''; editLongLoco.text:=''; + LabeledEditTempoD.text:=''; + checkboxSens.Checked:=false; + editIcone.Text:=''; + LabeledEditV1.Text:=''; + LabeledEditV2.Text:=''; + LabeledEditV3.Text:=''; + LabeledEditCV3.Text:=''; + LabeledEditCV4.Text:=''; + LabeledEditCrans.Text:=''; end; // suppression @@ -13797,7 +13837,7 @@ begin // réafficher la liste for i:=1 to ntrains do begin - s:=trains[i].nom_train+','+inttostr(trains[i].adresse)+','+intToSTR(trains[i].vitmax); + s:=encode_train(i); FormConfig.ListBoxtrains.items.Add(s); end; ligneclicTrain:=-1; @@ -15766,7 +15806,7 @@ begin with ListBoxTrains do begin clear; - for i:=1 to ntrains do items.Add(Train_tablo(i)); + for i:=1 to ntrains do items.Add(encode_train(i)); end; with StringGridArr do @@ -15962,7 +16002,7 @@ var s,repini :string; i : integer;begin if ligneclicTrain<0 then exit; trains[i].icone.Picture.LoadFromFile(s); //ImageTrain.Canvas.Rectangle(0,0,ImageTrain.Width,ImageTrain.Height); Maj_icone_train(formconfig.ImageTrain,i); - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); //formconfig.ImageTrain.Picture.assign(trains[i].icone.Picture); end; chDir(RepIni); @@ -15981,7 +16021,7 @@ var s,Nom,repIni : string;begin // Affiche(s,clWhite); trains[ligneclicTrain+1].icone.Picture.LoadFromFile(s); Maj_icone_train(formconfig.ImageTrain,ligneclicTrain+1); - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); end; end; @@ -15993,7 +16033,7 @@ var erreur,i :integer;begin val(LabeledEditTempoD.text,i,erreur); if i<0 then exit; trains[ligneclicTrain+1].TempsDemarreSig:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16003,7 +16043,7 @@ begin if clicliste then exit; if (ligneclicTrain<0) or (ligneclicTrain>=ntrains) or (ntrains<1) then exit; trains[ligneclicTrain+1].inverse:=CheckBoxSens.Checked; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); formconfig.ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16472,7 +16512,7 @@ begin begin trains[i].DetecteurArret[Arow].temps:=v; end; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16591,7 +16631,7 @@ begin end; end; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16618,7 +16658,7 @@ begin exit; end; end; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16645,14 +16685,14 @@ begin exit; end; end; - ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; procedure TFormConfig.EditDecalChange(Sender: TObject); -var r,i,erreur : integer; +var l,r,i,erreur : integer; begin if clicListe then exit; val(editDecal.Text,i,erreur); @@ -16663,16 +16703,32 @@ begin end; labelInfo.caption:=''; r:=adresse_detecteur[ligneclicDet+1]; + + l:=detecteur[r].longueur; + if i>=l then + begin + labelInfo.caption:='Erreur : la distance d''arrêt est supérieure à la longueur du détecteur'; + exit; + end; + + labelInfo.caption:=''; + detecteur[r].distArret:=i; ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1); ListBoxDet.selected[ligneclicDet]:=true; end; procedure TFormConfig.RadioButtonArrFinClick(Sender: TObject); -var r : integer; +var r,d,l : integer; begin if clicListe then exit; r:=adresse_detecteur[ligneclicDet+1]; + l:=detecteur[r].longueur; + d:=detecteur[r].distArret; + if d>=l then + begin + labelInfo.caption:='Erreur : la distance d''arrêt est supérieure à la longueur du détecteur'; + end; detecteur[r].ModeArret:=1; ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1); ListBoxDet.selected[ligneclicDet]:=true; @@ -16684,6 +16740,7 @@ begin if clicListe then exit; r:=adresse_detecteur[ligneclicDet+1]; detecteur[r].ModeArret:=2; + LabelInfo.Caption:=''; ListBoxDet.items[ligneclicDet]:=encode_detecteur(ligneclicDet+1); ListBoxDet.selected[ligneclicDet]:=true; end; @@ -16737,7 +16794,7 @@ begin val(LabeledEditCV3.text,i,erreur); if i<0 then exit; trains[ligneclicTrain+1].cv3:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16750,7 +16807,7 @@ begin val(LabeledEditCV4.text,i,erreur); if i<0 then exit; trains[ligneclicTrain+1].cv4:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; calculs; end; @@ -16764,7 +16821,7 @@ begin val(LabeledEditCrans.text,i,erreur); if i<0 then exit; trains[ligneclicTrain+1].Crans:=i; - formconfig.ListBoxTrains.items[ligneclicTrain]:=Train_tablo(ligneclicTrain+1); + formconfig.ListBoxTrains.items[ligneclicTrain]:=encode_train(ligneclicTrain+1); ListBoxTrains.selected[ligneclicTrain]:=true; end; @@ -16825,6 +16882,7 @@ procedure TFormConfig.LEAdrDetChange(Sender: TObject); var i,erreur : integer; s : string; begin + exit; if clicListe then exit; val(LEAdrDet.text,i,erreur); if (erreur<>0) or (i<1) then @@ -16840,7 +16898,7 @@ begin end; procedure TFormConfig.LElongDetChange(Sender: TObject); -var r,i,erreur :integer; +var r,i,d,erreur :integer; s : string; begin if clicListe then exit; @@ -16852,6 +16910,15 @@ begin end; labelInfo.caption:=''; r:=adresse_detecteur[ligneclicDet+1]; + + d:=detecteur[r].distArret; + if d>=i then + begin + labelInfo.caption:='Erreur : la longueur du détecteur est inférieure à la distance d''arrêt'; + exit; + end; + + labelInfo.caption:=''; detecteur[r].longueur:=i; s:=encode_detecteur(ligneclicDet+1); formconfig.ListBoxDet.items[ligneclicDet]:=s; @@ -18093,7 +18160,6 @@ begin end; procedure TFormConfig.ValueListEditorDrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState); -var coul : tColor; begin with ValueListEditor do begin @@ -18232,6 +18298,11 @@ begin end; +procedure TFormConfig.ButtonRepriseDCCClick(Sender: TObject); +begin + reprise_dcc; +end; + end. diff --git a/UnitConfigCellTCO.dfm b/UnitConfigCellTCO.dfm index f3a697e..bd0ce3a 100644 --- a/UnitConfigCellTCO.dfm +++ b/UnitConfigCellTCO.dfm @@ -561,8 +561,8 @@ object FormConfCellTCO: TFormConfCellTCO OnClick = BitBtnAnnuleClick end object GroupBoxCanton: TGroupBox - Left = 360 - Top = 288 + Left = 328 + Top = 280 Width = 281 Height = 129 Caption = 'Canton' diff --git a/UnitConfigCellTCO.pas b/UnitConfigCellTCO.pas index 8bc7805..2d238b3 100644 --- a/UnitConfigCellTCO.pas +++ b/UnitConfigCellTCO.pas @@ -254,20 +254,22 @@ begin with formConfCellTCO do begin // ramener la coordonnée cliquée à l'origine du canton - { - if (Bimage>=Id_cantonH) and (Bimage<=Id_cantonH+9) then + + if isCantonH(Bimage) then + //if (Bimage>=Id_cantonH) and (Bimage<=Id_cantonH+9) then begin H:=true; - xClicC:=xClicC-(Bimage-Id_cantonH); + //xClicC:=xClicC-(Bimage-Id_cantonH); end; - if (Bimage>=Id_cantonV) and (Bimage<=Id_cantonV+9) then + if isCantonV(Bimage) then + //if (Bimage>=Id_cantonV) and (Bimage<=Id_cantonV+9) then begin H:=false; - yClicC:=yClicC-(Bimage-Id_cantonV); + //yClicC:=yClicC-(Bimage-Id_cantonV); end; - XclicCell[indexTCO]:=XclicC; - YclicCell[indexTCO]:=YclicC; - } + //XclicCell[indexTCO]:=XclicC; + //YclicCell[indexTCO]:=YclicC; + idCanton:=index_canton(indexTCO,xclicC,yclicC); GroupBoxOrientation.visible:=false; @@ -519,15 +521,12 @@ begin if tco[indexTCO,Xclic,Yclic].adresse<>0 then s:=s+' Adr='+intToSTR(tco[indexTCO,XclicC,YclicC].adresse); //hint:=s; - if not(ConfCellTCO) then exit; actualize:=true; // évite les évènements parasites FormConfCellTCO.caption:='Propriétés de la cellule '+IntToSTR(XclicC)+','+intToSTR(YclicC)+' TCO '+intToSTR(IndexTCO); Bimage:=tco[indexTCO,XclicC,YclicC].Bimage; formConfCellTCO.EditTypeImage.Text:=intToSTR(Bimage); - - // mettre l'image de la cellule cliquée dans l'icone de la fenetre de config cellule if Bimage=0 then begin diff --git a/UnitDebug.dfm b/UnitDebug.dfm index a1c7af3..c7c9cb3 100644 --- a/UnitDebug.dfm +++ b/UnitDebug.dfm @@ -32,6 +32,7 @@ object FormDebug: TFormDebug Width = 872 Height = 677 HorzScrollBar.Visible = False + VertScrollBar.Position = 96 Anchors = [akLeft, akTop, akRight, akBottom] Color = clBtnFace ParentColor = False @@ -41,7 +42,7 @@ object FormDebug: TFormDebug 673) object LabelTitreDebug: TLabel Left = 475 - Top = 8 + Top = -88 Width = 131 Height = 18 Anchors = [akTop, akRight] @@ -55,7 +56,7 @@ object FormDebug: TFormDebug end object Label1: TLabel Left = 627 - Top = 10 + Top = -86 Width = 108 Height = 13 Anchors = [akTop, akRight] @@ -71,7 +72,7 @@ object FormDebug: TFormDebug end object RichDebug: TRichEdit Left = 0 - Top = 0 + Top = -96 Width = 454 Height = 753 Anchors = [akLeft, akTop, akRight] @@ -85,7 +86,7 @@ object FormDebug: TFormDebug end object ButtonRazTout: TButton Left = 465 - Top = 216 + Top = 120 Width = 97 Height = 25 Hint = @@ -100,7 +101,7 @@ object FormDebug: TFormDebug end object ButtonCop: TButton Left = 465 - Top = 248 + Top = 152 Width = 97 Height = 41 Anchors = [akTop, akRight] @@ -117,7 +118,7 @@ object FormDebug: TFormDebug end object ButtonAffEvtChrono: TButton Left = 465 - Top = 296 + Top = 200 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -128,7 +129,7 @@ object FormDebug: TFormDebug end object ButtonCherche: TButton Left = 465 - Top = 336 + Top = 240 Width = 97 Height = 25 Hint = 'Cherche la cha'#238'ne "erreur"' @@ -141,7 +142,7 @@ object FormDebug: TFormDebug end object ButtonEcrLog: TButton Left = 465 - Top = 184 + Top = 88 Width = 97 Height = 29 Anchors = [akTop, akRight] @@ -151,7 +152,7 @@ object FormDebug: TFormDebug end object ButtonRazTampon: TButton Left = 465 - Top = 368 + Top = 272 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -162,7 +163,7 @@ object FormDebug: TFormDebug end object ButtonRazLog: TButton Left = 465 - Top = 408 + Top = 312 Width = 97 Height = 33 Anchors = [akTop, akRight] @@ -173,7 +174,7 @@ object FormDebug: TFormDebug end object MemoEvtDet: TRichEdit Left = 570 - Top = 186 + Top = 90 Width = 272 Height = 263 Anchors = [akTop, akRight] @@ -184,7 +185,7 @@ object FormDebug: TFormDebug end object GroupBox5: TGroupBox Left = 462 - Top = 456 + Top = 360 Width = 380 Height = 57 Anchors = [akTop, akRight] @@ -251,7 +252,7 @@ object FormDebug: TFormDebug end object GroupBox6: TGroupBox Left = 462 - Top = 520 + Top = 424 Width = 380 Height = 52 Anchors = [akTop, akRight] @@ -328,7 +329,7 @@ object FormDebug: TFormDebug end object GroupBoxPrim: TGroupBox Left = 464 - Top = 584 + Top = 488 Width = 378 Height = 185 Anchors = [akTop, akRight] @@ -499,7 +500,7 @@ object FormDebug: TFormDebug end object GroupBox2: TGroupBox Left = 466 - Top = 28 + Top = -68 Width = 376 Height = 149 Anchors = [akTop, akRight] @@ -712,7 +713,7 @@ object FormDebug: TFormDebug end object EditNivDebug: TEdit Left = 751 - Top = 8 + Top = -88 Width = 49 Height = 21 Anchors = [akTop, akRight] diff --git a/UnitDebug.pas b/UnitDebug.pas index a35db30..9764e82 100644 --- a/UnitDebug.pas +++ b/UnitDebug.pas @@ -473,7 +473,7 @@ begin if (erreur<>0) or (adr<1) then exit; ancdebug:=NivDebug; NivDebug:=3; - if PresTrainPrec(Adr,Nb_cantons_Sig,false,adrtrain,voie) then AfficheDebug('Présence train '+intToSTR(AdrTrain),clYellow) else + if PresTrainPrec(Adr,Nb_cantons_Sig,true,adrtrain,voie) then AfficheDebug('Présence train @='+intToSTR(AdrTrain),clYellow) else AfficheDebug('Absence train',clyellow); NivDebug:=AncDebug; end; diff --git a/UnitMemZone.dfm b/UnitMemZone.dfm new file mode 100644 index 0000000..39cb5fd --- /dev/null +++ b/UnitMemZone.dfm @@ -0,0 +1,164 @@ +object FormMemZone: TFormMemZone + Left = 391 + Top = 155 + BorderStyle = bsDialog + Caption = 'Activer / d'#233'sactiver des m'#233'moires de zone' + ClientHeight = 173 + ClientWidth = 370 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 24 + Top = 8 + Width = 329 + Height = 33 + Caption = + 'Les m'#233'moires de zone sont constitu'#233'es de deux d'#233'tecteurs contigu' + + 's' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + WordWrap = True + end + object LabelInfo: TLabel + Left = 16 + Top = 120 + Width = 3 + Height = 13 + end + object Shape1: TShape + Left = 216 + Top = 88 + Width = 137 + Height = 9 + Brush.Color = clBlue + end + object Shape2: TShape + Left = 232 + Top = 83 + Width = 25 + Height = 20 + Brush.Color = clRed + end + object Shape3: TShape + Left = 312 + Top = 83 + Width = 25 + Height = 20 + Brush.Color = clRed + end + object Label2: TLabel + Left = 225 + Top = 56 + Width = 35 + Height = 19 + Caption = 'Det1' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object Label3: TLabel + Left = 304 + Top = 56 + Width = 35 + Height = 19 + Caption = 'Det2' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + end + object ButtonOk: TButton + Left = 280 + Top = 144 + Width = 75 + Height = 25 + Caption = 'Ok' + TabOrder = 0 + OnClick = ButtonOkClick + end + object LabeledEditDet1: TLabeledEdit + Left = 152 + Top = 56 + Width = 33 + Height = 21 + EditLabel.Width = 77 + EditLabel.Height = 13 + EditLabel.Caption = 'De : d'#233'tecteur 1' + LabelPosition = lpLeft + LabelSpacing = 10 + TabOrder = 1 + end + object LabeledEditDet2: TLabeledEdit + Left = 152 + Top = 88 + Width = 33 + Height = 21 + EditLabel.Width = 72 + EditLabel.Height = 13 + EditLabel.Caption = ' '#224' : d'#233'tecteur 2' + LabelPosition = lpLeft + LabelSpacing = 10 + TabOrder = 2 + end + object ButtonAct: TButton + Left = 8 + Top = 144 + Width = 75 + Height = 25 + Caption = 'Activer' + TabOrder = 3 + OnClick = ButtonActClick + end + object ButtonDes: TButton + Left = 96 + Top = 144 + Width = 75 + Height = 25 + Caption = 'D'#233'sactiver' + TabOrder = 4 + OnClick = ButtonDesClick + end + object ButtonClicDet1: TButton + Left = 24 + Top = 56 + Width = 25 + Height = 25 + Hint = 'Cliquer sur le d'#233'tecteur 1 dans le TCO' + Caption = 'Clic' + ParentShowHint = False + ShowHint = True + TabOrder = 5 + OnClick = ButtonClicDet1Click + end + object Button1: TButton + Left = 24 + Top = 84 + Width = 25 + Height = 25 + Hint = 'Cliquer sur le d'#233'tecteur 2 dans le TCO' + Caption = 'Clic' + ParentShowHint = False + ShowHint = True + TabOrder = 6 + OnClick = Button1Click + end +end diff --git a/UnitMemZone.pas b/UnitMemZone.pas new file mode 100644 index 0000000..b66c88d --- /dev/null +++ b/UnitMemZone.pas @@ -0,0 +1,159 @@ +unit UnitMemZone; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls; + +type + TFormMemZone = class(TForm) + ButtonOk: TButton; + LabeledEditDet1: TLabeledEdit; + LabeledEditDet2: TLabeledEdit; + Label1: TLabel; + LabelInfo: TLabel; + ButtonAct: TButton; + ButtonDes: TButton; + Shape1: TShape; + Shape2: TShape; + Shape3: TShape; + Label2: TLabel; + Label3: TLabel; + ButtonClicDet1: TButton; + Button1: TButton; + procedure ButtonOkClick(Sender: TObject); + procedure ButtonActClick(Sender: TObject); + procedure ButtonDesClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure ButtonClicDet1Click(Sender: TObject); + procedure Button1Click(Sender: TObject); + private + { Déclarations privées } + public + { Déclarations publiques } + end; + +var + FormMemZone: TFormMemZone; + det1Z,det2Z: integer; + formZone,clicDet1,clicDet2 : boolean; + +procedure actualise_memZone(indexTCO : integer); + +implementation + +uses UnitPrinc, unitTCO; + +{$R *.dfm} + +procedure actualise_memZone(indexTCO : integer); +var adr,x,y,Bim : integer; +begin + if (indexTCO=0) or (formMemZone=nil) or not(FormZone) then exit; + x:=XclicCell[indexTCO]; + y:=YclicCell[indexTCO]; + Bim:=Tco[indexTCO,x,y].bimage; + if IsVoieDroite(bim) then + begin + Adr:=tco[indexTCO,x,y].Adresse; + if (adr>0) and FormZone then + begin + if clicDet1 then formMemZone.LabeledEditdet1.Text:=intToStr(Adr); + if clicDet2 then formMemZone.LabeledEditdet2.Text:=intToStr(Adr); + clicDet1:=false; + clicDet2:=false; + Screen.Cursor:=crDefault; + end; + end; +end; + +procedure TFormMemZone.ButtonOkClick(Sender: TObject); +begin + FormZone:=false; + close; +end; + +function valide_det : boolean; +var erreur : integer; + elsuiv : tEquipement; +begin + result:=false; + val(FormMemZone.labeledEditDet1.text,det1Z,erreur); + if (erreur<>0) or (det1Z<1) or (det1Z>NbMaxDet) then + begin + FormMemZone.LabelInfo.Caption:='Erreur détecteur 1';exit; + end; + val(FormMemZone.labeledEditDet2.text,det2Z,erreur); + if (erreur<>0) or (det2Z<1) or (det2Z>NbMaxDet) then + begin + FormMemZone.LabelInfo.Caption:='Erreur détecteur 2';exit; + end; + + val(FormMemZone.labeledEditDet2.text,det2Z,erreur); + det_contigu(det1Z,det2Z,suivant,ElSuiv); + + if suivant=0 then + begin + FormMemZone.LabelInfo.Caption:='Les détecteurs '+intToSTR(det1Z)+' / '+intToSTR(det2Z)+' ne sont pas contigus'; + exit; + end; + FormMemZone.LabelInfo.caption:=''; + result:=true; +end; + +procedure TFormMemZone.ButtonActClick(Sender: TObject); +begin + if valide_det then + begin + Memzone[det1Z,det2Z].etat:=true; + LabelInfo.caption:='MemZone '+intToSTR(det1Z)+' -> '+intToSTR(det2Z)+' à 1'; + Maj_Signaux(false); + end; +end; + +procedure TFormMemZone.ButtonDesClick(Sender: TObject); +begin + if valide_det then + begin + Memzone[det1Z,det2Z].etat:=false; + LabelInfo.caption:='MemZone '+intToSTR(det1Z)+' -> '+intToSTR(det2Z)+' à 0'; + Maj_Signaux(false); + end; +end; + +procedure TFormMemZone.FormCreate(Sender: TObject); +begin + // fenêtre toujours devant + SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NoMove or SWP_NoSize); +end; + +procedure TFormMemZone.FormActivate(Sender: TObject); +begin + FormZone:=true; +end; + +procedure TFormMemZone.FormClose(Sender: TObject; + var Action: TCloseAction); +begin + clicDet1:=false; + clicDet2:=false; + Screen.Cursor:=crDefault; + FormZone:=false; +end; + +procedure TFormMemZone.ButtonClicDet1Click(Sender: TObject); +begin + clicDet1:=true; + Screen.Cursor:=crHandPoint; //crHourGlass; +end; + +procedure TFormMemZone.Button1Click(Sender: TObject); +begin + clicDet2:=true; + Screen.Cursor:=crHandPoint; +end; + +end. diff --git a/UnitMesure.pas b/UnitMesure.pas index afcc8de..de7d4d1 100644 --- a/UnitMesure.pas +++ b/UnitMesure.pas @@ -155,15 +155,72 @@ begin end; procedure TFormMesure.ButtonLanceMesClick(Sender: TObject); +var el1,el2,i,det_depart,el : integer; + t1,t2,t : Tequipement; + s: string; + boucle : boolean; begin if (IndexTrainMes<1) or mesureTrains then exit; + i:=trains[indexTrainMes].canton; // numéro du canton sur lequel le train se trouve + if i=0 then + begin + Affiche('Le train '+trains[indexTrainMes].nom_train+'ne se trouve sur aucun canton',clred); + exit; + end; + el1:=canton[i].el1; t1:=canton[i].typ1; + el2:=canton[i].el2; t2:=canton[i].typ2; + if t1=det then det_depart:=el1; + if t2=det then det_depart:=el2; + + i:=0; + repeat + el:=suivant_alg3(el1,t1,el2,t2,1); + t:=typeGen; + + el1:=el2;t1:=t2; + el2:=el;t2:=t; + + inc(i); + until (i>50) or (el>9000) or (el=det_depart); + + boucle:=true; + if el>9000 then + begin + if el=9996 then + begin + s:='La position de l''aiguillage '+intToSTR(el1)+' est inconnue'+#13; + s:=s+'L''itinéraire du train '+trains[indexTrainMes].nom_train+' peut ne pas être bouclé.'+#13; + boucle:=false; + end + else + begin + s:='Il n''est pas possible de déterminer si l''itinéraire du train '+trains[indexTrainMes].nom_train+' est bouclé.'+#13; + boucle:=false; + end; + end + else + if el<>det_depart then + begin + s:='Il n''est pas possible de déterminer si l''itinéraire du train '+trains[indexTrainMes].nom_train+' est bouclé.'+#13; + boucle:=false; + end; + + if not boucle then + begin + s:=s+'Voulez vous continuer?'; + if MessageDlg(s,mtConfirmation,[mbNo,mbYes],0)=mrNo then exit; + end; + ComboBoxTrains.Enabled:=false; ButtonLanceMes.Enabled:=false; Affiche('Mesure vitesse 1',clYellow); PhaseVitesse:=1; // vitesse 1 2 ou 3 DetecteurREF:=0; + + mesureTrains:=true; vitesse_loco('',0,trains[indexTrainMes].adresse,v1,10); + LabelMesC.Visible:=true; LabelMesC.top:=178; end; diff --git a/UnitModifAction.dfm b/UnitModifAction.dfm index 61a88a8..5186738 100644 --- a/UnitModifAction.dfm +++ b/UnitModifAction.dfm @@ -60,7 +60,7 @@ object FormModifAction: TFormModifAction Top = 64 Width = 729 Height = 337 - ActivePage = TabSheetDecl + ActivePage = TabSheetOp MultiLine = True TabOrder = 1 object TabSheetDecl: TTabSheet @@ -516,7 +516,7 @@ object FormModifAction: TFormModifAction Top = 32 Width = 217 Height = 21 - ItemHeight = 0 + ItemHeight = 13 TabOrder = 0 OnChange = ComboBoxFamilleChange end @@ -716,9 +716,9 @@ object FormModifAction: TFormModifAction Top = 144 Width = 201 Height = 21 - Hint = 'Nom de l'#39'accessoire d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' + Hint = 'Nom du p'#233'riph'#233'rique d'#233'fini dans l'#39'onglet "p'#233'riph'#233'riques COM/USB"' Style = csDropDownList - ItemHeight = 0 + ItemHeight = 13 ParentShowHint = False ShowHint = True TabOrder = 4 diff --git a/UnitPrinc.dfm b/UnitPrinc.dfm index 8890901..fdd25f8 100644 --- a/UnitPrinc.dfm +++ b/UnitPrinc.dfm @@ -2309,7 +2309,7 @@ object FormPrinc: TFormPrinc OnClick = Vrifiernouvelleversion1Click end end - object COs1: TMenuItem + object TCOs1: TMenuItem Caption = 'TCOs' object AffichertouslesTCO1: TMenuItem Caption = 'Afficher tous les TCO' @@ -2521,8 +2521,7 @@ object FormPrinc: TFormPrinc OnConnect = ClientSocketCde1Connect OnRead = ClientSocketCde1Read OnError = ClientSocketCde1Error - Left = 1072 - Top = 344 + Left = 360 end object ClientSocketCde2: TClientSocket Active = False @@ -2531,8 +2530,7 @@ object FormPrinc: TFormPrinc OnConnect = ClientSocketCde2Connect OnRead = ClientSocketCde2Read OnError = ClientSocketCde2Error - Left = 1072 - Top = 376 + Left = 392 end object ServerSocket: TServerSocket Active = False diff --git a/UnitPrinc.pas b/UnitPrinc.pas index bdf4fdc..a9ea091 100644 --- a/UnitPrinc.pas +++ b/UnitPrinc.pas @@ -169,7 +169,7 @@ type Coller1: TMenuItem; Affiche_fenetre_CDM: TMenuItem; ImageSignal20: TImage; - COs1: TMenuItem; + TCOs1: TMenuItem; AffichertouslesTCO1: TMenuItem; N10: TMenuItem; Mosaquehorizontale1: TMenuItem; @@ -289,8 +289,18 @@ type procedure ButtonDroitClick(Sender: TObject); procedure EditvalEnter(Sender: TObject); procedure BoutonRafClick(Sender: TObject); - procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket; - ErrorEvent: TErrorEvent; var ErrorCode: Integer); + + procedure ClientSocketInterfaceError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure ClientSocketInterfaceConnect(Sender: TObject;Socket: TCustomWinSocket); + procedure ClientSocketInterfaceDisconnect(Sender: TObject; Socket: TCustomWinSocket); + procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); + + procedure ClientInfoError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure ClientInfoConnect(Sender: TObject;Socket: TCustomWinSocket); + procedure ClientInfoDisconnect(Sender: TObject; Socket: TCustomWinSocket); + procedure ClientInfoRead(Sender: TObject; Socket: TCustomWinSocket); + + procedure MenuConnecterUSBClick(Sender: TObject); procedure DeconnecterUSBClick(Sender: TObject); procedure MenuConnecterEthernetClick(Sender: TObject); @@ -302,8 +312,7 @@ type procedure ClientSocketCDMError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); - procedure ClientSocketInterfaceConnect(Sender: TObject; - Socket: TCustomWinSocket); + procedure ClientSocketCDMConnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocketCDMRead(Sender: TObject; @@ -313,8 +322,6 @@ type procedure ClientSocketCDMDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure CodificationdessignauxClick(Sender: TObject); - procedure ClientSocketInterfaceDisconnect(Sender: TObject; - Socket: TCustomWinSocket); procedure FichierSimuClick(Sender: TObject); procedure ButtonEcrCVClick(Sender: TObject); procedure LireunfichierdeCV1Click(Sender: TObject); @@ -444,7 +451,6 @@ type procedure proc_checkBoxFV(Sender : Tobject); procedure proc_checkBoxFR(Sender : Tobject); procedure procAide(Sender : Tobject); - procedure ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); {$IF CompilerVersion >= 28.0} procedure DataReceived(const Data: TidBytes); {$ELSE} @@ -904,11 +910,92 @@ Tactionneur = record train : string; end; - TUneRoute=array[0..MaxParcoursTablo] of TelementRoute; // Une route TElroute=array[1..MaxRoutesCte] of TUneroute; // tableau de routes +// la longueur de la structure ttrain ne permet pas le passage de paramètre en procédure +tTrain = record + nom_train : string; + inverse : boolean; // placement + detecteurA : integer; // détecteur sur lequel le train se trouve + detecteurSuiv : integer; // détecteur vers lequel se dirige le train + ElSuivant : integer; // élément suivant vers lequel se dirige le train + TElSuivant : tEquipement; + adresse,vitmax,VitNominale,VitRalenti : integer; + AncVitesseCons : integer; // ancienne consigne + AVitesseCons : integer; // ancienne consigne du tick précédent + vitesseCons : integer; // vitesse Consigne actuelle de pilotage + VitesseReelleR : single; // Vitesse réelle calculée (tient compte de la décélération + VitesseReelle : integer; + sens : integer; // sens de déplacement, stockage provisoire pour restocker dans le tableau canton[] + longueur: integer; // longueur de la loco + compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s + cv3,cv4 : integer; + crans : integer; // crans du décodeur + // pilotage des trains------------------- + //TempoArret : integer; // tempo d'arret pour le timer + TempoArretCour : integer; // valeur dynamique + TempoDemarre : integer; // tempo de démarrage, valeur dynamique + TempsDemarreSig : integer; // temps de redémarrage du signal, valeur d'initialisation (fichier de config) + TempoArretTemp : integer; // temps d'arrêt temporisé sur un détecteur + index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train + arret_det : boolean; // arrêt du train sur le détecteur + phase_arret : integer; // numéro de phase arret + // mesure et étalonnage de la vitesse------ + VitesseDetE : integer; // vitesse en entrée du détecteur + VitesseDetS : integer; // vitesse en sortie du détecteur + //Temps_cour : integer; // compteur du temps en 1/10 s évolution pendant le détecteur à 1 + pointMes : integer; // pointeur de mesures 1 à 100 + // tableau des mesures + mesure : array[1..100] of record + // valeurs mesurées: + VitCons : integer; // vitesse de consigne en crans + detecteurM : integer; // détecteur + temps : integer; // temps de passage sur le détecteue à 1 (1/10s) + // valeurs calculées: + vr : single; // vitesse réelle calculée en cm/s + end; + // Mesure vitesse des trains: affectation des vitesses moyennes aux détecteurs rencontrés + // par detecteur (NbMaxDet) et par consigne (128 max) + detecteurR : array[0..NbMaxDet,1..128] of record + nombre : integer; + moyenne : single; // moyenne de la vitesse calculée par détecteur/ + ecart : single; // + somme : single; + end; + ConsV1,consV2,consV3 : integer; // consignes auxquels les coefficients V1 V2 V3 ont été calculés + CoeffV1,CoeffV2,CoeffV3 : single; // coefficients pour calculer la vitesse réelle en cm/s depuis la vitesse en crans + pente1,b1,pente2,b2 : single; // pente et b des 2 équations de droite de vitesse + //--------- + canton : integer ; // numéro du canton (pas index) sur lequel le train se trouve + icone : Timage ; + NomIcone : string; + // icone sur fenetre cdm (FormAnalyseCDM)--- + SbitMap : TBitmap ; // pointeur sur tampon sous l'icone de déplacement du train en page CDM + ax,ay,x,y : integer; // coordonnées du train (anciennes et nouvelles) en points windows + x0,y0,x1,y1 : integer; // ancien contour du tampon, pour l'animation dans la fenêtre cdm + // routes ----------------------------------- + roulage : integer; // =1 train en roulage mais arrêté pour réservation par tiers =2 en roulage effectif + dernierDet : integer; // dernier détecteur traité + cantonOrg,CantonDest : integer; // cantons origine et destination si route + route : TuneRoute; // tableau de la route en cours du train + NomRoute : array[1..30] of string; // nom de la route sauvegardée + NomRouteCour : string; // nom de la route courante + routePref : array[0..30] of TUneroute; // tableaux dess route sauvegardées du train. routePref[0,0].adresse est le nombre de routes + // routePref[0,0].talon = consigne inverse au train + PointRout : integer; + // cantons (via leurs déteceteurs) sur lesquels le train doit d'arrêter + DetecteurArret : array[1..NbDetArret] of record + Prec, // adresse précédent, pour le sens + detecteur, // détecteur sur lequel s'arreter si le canton a 2 détecteurs + temps : integer; // temps d'arrêt en s + TPrec : tEquipement; // aig ou det uniquement + end; + end; + + + TchaineBIN=array[0..Long_tampon_interface] of byte; {$IF CompilerVersion >= 28.0} // si delphi>=11 @@ -1131,82 +1218,8 @@ var end; // trains en roulage sur le réseau et de la base de données [section_trains] - trains : array[0..Max_Trains] of record - nom_train : string; - inverse : boolean; // placement - detecteurA : integer; // détecteur sur lequel le train se trouve - detecteurSuiv : integer; // détecteur vers lequel se dirige le train - adresse,vitmax,VitNominale,VitRalenti : integer; - AncVitesseCons : integer; // ancienne consigne - AVitesseCons : integer; // ancienne consigne du tick précédent - vitesseCons : integer; // vitesse Consigne actuelle de pilotage - VitesseReelleR : single; // Vitesse réelle calculée (tient compte de la décélération - VitesseReelle : integer; - sens : integer; // sens de déplacement, stockage provisoire pour restocker dans le tableau canton[] - longueur: integer; // longueur de la loco - compteur_consigne : integer; // compteur de consigne pour envoyer deux fois la vitesse en 10eme de s - cv3,cv4 : integer; - crans : integer; // crans du décodeur - // pilotage des trains------------------- - //TempoArret : integer; // tempo d'arret pour le timer - TempoArretCour : integer; // valeur dynamique - TempoDemarre : integer; // tempo de démarrage, valeur dynamique - TempsDemarreSig : integer; // temps de redémarrage du signal, valeur d'initialisation (fichier de config) - TempoArretTemp : integer; // temps d'arrêt temporisé sur un détecteur - index_event_det_train : integer; // index du train en cours de roulage du tableau event_det_train - arret_det : boolean; // arrêt du train sur le détecteur - phase_arret : integer; // numéro de phase arret - // mesure et étalonnage de la vitesse------ - VitesseDetE : integer; // vitesse en entrée du détecteur - VitesseDetS : integer; // vitesse en sortie du détecteur - //Temps_cour : integer; // compteur du temps en 1/10 s évolution pendant le détecteur à 1 - pointMes : integer; // pointeur de mesures 1 à 100 - // tableau des mesures - mesure : array[1..100] of record - // valeurs mesurées: - VitCons : integer; // vitesse de consigne en crans - detecteurM : integer; // détecteur - temps : integer; // temps de passage sur le détecteue à 1 (1/10s) - // valeurs calculées: - vr : single; // vitesse réelle calculée en cm/s - end; - // Mesure vitesse des trains: affectation des vitesses moyennes aux détecteurs rencontrés - // par detecteur (NbMaxDet) et par consigne (128 max) - detecteurR : array[0..NbMaxDet,1..128] of record - nombre : integer; - moyenne : single; // moyenne de la vitesse calculée par détecteur/ - ecart : single; // - somme : single; - end; - ConsV1,consV2,consV3 : integer; // consignes auxquels les coefficients V1 V2 V3 ont été calculés - CoeffV1,CoeffV2,CoeffV3 : single; // coefficients pour calculer la vitesse réelle en cm/s depuis la vitesse en crans - pente1,b1,pente2,b2 : single; // pente et b des 2 équations de droite de vitesse - //--------- - canton : integer ; // numéro du canton (pas index) sur lequel le train se trouve - icone : Timage ; - NomIcone : string; - // icone sur fenetre cdm (FormAnalyseCDM)--- - SbitMap : TBitmap ; // pointeur sur tampon sous l'icone de déplacement du train en page CDM - ax,ay,x,y : integer; // coordonnées du train (anciennes et nouvelles) en points windows - x0,y0,x1,y1 : integer; // ancien contour du tampon, pour l'animation dans la fenêtre cdm - // routes ----------------------------------- - roulage : integer; // =1 train en roulage mais arrêté pour réservation par tiers =2 en roulage effectif - dernierDet : integer; // dernier détecteur traité - cantonOrg,CantonDest : integer; // cantons origine et destination si route - route : TuneRoute; // tableau de la route en cours du train - NomRoute : array[1..30] of string; // nom de la route sauvegardée - NomRouteCour : string; // nom de la route courante - routePref : array[0..30] of TUneroute; // tableaux dess route sauvegardées du train. routePref[0,0].adresse est le nombre de routes - // routePref[0,0].talon = consigne inverse au train - PointRout : integer; - // cantons (via leurs déteceteurs) sur lesquels le train doit d'arrêter - DetecteurArret : array[1..NbDetArret] of record - Prec, // adresse précédent, pour le sens - detecteur, // détecteur sur lequel s'arreter si le canton a 2 détecteurs - temps : integer; // temps d'arrêt en s - TPrec : tEquipement; // aig ou det uniquement - end; - end; + // trains[0] est utilisé pour le tri. L'indice 1 contient le 1er train. + trains : array[0..Max_Trains] of tTrain; // éléments scannés et/ou verrouillés elements : array[1..Maxelements] of @@ -1250,6 +1263,7 @@ var ClientSocketIdInterface: tIdTCPClient; {$ENDIF} ClientSocketInterface: TClientSocket; + ClientInfo : TclientSocket; {$R *.dfm} @@ -1373,6 +1387,7 @@ procedure Fonction_Loco_Operation(loco,fonction,etat : integer); procedure calcul_equations_coeff(indexTrain : integer); procedure connecte_interface_ethernet; function lire_cv(cv : integer) : integer; +procedure reprise_dcc; implementation @@ -1581,7 +1596,7 @@ begin if s='carbon' then style[i].clarte:=sombre; if s='charcoal dark slate' then style[i].clarte:=sombre; if s='cobalt xemedia' then style[i].clarte:=sombre; - if s='copper' then style[i].clarte:=sombre; + if s='copper' then style[i].clarte:=clair; if s='copperdark' then style[i].clarte:=sombre; if s='coppervari' then style[i].clarte:=clair; if s='coppervaridark' then style[i].clarte:=clair; @@ -1709,7 +1724,7 @@ begin end; s:=style[index].NomCheminFichier; - // vérificztion si le fichier de style existe + // vérifie si le fichier de style existe if FileExists(s)=false then begin Affiche('Le fichier de style '+Nom_Style_aff+' est inexistant',clOrange); @@ -1972,7 +1987,9 @@ end; // renvoyer date heure, MAC, version SC , verif_version // ex 1 ... renvoie celui de la virtual box -procedure envoie_infos; +// mode=1 envoie en affichage +// mode=2 envoie au réseau +procedure envoie_infos(mode : integer); var ts : tstrings; s,cmd : string; retour,i,erreur : integer; @@ -1983,7 +2000,7 @@ begin cmd:='/c vol '+s+' >vol.txt'; // /c ferme la fenetre en fin d'exec /k ne ferme pas // si on fait un runas au lieu de open, çà ouvre une fenetre de demande admin sur les postes non admin // ou dont le niveau d'utilisateur est bas dans le profil - retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.Exe'),PChar(cmd),nil,SW_SHOWNORMAL); + retour:=ShellExecute(formprinc.Handle,pchar('open'),pchar('cmd.exe'),PChar(cmd),nil,SW_SHOWNORMAL); s:=''; if retour<=32 then begin @@ -2015,9 +2032,18 @@ begin begin s:=s+ts[i]+' '; end; - Affiche(s,clyellow); + if mode=1 then Affiche(s,clyellow); + if mode=2 then ClientInfo.Socket.SendText(s); + s:=DateToStr(date)+' '+TimeToStr(Time)+' V'+versionSC; - Affiche(s,clyellow); + {$IF CompilerVersion >= 28.0} + s:=s+' D12'; + {$IFEND} + {$IFDEF WIN64} // si compilé en 64 bits + s:=s+' x64'; + {$ENDIF} + if mode=1 then Affiche(s,clyellow); + if mode=2 then ClientInfo.Socket.SendText(s+#13+#10); //Affiche(GetCurrentDir,clyellow); @@ -2033,9 +2059,23 @@ begin s:=s+' Nbrefonctions='+intToSTR(NbreFL); s:=s+' NbrePeriph='+intToSTR(NbPeriph); - Affiche(s,clyellow); + if mode=1 then Affiche(s,clyellow); + if mode=2 then ClientInfo.Socket.SendText(s); end; +procedure menu_selec; +begin + // autoriser le menu + with formprinc do + begin + Afficher1.Enabled:=true; + Interface1.Enabled:=true; + Horaires1.Enabled:=true; + Divers1.Enabled:=true; + TCOs1.Enabled:=true; + Roulage1.Enabled:=true; + end; +end; procedure fin_preliminaire; var i,j : integer; @@ -2080,13 +2120,14 @@ begin interface_ou_cdm; // démarrer l'interface , génère les evts détecteurs ; ou cdm - - //envoie_infos; + formprinc.SetFocus; s:='Fin du préliminaire'; procetape(s); + menu_selec; + end; // renvoie une chaine ASCI Hexa affichable à partir d'une chaîne @@ -5005,11 +5046,9 @@ begin with Signaux[rang].Img do begin if debug=1 then affiche('Image '+intToSTR(rang)+' créée',clLime); - //canvas.Create; Autosize:=true; align:=alNone; Parent:=Formprinc.ScrollBoxSig; // dire que l'image est dans la scrollBox1 - //formprinc.ScrollBox1.Color:=ClGreen; Name:='ImageSignal'+IntToSTR(rang); // nom de l'image Top:=(HtImg+espY+20)*((rang-1) div NbreImagePLigne); // détermine les points d'origine Left:=10+ (LargImg+5)*((rang-1) mod (NbreImagePLigne)); @@ -12738,6 +12777,12 @@ begin Signal_precedent:=0; end; +// détermine si les détecteurs det1,det2 (contigus) sont dans le sens du signal AdrSig +function sensDetSignal(det1,det2,AdrSig : integer) : boolean; +begin + +end; + // présence train précédent les n (NbCtSig) cantons du signal Adresse, dans le sens d'avance vers le signal. // detect=true si on doit contrôler aussi sur les détecteurs @@ -12748,8 +12793,9 @@ end; function PresTrainPrec(Adresse,NbCtSig : integer;detect : boolean;var AdrTr,voie : integer) : boolean; var AdrSuiv,prec,ife,actuel,i,j,k,ifd,d,ia, - dernierdet,AdrSignal,Nsignaux,voieLoc,voie1,voie2,indexSig1,indexSig2 : integer; - TypePrec,TypeActuel : TEquipement; + dernierdet,AdrSignal,Nsignaux,voieLoc,voie1,voie2,indexSig1,indexSig2, + ElSuiv : integer; + Tsuiv,TypePrec,TypeActuel : TEquipement; Pres_train,malpositionne,etat,etatDet,EtatZone,tcanton : boolean; s : string; begin @@ -12818,7 +12864,7 @@ begin begin if roulage then AdrTr:=Detecteur[actuel].AdrTrain; end; - if pres_train and (nivDebug=3) then AfficheDebug('Présence train '+intToSTR(AdrTr)+' sur dét '+intToSTR(actuel),clyellow); + if pres_train and (nivDebug=3) then AfficheDebug('1.Présence train '+intToSTR(AdrTr)+' sur dét '+intToSTR(actuel),clyellow); TypeActuel:=det; if actuel=0 then @@ -12882,7 +12928,7 @@ begin begin if nivDebug=3 then begin - s:='Présence train '; + s:='2.Présence train '; if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' '; s:=s+'sur det '+intToSTR(actuel); AfficheDebug(s,clYellow); @@ -12908,6 +12954,8 @@ begin if typeactuel=det then begin etatDet:=Detecteur[actuel].etat and detect; + ElSuiv:=Detecteur[actuel].suivant; + Tsuiv:=detecteur[actuel].TypSuivant; etatZone:=MemZone[actuel,dernierdet].etat; Pres_train:=Pres_Train or EtatZone or EtatDet; @@ -12916,10 +12964,11 @@ begin if roulage then AdrTr:=MemZone[actuel,dernierdet].AdrTrain; // adresse if (nivDebug=3) then begin - s:='Présence train '; + s:='3.Présence train '; if AdrTr<>0 then s:=s+'@'+IntToSTR(AdrTr)+' '; if etatZone then s:=s+'de '+intToSTR(actuel)+' à '+intToSTR(dernierdet); if etatDet then s:=s+'sur det '+intToSTR(actuel); + if El<>0 then s:=s+' Elsuiv='+intToSTR(ElSuiv); AfficheDebug(s,clYellow); if debug=3 then formprinc.Caption:=''; end; @@ -12990,7 +13039,7 @@ begin until (j=10) or Pres_train or malpositionne or (Nsignaux>=NbCtSig); // on arrete jusqu'à trouver un train ou un signal ou si on va trop loin (10 itérations) inc(ife); until (ife>=5) or Pres_train; - if (NivDebug>0) then AfficheDebug('606. Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow); + //if (NivDebug>0) then AfficheDebug('606. Pas trouvé de signal suivant au '+intToSTR(adresse),clyellow); if debug=3 then formprinc.Caption:=''; voie:=ife-1; PresTrainPrec:=Pres_Train; @@ -13246,7 +13295,7 @@ begin if debug=3 then formprinc.Caption:=''; end; end; - //if AffSignal then AfficheDebug('Debut du traitement général',clYellow); + //if AffSignal then AfficheDebug('Debut du traitement général',clYellow); // traitement des feux >3 feux différents de violet (cas général) if (modele>=3) and (Signaux[index].EtatSignal<>violet_F) then begin @@ -18382,7 +18431,6 @@ function ProcessRunning(sExeName: String) : Boolean; var hSnapShot : THandle; ProcessEntry32 : TProcessEntry32; // pointeur sur la structure ProcessEntry32 processID : DWord; - //s : array[0..MAX_PATH - 1] of char; //PAnsiChar; begin Result:=false; hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); @@ -18854,6 +18902,21 @@ begin Maj_signaux(false); end; +procedure menu_deselec; +begin + // interdire le menu + with formprinc do + begin + Afficher1.Enabled:=false; + Interface1.Enabled:=false; + Horaires1.Enabled:=false; + Divers1.Enabled:=false; + TCOs1.Enabled:=false; + Roulage1.Enabled:=false; + end; +end; + + // positionnement des aiguillages au démarrage : seulement en mode autonome procedure init_aiguillages; var i,pos : integer; @@ -18866,6 +18929,9 @@ begin // 2eme fois pour positionner physiquement les aiguillages // et générer les evts de position // Affiche('Positionnement aiguillages',cyan); + + menu_deselec; + init_aig_cours:=true; for i:=1 to maxaiguillage do begin @@ -18904,6 +18970,10 @@ begin end; init_aig_cours:=false; Maj_Signaux(false); + + // autoriser le menu + menu_selec; + end; // positionne les composants de la fenêtre principale @@ -19495,6 +19565,26 @@ begin end; {$IFEND} +procedure tFormPrinc.ClientInfoError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer); +begin + //Affiche('IE',clyellow); + ErrorCode:=0; +end; +procedure tFormPrinc.ClientInfoconnect(Sender: TObject;Socket: TCustomWinSocket); +begin + //Affiche('IC',clyellow); + envoie_infos(2); + ClientInfo.Close; +end; +procedure tFormPrinc.ClientInfoDisconnect(Sender: TObject; Socket: TCustomWinSocket); +begin + //Affiche('ID',clyellow); +end; +procedure tFormPrinc.ClientInfoRead(Sender: TObject; Socket: TCustomWinSocket); +begin + //Affiche('IR',clyellow); +end; + // lecture depuis socket interface procedure TformPrinc.ClientSocketInterfaceRead(Sender: TObject; Socket: TCustomWinSocket); @@ -19522,9 +19612,9 @@ var n,t,i,j,index,OrgMilieu : integer; s,vc : string; trouve : boolean; Sr : TSearchRec; - comp : Tcomponent; tmP,tmA : tMenuItem; begin + menu_deselec; Ancien_Nom_Style:=''; Nom_style_aff:='windows'; af:='Client TCP-IP ou USB CDM Rail - Système XpressNet DCC++ Version '+VersionSC+sousVersion; @@ -19758,11 +19848,10 @@ begin end; - // création des composants MSComm (USB COM) ----------------- + // création des composants Comm (USB COM) ----------------- {$IF CompilerVersion >= 28.0} - // D12 - // composant AsycPro + // D12 composant AsyncPro try MSCommUSBInterface:=tApdComPort.Create(formprinc); except s:='Erreur 6000 : Composant Interface non créé'; @@ -19784,7 +19873,7 @@ begin if MsCommCde2<>nil then MSCommCde2.onTriggerAvail:=RecuPeriph2; {$IFDEF AvecIdTCP} - // composant Indy Interface réseausocket + // composant Indy Interface réseausocket en D12 : ne marche pas bien ClientSocketIdInterface:=TIdTCPClient.Create(self); try ThreadInterface:=TReadingThreadInterface.Create(ClientSocketIdInterface); @@ -19863,6 +19952,20 @@ begin if MsCommCde2<>nil then MSCommCde2.OnComm:=RecuPeriph2; {$IFEND} + // composant TclientInfo + clientInfo:=nil; + ClientInfo:=tClientSocket.Create(nil); + with ClientInfo do + begin + Address:='176.174.47.40'; + Port:=5107; + OnRead:=ClientInfoRead; + onConnect:=ClientInfoConnect; + OnDisconnect:=ClientInfoDisconnect; + OnError:=ClientInfoError; + Open; + end; + //s:=GetCurrentDir; //Affiche(s,clLime); if FindFirst('*.*', faAnyFile, SR) = 0 then @@ -19879,7 +19982,7 @@ begin end; if trouve then begin - // menu principal + // ajouter entrée dans le menu principal tmP:=TmenuItem.Create(MainMenu1); tmP.Caption:='Aide'; tmP.Name:='MiAide'; @@ -19948,7 +20051,6 @@ begin procetape('Lecture de la configuration'); lit_config; - {$IF CompilerVersion >= 28.0} //https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions change_style; @@ -20303,6 +20405,7 @@ begin {$ELSE} ClientSocketInterface.close; {$ENDIF} + clientInfo.Close; end; // appellé sur réception trame train CDM @@ -20975,6 +21078,7 @@ end; procedure TFormPrinc.BoutonRafClick(Sender: TObject); begin Maj_Signaux(false); + end; // erreur sur socket Lenz (interface XpressNet) @@ -22552,7 +22656,6 @@ begin end; end; - procedure TFormPrinc.ButtonArretSimuClick(Sender: TObject); begin Index_Simule:=0; // fin de simulation @@ -22563,8 +22666,8 @@ begin end; procedure TFormPrinc.OuvrirunfichiertramesCDM1Click(Sender: TObject); -var s : string; - fte : textFile; +var s : string; + fte : textFile; begin s:=GetCurrentDir; OpenDialog.InitialDir:=s; @@ -22645,7 +22748,6 @@ begin FenRich.SetFocus; end; - procedure TFormPrinc.Toutslectionner1Click(Sender: TObject); begin FenRich.SelectAll; @@ -22684,7 +22786,6 @@ begin end; end; - procedure TFormPrinc.Etatdeszonespartrain1Click(Sender: TObject); var i,j,n,train : integer; couleur : tcolor; @@ -22826,14 +22927,18 @@ begin t:=t+t1*NbreCellX[i]*NbreCellY[i]; Affiche('Taille des '+intToSTR(NbreTCO)+' TCOs : '+intToSTR(t)+' octets',clOrange); Affiche('Taille des aiguillages : '+intToSTR(SizeOf(aiguillage) )+' octets',clorange); + Affiche('Taille de la structure aiguillage : '+intToSTR(SizeOf(Taiguillage) )+' octets',clorange); Affiche('Taille des signaux : '+intToSTR(SizeOf(Signaux) )+' octets',clorange); + Affiche('Taille de la structure signal : '+intToSTR(SizeOf(Tsignal) )+' octets',clorange); Affiche('Taille des branches : '+intToSTR(SizeOf(brancheN) )+' octets',clorange); - Affiche('Taille des actionneurs standards: '+intToSTR(SizeOf(Tablo_Action))+' octets',clorange); - Affiche('Taille des actionneurs PN: '+intToSTR(SizeOf(Tablo_PN) )+' octets',clorange); + Affiche('Taille des trains : '+intToSTR(sizeOf(Trains) div 1024)+' Ko',clOrange); + Affiche('Taille de la structure train : '+intToSTR(sizeOf(Ttrain) div 1024)+' Ko',clOrange); + Affiche('Taille des actions : '+intToSTR(SizeOf(Tablo_Action))+' octets',clorange); + Affiche('Taille des PN: '+intToSTR(SizeOf(Tablo_PN) )+' octets',clorange); Affiche('Taille du tableau d''évènements détecteurs '+intToSTR(SizeOf(event_det) )+' octets',clorange); Affiche(' ',clyellow); - envoie_infos; + envoie_infos(1); end; // cliqué droit sur un signal puis sur le menu propriétés @@ -23115,14 +23220,9 @@ begin if (protocole=1) then demande_etat_acc ; end; -procedure TFormPrinc.RepriseDCC1Click(Sender: TObject); +procedure reprise_dcc; var s : string; begin - if (portcommOuvert=false) and (parsocketLenz=false) then - begin - Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange); - exit; - end; if protocole=1 then begin s:=#$21+#$81; @@ -23132,6 +23232,16 @@ begin if protocole=2 then envoi('<1>'); end; +procedure TFormPrinc.RepriseDCC1Click(Sender: TObject); +begin + if (portcommOuvert=false) and (parsocketLenz=false) then + begin + Affiche('L''interface n''est pas connectée par USB ou par Ethernet',clorange); + exit; + end; + reprise_dcc; +end; + procedure TFormPrinc.BoutonRazTrainsClick(Sender: TObject); begin Affiche('Raz tous trains et routes',clLime); @@ -26188,7 +26298,8 @@ begin Affiche('Train '+intToSTR(i)+' @='+intToSTR(trains[i].adresse)+' '+trains[i].nom_train+ ' Roulage='+intToSTR(trains[i].roulage)+ ' Vitesse='+intToSTR(trains[i].vitesseCons)+ - ' DernierDet='+intToSTR(trains[i].dernierDet) + ' DernierDet='+intToSTR(trains[i].dernierDet)+ + ' sur canton '+intToSTR(trains[i].canton) ,clyellow); // ' DetDepart='+intToSTR(trains[i].Det_depart)+' DetFin='+intToSTR(trains[i].Det_fin),clYellow); end; @@ -26206,6 +26317,7 @@ end; procedure TFormPrinc.MesurerlavitessedestrainsClick(Sender: TObject); begin + if not diffusion then FormMesure.showModal; if CDM_connecte then begin Affiche('La mesure de la vitesse des trains n''est disponible qu''en mode autonome sans CDM rail',clYellow); diff --git a/UnitTCO.dfm b/UnitTCO.dfm index e853217..7ed8d2d 100644 --- a/UnitTCO.dfm +++ b/UnitTCO.dfm @@ -1637,6 +1637,10 @@ object FormTCO: TFormTCO Caption = 'Trouver un '#233'l'#233'ment' OnClick = Trouverunlment1Click end + object Mmoiredezone1: TMenuItem + Caption = 'Activer/d'#233'sactiver m'#233'moire de zone' + OnClick = Mmoiredezone1Click + end object DessinerleTCO1: TMenuItem Caption = 'Dessiner le TCO' Hint = 'Dessine le TCO '#224' la souris' diff --git a/UnitTCO.pas b/UnitTCO.pas index 92fa1af..3fb6fd1 100644 --- a/UnitTCO.pas +++ b/UnitTCO.pas @@ -165,6 +165,7 @@ type Trouverunlment1: TMenuItem; ImageBt0Bistable: TImage; ImageBt1Bistable: TImage; + Mmoiredezone1: TMenuItem; //TimerTCO: TTimer; procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); @@ -403,6 +404,7 @@ type procedure Trouverunlment1Click(Sender: TObject); { Déclarations privées } function index_TCOMainMenu : integer; + procedure Mmoiredezone1Click(Sender: TObject); public { Déclarations publiques } end; @@ -696,11 +698,12 @@ function index_canton_numero(n : integer) : integer; procedure renseigne_TJDs_TCO; procedure Affiche_temps_arret(IdTrain,tps : integer); procedure titre_fenetre(indexTCO : integer); +function IsVoieDroite(i : integer) : boolean; implementation uses UnitConfigTCO, Unit_Pilote_aig, UnitConfigCellTCO, UnitClock, selection_train , - UnitRoute, UnitRouteTrains, UnitInfo, UnitIntro; + UnitRoute, UnitRouteTrains, UnitInfo, UnitIntro, UnitMemZone; {$R *.dfm} @@ -721,11 +724,11 @@ procedure coord_canton(indexTCO : integer;var x,y : integer); var el : integer; begin El:=TCO[indexTCO,x,y].BImage; - if (El>=Id_cantonH) and (El<=Id_cantonH+9) then + if isCantonH(El) then begin x:=x-(el-Id_cantonH); end; - if (El>=Id_cantonV) and (El<=Id_cantonV+9) then + if isCantonV(El) then begin y:=y-(el-Id_cantonV); end; @@ -736,7 +739,7 @@ function index_canton(IndexTCO,x,y : integer) : integer; var i : integer; trouve : boolean; begin - coord_canton(indexTCO,x,y); + coord_canton(indexTCO,x,y); // ramener les coordonnées à la première cellule i:=1; repeat trouve:=(canton[i].x=x) and (canton[i].y=y); @@ -2761,6 +2764,11 @@ begin end; end; +function IsVoieDroite(i : integer) : boolean; +begin + result:=(i=1) or (i=10) or (i=11) or (i=20); +end; + // renvoie vrai si l'élément i est un canton H ou V function IsCanton(i : integer) : boolean; begin @@ -2773,7 +2781,7 @@ begin result:=((i>=Id_cantonH) and (i<=Id_CantonH+9)); end; -// 2eme forme +// 2eme forme ; si x,y est un canton function IsCantonH(indexTCO,x,y : integer) : boolean; overload; var b : integer; begin @@ -2847,7 +2855,7 @@ begin repeat s:=s+st[i]+' '; inc(i); - //Affiche(s+' '+intToSTR(tf*length(s+st[i])),clyellow); + //Affiche(s+' '+intToSTR(tf*length(s+st[i])),clyellow); until (round(0.8*tf*length(s+st[i]))>larg) or (i>NombreMots); //yl:=(y-1)*round((l*tf)); delete(s,length(s),1); @@ -5477,14 +5485,12 @@ begin end; end; - procedure dessin_14(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); begin if graphisme=1 then dessin_14L(indexTco,Canvas,x,y,Mode); if graphisme=2 then dessin_14C(indexTco,Canvas,x,y,Mode); end; - // Element 15 procedure dessin_15L(indexTCO : integer;Canvas : Tcanvas;x,y : integer;Mode : integer); var x0,y0,xc,yc,xf,yf,x1,x2,y1,y2,x3,position,ep : integer; @@ -12025,8 +12031,11 @@ begin s101:='Supprime la colonne pointée'; popupMenu1.Items[10][1].Hint:=s101; - if MasqueBandeauTCO then bandeauMasque:=true; - + if MasqueBandeauTCO then + begin + bandeauMasque:=true; + Bandeau.Caption:='Afficher le bandeau'; + end; tcoCree:=true; if debug=1 then Affiche('Fin création fenêtre TCO',clLime); end; @@ -14991,13 +15000,14 @@ var n,iD,xg,yg : integer; begin if affevt then affiche('Debut_drag_train',clYellow); Id:=Index_canton_numero(Tco[indexTCO,x,y].NumCanton); - if id=0 then exit; + if (id=0) or Maj_signaux_cours then exit; n:=canton[Id].Nelements; horizontal:=canton[Id].horizontal; PImageTCO[indexTCO].BeginDrag(true); IdCantonDragOrg:=Id; + cantonOrg:=canton[id].numero; lDrag:=canton[id].Licone-1; hDrag:=canton[id].Hicone-1; xg:=canton[id].Xicone+1; // début de l'image du train (coord absolues) @@ -16334,7 +16344,7 @@ begin //detDepart:=0; exit; end; - // on clique sur le drapeau rouge + // on clique sur le drapeau vert ou rouge if (bt>=3) then // canton de destination begin // est-ce un canton de destination? @@ -16355,7 +16365,13 @@ begin if indextrain<>0 then begin indexTrainFR:=IndexTrain; // la formRouteTrain utilise IndexTrainFR - if (trains[indexTrain].route[0].adresse<>0) then formRouteTrain.show else formRoute.show; + if (trains[indexTrain].route[0].adresse<>0) then + begin + // afficher la fenetre des routes + formRouteTrain.PageControlRoutes.ActivePage:=formRouteTrain.TabSheetRA; + formRouteTrain.show; + end + else formRoute.show; end; AdrTrain:=canton[IdCantonClic].AdrTrainRoute; if AdrTrain<>0 then @@ -16729,6 +16745,7 @@ begin //if cantonSelect<>0 then exit; if not(selectionaffichee[indexTCO]) and (Tdoubleclic=0) then _entoure_cell_clic(indexTCO); actualise(indexTCO); // actualise la fenetre de config cellule + actualise_memZone(indexTCO); end; clicTCO:=false; @@ -16809,7 +16826,8 @@ begin end; idTrain:=canton[IdCantonSelect].indexTrain; - if (clicsouris) and (idTrain<>0) then if (trains[IdTrain].icone<>nil) and (trains[IdTrain].icone.width<>0) then + // ajouté Maj_signaux_cours car si on déplace un train pendant une maj de signaux, çà plante en fin de procédure TFormTCO.ImageTCOEndDrag + if (clicsouris) and (idTrain<>0) and not(Maj_signaux_cours) then if (trains[IdTrain].icone<>nil) and (trains[IdTrain].icone.width<>0) then begin debut_drag_train(IndexTCO,canton[IdCantonSelect].x,canton[IdCantonSelect].y); exit; @@ -17004,7 +17022,7 @@ begin begin NouvY:=yc; for i:=1 to n do Tco[indexTCO,xc,yc+i-1].BImage:=Id_CantonV+(i-1); - if n=Id_CantonH) and (El<=Id_CantonH+9)) or ((El>=Id_CantonV) and (El<=Id_CantonV+9)) then + if isCanton(El) then + //if ((El>=Id_CantonH) and (El<=Id_CantonH+9)) or ((El>=Id_CantonV) and (El<=Id_CantonV+9)) then begin formSelTrain.Show; end; @@ -18971,7 +19003,7 @@ end; procedure TFormTCO.ImageTCOEndDrag(Sender, Target: TObject; X, Y: Integer); var s : string; Sens,idCantondest,IdTrain,Bim,xdest,ydest,xOrg,Yorg,indexTCO,milieuX_pix,milieuY_pix, - xPix,yPix,adresse,AdrTrain,xDrag,yDrag : integer; + xPix,yPix,adresse,AdrTrain,xDrag,yDrag,trainDest,idTrainDest : integer; t : tequipement; begin if not(Target is TImage) then exit; @@ -19013,11 +19045,27 @@ begin // dessine le train sur le canton de destination //BitBlt(PcanvasTCO[indexTCO].handle,oldx+50,oldy,LIcone,hIcone,oldbmp.canvas.handle,0,0,SRCCOPY); - // ici on dépose sur un canton - IdCantonDest:=index_canton_numero(tco[IndexTCO,x,y].NumCanton); + // ici on dépose sur un canton AdrTrain:=canton[IdCantonDragOrg].adresseTrain; // train sur le canton source + cantonDest:=tco[IndexTCO,x,y].NumCanton; + IdCantonDest:=index_canton_numero(cantonDest); IdTrain:=index_train_adresse(AdrTrain); + + Traindest:=canton[IdcantonDest].adresseTrain; + idTrainDest:=index_train_adresse(TrainDest); + + if (TrainDest<>0) and (TrainDest<>AdrTrain) then + begin + s:='Le train '+Trains[idTrain].nom_train+' va écraser le train '+Trains[idTrainDest].nom_train+#13; + s:=s+'Voulez-vous continuer?'; + if Application.MessageBox(pchar(s),pchar('Confirmation'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION)=idNo then + begin + Affiche_tco(indexTCO); + exit; + end; + end; + // si le train du canton source a une route affectée if Trains[IdTrain].route[0].adresse<>0 then begin @@ -19053,7 +19101,7 @@ begin // vérifier si le sens de dépose est compatible avec le sens du canton if (canton[idcantonDest].SensCirc<>0) and (canton[idcantonDest].SensCirc<>sens) then - begin + begin s:='Le sens de circulation du canton '+intToSTR(canton[idcantonDest].numero)+' ne permet pas de positionner le train dans ce sens'; formTCO[indexTCO].Caption:=s; //Affiche(intToSTR(ypix),clred); @@ -19071,7 +19119,14 @@ begin // affectation train canton destination affecte_Train_canton(trains[idTrain].adresse,IdCantonDest,sens); - application.processMessages; + //application.processMessages; + + // si le canton destination était occupé au déplacement d'un train de canton + if (TrainDest<>0) and (cantonDest<>CantonOrg) then + begin + supprime_route_train(idTrainDest); + raz_cantons_train(TrainDest,true); // true=avec raz détecteur + end; Affiche_TCO(indexTCO); XclicCell[indexTCO]:=xDest; @@ -19162,6 +19217,13 @@ begin end; end; +procedure TFormTCO.Mmoiredezone1Click(Sender: TObject); +begin + FormMemZone.show; + FormMemZone.BringToFront; + +end; + end. diff --git a/selection_train.dfm b/selection_train.dfm index b3fda76..b082277 100644 --- a/selection_train.dfm +++ b/selection_train.dfm @@ -1,9 +1,10 @@ object FormSelTrain: TFormSelTrain Left = 405 Top = 201 - Width = 800 - Height = 464 + BorderStyle = bsDialog Caption = 'S'#233'lection train' + ClientHeight = 433 + ClientWidth = 792 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText diff --git a/selection_train.pas b/selection_train.pas index b0e152f..a634415 100644 --- a/selection_train.pas +++ b/selection_train.pas @@ -61,7 +61,7 @@ uses UnitConfigCellTCO,UnitTCO,unitconfig,unitDebug, UnitRouteTrains,UnitInfo; // i=index canton - AdrTrain=adresse du train - adresse=adresse du détecteur // attention le suivant et le précédent concernent le détecteur, pas le canton procedure Maj_detecteurs_canton(i,AdrTrain,adresse : integer); -var sens,e1c,e2c,prec,suivant : integer; +var j,sens,e1c,e2c,prec,suivant : integer; typeSuiv,t1,t2,typePrec : tequipement; trouve : boolean; begin @@ -116,6 +116,9 @@ begin detecteur[adresse].TypPrecedent:=typePrec; detecteur[adresse].AdrTrain:=AdrTrain; detecteur[adresse].Train:=canton[i].NomTrain; + j:=index_train_adresse(AdrTrain); + trains[j].ElSuivant:=suivant; + trains[j].tElSuivant:=typesuiv; end; end; @@ -206,6 +209,14 @@ begin end; end; + // supprimer le canton du train + i:=index_train_adresse(AdrTrain); + if i<>0 then + begin + trains[i].canton:=0; + end; + + // balayer les détecteurs pour trouver sur quel détecteur est le train pour le razer // non if raz then @@ -231,10 +242,10 @@ begin end; -// affecte le train id train ou adresse à l'Index canton et au TCO. +// affecte le train Adrtrain à l'Index canton dans le sens, et affecte la loco au détecteur à 1 du canton // désaffecte ce train pour tous les autres cantons // si adrTrain=9999 , train inconnu -// si adrTrain=0 ; efface +// si adrTrain=0 ; efface le train du canton // et les pointeurs de trains de l'idTrain sont razés procedure affecte_Train_canton(AdrTrain,idcanton,sens : integer); var idTrain,t,el1,el2 : integer; @@ -277,7 +288,7 @@ begin TCO[t,canton[idCanton].x,canton[idCanton].y].train:=idTrain; end; - // si l'un des deux détecteurs est à 1, affecter la loco au détecteur + // si l'un des deux éléments adjacents au canton est un détecteur à 1, affecter la loco au détecteur el1:=canton[IdCanton].el1;t1:=canton[IdCanton].typ1; el2:=canton[IdCanton].el2;t2:=canton[IdCanton].typ2; if (t1=det) and detecteur[el1].Etat then @@ -293,6 +304,8 @@ begin Maj_detecteurs_canton(idCanton,AdrTrain,el2); end; end; + //affiche('Det du canton '+intToSTR(canton[Idcanton].numero)+' det1='+intToSTR(canton[Idcanton].det1)+' det2='+intToSTR(canton[Idcanton].det2),clyellow); + end; // renvoie x,y El et indexCanton de IdCantonSelect en variable globale @@ -627,7 +640,6 @@ begin if (canton[IdCantonSelect].sensCirc<>0) then sensLoco:=canton[IdCantonSelect].sensCirc ; - //canton[IdCantonSelect].SensLoco:=sensLoco; affecte_Train_canton(trains[indexTrainClic].adresse,IdCantonSelect,sensLoco); // le train affecté contient la route du train razé LabelInfo.caption:='Affectation du train '+intToSTR(IndexTrainClic)+' '+trains[indexTrainClic].nom_train+' au canton '+intToSTR(canton[idcantonSelect].numero); maj_signaux(true); @@ -785,5 +797,7 @@ end; + + end. diff --git a/verif_version.pas b/verif_version.pas index d6115e5..2e112c5 100644 --- a/verif_version.pas +++ b/verif_version.pas @@ -26,7 +26,7 @@ var f : text; Const -VersionSC = '9.76'; // sert à la comparaison de la version publiée +VersionSC = '9.77'; // sert à la comparaison de la version publiée SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace // pour unzip SHCONTCH_NOPROGRESSBOX=4; diff --git a/versions.txt b/versions.txt index 5464e35..3fb17f6 100644 --- a/versions.txt +++ b/versions.txt @@ -30,7 +30,7 @@ version 1.74 : Am Version 1.75 : conditions supplémentaires permettant l'affichage d'un carré sur un signal en fonction des aiguillages dans le fichier config.cfg version 1.76 : Modification des aiguillages modélisés depuis le menu de configuration générale Les aiguillages BIS ne sont plus supportés car ils induisent des erreurs. - Correction d'un bug sur les feux dont l'élément suivant est un détecteur + Correction d'un bug sur les signaux dont l'élément suivant est un détecteur version 2.0 : Changement de description des TJD Amélioration de l'algorithme des routes Variables nommées dans config-GL.cfg @@ -307,6 +307,8 @@ version 9.75 : Corrections dans le TCO. version 9.76 : Amélioration de l'importation des réseaux depuis CDM rail. Correction de l'affichage du réseau CDM en version x64. Renforcement de la vérification de la configuration. +version 9.77 : Amélioratios diverses. + Correction de quelques bugs.